Heater
Posts: 12962
Joined: Tue Jul 17, 2012 3:02 pm

Re: A Final Fibonacci Challenge

Wed Jun 12, 2019 6:32 am

ScriptBasic,

No you should not be using the _ui versions of the functions. We are dealing with strings here, or mpz objects internally. Not any little unsigned ints.

Personally I think you should throw all that away and start again. It's a mess. It mixes up concerns, BASIC to C interfacing and big integer calculation. It's hard to understand, even for you apparently, it's hard to test.

What should happen is that the big integer maths function get split out into their own C file with their own header file. This makes them easy to understand, isolates the interface to GMP from the rest of the code, is easy to test with a test harness in C.

Then you interface.c module should only use the interface exposed by that big integers header file. It would only pass strings in and out. It should not contain any GMP calls or know anything about GMP so becomes easier to understand and test.

It's all about isolation of concerns.

To that end I have split the code into three files:

integer_strings.c - Contains the maths functions and all GMP interfacing.
integer_strings.h - Defines the interface to the above. Only strings as parameters and return values.
fibo_strings.h - The test harness for integer strings. Happens to be a fibo calculator.

Integer_strings.h

Code: Select all

//
//
// An experiment in doing integer arithmetic using GMP with all numbers represented by strings.
//
// By heater.
//

// Number base used for internal calculations by GMP.
#define IS_BASE 32

// Functions letis, addis, subis and mulis do large integer arithmetic on integers represented by strings.

void is_write(const char *s);

char* is_let(const char* s);

char* is_add(const char* s1, const char* s2);

char* is_sub(const char* s1, const char* s2);

char* is_mul(const char* s1, const char* s2);

char* is_base(const char *s, int base);

void is_init();

void is_clear();

integer_strings.c

Code: Select all

//
// An experiment in doing integer arithmetic using GMP with all numbers represented by strings.
//
// By heater.
// Modified June 11, 2019 to use base 32 strings for intermediate results.
//
#include <gmp.h>
#include <string.h>

#include "integer_strings.h"

// Functions letis, addis, subis and mulis do large integer arithmetic on integers represented by strings.
// WARNING: Not thread safe due to use of global op1, op2, res.

static mpz_t op1;
static mpz_t op2;
static mpz_t res;

char* is_base(const char *s, int base) {
    mpz_set_str (op1, s, IS_BASE);
    char* res_string = mpz_get_str (0, base, op1);
    return res_string;
}

char* is_let(const char* s) {
    return strdup(s);
}

char* is_add(const char* s1, const char* s2) {
    mpz_set_str (op1, s1, IS_BASE);
    mpz_set_str (op2, s2, IS_BASE);
    mpz_add (res, op1, op2);  // result = x * y
    char* res_string = mpz_get_str (0, IS_BASE, res); 
    return res_string;
}

char* is_sub(const char* s1, const char* s2) {
    mpz_set_str (op1, s1, IS_BASE);
    mpz_set_str (op2, s2, IS_BASE);
    mpz_sub (res, op1, op2);  // result = x * y
    char* res_string = mpz_get_str (0, IS_BASE, res); 
    return res_string;
}

char* is_mul(const char* s1, const char* s2) {
    mpz_set_str (op1, s1, IS_BASE);
    mpz_set_str (op2, s2, IS_BASE);
    mpz_mul (res, op1, op2);  // result = x * y
    char* res_string = mpz_get_str (0, IS_BASE, res); 
    return res_string;
}

void is_init() {
    mpz_init(op1);
    mpz_init(op2);
    mpz_init(res);

}

void is_clear() {
    mpz_clear(op1);
    mpz_clear(op2);
    mpz_clear(res);
}
fibo_strings.c

Code: Select all

//
// An experiment in doing integer arithmetic using GMP with all numbers represented by strings.
//
// By heater.
//
#include <stdio.h>
#include <stdlib.h>

#include "integer_strings.h"

char* fibos[3];

// Return the n'th Fibonacci number as a decimal string for integer n
char* fibo (int n) {
    char* res;
    if (n <= 2) {
        return is_let(fibos[n]);
    }

    int k = (n / 2);
    char* fk = fibo(k);
    char* fk1 = fibo(k + 1);
    char* a;
    char* b;
    if ((n % 2) == 0) {
        a = is_add(fk1, fk1);
        b = is_sub(a, fk);
        res = is_mul(fk, b);
    } else {
        a = is_mul(fk, fk);
        b = is_mul(fk1, fk1);
        res = is_add(a, b);
    }
    free(a);
    free(b);
    free(fk);
    free(fk1);
    return res;
}

int main(int argc, char* argv[]) {
    int n = 4784969;               // The first Fibonacci number with a million digits

    if (argc >= 2) {
        n = atoi(argv[1]);
    }

    is_init();

    fibos[0] = is_let("0");
    fibos[1] = is_let("1");
    fibos[2] = is_let("1");

    char* f = fibo(n);
    char* f10 = is_base(f, 10);
    puts(f10);
    free(f10);
    free(f);

    free(fibos[0]);
    free(fibos[1]);
    free(fibos[2]);

    is_clear();

    return (0);
}
I tested all this with valgrind. Seems memory leak free.

Code: Select all

$ gcc -Wall  -g -O0 -o fibo_strings fibo_strings.c integer_strings.c -lgmp
$ time ./fibo_strings | head -c 32 ;  time ./fibo_strings | tail -c 32
10727395641800477229364813596225
real    0m1.946s
user    0m1.891s
sys     0m0.016s
4856539211500699706378405156269

real    0m1.957s
user    0m1.906s
sys     0m0.063s
You might argue that the extra function call layer in the resulting BASC to C interface will reduce performance a bit. I suspect it's minimal and will hardly show up against all the other work we are doing here. The compiler might inline it all anyway.

All in the fibo repository: https://github.com/ZiCog/fibo_4784969/tree/master/c
Last edited by Heater on Wed Jun 12, 2019 7:21 am, edited 1 time in total.

jahboater
Posts: 4595
Joined: Wed Feb 04, 2015 6:38 pm

Re: A Final Fibonacci Challenge

Wed Jun 12, 2019 7:03 am

Heater wrote:
Tue Jun 11, 2019 7:33 pm
There are still errors when trying to use the address and memory sanitizers. But that seems to be inside mpz_set_str and I have no idea what to do about that yet.
I think that may be a bug in the sanitizer stuff.

1) get no errors at all with GCC 9.1 and with a lot more sanitizers switched on

2) the compiler cannot have instrumented mpz_set_str

I use:

Code: Select all

SAN = -fno-sanitize-recover=all          \
      -fsanitize=address                 \
      -fsanitize=undefined               \
      -fsanitize-address-use-after-scope \
      -fsanitize=leak                    \
      -fsanitize=bounds                  \
      -fsanitize=bounds-strict           \
      -fsanitize=integer-divide-by-zero  \
      -fsanitize=float-divide-by-zero    \
      -fsanitize=float-cast-overflow     \
      -fsanitize=unreachable             \
      -fsanitize=vla-bound               \
      -fsanitize=null                    \
      -fsanitize=signed-integer-overflow \
      -fsanitize=object-size             \
      -fsanitize=bool                    \
      -fsanitize=enum                    \
      -fsanitize=return                  \
      -fsanitize=shift                   \
      -fsanitize=alignment               \
      -fsanitize=builtin                 \
      -fsanitize=pointer-compare         \
      -fsanitize=pointer-subtract        \
      -fsanitize=pointer-overflow
and

Code: Select all

LD_PRELOAD=/usr/local/lib64/libasan.so:/usr/local/lib64/libubsan.so ./fibo_san
Edit: compiled with

Code: Select all

$(CC) fibo_strings.c -O3 -o fibo_san -fstack-protector-all $(SAN) -lgmp
to add stack checking.

The code is what you last published here, except that I removed memory.h which is never needed now (its all in string.h) and is just a one line wrapper file that includes string.h
Last edited by jahboater on Wed Jun 12, 2019 7:41 am, edited 2 times in total.

Heater
Posts: 12962
Joined: Tue Jul 17, 2012 3:02 pm

Re: A Final Fibonacci Challenge

