Commit d718a2e2 authored by kollo's avatar kollo

version 1.23-17

parent ab61b4b0
# Makefile for X11-Basic (c) Markus Hoffmann V.@version@
# Version 10.03.2014 modified by Markus Hoffmann
# Version 10.12.2014 modified by Markus Hoffmann
# Insert the defs for your machine
......@@ -19,6 +19,9 @@ INCDIR=@prefix@/include/x11basic
LIBNO=@version@
RELEASE=17
# Register variables (-ffixed-reg) -Wall
REGS= @regs@ -Wall
......@@ -59,7 +62,7 @@ CFLAGS= $(INC) $(DEF) $(OPT)
# these are the objects which go into libx11basic
LIBOBJS=xbasic.o file.o io.o parser.o variablen.o svariablen.o \
LIBOBJS=xbasic.o tools.o loadprg.o file.o io.o io_basic.o parser.o variablen.o svariablen.o \
array.o parameter.o fft.o mathematics.o \
runtime.o wort_sep.o ltext.o functions.o sfunctions.o afunctions.o \
kommandos.o gkommandos.o bitmap.o do_gets.o errortxt.o window.o\
......@@ -80,7 +83,11 @@ LIBCSRC=$(LIBOBJS:.o=.c)
FBLIBOBJS= $(LIBOBJS) framebuffer.o raw_mouse.o consolefont.o terminal.o spat-a-fnt.o 8x16.o 5x7.o unifont.o unifont57.o
LIBCSRCFB=$(FBLIBOBJS:.o=.c)
WINLIBOBJS= $(LIBOBJS) Windows.extension/fnmatch.o
WINLIBOBJS= $(LIBOBJS) Windows.extension/fnmatch.o
TOSLIBOBJS= $(LIBOBJS)
CSRC= $(LIBOBJS:.o=.c) 5x7-rev.c $(EXTRAOBJS:.o=.c) $(MAINOBJS:.o=.c)
......@@ -153,6 +160,7 @@ DIST= README INSTALL COPYING doc/man-pages/*.1 doc/ACKNOWLEGEMENTS \
examples/compiler/bas2x11basic.bas \
examples/compiler/gui2bas.bas \
examples/compiler/xbc-win.bas \
examples/compiler/xbc-st.bas \
examples/c-usage/c-demo.c \
examples/c-usage/c-demo2.c \
examples/c-usage/library.bas \
......@@ -177,12 +185,16 @@ BINDIST=README INSTALL COPYING doc/man-pages/*.1 doc/ACKNOWLEGEMENTS \
WINDIST=Windows-Installer/setup.exe Windows.extension/lib/SDL.dll \
Windows.extension/lib/README-SDL.txt \
Windows.extension/lib/README-GMP.txt \
Windows.extension/lib/README-LAPACK.txt \
Windows-Installer/readme.txt Windows-Installer/demo.bas \
xbasic.exe xbvm.exe xbbc.exe xbc.exe xb2c.exe \
Windows-Installer/x11basic.ico Windows-Installer/x11bver.txt \
Windows-Installer/X11-Basic.pdf Windows-Installer/bas.ico
TOSDIST=xbasic.tos xbvm.tos xbbc.tos xbc.tos xb2c.tos
TOSDIST=xbasic.prg xbvm.prg xbbc.ttp xbc.prg xb2c.ttp Atari-ST-Installer/AUTO/VT100EMU.PRG \
Atari-ST-Installer/readme.txt Atari-ST-Installer/demo.bas Atari-ST-Installer/RELEASE_NOTES \
Atari-ST-Installer/X11-Basic-manual.txt
DIST2=$(LIBOBJS:.o=.c) main.c
......@@ -209,7 +221,10 @@ CONSOLELIBS= @libs@ @xtra@
WINLIBS = -lm -lgdi32 -lkernel32 -luser32 -lole32 -luuid -lwsock32 -lSDL
TOSLIBS = -lm -lgem
MYWINLIBS = x11basic.lib Windows.extension/lib/libgfx.lib
MYWINLIBS = x11basic.lib Windows.extension/lib/libgfx.lib Windows.extension/lib/libgmp.a \
Windows.extension/clapack/lapack.lib \
Windows.extension/blas/blas.lib Windows.extension/f2c/f2c.lib
MYTOSLIBS = x11basic.toslib
all : configure Makefile xbasic xb2c xbbc xbvm xbc bas2x11basic
......@@ -293,28 +308,28 @@ libx11basic.dll : x11basic.lib
x11basic.lib : $(WINLIBOBJS)
rm -f *.o
$(WINCC) -DWINDOWS -c $(DIST2) -I./Windows.extension/include
$(WINCC) -DWINDOWS -c mathematics.c -I./Windows.extension/include
$(WINCC) -DWINDOWS -c $(DIST2) -I./Windows.extension/include -I./Windows.extension/include/GMP
$(WINCC) -DWINDOWS -c mathematics.c -I./Windows.extension/include -I./Windows.extension/include/GMP
i586-mingw32msvc-ar -ru $@ $(WINLIBOBJS)
rm -f *.o
# Make the exe for MS WINDOWS
xbasic.exe: x11basic.lib main.c
$(WINCC) -DWINDOWS $(OPT) $(WINLINKFLAGS) main.c -o $@ $(MYWINLIBS) \
$(WINCC) -DWINDOWS $(OPT) -I./Windows.extension/include -I./Windows.extension/include/GMP $(WINLINKFLAGS) main.c -o $@ $(MYWINLIBS) \
$(WINLIBS)
strip $@
xbbc.exe: x11basic.lib bytecode.h bytecode.c xbbc.c
$(WINCC) -DWINDOWS $(OPT) $(WINLINKFLAGS) -o $@ xbbc.c bytecode.c \
$(WINCC) -DWINDOWS $(OPT) -I./Windows.extension/include -I./Windows.extension/include/GMP $(WINLINKFLAGS) -o $@ xbbc.c bytecode.c \
$(MYWINLIBS) $(WINLIBS)
strip $@
xb2c.exe: x11basic.lib xb2c.c
$(WINCC) -DWINDOWS $(OPT) $(WINLINKFLAGS) -o $@ xb2c.c \
$(WINCC) -DWINDOWS $(OPT) -I./Windows.extension/include -I./Windows.extension/include/GMP $(WINLINKFLAGS) -o $@ xb2c.c \
$(MYWINLIBS) $(WINLIBS)
strip $@
xbvm.exe: x11basic.lib bytecode.h xbvm.c
$(WINCC) -DWINDOWS $(OPT) $(WINLINKFLAGS) -o $@ xbvm.c \
$(WINCC) -DWINDOWS $(OPT) -I./Windows.extension/include -I./Windows.extension/include/GMP $(WINLINKFLAGS) -o $@ xbvm.c \
$(MYWINLIBS) $(WINLIBS)
strip $@
......@@ -328,10 +343,24 @@ xbc.exe : xbasic examples/compiler/xbc-win.bas xbvm.exe xbbc
###################################################
# Make the exe for ATARI ST
xbasic.tos: x11basic.toslib main.c
xbasic.prg: x11basic.toslib main.c
$(TOSCC) -DATARI $(OPT) $(WINLINKFLAGS) main.c -o $@ $(MYTOSLIBS) \
$(TOSLIBS)
m68k-atari-mint-strip $@
xbbc.ttp: bytecode.h bytecode.c x11basic.toslib
$(TOSCC) -DATARI $(OPT) -o $@ xbbc.c bytecode.c $(MYTOSLIBS) $(TOSLIBS)
m68k-atari-mint-strip $@
xbvm.prg: x11basic.toslib bytecode.h xbvm.c
$(TOSCC) -DATARI $(OPT) $(WINLINKFLAGS) -o $@ xbvm.c \
$(MYTOSLIBS) $(TOSLIBS)
m68k-atari-mint-strip $@
xbc.prg : xbasic examples/compiler/xbc-st.bas xbvm.prg xbbc
LD_LIBRARY_PATH=. ./xbasic -q examples/compiler/xbc-st.bas -o $@
chmod 755 $@
xb2c.ttp: xb2c.c tools.c kommandos.c functions.c io_basic.c afunctions.c sfunctions.c file.c svariablen.c
$(TOSCC) -DATARI -DDUMMY_LIST $(OPT) -o $@ xb2c.c tools.c kommandos.c functions.c io_basic.c afunctions.c sfunctions.c svariablen.c file.c
m68k-atari-mint-strip $@
# Make the (static) library for ATARI ST
x11basic.toslib : $(DIST2) mathematics.c
......@@ -453,12 +482,12 @@ TomTom: $(DIR33).zip
windows: $(WINDIST) xbasic.exe xbvm.exe xbbc.exe xbc.exe xb2c.exe
rm -f X11-Basic-@version@.zip
zip -j -D -o X11-Basic-@version@-win.zip $(WINDIST)
rm -f X11-Basic-@version@-$(RELEASE)-win.zip
zip -j -D -o X11-Basic-@version@-$(RELEASE)-win.zip $(WINDIST)
# Make an ATARI ST version
tos: $(TOSDIST) xbasic.tos xbvm.tos xbbc.tos xbc.tos xb2c.tos
tos: $(TOSDIST) xbasic.prg xbvm.prg xbbc.ttp xbc.prg xb2c.ttp
rm -f X11-Basic-atari-@version@.zip
zip -j -D -o X11-Basic-@version@-st.zip $(TOSDIST)
......@@ -521,13 +550,25 @@ myzip : xbc
strip myzip
strip myunzip
afunctions_d.o: afunctions.c
$(CC) -c $(CFLAGS) -DDUMMY_LIST -o $@ $<
sfunctions_d.o: sfunctions.c
$(CC) -c $(CFLAGS) -DDUMMY_LIST -o $@ $<
svariablen_d.o: svariablen.c
$(CC) -c $(CFLAGS) -DDUMMY_LIST -o $@ $<
kommandos_d.o: kommandos.c
$(CC) -c $(CFLAGS) -DDUMMY_LIST -o $@ $<
functions_d.o: functions.c
$(CC) -c $(CFLAGS) -DDUMMY_LIST -o $@ $<
xb2c_d.o: xb2c.c
$(CC) -c $(CFLAGS) -DDUMMY_LIST -o $@ $<
# make the X11-Basic to C translator
xb2c : xb2c.o
$(CC) -o $@ xb2c.o -L . $(LIBS) -lx11basic -L /usr/X11/lib/ -lX11
strip $@
xb2c.static : xb2c.o x11basic.a
$(CC) -o $@ xb2c.o x11basic.a -lm -L /usr/X11/lib/ -lX11 $(LIBS)
xb2c.static : xb2c_d.o file.o functions_d.o io_basic.o tools.o afunctions_d.o svariablen_d.o sfunctions_d.o kommandos_d.o
$(CC) -o $@ xb2c_d.o functions_d.o tools.o afunctions_d.o svariablen_d.o file.o io_basic.o sfunctions_d.o kommandos_d.o -lm -L /usr/X11/lib/ -lX11 $(LIBS)
strip $@
xb2c.debug : xb2c.c $(LIBCSRC)
$(CCDEBUG) -o $@ xb2c.c $(LIBCSRC) -lm -L /usr/X11/lib/ -lX11 $(LIBS)
......@@ -619,9 +660,9 @@ rpm : $(DIR).tar.gz x11basic.spec
rpmbuild -ba --clean --nodeps x11basic.spec
deb : $(BINDIST)
sudo checkinstall -D --pkgname x11basic --pkgversion @version@ \
--pkgrelease 97 --arch i386 \
--pkgrelease $(RELEASE) \
--maintainer kollo@users.sourceforge.net \
--requires libasound2,libreadline6,liblapack3 --backup \
--requires libasound2,libreadline6,liblapack3,libgmp10 --backup \
--pkggroup interpreters --provides libx11basic \
--pkglicense GPL --strip=yes --stripso=yes --reset-uids
rm -f backup-*.tgz
......
......@@ -10,13 +10,13 @@
VERSION 1.22
VERSION 1.23
(C) 1997-2014 by Markus Hoffmann
(C) 1997-2015 by Markus Hoffmann
(kollo@users.sourceforge.net)
Name : X11Basic
Version : 1.22 Vendor: Markus Hoffmann
Version : 1.23 Vendor: Markus Hoffmann
Group : Development/Languages License: GPL
Packager : Markus Hoffmann <kollo@users.sourceforge.net>
URL : http://x11-basic.sourceforge.net/
......@@ -59,7 +59,7 @@ Description :
You will find the compiler sourcecode and some other sample programs in
/usr/share/doc/packages/X11Basic/examples. A variety of other sample programs
can be found in X11-Basic-examples-1.22.zip, which you can download from the
can be found in X11-Basic-examples-1.23.zip, which you can download from the
homepage (http://x11-basic.sourceforge.net/). Also an up-to-date pdf-version
of the manual can be found there.
......
Release notes for Version 1.22 (Dec 2013-Mar 2014)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- improved crash reports (Android)
- Bugfix ARRAY (create, init)
- new: ABSOLUTE command
- new: VAR statement allows parameters "by reference"
- added UTF-8 (unicode) support for LTEXT
- added UTF-8 (unicode) support for console/terminal (Android)
- added unicode bitmap font for greek/kyrillic for console/terminal (Android)
- MENUDEF now compiles without error
- AFTER/EVERY works in bytecode now
- new functions: FSFIRST$(), FSNEXT$()
- new example program: stepdir.bas
- fixed bug in MOUSEK, MOUSE (Windows version)
- small bugfixes in CASE,PAUSE,INSTR(), SORT, USING$(), PRINT USING
- fixed bug in VAL?(), DET(), and GPRINT
- fixed bug in ON ERROR, ON BREAK and ON MENU
- fixed bug in String compare
- fixed bug in HEX constants "0x" (Android)
- new string function RADIX$()
- fixed bug in framebuffer version (linux)
- fixed bugs in parser
- new statement: ENDPROCEDURE (optional)
- improved speed of bytecode
- bugfix in compiler, improved error messages
- fixed bug in DIM, VAL?(), PLIST
Release notes for Version 1.23 (July 2014 --Mar 2015)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
- New data type: complex numbers a#
- New data type: arbitrary precision integers a& (experimental)
- LAPACK functions (e.g. SOLVE(), INVERT() etc.) now work in Android version
- New functions LCM() and GCD()
- fixed bugs in compiler (PRINT)
- fixed bug in MID$()
- compiled an ATARI ST (MINT) version of X11-Basic
- Fixed bug in LOAD / Screen rotation
- Again modified MID$
- Crashfix: clear_variable
- Fixed unavail Basedir in Android
- fixed bug in EVAL, HELP, RND(), SGET, GET
- increased speed of assignment in interpreter
- workaround for TTS crash (Android)
This diff is collapsed.
......@@ -8,14 +8,18 @@
#ifndef __aes__
#define __aes__
#define GEMFONT "-*-fixed-*-r-normal-*-16-*-iso8859-*"
#define GEMFONTSMALL "-*-fixed-medium-r-normal-*-10-*-iso8859-*"
//#define GEMFONT "-*-fixed-*-r-normal-*-15-*-ISO10646-1"
#define GEMFONT "*8x16*"
//#define GEMFONTSMALL "-*-fixed-*-r-normal-*-8-*-ISO10646-1"
#define GEMFONTSMALL "*5x8*"
#define WORD short
#define LONG unsigned long
#ifdef USE_GEM
#include <gem.h>
#endif
/* Object Drawing Types */
/* Graphic types of obs */
#define G_BOX 20
......@@ -62,10 +66,6 @@
#undef BLUE
#undef YELLOW
#undef MAGENTA
/* Object colors */
#define WHITE 0
#define BLACK 1
......@@ -102,10 +102,13 @@
#define FONT_LARGE 20
#define FONT_DEFAULT FONT_IBM
#ifndef USE_GEM
#define EDSTART 0
#define EDINIT 1
#define EDCHAR 2
#define EDEND 3
#endif
#define TE_LEFT 0
#define TE_RIGHT 1
......@@ -136,19 +139,49 @@
#define HDR_LENGTH (RS_SIZE + 1) * 2 /* in bytes */
#ifdef USE_GEM
/* AES-Definitionen */
typedef struct {
int x;
int y;
unsigned int w;
unsigned int h;
short x;
short y;
unsigned short w;
unsigned short h;
} ARECT;
#else
/* AES-Definitionen */
typedef struct {
int x;
int y;
unsigned int w;
unsigned int h;
} ARECT;
#endif
#ifndef USE_GEM
#define OBJECT struct object
#define TEDINFO struct text_edinfo
#define GRECT struct grect
#define ORECT struct orect
#define ICONBLK struct icon_block
#define BITBLK struct bit_block
#define USERBLK struct user_blk
#define PARMBLK struct parm_blk
typedef union obspecptr
{
long index;
union obspecptr *indirect;
// BFOBSPEC obspec;
TEDINFO *tedinfo;
BITBLK *bitblk;
ICONBLK *iconblk;
// CICONBLK *ciconblk;
struct user_block *userblk;
char *free_string;
} OBSPEC;
OBJECT
{
......@@ -158,14 +191,13 @@ OBJECT
unsigned WORD ob_type; /* type of object- BOX, CHAR,...*/
unsigned WORD ob_flags; /* flags */
unsigned WORD ob_state; /* state- SELECTED, OPEN, ... */
LONG ob_spec; /* "out"- -> anything else */
OBSPEC ob_spec; /* "out"- -> anything else */
WORD ob_x; /* upper left corner of object */
WORD ob_y; /* upper left corner of object */
WORD ob_width; /* width of obj */
WORD ob_height; /* height of obj */
};
#define ORECT struct orect
ORECT
{
......@@ -177,7 +209,6 @@ ORECT
} ;
#define GRECT struct grect
GRECT
{
......@@ -190,25 +221,23 @@ GRECT
#define TEDINFO struct text_edinfo
TEDINFO
{
LONG te_ptext; /* ptr to text (must be 1st) */
LONG te_ptmplt; /* ptr to template */
LONG te_pvalid; /* ptr to validation chrs. */
char *te_ptext; /* ptr to text (must be 1st) */
char *te_ptmplt; /* ptr to template */
char *te_pvalid; /* ptr to validation chrs. */
WORD te_font; /* font */
WORD te_junk1; /* junk word */
WORD te_fontid; /* junk word 1 */
WORD te_just; /* justification- left, right...*/
WORD te_color; /* color information word */
WORD te_junk2; /* junk word */
WORD te_fontsize; /* junk word 2 */
WORD te_thickness; /* border thickness */
WORD te_txtlen; /* length of text string */
WORD te_tmplen; /* length of template string */
};
#define ICONBLK struct icon_block
ICONBLK
{
......@@ -231,7 +260,6 @@ ICONBLK
WORD ib_htext;
};
#define BITBLK struct bit_block
BITBLK
{
......@@ -245,14 +273,12 @@ BITBLK
};
#define USERBLK struct user_blk
USERBLK
{
LONG ub_code;
LONG ub_parm;
};
#define PARMBLK struct parm_blk
PARMBLK
{
LONG pb_tree;
......@@ -265,10 +291,6 @@ PARMBLK
};
typedef struct objc_colorword {
unsigned borderc : 4;
unsigned textc : 4;
......@@ -276,6 +298,7 @@ typedef struct objc_colorword {
unsigned pattern : 3;
unsigned fillc : 4;
} OBJC_COLORWORD;
#endif
typedef struct {
unsigned character : 8;
......@@ -287,6 +310,8 @@ typedef struct {
unsigned interiorcol : 4;
} bfobspec;
#ifndef USE_GEM
typedef struct rshdr
{
WORD rsh_vrsn; /* must same order as RT_ */
......@@ -308,7 +333,7 @@ typedef struct rshdr
WORD rsh_nimages;
WORD rsh_rssize; /* total bytes in resource */
}RSHDR;
#endif
typedef struct rshdrv3
{
WORD rsh_vrsn; /* must same order as RT_ */
......@@ -337,32 +362,26 @@ typedef struct { unsigned char r,g,b;} AESRGBCOLOR;
/* Prototypes */
extern RSHDR *rsrc;
extern unsigned int chw,chh,baseline,depth;
extern int gem_colors[];
extern ARECT sbox;
void gem_init();
void load_GEMFONT(int n);
void box_center(ARECT *b);
int form_alert(int dbut,char *n);
int form_alert2(int dbut,char *n, char *tval);
int form_center(OBJECT *tree, int *x, int *y, int *w, int *h);
int rsrc_gaddr(int re_gtype, unsigned int re_gindex, char **re_gaddr);
int rsrc_free();
#ifndef USE_GEM
short form_alert(short dbut,char *n);
short form_center(OBJECT *tree,short *x,short *y,short *w,short *h);
short rsrc_free();
void objc_add(OBJECT *tree,int p,int c);
void objc_delete(OBJECT *tree,int object);
int objc_draw( OBJECT *tree,int start, int stop,int rootx,int rooty);
int objc_offset(OBJECT *tree,int object,int *x,int *y);
int objc_find(OBJECT *tree,int x,int y);
short rsrc_load(const char *filename);
short objc_offset(OBJECT *tree,short object,short *x,short *y);
short objc_find(OBJECT *tree,short startob, short depth,short x,short y);
short objc_draw(OBJECT *tree,short startob, short depth,short x,short y, short w, short h);
short rsrc_gaddr(short re_gtype, unsigned short re_gindex, char **re_gaddr);
int finded(OBJECT *tree,int start, int r);
void draw_edcursor(OBJECT *tree,int ndx);
int rootob(OBJECT *tree,int onr);
void relobxy(OBJECT *tree,int ndx,int *x, int *y);
int rsrc_load(char *filename);
#endif
int form_alert2(int dbut,char *n, char *tval);
#endif
......@@ -15,19 +15,66 @@
#include "x11basic.h"
#include "variablen.h"
#include "xbasic.h"
#include "parser.h"
#include "parameter.h"
#include "array.h"
#include "afunctions.h"
#include "mathematics.h"
#include "functions.h"
#include "number.h"
#ifdef DUMMY_LIST
#define f_nop NULL
#define f_nullmat NULL
#define f_einsmat NULL
#define f_convolut NULL
#define f_csvgeta NULL
#define f_csvgeta NULL
#define string_to_array NULL
#define f_doocsgeta NULL
#define f_doocsnames NULL
#define f_doocsgeta NULL
#define f_fft NULL
#define inv_array NULL
#define f_smula NULL
#define f_solvea NULL
#define f_tinegeta NULL
#define f_tinegeta NULL
#define f_tinehistorya NULL
#define trans_array NULL
#else
static ARRAY f_smula(PARAMETER *plist, int e) {
ARRAY ergeb;
ergeb.typ=((ARRAY *)&(plist->integer))->typ;
ergeb.dimension=plist->integer;
ergeb.pointer=plist->pointer;
ergeb=double_array(&ergeb);
array_smul(ergeb,plist[1].real);
int rt=combine_type(((ARRAY *)&(plist->integer))->typ,plist[1].typ&PL_BASEMASK,'*');
ARRAY ergeb=convert_to_xarray((ARRAY *)&(plist->integer),rt);
int anz=anz_eintraege(&ergeb),j;
switch(rt) {
case FLOATTYP: {
double *pp1=(double *)(ergeb.pointer+ergeb.dimension*INTSIZE);
double m=p2float(&plist[1]);
for(j=0;j<anz;j++) pp1[j]*=m;
} break;
case INTTYP: {
int *pp1=(int *)(ergeb.pointer+ergeb.dimension*INTSIZE);
int m=p2int(&plist[1]);
for(j=0;j<anz;j++) pp1[j]*=m;
} break;
case COMPLEXTYP: {
COMPLEX *pp1=(COMPLEX *)(ergeb.pointer+ergeb.dimension*INTSIZE);
COMPLEX m=p2complex(&plist[1]);
for(j=0;j<anz;j++) {pp1[j]=complex_mul(m,pp1[j]);}
} break;
case ARBINTTYP: {
ARBINT *pp1=(ARBINT *)(ergeb.pointer+ergeb.dimension*INTSIZE);
ARBINT m;
mpz_init(m);
p2arbint(&plist[1],m);
for(j=0;j<anz;j++) mpz_mul(pp1[j],pp1[j],m);
mpz_clear(m);
}
break;
default: xberror(96,""); /* ARRAY %s has the wrong type. */
}
return(ergeb);
}
static ARRAY f_nullmat(PARAMETER *plist, int e) {
......@@ -41,52 +88,117 @@ static ARRAY f_einsmat(PARAMETER *plist, int e) {
/*Determinante berechnen*/
double f_det(PARAMETER *plist, int e) {
ARRAY *arr=(ARRAY *)&(plist->integer);
return array_det(arr);
PARAMETER f_det(PARAMETER *plist, int e) {
PARAMETER ret;
ret.typ=PL_FLOAT; /* TODO !!!*/
ret.real=array_det((ARRAY *)&(plist->integer));
return(ret);
}
/* Gleichungssystem loesen d=Mx x()=SOLVE(m(),d())*/
static ARRAY f_solvea(PARAMETER *plist, int e) {
ARRAY ergeb;
ARRAY ergeb,*arr1,*arr2;
int anzzeilen,anzspalten;
ergeb.typ=((ARRAY *)&(plist->integer))->typ;
arr1=(ARRAY *)&(plist->integer);
arr2=(ARRAY *)&(plist[1].integer);
ergeb.typ=combine_type(arr1->typ,arr2->typ,'+');
ergeb.dimension=1;
if(plist[0].integer>2) xberror(80,""); /* Matrizenoperationen nur fr ein- oder zweidimensionale Felder*/
else if(plist[0].integer!=2) xberror(81,""); /* "Matrizen haben nicht die gleiche Ordnung" */
if(plist->integer>2) xberror(80,""); /* Matrizenoperationen nur fr ein- oder zweidimensionale Felder*/
else if(plist->integer!=2) xberror(81,""); /* "Matrizen haben nicht die gleiche Ordnung" */
if(plist[1].integer!=1) xberror(81,""); /* "Matrizen haben nicht die gleiche Ordnung" */
anzspalten=*((int *)(plist[0].pointer+sizeof(int)));
anzzeilen=*((int *)(plist[0].pointer));
anzspalten=*((int *)(plist->pointer+sizeof(int)));
anzzeilen=*((int *)(plist->pointer));
if(anzzeilen!=*((int *)(plist[1].pointer))) xberror(81,""); /* "Matrizen haben nicht die gleiche Ordnung" */
ergeb.pointer=malloc(INTSIZE+anzspalten*sizeof(double));
ARRAY a=convert_to_xarray(arr1,ergeb.typ);
ARRAY b=convert_to_xarray(arr2,ergeb.typ);
ergeb.pointer=malloc(INTSIZE+anzspalten*typlaenge(ergeb.typ));
*((int *)ergeb.pointer)=anzspalten;
solve((double *)(plist[1].pointer+plist[1].integer*INTSIZE),(double *)(plist[0].pointer+plist[0].integer*INTSIZE),anzzeilen,anzspalten, (double *)(ergeb.pointer+INTSIZE));
if(ergeb.typ!=FLOATTYP) printf("ERROR: Operation for complex arrays not yet implemented.\n");
else solve((double *)(b.pointer+b.dimension*INTSIZE),(double *)(a.pointer+a.dimension*INTSIZE),anzzeilen,anzspalten, (double *)(ergeb.pointer+INTSIZE));
free_array(&a);
free_array(&b);
return(ergeb);
}
/* Diskrete Faltung x()=CONVOLUT(A(),h())*/
static ARRAY f_convolut(PARAMETER *plist, int e) {
ARRAY *arr=(ARRAY *)&(plist->integer);
ARRAY ergeb=double_array(arr);
int n=anz_eintraege(&ergeb);
ARRAY *h=(ARRAY *)&(plist[1].integer);
int n2=anz_eintraege(h);
double *varptr=(double *)(ergeb.pointer+ergeb.dimension*INTSIZE);
double *varptr1=(double *)(arr->pointer+arr->dimension*INTSIZE);
double *varptr2=(double *)(h->pointer+h->dimension*INTSIZE);
ARRAY *arr1=(ARRAY *)&(plist->integer);
ARRAY ergeb;
int n=anz_eintraege(arr1);
ARRAY *arr2=(ARRAY *)&(plist[1].integer);
int n2=anz_eintraege(arr2);
ergeb.typ=combine_type(arr1->typ,arr2->typ,'+');
ergeb.dimension=arr1->dimension;
ergeb.pointer=malloc(INTSIZE*ergeb.dimension+n*typlaenge(ergeb.typ));
memcpy(ergeb.pointer,arr1->pointer,INTSIZE*ergeb.dimension);
ARRAY a=convert_to_xarray(arr1,ergeb.typ);
ARRAY h=convert_to_xarray(arr2,ergeb.typ);
int i,j;
int o=n2/2;
double a;
for(i=0;i<n;i++) {
a=0;
for(j=0;j<n2;j++) {
if(i+j-o>=0 && i+j-o<n) a+=varptr1[i+j-o]*varptr2[j];
}
varptr[i]=a;
switch(ergeb.typ) {
case INTTYP: {
int *varptr=(int *)(ergeb.pointer+ergeb.dimension*INTSIZE);
int *varptr1=(int *)(a.pointer+a.dimension*INTSIZE);
int *varptr2=(int *)(h.pointer+h.dimension*INTSIZE);
int sum;
for(i=0;i<n;i++) {
sum=0;
for(j=0;j<n2;j++) {
if(i+j-o>=0 && i+j-o<n) sum+=varptr1[i+j-o]*varptr2[j];
}
varptr[i]=sum;
}
} break;
case FLOATTYP: {
double *varptr=(double *)(ergeb.pointer+ergeb.dimension*INTSIZE);
double *varptr1=(double *)(a.pointer+a.dimension*INTSIZE);
double *varptr2=(double *)(h.pointer+h.dimension*INTSIZE);
double sum;
for(i=0;i<n;i++) {
sum=0;
for(j=0;j<n2;j++) {
if(i+j-o>=0 && i+j-o<n) sum+=varptr1[i+j-o]*varptr2[j];
}
varptr[i]=sum;
}
} break;
case COMPLEXTYP: {
COMPLEX *varptr=(COMPLEX *)(ergeb.pointer+ergeb.dimension*INTSIZE);
COMPLEX *varptr1=(COMPLEX *)(a.pointer+a.dimension*INTSIZE);
COMPLEX *varptr2=(COMPLEX *)(h.pointer+h.dimension*INTSIZE);
COMPLEX sum;
for(i=0;i<n;i++) {
sum.r=sum.i=0;
for(j=0;j<n2;j++) {
if(i+j-o>=0 && i+j-o<n) sum=complex_add(sum,complex_mul(varptr1[i+j-o],varptr2[j]));
}
varptr[i]=sum;
}
} break;
case ARBINTTYP: {
ARBINT *varptr=(ARBINT *)(ergeb.pointer+ergeb.dimension*INTSIZE);
ARBINT *varptr1=(ARBINT *)(a.pointer+a.dimension*INTSIZE);
ARBINT *varptr2=(ARBINT *)(h.pointer+h.dimension*INTSIZE);
for(i=0;i<n;i++) {
mpz_set_si(varptr[i],0);
for(j=0;j<n2;j++) {
if(i+j-o>=0 && i+j-o<n) mpz_addmul(varptr[i],varptr1[i+j-o],varptr2[j]);
}
}