Wed Jun 12, 2019 7:16 am

jahboater,

Thanks for checking that. I must get me a new C compiler.

I removed the redundant headers. Code in the repo.

Edit: I also changed is_base10(*s) to is_base(*s, int) so that strings in different bases can be produced.

User avatar
John_Spikowski
Posts: 1308
Joined: Wed Apr 03, 2019 5:53 pm
Location: Anacortes, WA USA
Contact: Website Twitter

Re: A Final Fibonacci Challenge

Wed Jun 12, 2019 1:05 pm

Heater wrote: Happens to be a fibo calculator.
I was looking to add BIGINT support for ScriptBasic not build a fibo calculator. GMP already has a fibo function.

I posted a framework for a GMP extenstion module. If anyone would like to get BIGINT support working in ScriptBasic, I would be happy to assist. I personally have no need for integers in this range.

Besides a million digit fibo, what other practical use does BIGINT provide? Calculating the square footage of the universe?
Last edited by John_Spikowski on Wed Jun 12, 2019 2:36 pm, edited 4 times in total.

Heater
Posts: 12962
Joined: Tue Jul 17, 2012 3:02 pm

Re: A Final Fibonacci Challenge

Wed Jun 12, 2019 1:22 pm

ScriptBasic,
I was looking to add BIGINT support for ScriptBasic not build a fibo calculator.
I don't understand why you have said that.

You have BIGINT support, using decimal string representation and GMP for the work offered on a plate. See integer_strings.c/h above.

You only have to do this simple job of interfacing ScriptBasic to some functions that take string parameters and return string results.

As stated the fibo_strings.c is only a test harness for integer_strings.c/h. Which is just as well as we shook all the memory leaks and the like out of it using that.

hippy
Posts: 5588
Joined: Fri Sep 09, 2011 10:34 pm
Location: UK

Re: A Final Fibonacci Challenge

Wed Jun 12, 2019 3:27 pm

Heater wrote:
Wed Jun 12, 2019 1:22 pm
You have BIGINT support, using decimal string representation and GMP for the work offered on a plate. See integer_strings.c/h above.

You only have to do this simple job of interfacing ScriptBasic to some functions that take string parameters and return string results.
The only issue I can foresee is that the C code passes char* pointers around, and I don't know how ScriptBasic handles those.

That Python doesn't was an issue I realised I had when trying to create a gmp based bigint library for Python. I know Python is intrinsically bigint, but it is a stepping stone to creating a library for Scriptbasic using my extension generating tools.

The easiest way of resolving that is to cast them to and from uint, have another wrapper layer for that. Then adjust the main code to use string, integer or those 'bigint uint'.

The libraries are done but I ran out of time to adjust the main code, get things tested, and determine what more needs to be done to make it work.

User avatar
John_Spikowski
Posts: 1308
Joined: Wed Apr 03, 2019 5:53 pm
Location: Anacortes, WA USA
Contact: Website Twitter

Re: A Final Fibonacci Challenge

Wed Jun 12, 2019 3:33 pm

The libraries are done but I ran out of time to adjust the main code, get things tested, and determine what more needs to be done to make it work.
My hero!

Looking forward to seeing YOUR ScriptBasic GMP extension module. (not just a fibo calcutator)
Last edited by John_Spikowski on Wed Jun 12, 2019 4:14 pm, edited 1 time in total.

hippy
Posts: 5588
Joined: Fri Sep 09, 2011 10:34 pm
Location: UK

Re: A Final Fibonacci Challenge

Wed Jun 12, 2019 4:14 pm

Seems to be working

Code: Select all

import BIGINT

bigintFibos = [None,None,None]

def bigintFibo(n):
  if (n <= 2):
    return BIGINT.ix_let(BIGINT.ix_asString(bigintFibos[n]))
  k = (n / 2)
  bigintFk = bigintFibo(k)
  bigintFk1 = bigintFibo(k + 1)
  if (n % 2) == 0:
    bigintA = BIGINT.ix_add(bigintFk1, bigintFk1)
    bigintB = BIGINT.ix_sub(bigintA, bigintFk)
    bigintR = BIGINT.ix_mul(bigintFk, bigintB)
  else:
    bigintA = BIGINT.ix_mul(bigintFk, bigintFk)
    bigintB = BIGINT.ix_mul(bigintFk1, bigintFk1)
    bigintR = BIGINT.ix_add(bigintA, bigintB)
  BIGINT.ix_free(bigintA)
  BIGINT.ix_free(bigintB)
  BIGINT.ix_free(bigintFk)
  BIGINT.ix_free(bigintFk1)
  return bigintR

def Main(n):

  BIGINT.ix_init()

  bigintFibos[0] = BIGINT.ix_let("0")
  bigintFibos[1] = BIGINT.ix_let("1")
  bigintFibos[2] = BIGINT.ix_let("1")

  bigintF = bigintFibo(n)
  bigintF10 = BIGINT.ix_base(bigintF, 10)
  print(BIGINT.ix_asString(bigintF10))
  BIGINT.ix_free(bigintF10)
  BIGINT.ix_free(bigintF)

  BIGINT.ix_free(bigintFibos[0])
  BIGINT.ix_free(bigintFibos[1])
  BIGINT.ix_free(bigintFibos[2])

  BIGINT.ix_clear()

Main( 4784969) # The first Fibonacci number with a million digits

Code: Select all

[email protected]:~/extensions $ time python bigintfibo.py | tail -c 40
407167474856539211500699706378405156269
real    1m18.817s
user    1m18.800s
sys     0m0.015s
And all the following is generated from -

bigint.def

Code: Select all

#module  BIGINT Heater's bigint stuff using gmp

#options ScriptBasic=/home/pi/sb-dev-cleanup, Python 2
#license Heater
#library "gmp"

#include <gmp.h>
#include <string.h>

#var static mpz_t op1;
#var static mpz_t op2;
#var static mpz_t res;

IS_BASE = 32

void ix_write(uint s)
uint ix_let(str s)
uint ix_add(uint s1, uint s2)
uint ix_sub(uint s1, uint s2)
uint ix_mul(uint s1, uint s2)
uint ix_base(uint s, int base)
void ix_init()
void ix_clear()
void ix_free(uint s)
str  ix_asString(uint s)

void !is_write(str s)
str  !is_let(str s)
str  !is_add(str s1, str s2)
str  !is_sub(str s1, str s2)
str  !is_mul(str s1, str s2)
str  !is_base(str s, int base)
void !is_init()
void !is_clear()
void !is_free(str s)
bigint.bas

Code: Select all


' *****************************************************************************
' *                                                                           *
' *  BIGINT extension module for ScriptBasic                                  *
' *                                                                           *
' *****************************************************************************

' PRODUCT "Heater's bigint stuff using gmp"
' PACKAGE "BIGINT"
' OPTIONS "ScriptBasic=/home/pi/sb-dev-cleanup, Python 2"
' LICENSE "Heater"
' VERSION "0.00"
' RELEASE "0009"
' CREATED "2019-06-12 15:35:55"
' TOUCHED "2019-06-12 16:56:45"

GLOBAL CONST IS_BASE = 32

MODULE BIGINT

DECLARE SUB ::ix_write    ALIAS "BIGINT_ix_write"    LIB "bigint"
DECLARE SUB ::ix_let      ALIAS "BIGINT_ix_let"      LIB "bigint"
DECLARE SUB ::ix_add      ALIAS "BIGINT_ix_add"      LIB "bigint"
DECLARE SUB ::ix_sub      ALIAS "BIGINT_ix_sub"      LIB "bigint"
DECLARE SUB ::ix_mul      ALIAS "BIGINT_ix_mul"      LIB "bigint"
DECLARE SUB ::ix_base     ALIAS "BIGINT_ix_base"     LIB "bigint"
DECLARE SUB ::ix_init     ALIAS "BIGINT_ix_init"     LIB "bigint"
DECLARE SUB ::ix_clear    ALIAS "BIGINT_ix_clear"    LIB "bigint"
DECLARE SUB ::ix_free     ALIAS "BIGINT_ix_free"     LIB "bigint"
DECLARE SUB ::ix_asString ALIAS "BIGINT_ix_asString" LIB "bigint"

END MODULE
interface.c

Code: Select all

// ****************************************************************************
// *                                                                          *
// *  Heater's bigint stuff using gmp                                         *
// *                                                                          *
// ****************************************************************************

#define PRODUCT "Heater's bigint stuff using gmp"
#define PACKAGE "BIGINT"
#define OPTIONS "ScriptBasic=/home/pi/sb-dev-cleanup, Python 2"
#define LIBRARY "gmp"
#define LICENSE "Heater"
#define VERSION "0.00"
#define RELEASE "0009"
#define CREATED "2019-06-12 15:35:55"
#define TOUCHED "2019-06-12 16:56:45"

// .--------------------------------------------------------------------------.
// |  Native C interfacing                                                    |
// `--------------------------------------------------------------------------'

#include "bigint.h"
#include "bigint.c"

// .--------------------------------------------------------------------------.
// |  ScriptBasic Extension Integration                                       |
// `--------------------------------------------------------------------------'

/*
UXLIBS: -lc
*/

#include "../../basext.h"
#include "../../basext.c"

// ****************************************************************************
// *                                                                          *
// *  ScriptBasic Extension Module Definition                                 *
// *                                                                          *
// ****************************************************************************

typedef struct _ModuleObject {
  void *HandleArray;
}ModuleObject,*pModuleObject;

besVERSION_NEGOTIATE
  return (int)INTERFACE_VERSION;
besEND

besSUB_START
  pModuleObject p;

  besMODULEPOINTER = besALLOC(sizeof(ModuleObject));
  if( besMODULEPOINTER == NULL )return 0;

  p = (pModuleObject)besMODULEPOINTER;
  return 0;
besEND

besSUB_FINISH
  pModuleObject p;

  p = (pModuleObject)besMODULEPOINTER;
  if( p == NULL )return 0;
  return 0;
besEND

// ****************************************************************************
// *                                                                          *
// *  ScriptBasic Extension Interfacing                                       *
// *                                                                          *
// ****************************************************************************

// .--------------------------------------------------------------------------.
// |  BIGINT::ix_write(s)                                                     |
// `--------------------------------------------------------------------------'

besFUNCTION(BIGINT_ix_write)
  long arg_s;
  besARGUMENTS("i")
    &arg_s
  besARGEND
  uint s = (uint) arg_s;
  ix_write(s);
besEND

// .--------------------------------------------------------------------------.
// |  (long) uint = BIGINT::ix_let(s)                                         |
// `--------------------------------------------------------------------------'

besFUNCTION(BIGINT_ix_let)
  char * s;
  besARGUMENTS("s")
    &s
  besARGEND
  besRETURN_LONG((long)ix_let(s))
besEND

// .--------------------------------------------------------------------------.
// |  (long) uint = BIGINT::ix_add(s1, s2)                                    |
// `--------------------------------------------------------------------------'

besFUNCTION(BIGINT_ix_add)
  long arg_s1;
  long arg_s2;
  besARGUMENTS("ii")
    &arg_s1, &arg_s2
  besARGEND
  uint s1 = (uint) arg_s1;
  uint s2 = (uint) arg_s2;
  besRETURN_LONG((long)ix_add(s1, s2))
besEND

// .--------------------------------------------------------------------------.
// |  (long) uint = BIGINT::ix_sub(s1, s2)                                    |
// `--------------------------------------------------------------------------'

besFUNCTION(BIGINT_ix_sub)
  long arg_s1;
  long arg_s2;
  besARGUMENTS("ii")
    &arg_s1, &arg_s2
  besARGEND
  uint s1 = (uint) arg_s1;
  uint s2 = (uint) arg_s2;
  besRETURN_LONG((long)ix_sub(s1, s2))
besEND

// .--------------------------------------------------------------------------.
// |  (long) uint = BIGINT::ix_mul(s1, s2)                                    |
// `--------------------------------------------------------------------------'

besFUNCTION(BIGINT_ix_mul)
  long arg_s1;
  long arg_s2;
  besARGUMENTS("ii")
    &arg_s1, &arg_s2
  besARGEND
  uint s1 = (uint) arg_s1;
  uint s2 = (uint) arg_s2;
  besRETURN_LONG((long)ix_mul(s1, s2))
besEND

// .--------------------------------------------------------------------------.
// |  (long) uint = BIGINT::ix_base(s, base)                                  |
// `--------------------------------------------------------------------------'

besFUNCTION(BIGINT_ix_base)
  long arg_s;
  long arg_base;
  besARGUMENTS("ii")
    &arg_s, &arg_base
  besARGEND
  uint s = (uint) arg_s;
  int base = (int) arg_base;
  besRETURN_LONG((long)ix_base(s, base))
besEND

// .--------------------------------------------------------------------------.
// |  BIGINT::ix_init()                                                       |
// `--------------------------------------------------------------------------'

besFUNCTION(BIGINT_ix_init)
  ix_init();
besEND

// .--------------------------------------------------------------------------.
// |  BIGINT::ix_clear()                                                      |
// `--------------------------------------------------------------------------'

besFUNCTION(BIGINT_ix_clear)
  ix_clear();
besEND

// .--------------------------------------------------------------------------.
// |  BIGINT::ix_free(s)                                                      |
// `--------------------------------------------------------------------------'

besFUNCTION(BIGINT_ix_free)
  long arg_s;
  besARGUMENTS("i")
    &arg_s
  besARGEND
  uint s = (uint) arg_s;
  ix_free(s);
besEND

// .--------------------------------------------------------------------------.
// |  string = BIGINT::ix_asString(s)                                         |
// `--------------------------------------------------------------------------'

besFUNCTION(BIGINT_ix_asString)
  long arg_s;
  besARGUMENTS("i")
    &arg_s
  besARGEND
  uint s = (uint) arg_s;
  besRETURN_STRING(ix_asString(s))
besEND
bigint.h

Code: Select all

// ****************************************************************************
// *                                                                          *
// *  Native C definitions for the BIGINT extension                           *
// *                                                                          *
// ****************************************************************************

#include <stdio.h>
#include <ctype.h>

#include "../../basext.h"

void   ix_write(uint s);
uint   ix_let(char * s);
uint   ix_add(uint s1, uint s2);
uint   ix_sub(uint s1, uint s2);
uint   ix_mul(uint s1, uint s2);
uint   ix_base(uint s, int base);
void   ix_init(void);
void   ix_clear(void);
void   ix_free(uint s);
char * ix_asString(uint s);
void   is_write(char * s);
char * is_let(char * s);
char * is_add(char * s1, char * s2);
char * is_sub(char * s1, char * s2);
char * is_mul(char * s1, char * s2);
char * is_base(char * s, int base);
void   is_init(void);
void   is_clear(void);
void   is_free(char * s);

// .--------------------------------------------------------------------------.
// |  Exposed module's variables / constants                                  |
// `--------------------------------------------------------------------------'

#define IS_BASE 32              // BIGINT::IS_BASE = 32
bigint.c

Code: Select all

// ****************************************************************************
// *                                                                          *
// *  Native C functionality of the BIGINT extension                          *
// *                                                                          *
// ****************************************************************************

#include "bigint.h"

#include <gmp.h>
#include <string.h>

// .--------------------------------------------------------------------------.
// |  Global variables                                                        |
// `--------------------------------------------------------------------------'

static mpz_t op1;
static mpz_t op2;
static mpz_t res;

// .--------------------------------------------------------------------------.
// |  ix_write(s)                                                             |
// `--------------------------------------------------------------------------'

void ix_write(uint s)
{
  // -- TO DO - Added by CREATE
}

// .--------------------------------------------------------------------------.
// |  uint = ix_let(s)                                                        |
// `--------------------------------------------------------------------------'

uint ix_let(char * s)
{
    return (uint) is_let(s);
}

// .--------------------------------------------------------------------------.
// |  uint = ix_add(s1, s2)                                                   |
// `--------------------------------------------------------------------------'

uint ix_add(uint s1, uint s2)
{
  return (uint) is_add((char*) s1, (char*) s2);
}

// .--------------------------------------------------------------------------.
// |  uint = ix_sub(s1, s2)                                                   |
// `--------------------------------------------------------------------------'

uint ix_sub(uint s1, uint s2)
{
  return (uint) is_sub((char*) s1, (char*) s2);
}

// .--------------------------------------------------------------------------.
// |  uint = ix_mul(s1, s2)                                                   |
// `--------------------------------------------------------------------------'

uint ix_mul(uint s1, uint s2)
{
  return (uint) is_mul((char*) s1, (char*) s2);
}

// .--------------------------------------------------------------------------.
// |  uint = ix_base(s, base)                                                 |
// `--------------------------------------------------------------------------'

uint ix_base(uint s, int base)
{
    return (uint) is_base((char*)s,base);
}

// .--------------------------------------------------------------------------.
// |  ix_init()                                                               |
// `--------------------------------------------------------------------------'

void ix_init(void)
{
    is_init();
}

// .--------------------------------------------------------------------------.
// |  ix_clear()                                                              |
// `--------------------------------------------------------------------------'

void ix_clear(void)
{
  is_clear();
}

// .--------------------------------------------------------------------------.
// |  ix_free(s)                                                              |
// `--------------------------------------------------------------------------'

void ix_free(uint s)
{
  is_free((char*)s);
}

// .--------------------------------------------------------------------------.
// |  string = ix_asString(s)                                                 |
// `--------------------------------------------------------------------------'

char * ix_asString(uint s)
{
  return (char*) s;
}

// .--------------------------------------------------------------------------.
// |  is_write(s)                                                             |
// `--------------------------------------------------------------------------'

void is_write(char * s)
{
  // -- TO DO - Added by CREATE
}

// .--------------------------------------------------------------------------.
// |  string = is_let(s)                                                      |
// `--------------------------------------------------------------------------'

char * is_let(char * s)
{
    return strdup(s);
}

// .--------------------------------------------------------------------------.
// |  string = is_add(s1, s2)                                                 |
// `--------------------------------------------------------------------------'

char * is_add(char * s1, char * s2)
{
    mpz_set_str (op1, s1, IS_BASE);
    mpz_set_str (op2, s2, IS_BASE);
    mpz_add (res, op1, op2);  // result = x * y
    char* res_string = mpz_get_str (0, IS_BASE, res);
    return res_string;
}

// .--------------------------------------------------------------------------.
// |  string = is_sub(s1, s2)                                                 |
// `--------------------------------------------------------------------------'

char * is_sub(char * s1, char * s2)
{
    mpz_set_str (op1, s1, IS_BASE);
    mpz_set_str (op2, s2, IS_BASE);
    mpz_sub (res, op1, op2);  // result = x * y
    char* res_string = mpz_get_str (0, IS_BASE, res);
    return res_string;
}

// .--------------------------------------------------------------------------.
// |  string = is_mul(s1, s2)                                                 |
// `--------------------------------------------------------------------------'

char * is_mul(char * s1, char * s2)
{
    mpz_set_str (op1, s1, IS_BASE);
    mpz_set_str (op2, s2, IS_BASE);
    mpz_mul (res, op1, op2);  // result = x * y
    char* res_string = mpz_get_str (0, IS_BASE, res);
    return res_string;
}

// .--------------------------------------------------------------------------.
// |  string = is_base(s, base)                                               |
// `--------------------------------------------------------------------------'

char * is_base(char * s, int base)
{
    mpz_set_str (op1, s, IS_BASE);
    char* res_string = mpz_get_str (0, base, op1);
    return res_string;
}

// .--------------------------------------------------------------------------.
// |  is_init()                                                               |
// `--------------------------------------------------------------------------'

void is_init(void)
{
    mpz_init(op1);
    mpz_init(op2);
    mpz_init(res);

}

// .--------------------------------------------------------------------------.
// |  is_clear()                                                              |
// `--------------------------------------------------------------------------'

void is_clear(void)
{
    mpz_clear(op1);
    mpz_clear(op2);
    mpz_clear(res);
}

// .--------------------------------------------------------------------------.
// |  is_free(s)                                                              |
// `--------------------------------------------------------------------------'

void is_free(char * s)
{
  free(s);
}

// ****************************************************************************
// *                                                                          *
// *  End of native C functionality of the BIGINT extension                   *
// *                                                                          *
// ****************************************************************************

User avatar
John_Spikowski
Posts: 1308
Joined: Wed Apr 03, 2019 5:53 pm
Location: Anacortes, WA USA
Contact: Website Twitter

Re: A Final Fibonacci Challenge

Wed Jun 12, 2019 4:21 pm

Wow!

What is the time for the ScriptBasic version?

hippy
Posts: 5588
Joined: Fri Sep 09, 2011 10:34 pm
Location: UK

Re: A Final Fibonacci Challenge

Wed Jun 12, 2019 4:40 pm

ScriptBasic wrote:
Wed Jun 12, 2019 4:21 pm
What is the time for the ScriptBasic version?
No idea. I don't have an SB version of 'bigintfibo.py'. In fact the SB library hasn't been tested at all. But it builds and I would expect it to work given the Python library does and it's effectively the same code.

User avatar
John_Spikowski
Posts: 1308
Joined: Wed Apr 03, 2019 5:53 pm
Location: Anacortes, WA USA
Contact: Website Twitter

Re: A Final Fibonacci Challenge

Wed Jun 12, 2019 4:45 pm

I'll give it a try and see where I get.

User avatar
John_Spikowski
Posts: 1308
Joined: Wed Apr 03, 2019 5:53 pm
Location: Anacortes, WA USA
Contact: Website Twitter

Re: A Final Fibonacci Challenge

Wed Jun 12, 2019 5:50 pm

@hippy,

Same boat as before. seg fault. Here is the changes and new bigintfibo.sb.

interface.c

Code: Select all

// ****************************************************************************
// *                                                                          *
// *  Heater's bigint stuff using gmp                                         *
// *                                                                          *
// ****************************************************************************

#define PRODUCT "Heater's bigint stuff using gmp"
#define PACKAGE "BIGINT"
#define OPTIONS "ScriptBasic=/home/pi/sb-dev-cleanup, Python 2"
#define LIBRARY "gmp"
#define LICENSE "Heater"
#define VERSION "0.00"
#define RELEASE "0009"
#define CREATED "2019-06-12 15:35:55"
#define TOUCHED "2019-06-12 16:56:45"

// .--------------------------------------------------------------------------.
// |  Native C interfacing                                                    |
// `--------------------------------------------------------------------------'

#include "bigint.h"
// #include "bigint.c"

// .--------------------------------------------------------------------------.
// |  ScriptBasic Extension Integration                                       |
// `--------------------------------------------------------------------------'

/*
UXLIBS: -lc -lgmp
*/

// #include "../../basext.h"
// #include "../../basext.c"

// ****************************************************************************
// *                                                                          *
// *  ScriptBasic Extension Module Definition                                 *
// *                                                                          *
// ****************************************************************************

typedef struct _ModuleObject {
  void *HandleArray;
}ModuleObject,*pModuleObject;

besVERSION_NEGOTIATE
  return (int)INTERFACE_VERSION;
besEND

besSUB_START
  pModuleObject p;

  besMODULEPOINTER = besALLOC(sizeof(ModuleObject));
  if( besMODULEPOINTER == NULL )return 0;

  p = (pModuleObject)besMODULEPOINTER;
  return 0;
besEND

besSUB_FINISH
  pModuleObject p;

  p = (pModuleObject)besMODULEPOINTER;
  if( p == NULL )return 0;
  return 0;
besEND

// ****************************************************************************
// *                                                                          *
// *  ScriptBasic Extension Interfacing                                       *
// *                                                                          *
// ****************************************************************************

// .--------------------------------------------------------------------------.
// |  BIGINT::ix_write(s)                                                     |
// `--------------------------------------------------------------------------'

besFUNCTION(BIGINT_ix_write)
  long arg_s;
  besARGUMENTS("i")
    &arg_s
  besARGEND
  uint s = (uint) arg_s;
  ix_write(s);
besEND

// .--------------------------------------------------------------------------.
// |  (long) uint = BIGINT::ix_let(s)                                         |
// `--------------------------------------------------------------------------'

besFUNCTION(BIGINT_ix_let)
  char * s;
  besARGUMENTS("s")
    &s
  besARGEND
  besRETURN_LONG((long)ix_let(s))
besEND

// .--------------------------------------------------------------------------.
// |  (long) uint = BIGINT::ix_add(s1, s2)                                    |
// `--------------------------------------------------------------------------'

besFUNCTION(BIGINT_ix_add)
  long arg_s1;
  long arg_s2;
  besARGUMENTS("ii")
    &arg_s1, &arg_s2
  besARGEND
  uint s1 = (uint) arg_s1;
  uint s2 = (uint) arg_s2;
  besRETURN_LONG((long)ix_add(s1, s2))
besEND

// .--------------------------------------------------------------------------.
// |  (long) uint = BIGINT::ix_sub(s1, s2)                                    |
// `--------------------------------------------------------------------------'

besFUNCTION(BIGINT_ix_sub)
  long arg_s1;
  long arg_s2;
  besARGUMENTS("ii")
    &arg_s1, &arg_s2
  besARGEND
  uint s1 = (uint) arg_s1;
  uint s2 = (uint) arg_s2;
  besRETURN_LONG((long)ix_sub(s1, s2))
besEND

// .--------------------------------------------------------------------------.
// |  (long) uint = BIGINT::ix_mul(s1, s2)                                    |
// `--------------------------------------------------------------------------'

besFUNCTION(BIGINT_ix_mul)
  long arg_s1;
  long arg_s2;
  besARGUMENTS("ii")
    &arg_s1, &arg_s2
  besARGEND
  uint s1 = (uint) arg_s1;
  uint s2 = (uint) arg_s2;
  besRETURN_LONG((long)ix_mul(s1, s2))
besEND

// .--------------------------------------------------------------------------.
// |  (long) uint = BIGINT::ix_base(s, base)                                  |
// `--------------------------------------------------------------------------'

besFUNCTION(BIGINT_ix_base)
  long arg_s;
  long arg_base;
  besARGUMENTS("ii")
    &arg_s, &arg_base
  besARGEND
  uint s = (uint) arg_s;
  int base = (int) arg_base;
  besRETURN_LONG((long)ix_base(s, base))
besEND

// .--------------------------------------------------------------------------.
// |  BIGINT::ix_init()                                                       |
// `--------------------------------------------------------------------------'

besFUNCTION(BIGINT_ix_init)
  ix_init();
besEND

// .--------------------------------------------------------------------------.
// |  BIGINT::ix_clear()                                                      |
// `--------------------------------------------------------------------------'

besFUNCTION(BIGINT_ix_clear)
  ix_clear();
besEND

// .--------------------------------------------------------------------------.
// |  BIGINT::ix_free(s)                                                      |
// `--------------------------------------------------------------------------'

besFUNCTION(BIGINT_ix_free)
  long arg_s;
  besARGUMENTS("i")
    &arg_s
  besARGEND
  uint s = (uint) arg_s;
  ix_free(s);
besEND

// .--------------------------------------------------------------------------.
// |  string = BIGINT::ix_asString(s)                                         |
// `--------------------------------------------------------------------------'

besFUNCTION(BIGINT_ix_asString)
  long arg_s;
  besARGUMENTS("i")
    &arg_s
  besARGEND
  uint s = (uint) arg_s;
  besRETURN_STRING(ix_asString(s))
besEND
bigint.h

Code: Select all

// ****************************************************************************
// *                                                                          *
// *  Native C definitions for the BIGINT extension                           *
// *                                                                          *
// ****************************************************************************

#include <stdio.h>
#include <ctype.h>

#include "../../basext.h"

void   ix_write(uint s);
uint   ix_let(char * s);
uint   ix_add(uint s1, uint s2);
uint   ix_sub(uint s1, uint s2);
uint   ix_mul(uint s1, uint s2);
uint   ix_base(uint s, int base);
void   ix_init(void);
void   ix_clear(void);
void   ix_free(uint s);
char * ix_asString(uint s);
void   is_write(char * s);
char * is_let(char * s);
char * is_add(char * s1, char * s2);
char * is_sub(char * s1, char * s2);
char * is_mul(char * s1, char * s2);
char * is_base(char * s, int base);
void   is_init(void);
void   is_clear(void);
void   is_free(char * s);

// .--------------------------------------------------------------------------.
// |  Exposed module's variables / constants                                  |
// `--------------------------------------------------------------------------'

#define IS_BASE 32              // BIGINT::IS_BASE = 32
bigint.c

Code: Select all

// ****************************************************************************
// *                                                                          *
// *  Native C functionality of the BIGINT extension                          *
// *                                                                          *
// ****************************************************************************

#include "bigint.h"

#include <gmp.h>
#include <string.h>

// .--------------------------------------------------------------------------.
// |  Global variables                                                        |
// `--------------------------------------------------------------------------'

static mpz_t op1;
static mpz_t op2;
static mpz_t res;

// .--------------------------------------------------------------------------.
// |  ix_write(s)                                                             |
// `--------------------------------------------------------------------------'

void ix_write(uint s)
{
  // -- TO DO - Added by CREATE
}

// .--------------------------------------------------------------------------.
// |  uint = ix_let(s)                                                        |
// `--------------------------------------------------------------------------'

uint ix_let(char * s)
{
    return (uint) is_let(s);
}

// .--------------------------------------------------------------------------.
// |  uint = ix_add(s1, s2)                                                   |
// `--------------------------------------------------------------------------'

uint ix_add(uint s1, uint s2)
{
  return (uint) is_add((char*) s1, (char*) s2);
}

// .--------------------------------------------------------------------------.
// |  uint = ix_sub(s1, s2)                                                   |
// `--------------------------------------------------------------------------'

uint ix_sub(uint s1, uint s2)
{
  return (uint) is_sub((char*) s1, (char*) s2);
}

// .--------------------------------------------------------------------------.
// |  uint = ix_mul(s1, s2)                                                   |
// `--------------------------------------------------------------------------'

uint ix_mul(uint s1, uint s2)
{
  return (uint) is_mul((char*) s1, (char*) s2);
}

// .--------------------------------------------------------------------------.
// |  uint = ix_base(s, base)                                                 |
// `--------------------------------------------------------------------------'

uint ix_base(uint s, int base)
{
    return (uint) is_base((char*)s,base);
}

// .--------------------------------------------------------------------------.
// |  ix_init()                                                               |
// `--------------------------------------------------------------------------'

void ix_init(void)
{
    is_init();
}

// .--------------------------------------------------------------------------.
// |  ix_clear()                                                              |
// `--------------------------------------------------------------------------'

void ix_clear(void)
{
  is_clear();
}

// .--------------------------------------------------------------------------.
// |  ix_free(s)                                                              |
// `--------------------------------------------------------------------------'

void ix_free(uint s)
{
  is_free((char*)s);
}

// .--------------------------------------------------------------------------.
// |  string = ix_asString(s)                                                 |
// `--------------------------------------------------------------------------'

char * ix_asString(uint s)
{
  return (char*) s;
}

// .--------------------------------------------------------------------------.
// |  is_write(s)                                                             |
// `--------------------------------------------------------------------------'

void is_write(char * s)
{
  // -- TO DO - Added by CREATE
}

// .--------------------------------------------------------------------------.
// |  string = is_let(s)                                                      |
// `--------------------------------------------------------------------------'

char * is_let(char * s)
{
    return strdup(s);
}

// .--------------------------------------------------------------------------.
// |  string = is_add(s1, s2)                                                 |
// `--------------------------------------------------------------------------'

char * is_add(char * s1, char * s2)
{
    mpz_set_str (op1, s1, IS_BASE);
    mpz_set_str (op2, s2, IS_BASE);
    mpz_add (res, op1, op2);  // result = x * y
    char* res_string = mpz_get_str (0, IS_BASE, res);
    return res_string;
}

// .--------------------------------------------------------------------------.
// |  string = is_sub(s1, s2)                                                 |
// `--------------------------------------------------------------------------'

char * is_sub(char * s1, char * s2)
{
    mpz_set_str (op1, s1, IS_BASE);
    mpz_set_str (op2, s2, IS_BASE);
    mpz_sub (res, op1, op2);  // result = x * y
    char* res_string = mpz_get_str (0, IS_BASE, res);
    return res_string;
}

// .--------------------------------------------------------------------------.
// |  string = is_mul(s1, s2)                                                 |
// `--------------------------------------------------------------------------'

char * is_mul(char * s1, char * s2)
{
    mpz_set_str (op1, s1, IS_BASE);
    mpz_set_str (op2, s2, IS_BASE);
    mpz_mul (res, op1, op2);  // result = x * y
    char* res_string = mpz_get_str (0, IS_BASE, res);
    return res_string;
}

// .--------------------------------------------------------------------------.
// |  string = is_base(s, base)                                               |
// `--------------------------------------------------------------------------'

char * is_base(char * s, int base)
{
    mpz_set_str (op1, s, IS_BASE);
    char* res_string = mpz_get_str (0, base, op1);
    return res_string;
}

// .--------------------------------------------------------------------------.
// |  is_init()                                                               |
// `--------------------------------------------------------------------------'

void is_init(void)
{
    mpz_init(op1);
    mpz_init(op2);
    mpz_init(res);

}

// .--------------------------------------------------------------------------.
// |  is_clear()                                                              |
// `--------------------------------------------------------------------------'

void is_clear(void)
{
    mpz_clear(op1);
    mpz_clear(op2);
    mpz_clear(res);
}

// .--------------------------------------------------------------------------.
// |  is_free(s)                                                              |
// `--------------------------------------------------------------------------'

void is_free(char * s)
{
  free(s);
}

// ****************************************************************************
// *                                                                          *
// *  End of native C functionality of the BIGINT extension                   *
// *                                                                          *
// ****************************************************************************

gmp.bas

Code: Select all


' *****************************************************************************
' *                                                                           *
' *  BIGINT extension module for ScriptBasic                                  *
' *                                                                           *
' *****************************************************************************

' PRODUCT "Heater's bigint stuff using gmp"
' PACKAGE "BIGINT"
' OPTIONS "ScriptBasic=/home/pi/sb-dev-cleanup, Python 2"
' LICENSE "Heater"
' VERSION "0.00"
' RELEASE "0009"
' CREATED "2019-06-12 15:35:55"
' TOUCHED "2019-06-12 16:56:45"

GLOBAL CONST IS_BASE = 32

MODULE GMP

DECLARE SUB ::ix_write    ALIAS "BIGINT_ix_write"    LIB "gmp"
DECLARE SUB ::ix_let      ALIAS "BIGINT_ix_let"      LIB "gmp"
DECLARE SUB ::ix_add      ALIAS "BIGINT_ix_add"      LIB "gmp"
DECLARE SUB ::ix_sub      ALIAS "BIGINT_ix_sub"      LIB "gmp"
DECLARE SUB ::ix_mul      ALIAS "BIGINT_ix_mul"      LIB "gmp"
DECLARE SUB ::ix_base     ALIAS "BIGINT_ix_base"     LIB "gmp"
DECLARE SUB ::ix_init     ALIAS "BIGINT_ix_init"     LIB "gmp"
DECLARE SUB ::ix_clear    ALIAS "BIGINT_ix_clear"    LIB "gmp"
DECLARE SUB ::ix_free     ALIAS "BIGINT_ix_free"     LIB "gmp"
DECLARE SUB ::ix_asString ALIAS "BIGINT_ix_asString" LIB "gmp"

END MODULE
bigintfibo.sb

Code: Select all

IMPORT gmp.bas

FUNCTION bigintFibo(n)
  IF n <= 2 THEN
    bigintFibo = GMP::ix_let(GMP::ix_asString(bigintFibos[n]))
  END IF
  k = (n / 2)
  bigintFk = bigintFibo(k)
  bigintFk1 = bigintFibo(k + 1)
  IF (n % 2) = 0 THEN
    bigintA = GMP::ix_add(bigintFk1, bigintFk1)
    bigintB = GMP::ix_sub(bigintA, bigintFk)
    bigintR = GMP::ix_mul(bigintFk, bigintB)
  ELSE
    bigintA = GMP::ix_mul(bigintFk, bigintFk)
    bigintB = GMP::ix_mul(bigintFk1, bigintFk1)
    bigintR = GMP::ix_add(bigintA, bigintB)
  END IF
  GMP::ix_free(bigintA)
  GMP::ix_free(bigintB)
  GMP::ix_free(bigintFk)
  GMP::ix_free(bigintFk1)
  bigintFibo = bigintR
END FUNCTION


' MAIN

GMP::ix_init()
bigintFibos[0] = GMP::ix_let("0")
bigintFibos[1] = GMP::ix_let("1")
bigintFibos[2] = GMP::ix_let("1")

bigintF = bigintFibo(n)
bigintF10 = GMP::ix_base(bigintF, 10)
PRINT LEN(GMP::ix_asString(bigintF10)),"\n"
GMP::ix_free(bigintF10)
GMP::ix_free(bigintF)

GMP::ix_free(bigintFibos[0])
GMP::ix_free(bigintFibos[1])
GMP::ix_free(bigintFibos[2])

GMP::ix_clear()

jahboater
Posts: 4595
Joined: Wed Feb 04, 2015 6:38 pm

Re: A Final Fibonacci Challenge

Wed Jun 12, 2019 6:13 pm

ScriptBasic wrote:
Wed Jun 12, 2019 5:50 pm
Same boat as before. seg fault. Here is the changes and new bigintfibo.sb.
Are you storing pointers in unsigned integers? (uint ?) If I misread it, please ignore me!

If so, I'm not surprised its seg faulting. Int's nowadays (on desktop computers anyway) are normally fixed at 32-bits.

In C you would use uintptr_t
Subtracting two pointers returns a ptrdiff_t (but a long is usually OK - except on Windows with MSVC).

See the ILP32 memory model and the LP64 memory model.

User avatar
John_Spikowski
Posts: 1308
Joined: Wed Apr 03, 2019 5:53 pm
Location: Anacortes, WA USA
Contact: Website Twitter

Re: A Final Fibonacci Challenge

Wed Jun 12, 2019 6:17 pm

The original GMP fibo function works that AIR assembled.

A bit overkill on the buffer def.

hippy
Posts: 5588
Joined: Fri Sep 09, 2011 10:34 pm
Location: UK

Re: A Final Fibonacci Challenge

Wed Jun 12, 2019 6:46 pm

ScriptBasic wrote:
Wed Jun 12, 2019 5:50 pm
Same boat as before. seg fault.
You could try putting printf() in all the routines to see where it's getting to when it fails.

I'm getting an undefined gmp symbol error when I try and run my version so I guess I'm not building things correctly -

Code: Select all

[email protected]:~/sb-dev-cleanup/extensions/bigint $ scriba bigintfibo.sb 
scriba: symbol lookup error: /usr/local/lib/scriba/bigint.so: undefined symbol: __gmpz_init
I'm guessing I need to modify the makefile.jam file to include a reference to the gmp library but have no idea how to.
Right; "UXLIBS: -lc -lgmp"

And then I get the same segmentation error.

And because I can auto-generate printf() tracing ...

Code: Select all

[email protected]:~/sb-dev-cleanup/extensions/bigint $ scriba bigintfibo.sb 
  Inside ix_init
  Inside is_init
  Inside ix_let
  Inside is_let
  Inside ix_let
  Inside is_let
  Inside ix_let
  Inside is_let
Segmentation fault
And from that the bug can be determined to be in -

Code: Select all

bigintFibos[2] = BIGINT::ix_let("1")
Not sure why, because is_let seems to be getting a meaningful char*s value.
Last edited by hippy on Wed Jun 12, 2019 7:17 pm, edited 1 time in total.

User avatar
John_Spikowski
Posts: 1308
Joined: Wed Apr 03, 2019 5:53 pm
Location: Anacortes, WA USA
Contact: Website Twitter

Re: A Final Fibonacci Challenge

Wed Jun 12, 2019 7:10 pm

Positive news is you're able to pass strings before it blows up.

I would try using 3 strings rather than using an array.

hippy
Posts: 5588
Joined: Fri Sep 09, 2011 10:34 pm
Location: UK

Re: A Final Fibonacci Challenge

Wed Jun 12, 2019 7:37 pm

ScriptBasic wrote:
Wed Jun 12, 2019 7:10 pm
I would try using 3 strings rather than using an array.
Actually I was wrong. It seems to get further than that.

I'd also change that "IF n <=2 THEN ... ENDIF" to a "...ELSE" or it falls through into the rest of the function's code. Initialising "n" helps. As does printing the actual fibo result rather than its length.

With those fixes, n=0, n=1, n=2 seem to work, but n=3 ...

Code: Select all

*** Error in `scriba': double free or corruption (fasttop): 0x00810be8 ***
Aborted
If seems bigintB and bigintFk are pointing to the same address, so when you free bigintB you can't then free bigintFk.

Heater
Posts: 12962
Joined: Tue Jul 17, 2012 3:02 pm

Re: A Final Fibonacci Challenge

Wed Jun 12, 2019 7:50 pm

Given that ScriptBasic has no interest in big integer arithmetic or big Fibonacci numbers:
Besides a million digit fibo, what other practical use does BIGINT provide?
Would it be OK if discussion of ScriptBasic extensions to do that was taken elsewhere?

This is a (big) Fibonacci challenge thread after all.

User avatar
John_Spikowski
Posts: 1308
Joined: Wed Apr 03, 2019 5:53 pm
Location: Anacortes, WA USA
Contact: Website Twitter

Re: A Final Fibonacci Challenge

Wed Jun 12, 2019 7:59 pm

Sounds like you are.almost home. Nice job!

Maybe if you besDeref for the passed string arguments then it won't be an issue.
Last edited by John_Spikowski on Thu Jun 13, 2019 12:24 am, edited 3 times in total.

hippy
Posts: 5588
Joined: Fri Sep 09, 2011 10:34 pm
Location: UK

Re: A Final Fibonacci Challenge

Wed Jun 12, 2019 9:08 pm

jahboater wrote:
Wed Jun 12, 2019 6:13 pm
ScriptBasic wrote:
Wed Jun 12, 2019 5:50 pm
Same boat as before. seg fault. Here is the changes and new bigintfibo.sb.
Are you storing pointers in unsigned integers? (uint ?) If I misread it, please ignore me!

If so, I'm not surprised its seg faulting. Int's nowadays (on desktop computers anyway) are normally fixed at 32-bits.

In C you would use uintptr_t
Thanks for the info.

It's my fault we're using uint. As the Pi only has 1GB of memory, a 32-bit wide address bus, I figured a uint would be okay. And other mitigations are, I'm no C expert, I just wanted something which I could make work quickly, and my extension generator only understands the simpler C types :P

Given the uint casting seems to work with Python, I would expect it to also work with ScriptBasic, as the bottom level C code is the same in both cases. I don't think the uint casting is the cause of the seg fault.

I'm not going to dispute that xxxptr_t should be used but, for extensions, anything being passed back to the host language has to be coerced into something it can understand, and that's usually uint, int, long, float or double, so there's going to have to be some sort of casting to those at some point. It's really then just a question of where one does that casting.

I would probably agree that, ideally, 'C should be C' with low-level routines returning the appropriate type, only the interface doing any casting. I guess it's time to add support for 'ptr' types in my extension generator.

jahboater
Posts: 4595
Joined: Wed Feb 04, 2015 6:38 pm

Re: A Final Fibonacci Challenge

Wed Jun 12, 2019 9:38 pm

hippy wrote:
Wed Jun 12, 2019 9:08 pm
I'm not going to dispute that xxxptr_t should be used but, for extensions, anything being passed back to the host language has to be coerced into something it can understand, and that's usually uint, int, long, float or double, so there's going to have to be some sort of casting to those at some point. It's really then just a question of where one does that casting.
Yes, difficult problem.
Perhaps choose long, or unsigned long for the C side as that will change in size like a pointer does.

int is 32-bits and that should work on the Pi (Raspbian) because it has 32-bit addresses.
Move the code to an Intel pc, or a 64-bit OS on the Pi, then it probably wont work (or it it does, its "just luck" and that's never good)!

Your right though, the best thing is if BASIC could have pointers.

User avatar
John_Spikowski
Posts: 1308
Joined: Wed Apr 03, 2019 5:53 pm
Location: Anacortes, WA USA
Contact: Website Twitter

Re: A Final Fibonacci Challenge

Thu Jun 13, 2019 12:05 am

I use LONG for pointers on all 32/64 platforms.

User avatar
John_Spikowski
Posts: 1308
Joined: Wed Apr 03, 2019 5:53 pm
Location: Anacortes, WA USA
Contact: Website Twitter

Re: A Final Fibonacci Challenge

Thu Jun 13, 2019 5:40 am

I was able to get it to work. I'm using BASE = 10 with everything in a numeric string. No LET, SET, CLEAR, ... or whatever needed. I tried the 1 million digit challenge but it killed the task. So I did a fibo(10000) instead.

interface.c

Code: Select all

/* GMP Extension Module
UXLIBS: -lc -lgmp
*/

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <unistd.h>
#include <gmp.h>
#include "../../basext.h"

static mpz_t op1;
static mpz_t op2;


/**************************
 Extension Module Functions
**************************/


typedef struct _ModuleObject {
  void *HandleArray;
}ModuleObject,*pModuleObject;


besVERSION_NEGOTIATE
  return (int)INTERFACE_VERSION;
besEND


besSUB_START
  pModuleObject p;
  besMODULEPOINTER = besALLOC(sizeof(ModuleObject));
  if( besMODULEPOINTER == NULL )return 0;
  p = (pModuleObject)besMODULEPOINTER;
  return 0;
besEND


besSUB_FINISH
  pModuleObject p;
  p = (pModuleObject)besMODULEPOINTER;
  if( p == NULL )return 0;
  return 0;
besEND


/*************
 GMP Functions
*************/


besFUNCTION(fibo)
  int fval;

  besARGUMENTS("i")
    &fval
  besARGEND

  char buf[1500000];
  memset(buf,0,1);
  mpz_t res;
  mpz_init(res);

  mpz_fib_ui(res, fval);

  gmp_snprintf( buf,sizeof(buf),"%Zd", res );

  besRETURN_STRING(buf);

besEND


besFUNCTION(bi_add)
  const char* s1;
  const char* s2;

  besARGUMENTS("zz")
    &s1, &s2
  besARGEND

  char buf[1500000];
  memset(buf,0,1);
  mpz_init(op1);
  mpz_init(op2);
  mpz_set_str(op1, s1, 10);
  mpz_set_str(op2, s2, 10);
  mpz_t res;
  mpz_init(res);

  mpz_add(res, op1, op2);
  gmp_snprintf(buf, sizeof(buf), "%Zd", res);

  besRETURN_STRING(buf);

besEND


besFUNCTION(bi_sub)
  const char* s1;
  const char* s2;

  besARGUMENTS("zz")
    &s1, &s2
  besARGEND

  char buf[1500000];
  memset(buf,0,1);
  mpz_init(op1);
  mpz_init(op2);
  mpz_set_str(op1, s1, 10);
  mpz_set_str(op2, s2, 10);
  mpz_t res;
  mpz_init(res);

  mpz_sub (res, op1, op2);
  gmp_snprintf(buf, sizeof(buf), "%Zd", res);

  besRETURN_STRING(buf);

besEND


besFUNCTION(bi_mul)
  const char* s1;
  const char* s2;

  besARGUMENTS("zz")
    &s1, &s2
  besARGEND

  char buf[1500000];
  memset(buf,0,1);
  mpz_init(op1);
  mpz_init(op2);
  mpz_set_str(op1, s1, 10);
  mpz_set_str(op2, s2, 10);
  mpz_t res;
  mpz_init(res);

  mpz_mul (res, op1, op2);
  gmp_snprintf(buf, sizeof(buf), "%Zd", res);

  besRETURN_STRING(buf);

besEND
sfibo.sb

Code: Select all

DECLARE SUB BI_ADD    ALIAS  "bi_add"  LIB "gmp"

FUNCTION sfibo (n)
  IF n < 2 THEN
    sfibo = 1
  ELSE
    m = 0
    p = 1
    q = 0
    FOR i = 2 TO n
      m = BI_ADD(p, q)
      q = p
      p = m
    NEXT i
    sfibo = m
  END IF
END FUNCTION

PRINT sfibo(10000),"\n"
Output

Code: Select all

[email protected]:~/sb/GMP$ time scriba sfibo.sb
33644764876431783266621612005107543310302148460680063906564769974680081442166662368155595513633734025582065332680836159373734790483865268263040892463056431887354544369559827491606602099884183933864652731300088830269235673613135117579297437854413752130520504347701602264758318906527890855154366159582987279682987510631200575428783453215515103870818298969791613127856265033195487140214287532698187962046936097879900350962302291026368131493195275630227837628441540360584402572114334961180023091208287046088923962328835461505776583271252546093591128203925285393434620904245248929403901706233888991085841065183173360437470737908552631764325733993712871937587746897479926305837065742830161637408969178426378624212835258112820516370298089332099905707920064367426202389783111470054074998459250360633560933883831923386783056136435351892133279732908133732642652633989763922723407882928177953580570993691049175470808931841056146322338217465637321248226383092103297701648054726243842374862411453093812206564914032751086643394517512161526545361333111314042436854805106765843493523836959653428071768775328348234345557366719731392746273629108210679280784718035329131176778924659089938635459327894523777674406192240337638674004021330343297496902028328145933418826817683893072003634795623117103101291953169794607632737589253530772552375943788434504067715555779056450443016640119462580972216729758615026968443146952034614932291105970676243268515992834709891284706740862008587135016260312071903172086094081298321581077282076353186624611278245537208532365305775956430072517744315051539600905168603220349163222640885248852433158051534849622434848299380905070483482449327453732624567755879089187190803662058009594743150052402532709746995318770724376825907419939632265984147498193609285223945039707165443156421328157688908058783183404917434556270520223564846495196112460268313970975069382648706613264507665074611512677522748621598642530711298441182622661057163515069260029861704945425047491378115154139941550671256271197133252763631939606902895650288268608362241082050562430701794976171121233066073310059947366875

real	0m0.504s
user	0m0.475s
sys	0m0.028s
[email protected]:~/sb/GMP$ 

Heater
Posts: 12962
Joined: Tue Jul 17, 2012 3:02 pm

Re: A Final Fibonacci Challenge

Thu Jun 13, 2019 7:53 am

That leaks memory. Every call to mpz_init() should have a corresponding mpz_clear()

What does "besRETURN_STRING(buf);" do? Hope it's not returning a pointer to a buffer on the stack.

User avatar
PeterO
Posts: 4873
Joined: Sun Jul 22, 2012 4:14 pm

Re: A Final Fibonacci Challenge

Thu Jun 13, 2019 9:36 am

Way back near the start of the "challenge" I posted an Algol-60 version. This was written for the compiler on the Elliott 803 that I look after at
The National Museum of Computing (https://www.tnmoc.org/)

Another machine we have in our "Large Systems Gallery" is an ICL 2966. This actually operates in ICL 1900 mode and runs the George3 operating system, which includes and Algol-60 compiler.

There is an emulator for George3 that runs under Widows,PC Linux AND Raspbian ! When the 2966 is not turned on (most of the time) a PI running George3 is used instead to provide visitors with access to some demonstrations.

Anyway... Back to the point .....

Here is my challenge entry converted to the ICL 1900 Algol-60 dialect. As before it only calculates the first 500 numbers, but since the 2966 is faster and has more memory than the 803 it could produce more of the sequence. Also it is a 24 bit machine so each integer can only hold 6 digits.

Code: Select all


'BEGIN' 'INTEGER' N,M,COUNT,LIM,LZFMT,CTFMT;
'INTEGER' 'ARRAY' A, B, C[1:20], SZFMT[1:6]; 


'PROCEDURE' PUTI(A); 'INTEGER' 'ARRAY' A; 
'BEGIN' 'INTEGER' J,ND,AA; 
'BOOLEAN' ALLZERO;
   ALLZERO := 'TRUE';
   
   'FOR' J := N 'STEP' -1 'UNTIL' 1 'DO'

   'BEGIN'
       'IF' 'NOT' ALLZERO  'THEN'
              WRITE(0,LZFMT,A[J])
       'ELSE'
       'BEGIN'
         'IF' A[J] 'GT' 0 'THEN'
         'BEGIN'
	    AA := A[J];
	    'IF' AA 'GT' 99999 'THEN'
	       ND := 6
	    'ELSE'
	       'IF' AA 'GT' 9999 'THEN'
	         ND := 5
	       'ELSE'
	       	  'IF' AA 'GT' 999 'THEN'
	             ND := 4
		  'ELSE'
		    'IF' AA 'GT' 99 'THEN'
	               ND := 3
		    'ELSE'
		      'IF' AA 'GT' 9 'THEN'
	                 ND := 2
		       'ELSE'
		         ND := 1;
			
	    WRITE(0,SZFMT[ND],A[J]);	
            ALLZERO := 'FALSE';
         'END'
       'END' 
           
   'END'; 

'END' OF PUTI; 

'PROCEDURE' ADDI(A, B, C); 'INTEGER' 'ARRAY' A, B, C; 
'BEGIN' 'INTEGER' J, CARRY, SUM; 
   CARRY := 0; 
   'FOR' J:= 1 'STEP' 1 'UNTIL' N 'DO' 
   'BEGIN' 
      SUM := B[J] + C[J] + CARRY; 
      'IF' SUM 'GT' LIM 'THEN' 
      'BEGIN' 
         A[J] := SUM - LIM; 
         CARRY := 1 
      'END' 
      'ELSE' 
      'BEGIN' 
          A[J] := SUM; 
          CARRY := 0 
      'END' 
     'END' 
'END' OF ADDI; 

SELECTOUTPUT(0);	    
WRITETEXT('(''('C')'FIBBONACHI%% NUMBERS%%V2%%BY%%P.J.ONION'('C')'')');

SZFMT[1] := FORMAT('('D')');
SZFMT[2] := FORMAT('('DD')');
SZFMT[3] := FORMAT('('DDD')');
SZFMT[4] := FORMAT('('DDDD')');
SZFMT[5] := FORMAT('('DDDDD')');
SZFMT[6] := FORMAT('('DDDDDD')');

LZFMT := FORMAT('('DDDDDD')');
CTFMT := FORMAT('('SNNNDS')');
N := 20;
LIM := 1000000;

'FOR' M:= 1 'STEP' 1 'UNTIL' N 'DO'
'BEGIN'
   A[M] := 0;
   B[M] := 0;
   C[M] := 0;
'END';

B[1] := 1;
C[1] := 1;


WRITETEXT('(''('C')'')');	 
WRITE(0,CTFMT,1);
PUTI(B);

WRITETEXT('(''('C')'')');	 
WRITE(0,CTFMT,2);
PUTI(C);

COUNT := 0;
'FOR' COUNT := COUNT + 3 'WHILE' COUNT 'LT' 500 'DO'
'BEGIN'

    WRITETEXT('(''('C')'')');	 
    WRITE(0,CTFMT,COUNT);
    ADDI(A,B,C);
    PUTI(A);

    WRITETEXT('(''('C')'')');	 
    WRITE(0,CTFMT,COUNT+1);
    ADDI(C,B,A);
    PUTI(C);
    
    WRITETEXT('(''('C')'')');	 
    WRITE(0,CTFMT,COUNT+2);
    ADDI(B,A,C);
    PUTI(B);

'END';



'END';
'FINISH'
It's not as "pretty" as the 803 version due to it having different output and formatting functions.

PeterO
Discoverer of the PI2 XENON DEATH FLASH!
Interests: C,Python,PIC,Electronics,Ham Radio (G0DZB),1960s British Computers.
"The primary requirement (as we've always seen in your examples) is that the code is readable. " Dougie Lawson

Return to “General programming discussion”