diff options
Diffstat (limited to 'ipl/packs')
95 files changed, 12291 insertions, 16 deletions
diff --git a/ipl/packs/README b/ipl/packs/README index 9dc760d..f067e91 100644 --- a/ipl/packs/README +++ b/ipl/packs/README @@ -1,7 +1,11 @@ +Contributed packages distributed with Icon: + euler Euler compiler and interpreter + icondb loadable C function for access to SQL database ibpag2 LR-based parser generator idol Idol; object-oriented Icon written in Icon itweak interactive debugger loadfunc C functions loaded dynamically + loadfuncpp interface for loading C++ functions skeem Scheme language, implemented in Icon tcll1 parser-generator and parser diff --git a/ipl/packs/ibpag2/Makefile b/ipl/packs/ibpag2/Makefile index 56d917e..d9c7d18 100644 --- a/ipl/packs/ibpag2/Makefile +++ b/ipl/packs/ibpag2/Makefile @@ -23,7 +23,7 @@ LIBDIR = /usr/local/lib/icon/data # # Name of your icon compiler and compiler flags. # -ICONC = icont +ICONT = icont IFLAGS = -u -s #-Sc 400 -Sg 400 -Si 2000 -Sn 4000 -SF 40 SHAR = /usr/local/bin/shar @@ -48,7 +48,7 @@ SHARFILES = $(SRC) $(PARSER) $(GLRPARSER) sample.ibp beta2ref.ibp \ all: $(PROGNAME) $(PROGNAME): $(SRC) - $(ICONC) $(IFLAGS) -o $(PROGNAME) $(SRC) + $(ICONT) $(IFLAGS) -o $(PROGNAME) $(SRC) ########################################################################## diff --git a/ipl/packs/ibpag2/README b/ipl/packs/ibpag2/README index c2f5d82..0accddd 100644 --- a/ipl/packs/ibpag2/README +++ b/ipl/packs/ibpag2/README @@ -997,10 +997,7 @@ do. Please be sure to read the directions in the makefile carefully, and set DESTDIR and LIBDIR to the directory where you want the executable and parser file to reside. Also, make sure the paths -you specify are correct for your Icon executables. Although Ibpag2 -will apparently compile using iconc, I would recommend using the -interpreter, icont, first, unless you are planning on working with a -large grammar. +you specify are correct for your Icon executables. If you are using some other system - one that lacks "make" - then shame on your manufacturer :-). You'll be a bit inconvenienced. @@ -1012,13 +1009,7 @@ Try typing: version.icn slshupto.icn The backslashes merely indicate that the next line is a continuation. -The whole thing should, in other words, be on a single line. As noted -above, you may compile rather than interpret - if your OS supports the -Icon compiler. Just replace "icont" above with "iconc." The -resulting executable will run considerably faster than with "icont," -although the time required to compile it may be large, and the (still -somewhat experimental) compiler may not work smoothly in all -environments. +The whole thing should, in other words, be on a single line. If your operating system support environment variables, and you have set up your LPATH according to the specifications in the Icon @@ -1050,7 +1041,7 @@ input and output redirection. Naturally, the above example assumes that Ibpag2 is in c:\ibpag2. Ibpag2 assumes the existence on your system, not only of an -Icon interpreter or compiler, but also of an up-to-date Icon Program +Icon interpreter, but also of an up-to-date Icon Program Library. There are several routines included in the IPL that Bibleref uses. Make sure you (or the local system administrators) have put the IPL online, and have translated the appropriate object modules. Set diff --git a/ipl/packs/icondb/Makefile b/ipl/packs/icondb/Makefile new file mode 100644 index 0000000..5e616c4 --- /dev/null +++ b/ipl/packs/icondb/Makefile @@ -0,0 +1,41 @@ +# icondb -- Icon database interface contributed by Carl Sturtivant. + +# Requires GNU make, gcc, mysql utilities, and mysql development package. + +ifndef TARGET + +ifneq ($(strip $(shell g++ -v 2>&1 | grep "darwin")),) +TARGET=mac +else +ifneq ($(strip $(shell g++ -v 2>&1 | grep "cygwin")),) +TARGET=cygwin +else +TARGET=other +endif +endif + +endif #TARGET + + +ICON_PATH=../../.. + + +SHARED_mac = -bundle -undefined suppress +SHARED_cygwin = -shared +SHARED_other = -shared + +PIC_mac = -flat_namespace +PIC_other = -fPIC + +EXTRA_cygwin = $(ICON_PATH)/bin/iload.a -Wl,--enable-auto-import +EXTRA_other = -I./ + + +default: + icont -ucs icondb.icn + cp icondb.u1 icondb.u2 $(ICON_PATH)/lib + sh -c "gcc -I../../cfuncs $(SHARED_$(TARGET)) -o mysqldb.so $(PIC_$(TARGET)) `mysql_config --cflags` mysqldb.c `mysql_config --libs`" + cp mysqldb.so $(ICON_PATH)/bin + +clean Clean: + rm -f *.u? *.o *.so */*.o */*.u? */*.so diff --git a/ipl/packs/icondb/cgi.icn b/ipl/packs/icondb/cgi.icn new file mode 100644 index 0000000..2b47f9d --- /dev/null +++ b/ipl/packs/icondb/cgi.icn @@ -0,0 +1,43 @@ + +#everything needed for typical web form handling + +procedure cgiparms() #returns a table, mapping names to lists of values + local GET_data, POST_data, data, i, pname, pvalue, s + static result + initial { + result := table() + GET_data := trim(getenv("QUERY_STRING"))|"" + if *GET_data = 0 then GET_data := &null + POST_data := reads(&input, getenv("CONTENT_LENGTH")) + if \GET_data & \POST_data then + data := GET_data || "&" || POST_data + else + data := \GET_data | \POST_data + if /data then return result + data ? every i := upto('&')|0 do { + tab(i) ? { + pname := _urldecode( tab(upto('=')) ) + move(1) + pvalue := _urldecode( tab(0) ) + /result[pname] := [] + put( result[pname], pvalue ) + } + if pos(0) then break + move(1) + } + } + return result +end + +procedure _urldecode(url) + local s + s := "" + url ? repeat { + s ||:= tab(upto('%+')|0) + if pos(0) then return s + case move(1) of { + "%" : s ||:= char("16r" || map(move(2)) ) + "+" : s ||:= " " + } + } +end diff --git a/ipl/packs/icondb/icondb.icn b/ipl/packs/icondb/icondb.icn new file mode 100644 index 0000000..5cbc67b --- /dev/null +++ b/ipl/packs/icondb/icondb.icn @@ -0,0 +1,105 @@ + +#simulation of the real icondb.icn +#using the C mysql and postgresql interfaces for Icon 9.4. +#use with cgi.icn (instead of web.icn) +#until loadfuncpp becomes reliable + +#WARNING: can only connect to one mysql and one postgresql database at a time + +#CS 2008/7/27 + + +link io + +#the C interface +procedure _mysqldb(arg[]) + return ( _mysqldb := pathload("mysqldb.so","mysqldb") )!arg +end + +procedure _postgresqldb(arg[]) + return ( _postgresqldb := pathload("postgresqldb.so","postgresqldb") )!arg +end + +#simulated external value +record database_handle(connection, c_interface) + +#simulated mysql connection procedure +procedure _connectmysql(dbname, user, pwd, host, port) + local connection, result + icondb_error := &null + connection := [dbname, user, pwd] + if put(connection, \host) then put(connection, \port) + result := _mysqldb(connection) + if /result then return database_handle(connection, _mysqldb) + icondb_error := result + fail +end + +#simulated postgresql connection procedure +procedure _connectpostgresql(dbname, user, pwd, host, port) + local connection, result + icondb_error := &null + connection := [dbname, user, pwd] + if put(connection, \host) then put(connection, \port) + result := _postgresqldb(connection) + if /result then return database_handle(connection, _postgresqldb) + icondb_error := result + fail +end + +global icondb_error + +#icondb returns a connection procedure for a known kind of dbms +#which may then be called following the pattern +#dbhandle := connect(dbname, user, pwd, host, port) +#where host and port are optional + +procedure icondb(kind) + case kind of { + "mysql" : return _connectmysql + "postgresql" : return _connectpostgresql + default : stop("icondb: unknown dbms\nerror: ", image(kind)) | fail + } +end + +procedure dbclose(db) + if type(db) ~== "database_handle" then + stop("dbclose: not a database handle: ", image(db)) + icondb_error := &null + db.c_interface() + return +end + +procedure dbquery(db, query, constructor) + local result, rec + if type(db) ~== "database_handle" then + stop("dbquery: not a database handle: ", image(db)) + case type(constructor) of { + "null" : + &null + "procedure" : + image(constructor) ? { + ="record constructor" | + stop("dbquery: not a record constructor: ", image(constructor)) + } + default : + stop("dbquery: not a record constructor: ", image(constructor)) + } + icondb_error := &null + result := db.c_interface(query) + case type(result) of { + "integer" | "null" : return result + "list" : case type(result[1]) of { + "list": + if /constructor then + suspend !result + else { + if result[1] & *constructor() ~= *result[1] then + stop("dbquery: ",image(constructor)," needs at least ",*rec[1]," fields." ) + suspend constructor!!result + } + "integer" : icondb_error := result + } + } +end + diff --git a/ipl/packs/icondb/mysqldb.c b/ipl/packs/icondb/mysqldb.c new file mode 100644 index 0000000..06dc179 --- /dev/null +++ b/ipl/packs/icondb/mysqldb.c @@ -0,0 +1,289 @@ + +/*-----------------3/27/2007 11:23AM----------------- + * loadable C function mysqldb for icon access to + * a mySQL database from linux, by Carl Sturtivant. + * (This also built on solaris.) + * + * This should be Garbage Collection safe except + * under very extreme memory shortages. + * + * Requires a mySQL installation to build. + * I used the following from bash: + +CFG=/usr/bin/mysql_config +sh -c "gcc -shared -o mysqldb.so -fPIC `$CFG --cflags` mysqldb.c `$CFG --libs`" + + * for details about calling mysqldb, see below. + * --------------------------------------------------*/ + +#include <stdio.h> +#include <string.h> + +/* http://dev.mysql.com/doc/refman/5.0/en/c.html */ +/* #include "/usr/include/mysql/mysql.h" */ +#include <mysql.h> + + +#include "icall.h" + + +/* macros obtained by modifying some from icall.h */ + +#define Mkinteger(i, dp) \ +do { (dp)->dword = D_Integer; (dp)->vword = (i); } while(0) + +#define Mkstring(s, dp) \ +do { word n = strlen(s); \ +(dp)->dword = n; (dp)->vword = (word)alcstr(s,n); } while(0) + +/* ensure that return to icon removes our tended descriptors from the list */ +#define ReturnDescriptor(d) do { gcu_aware_pop(); return ( argv[0] = (d), 0 ); } while(0) +#define ReturnError(d, n) do { gcu_aware_pop(); return ( argv[0] = (d), n ); } while(0) + + +/****************start of Garbage Collection Utilities****************/ + +/* Structure for chaining descriptors to be tended properly by GC (rstructs.h) */ +struct tend_desc { + struct tend_desc *previous; + int num; + descriptor d[1]; /* actual size is in num */ +}; +typedef struct tend_desc gcu_tended; + +/* global chain of such structures used by iconx (rinit.r) */ +extern gcu_tended *tend; + +/* int parameter to pass to gcu_initialize */ +#define gcu_max(vars) ( (sizeof(vars) - sizeof(gcu_tended) )/sizeof(descriptor) ) + +/* initialize all descriptors to &null and assign the number */ +static void gcu_initialize(int maxindex, void *descriptors) { + int i; + gcu_tended *desc = (gcu_tended *)descriptors; + desc->num = maxindex+1; + for( i = 0; i <= maxindex; ++i ) (desc->d)[i] = nulldesc; +} + +/* add descriptors in a gcu_tended structure to the tended list */ +static void gcu_aware_push(void *descriptors) { + gcu_tended *desc = (gcu_tended *)descriptors; + desc->previous = tend; + tend = descriptors; +} + +/* remove descriptors in a gcu_tended structure from the tended list */ +static void gcu_aware_pop() { + tend = tend->previous; +} + +/****************end of Garbage Collection utilities****************/ + + +/****************start of list utilities****************/ + +int Zlist(descriptor argv[]); /* resolved in iconx: icon function list(i,X):L */ +int Osubsc(descriptor argv[]); /* resolved in iconx: icon operator L[i]:v */ +int Oasgn(descriptor argv[]); /* resolved in iconx: icon operator v:=X */ + +typedef int (*iconfunction)(descriptor argv[]); + +/* safely call an icon built-in function or operator with two arguments from C. */ +static descriptor iconcall2(iconfunction F, descriptor x1, descriptor x2) { + struct { /* structure like struct tend_desc with extra descriptors at the bottom */ + gcu_tended other; /* vital: used to chain onto the tend list */ + descriptor stack[3]; /* GC is aware of these once this struct is pushed onto the tend list */ + } tended; + gcu_initialize( gcu_max(tended), &tended ); /* vital: call before icon may be made aware of this */ + gcu_aware_push( &tended ); /* GC is now aware of tended.stack */ + tended.stack[0] = nulldesc; + tended.stack[1] = x1; + tended.stack[2] = x2; + F(tended.stack); /* No error handling for the uses below */ + gcu_aware_pop(); /* vital: GC is now unaware of tended.stack */ + return tended.stack[0]; +} + +/* returns list(n, &null) --- allocates memory */ +static descriptor newlist(int length) { + descriptor len; + Mkinteger(length, &len); + return iconcall2( &Zlist, len, nulldesc ); +} + +/* returns list[index] := value */ +static descriptor assign(descriptor list, int index, descriptor value) { + descriptor i; + Mkinteger(index, &i); + return iconcall2( &Oasgn, iconcall2(&Osubsc, list, i), value ); +} + +/* returns .list[index] */ +static descriptor subscript(descriptor list, int index) { + descriptor i, result; + Mkinteger(index, &i); + result = iconcall2(&Osubsc, list, i); + /* result of an icon subscripting operation is a variable */ + deref(&result, &result); /* deref resolved in iconx */ + return result; +} + +/****************end of list utilities****************/ + + +/* make icon list of mysql error information */ +static descriptor error_info(int mysqlNumber, const char * mysqlError) { + descriptor number; + struct { + gcu_tended other; + descriptor text, ls; + } tended; + gcu_initialize( gcu_max(tended), &tended ); + gcu_aware_push( &tended ); + tended.ls = newlist(2); + Mkinteger(mysqlNumber, &number); + Mkstring((char *)mysqlError, &tended.text); + assign( tended.ls, 1, number ); + assign( tended.ls, 2, tended.text ); + gcu_aware_pop(); + return tended.ls; +} + +/* make mySQL row retrieved from query results into icon list */ +static descriptor convertrow(MYSQL_ROW row, int numfields) { + int i; + struct { + gcu_tended other; + descriptor x, ls; + } tended; + gcu_initialize( gcu_max(tended), &tended ); + gcu_aware_push( &tended ); + tended.ls = newlist(numfields); + for( i = 1; i <= numfields; ++i ) { + if( row[i-1] ) Mkstring( row[i-1], &tended.x ); + else tended.x = nulldesc; + assign( tended.ls, i, tended.x ); + } + gcu_aware_pop(); + return tended.ls; +} + +/*-------------------------------------------------- + * Called with a list, mysqldb attempts to connect. + * Only one database can be connected to at a time. + * Needs the database name, username, password, + * and optionally the host, and if so optionally + * the port number, all passed in a list. The host + * defaults to localhost, and the port number to + * the default port number for mySQL. + * + * Called with a string, mysqldb attempts to + * execute that string as a mySQL query. + * + * Called with no parameters, mysqldb closes + * the connection if it is open. + * + * Returns a list of lists for a SELECT query, or + * the number of rows affected for other queries. + * Otherwise, fails if everything works, returns + * error information if not, except if incorrect + * argument types are supplied, in which case the + * result is an error. + * --------------------------------------------------*/ +int mysqldb(int argc, descriptor argv[]) { + static MYSQL dbh; /* connection sticks around between calls */ + static int connected = 0; + + MYSQL_RES *result; + MYSQL_ROW row; + char *querystring, *hoststring, + *databasestring, *userstring, *passwordstring; + int i, len, rowsize, portnum; + struct { + gcu_tended other; + descriptor ls, host, port, database, user, password, answer; + } tended; + gcu_initialize( gcu_max(tended), &tended ); + gcu_aware_push( &tended ); + + + if( argc == 0 ) { /* close connection */ + if( connected ) mysql_close(&dbh); + connected = 0; + gcu_aware_pop(); + Fail; + } /* end close connection */ + + if( argc >= 1 && IconType(argv[1]) == 'L' ) { /* connect to MySQL */ + if( connected ) + ReturnDescriptor( error_info(-1, "mysqldb: already connected") ); + if( !mysql_init(&dbh) ) + ReturnDescriptor( error_info(-1, "mysqldb: cannot initialize mySQL!") ); + + tended.ls = argv[1]; + hoststring = "localhost"; /* host defaults to localhost */ + portnum = 0; /* port defaults to 0 giving the mySQL default */ + + switch( ListLen(tended.ls) ) { + default: + ReturnDescriptor( error_info(-1, "mysqldb: list of dbname, user, pwd, [host, [port]] expected") ); + case 5 : + tended.port = subscript(tended.ls, 5); + if( !cnv_int(&tended.port,&tended.port) ) ReturnError(tended.port,101); + portnum = IntegerVal(tended.port); + case 4 : + tended.host = subscript(tended.ls, 4); + if ( !cnv_str(&tended.host,&tended.host) ) ReturnError(tended.host,103); + hoststring = StringVal(tended.host); + case 3 : + tended.password = subscript(tended.ls, 3); + if ( !cnv_str(&tended.password,&tended.password) ) ReturnError(tended.password,103); + passwordstring = StringVal(tended.password); + tended.user = subscript(tended.ls, 2); + if ( !cnv_str(&tended.user,&tended.user) ) ReturnError(tended.user,103); + userstring = StringVal(tended.user); + tended.database = subscript(tended.ls, 1); + if ( !cnv_str(&tended.database,&tended.database) ) ReturnError(tended.database,103); + databasestring = StringVal(tended.database); + } + + if( mysql_real_connect(&dbh, hoststring, userstring, + passwordstring, databasestring, portnum, NULL, 0) ) { + connected = 1; + gcu_aware_pop(); + Fail; + } + else ReturnDescriptor( error_info(mysql_errno(&dbh), mysql_error(&dbh)) ); + } /* end connect to MySQL */ + + if( argc >= 1 && IconType(argv[1]) == 's' ) { /* execute a query */ + if( !connected ) + ReturnDescriptor( error_info(-1, "mysqldb: not connected") ); + querystring = StringVal(argv[1]); + + if( mysql_query(&dbh, querystring) ) + ReturnDescriptor( error_info(mysql_errno(&dbh), mysql_error(&dbh)) ); + + result = mysql_store_result(&dbh); + + if( !result ) /* not a SELECT query or some sort of error */ + if( mysql_field_count(&dbh) != 0 ) + ReturnDescriptor( error_info(mysql_errno(&dbh), mysql_error(&dbh)) ); + else { /* not a SELECT query */ + gcu_aware_pop(); + RetInteger( mysql_affected_rows(&dbh) ); + } + + /* SELECT query */ + tended.answer = newlist( mysql_num_rows(result) ); + rowsize = mysql_num_fields(result); + i = 0; + while( row = mysql_fetch_row(result) ) + assign( tended.answer, ++i, convertrow(row, rowsize) ); + mysql_free_result(result); + ReturnDescriptor(tended.answer); + } /* end execute a query */ + + /* wrong argument type to mysqldb */ + ReturnError(argv[1], 110); /* list or string expected */ +} diff --git a/ipl/packs/loadfunc/Makefile b/ipl/packs/loadfunc/Makefile index 66c72d7..6c9cc2f 100644 --- a/ipl/packs/loadfunc/Makefile +++ b/ipl/packs/loadfunc/Makefile @@ -3,7 +3,7 @@ # It is assumed that the standard C functions will be found by iconx. include ../../../Makedefs -CFLAGS = -O $(CFDYN) -I../../cfuncs +CFLAGS = -O $(CFDYN) -I../../cfuncs ICONT = icont IFLAGS = -us @@ -28,7 +28,8 @@ libnames.icn: Makefile echo '$$define FUNCLIB "./$(FUNCLIB)"' >libnames.icn $(FUNCLIB): $(FUNCS) - CC="$(CC)" CFLAGS="$(CFLAGS)" sh $(MKLIB) $(FUNCLIB) $(FUNCS) + CC="$(CC)" CFLAGS="$(CFLAGS)" BIN="../../../bin" \ + sh $(MKLIB) $(FUNCLIB) $(FUNCS) # Copy progs to ../../iexe: diff --git a/ipl/packs/loadfuncpp/Makefile b/ipl/packs/loadfuncpp/Makefile new file mode 100644 index 0000000..15cce8b --- /dev/null +++ b/ipl/packs/loadfuncpp/Makefile @@ -0,0 +1,107 @@ +# loadfuncpp -- a C++ interface for icon. See doc/index.htm. + +# Requires GNU make and g++. + +CC=g++ + +ifneq ($(strip $(shell g++ -v 2>&1 | grep "darwin")),) +TARGET=mac +else +ifneq ($(strip $(shell g++ -v 2>&1 | grep "cygwin")),) +TARGET=cygwin +else +ifneq ($(strip $(shell g++ -v 2>&1 | grep "solaris")),) +#TARGET=sun +#CC=cc +TARGET=other +else +TARGET=other +endif +endif +endif + + + +#ICON_PATH = $(shell cd $(PWD)/../../..; pwd) +ICON_PATH = ../../.. + +ICON_BUILD_PATH = $(ICON_PATH) + +ICON_BIN_PATH = $(ICON_PATH)/bin +ICON_LIB_PATH = $(ICON_PATH)/lib +ICON_HDR_PATH = $(ICON_BUILD_PATH)/src/h + +ICON_HDR_FILE = \"$(ICON_HDR_PATH)/rt.h\" + +FLAGS_cygwin = -Wl,--enable-auto-import +FLAGS_cygwin_default = $(ICON_BIN_PATH)/iconx.a +FLAGS_cygwin_iexample = $(ICON_BIN_PATH)/iload.a + +SHARED_mac = -bundle -undefined suppress +SHARED_cygwin = -shared +SHARED_other = -shared + +IMPLIB_cygwin = -Wl,--out-implib=iload.a +PIC_other = -fPIC +PIC_mac = -flat_namespace + +COPY_cygwin =cp iload.a $(ICON_BIN_PATH)/ + +COPY_PACKAGE_cygwin=cp iload.a package/bin + +DEPS_cygwin_default = $(ICON_BIN_PATH)/iconx.a +DEPS_cygwin_iexample = $(ICON_BIN_PATH)/iload.a + +DEPS_default = $(ICON_BIN_PATH)/iload.so $(ICON_BIN_PATH)/iloadgpx.so $(ICON_BIN_PATH)/iloadnogpx.so +SLIBS = iload.so iloadgpx.so iloadnogpx.so + +.PHONY : default clean iconsrc iexample package + + +default : $(DEPS_default) $(DEPS_$(TARGET)_default) $(ICON_LIB_PATH)/loadfuncpp.u1 + +iload.so : %.so : %.cpp loadfuncpp.h iload.h + $(CC) $(PIC_$(TARGET)) $(SHARED_$(TARGET)) -o $@ $< $(FLAGS_$(TARGET)_default) $(FLAGS_$(TARGET)) $(IMPLIB_$(TARGET)) -DRTT=$(ICON_HDR_FILE) + +iloadgpx.so iloadnogpx.so : %.so : %.cpp loadfuncpp.h iload.h $(DEPS_$(TARGET)_iexample) + $(CC) $(PIC_$(TARGET)) $(SHARED_$(TARGET)) -o $@ $< $(FLAGS_$(TARGET)_default) $(FLAGS_$(TARGET)_iexample) $(FLAGS_$(TARGET)) -DRTT=$(ICON_HDR_FILE) + +$(DEPS_default) : $(ICON_BIN_PATH)/%.so : %.so + cp $< $(ICON_BIN_PATH) + +$(ICON_BIN_PATH)/iload.a : iload.a + cp $< $(ICON_BIN_PATH) + +iload.a : iload.so + +$(ICON_LIB_PATH)/loadfuncpp.u1 : loadfuncpp.u1 + cp loadfuncpp.u? $(ICON_LIB_PATH) + +loadfuncpp.u1 : loadfuncpp.icn + icont -cs loadfuncpp.icn + +clean Clean: + rm -f iexample *.exe *.u? *.so *.o *% *~ core .#* + +iconsrc: $(ICON_BIN_PATH) $(ICON_LIB_PATH) $(ICON_HDR_PATH) + @ echo "install Icon 9.5+ from source in $(ICON_PATH)" + @ exit 1 + +iexample: iexample.so $(DEPS_$(TARGET)_iexample) + icont -s iexample.icn + +iexample.so : iexample.cpp loadfuncpp.h + $(CC) $(PIC_$(TARGET)) $(SHARED_$(TARGET)) -o $@ $< $(FLAGS_$(TARGET)_iexample) $(FLAGS_$(TARGET)) + +package : $(SLIBS) loadfuncpp.u1 + mkdir package + mkdir package/bin + cp iload*.so package/bin + $(COPY_PACKAGE_$(TARGET)) + mkdir package/lib + cp loadfuncpp.u? package/lib + mkdir package/h + cp loadfuncpp.h package/h + tar -cf $(TARGET).tar package + gzip $(TARGET).tar + rm -rf package/ diff --git a/ipl/packs/loadfuncpp/doc/Makefile b/ipl/packs/loadfuncpp/doc/Makefile new file mode 100644 index 0000000..586d7d6 --- /dev/null +++ b/ipl/packs/loadfuncpp/doc/Makefile @@ -0,0 +1,51 @@ + +#Automatically generated from Makefile.mak and examples.txt by ../savex.icn + +# icont -ucs file.icn -> u1, u2, goes in the /opt/icon/lib/. +# g++ stuff -> .os, goes in the /opt/icon/bin/. + + +ifndef TARGET + +ifneq ($(strip $(shell g++ -v 2>&1 | grep "darwin")),) +TARGET=mac +else +ifneq ($(strip $(shell g++ -v 2>&1 | grep "cygwin")),) +TARGET=cygwin +else +TARGET=other +endif +endif + +endif + +FLAGS_cygwin = /opt/icon/bin/iload.a -Wl,--enable-auto-import +FLAGS_other = + +SHARED_mac = -bundle -undefined suppress +SHARED_cygwin = -shared +SHARED_other = -shared + +PIC_other = -fPIC +PIC_mac = -flat_namespace + +EXAMPLES = bang.exe divide.exe divide2.exe dull.exe generator.exe isexternal.exe iterate.exe keyword.exe makelist.exe object.exe +DYNAMICS = bang.so divide.so divide2.so dull.so generator.so isexternal.so iterate.so keyword.so makelist.so object.so + +%.so : %.cpp loadfuncpp.h + g++ $(SHARED_$(TARGET)) $(PIC_$(TARGET)) -o $@ $< $(FLAGS_$(TARGET)) + +%.exe : %.icn %.so + icont -so $@ $* + +default: $(DYNAMICS) $(EXAMPLES) + +.PHONY : loadfuncpp.h + +loadfuncpp.h : ../loadfuncpp.h + cp ../loadfuncpp.h ./ + +test : clean default + +clean : + rm -f *.exe *.so *.o *% *~ core .#* diff --git a/ipl/packs/loadfuncpp/doc/Makefile.mak b/ipl/packs/loadfuncpp/doc/Makefile.mak new file mode 100644 index 0000000..7a10f86 --- /dev/null +++ b/ipl/packs/loadfuncpp/doc/Makefile.mak @@ -0,0 +1,34 @@ + +ifndef TARGET +ifneq ($(strip $(shell g++ -v 2>&1 | grep "cygwin")),) +TARGET=cygwin +else +TARGET=other +endif +endif + +FLAGS_cygwin = /opt/icon/bin/iload.a -Wl,--enable-auto-import +FLAGS_other = + +PIC_other = -fPIC + +EXAMPLES = #exe# +DYNAMICS = #so# + +%.so : %.cpp loadfuncpp.h + g++ -shared $(PIC_$(TARGET)) -o $@ $< $(FLAGS_$(TARGET)) + +%.exe : %.icn %.so + icont -so $@ $* + +default: $(DYNAMICS) $(EXAMPLES) + +.PHONY : loadfuncpp.h + +loadfuncpp.h : ../loadfuncpp.h + cp ../loadfuncpp.h ./ + +test : clean default + +clean : + rm -f *.exe *.so *.o *% *~ core .#* diff --git a/ipl/packs/loadfuncpp/doc/bang.cpp b/ipl/packs/loadfuncpp/doc/bang.cpp new file mode 100644 index 0000000..c300169 --- /dev/null +++ b/ipl/packs/loadfuncpp/doc/bang.cpp @@ -0,0 +1,35 @@ + +/* Example of a C++ extension to icon via loadfunc, + * without garbage collection difficulties. + * Type 'make iexample' to build. + * Carl Sturtivant, 2008/3/16 + */ + +#include "loadfuncpp.h" +using namespace Icon; + + + + +struct addup: public iterate { + safe total; + int count; + + addup(): total(0L), count(0) {} + + virtual void takeNext(const value& x) { + total = total + x; + } + virtual bool wantNext(const value& x) { + return ++count <= 10; + } +}; + +extern "C" int sumlist(value argv[]) { + addup sum; + sum.bang(argv[1]); + argv[0] = sum.total; + return SUCCEEDED; +} + + diff --git a/ipl/packs/loadfuncpp/doc/bang.icn b/ipl/packs/loadfuncpp/doc/bang.icn new file mode 100644 index 0000000..bf0aba9 --- /dev/null +++ b/ipl/packs/loadfuncpp/doc/bang.icn @@ -0,0 +1,10 @@ + +link loadfuncpp + + +procedure main() + sumlist := loadfuncpp("./bang.so", "sumlist", 1) + write( sumlist([1,2,3,4,5]) ) +end + + diff --git a/ipl/packs/loadfuncpp/doc/compile.htm b/ipl/packs/loadfuncpp/doc/compile.htm new file mode 100644 index 0000000..04a8514 --- /dev/null +++ b/ipl/packs/loadfuncpp/doc/compile.htm @@ -0,0 +1,57 @@ +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN"> +<HTML> + +<HEAD> + <META HTTP-EQUIV="Content-Type" CONTENT="text/html;CHARSET=iso-8859-1"> + <TITLE>loadfuncpp</TITLE> + <LINK REL="stylesheet" TYPE="text/css" HREF="loadfuncpp.css"> +</HEAD> + +<BODY> + +<H3></H3> +<CENTER> +<P> +<TABLE BORDER="0" WIDTH="700"> + <TR> + <TD WIDTH="100%"> + <H1 ALIGN="CENTER"><BR> + Loadfuncpp</H1> + <H2 ALIGN="CENTER">Compiler Options</H2> + <H3 ALIGN="CENTER">Carl Sturtivant, January 2009</H3> + <BLOCKQUOTE> + <BLOCKQUOTE> + <P>When compiling a shared object (or dll) to dynamically load functions into Icon via loadfuncpp, try the following + compilation options, which have been successfully used to build libraries with version 0.91alpha on the systems + below. <BR> + <BR> + Everything is simplest if all shared objects are placed in the icon/bin directory and all linkable Icon (.u1/.u2 + files) are placed in the icon/lib directory. + </BLOCKQUOTE> + <H2>Linux</H2> + <P><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">g++ -fPIC -shared -o </FONT><I><FONT SIZE="2" FACE="Courier New, Courier">file</FONT></I><FONT + SIZE="2" COLOR="black" FACE="Courier New, Courier">.so </FONT><I><FONT SIZE="2" FACE="Courier New, Courier">file</FONT></I><FONT + SIZE="2" COLOR="black" FACE="Courier New, Courier">.cpp</FONT></P> + <H2>Cygwin</H2> + <P><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">g++ -shared -o </FONT><I><FONT SIZE="2" FACE="Courier New, Courier">file</FONT></I><FONT + SIZE="2" COLOR="black" FACE="Courier New, Courier">.so </FONT><I><FONT SIZE="2" FACE="Courier New, Courier">file</FONT></I><FONT + SIZE="2" COLOR="black" FACE="Courier New, Courier">.cpp </FONT><I><FONT SIZE="2" FACE="Courier New, Courier">iload_so_directory</FONT></I><FONT + SIZE="2" COLOR="black" FACE="Courier New, Courier">/iload.a</FONT></P> + <H2>Macintosh</H2> + <P><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">g++ -flat_namespace -bundle -undefined suppress -o + </FONT><I><FONT SIZE="2" FACE="Courier New, Courier">file</FONT></I><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">.so + </FONT><I><FONT SIZE="2" FACE="Courier New, Courier">file</FONT></I><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">.cpp</FONT> + <H2>Solaris</H2> + <P><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">g++ -fPIC -shared -o </FONT><I><FONT SIZE="2" FACE="Courier New, Courier">file</FONT></I><FONT + SIZE="2" COLOR="black" FACE="Courier New, Courier">.so </FONT><I><FONT SIZE="2" FACE="Courier New, Courier">file</FONT></I><FONT + SIZE="2" COLOR="black" FACE="Courier New, Courier">.cpp</FONT> + </BLOCKQUOTE> + </TD> + </TR> +</TABLE> + +</CENTER> + +</BODY> + +</HTML> diff --git a/ipl/packs/loadfuncpp/doc/divide.cpp b/ipl/packs/loadfuncpp/doc/divide.cpp new file mode 100644 index 0000000..a9f3d99 --- /dev/null +++ b/ipl/packs/loadfuncpp/doc/divide.cpp @@ -0,0 +1,20 @@ + + +/* Example of a C++ extension to icon via loadfunc, + * without garbage collection difficulties. + * Type 'make iexample' to build. + * Carl Sturtivant, 2008/3/16 + */ + + +#include "loadfuncpp.h" +using namespace Icon; + +extern "C" int div(value argv[]) { + safe x(argv[1]), y(argv[2]), z; + z = ( x/y, x%y ); + argv[0] = z; + return SUCCEEDED; +} + + diff --git a/ipl/packs/loadfuncpp/doc/divide.icn b/ipl/packs/loadfuncpp/doc/divide.icn new file mode 100644 index 0000000..9e5c0b8 --- /dev/null +++ b/ipl/packs/loadfuncpp/doc/divide.icn @@ -0,0 +1,10 @@ + +link loadfuncpp + +procedure main() + div := loadfuncpp("./divide.so", "div", 2) + ls := div(79, 10) + every write(!ls) +end + + diff --git a/ipl/packs/loadfuncpp/doc/divide2.cpp b/ipl/packs/loadfuncpp/doc/divide2.cpp new file mode 100644 index 0000000..a9f3d99 --- /dev/null +++ b/ipl/packs/loadfuncpp/doc/divide2.cpp @@ -0,0 +1,20 @@ + + +/* Example of a C++ extension to icon via loadfunc, + * without garbage collection difficulties. + * Type 'make iexample' to build. + * Carl Sturtivant, 2008/3/16 + */ + + +#include "loadfuncpp.h" +using namespace Icon; + +extern "C" int div(value argv[]) { + safe x(argv[1]), y(argv[2]), z; + z = ( x/y, x%y ); + argv[0] = z; + return SUCCEEDED; +} + + diff --git a/ipl/packs/loadfuncpp/doc/divide2.icn b/ipl/packs/loadfuncpp/doc/divide2.icn new file mode 100644 index 0000000..48da848 --- /dev/null +++ b/ipl/packs/loadfuncpp/doc/divide2.icn @@ -0,0 +1,10 @@ + +link loadfuncpp + +procedure main() + div := loadfuncpp("./divide2.so", "div", 2) + ls := div(79, 10) + every write(!ls) +end + + diff --git a/ipl/packs/loadfuncpp/doc/dull.cpp b/ipl/packs/loadfuncpp/doc/dull.cpp new file mode 100644 index 0000000..f1683ee --- /dev/null +++ b/ipl/packs/loadfuncpp/doc/dull.cpp @@ -0,0 +1,15 @@ + +/* Example of a C++ extension to icon via loadfunc, + * without garbage collection difficulties. + * Type 'make iexample' to build. + * Carl Sturtivant, 2008/3/16 + */ + +#include "loadfuncpp.h" +using namespace Icon; + +extern "C" int dull(value argv[]) { + argv[0] = nullvalue; + return SUCCEEDED; +} + diff --git a/ipl/packs/loadfuncpp/doc/dull.icn b/ipl/packs/loadfuncpp/doc/dull.icn new file mode 100644 index 0000000..128f8a1 --- /dev/null +++ b/ipl/packs/loadfuncpp/doc/dull.icn @@ -0,0 +1,9 @@ + +link loadfuncpp + + +procedure main() + dull := loadfuncpp("./dull.so", "dull", 1) + write(image( dull() )) +end + diff --git a/ipl/packs/loadfuncpp/doc/examples.txt b/ipl/packs/loadfuncpp/doc/examples.txt new file mode 100644 index 0000000..3b6a98e --- /dev/null +++ b/ipl/packs/loadfuncpp/doc/examples.txt @@ -0,0 +1,10 @@ +bang +divide +divide2 +dull +generator +isexternal +iterate +keyword +makelist +object diff --git a/ipl/packs/loadfuncpp/doc/generator.cpp b/ipl/packs/loadfuncpp/doc/generator.cpp new file mode 100644 index 0000000..5f99158 --- /dev/null +++ b/ipl/packs/loadfuncpp/doc/generator.cpp @@ -0,0 +1,31 @@ + +/* Example of a C++ extension to icon via loadfunc, + * without garbage collection difficulties. + * Type 'make iexample' to build. + * Carl Sturtivant, 2008/3/16 + */ + +#include "loadfuncpp.h" +using namespace Icon; + +class sequence: public generator { + safe current, inc; + public: + sequence(safe start, safe increment) { + current = start - increment; + inc = increment; + } + virtual bool hasNext() { + return true; + } + virtual value giveNext() { + return current = current + inc; + } +}; + +extern "C" int seq2(value argv[]){ + sequence seq(argv[1], argv[2]); + return seq.generate(argv); +} + + diff --git a/ipl/packs/loadfuncpp/doc/generator.icn b/ipl/packs/loadfuncpp/doc/generator.icn new file mode 100644 index 0000000..cf46dff --- /dev/null +++ b/ipl/packs/loadfuncpp/doc/generator.icn @@ -0,0 +1,9 @@ + +link loadfuncpp + + +procedure main() + seq2 := loadfuncpp("./generator.so", "seq2", 1) + every write( seq2(1001, 99) \ 30 ) +end + diff --git a/ipl/packs/loadfuncpp/doc/hello.php b/ipl/packs/loadfuncpp/doc/hello.php new file mode 100644 index 0000000..d96e074 --- /dev/null +++ b/ipl/packs/loadfuncpp/doc/hello.php @@ -0,0 +1,10 @@ +<HTML> + <HEAD> + <TITLE>Hello World</TITLE> + </HEAD> + <BODY> +<? + print("Hello World"); +?> + </BODY> +</HTML> diff --git a/ipl/packs/loadfuncpp/doc/icall.txt b/ipl/packs/loadfuncpp/doc/icall.txt new file mode 100644 index 0000000..700929f --- /dev/null +++ b/ipl/packs/loadfuncpp/doc/icall.txt @@ -0,0 +1,140 @@ + +A Technique to Call Icon from C under Icon Version 9 + Carl Sturtivant, 2008/2/20 Confidential Draft #1 + + +1. Summary. + +A new Icon function written in C with a special interface may be +dynamically loaded from a shared object using the built-in function +loadfunc [GT95]. We show how such a function may in turn call an Icon +procedure using the technique described below, provided that the +procedure call itself does not suspend, but only returns or fails. Note +that this does not impose constraints of any kind upon other procedures +executed as a consequence of calling the original procedure. In +particular, the Icon procedure called from C may in turn lead to a call +of another Icon function written in C calling Icon recursively. The +technique described has been implemented and briefly tested with Icon +9.51(?). + + +2. Overview. + +If the body of an Icon function written in C is to call an Icon +procedure that does not suspend and retrieve its return value, all +without modifying iconx, then there are a number of hurdles to jump. +The procedure descriptor, and those of its arguments must be pushed +onto the Icon stack, and the interpreter induced to believe it needs to +execute an icode instruction to invoke it, one that is not present in +the icode it loaded. Once the procedure returns (or fails) the +interpreter must be induced to return control to C just after the point +where the attempt to call it occurred, rather than simply to go on to +the next icode instruction. Then the result of the call needs to be +popped off the Icon stack so that it is in the same state as before the +call, since C does not normally modify the Icon stack. (Other details +of the state of the interpreter will be restored by the mechanism +whereby a procedure is called in Icon.) In all other respects, the main +interpreter loop must continue to behave as before. + +These hurdles are insurmountable, so long as the code of the main +interpreter loop is inviolate. The code of that loop as it is +incorporated into iconx is inviolate, since a design goal is that the +technique should work with the existing implementation. Therefore, we +take a copy of that loop, and modify it to the ends above, and execute +it only in order to call Icon. (The original interpreter continues to +be used for all other purposes.) Dynamic linking allows the new +interpreter loop to refer to all C globals and functions in iconx, and +so nothing else need be copied, these things are merely referred to. In +fact it takes very little modification of the copy to achieve these +goals, and the result is a C function called icall to which the +procedure and its arguments are passed to effect the call to Icoan. To +simplify this interface, the arguments are passed as a single Icon +list. The resulting function then has similar semantics as the binary +"!" operator in Icon, (which we henceforth call 'apply' as it applies a +procedure to its argument list) except that it may be called from C. + + +3. Implementation. + +The main interpreter loop written in RTL resides in the file +src/runtime/interp.r in the Icon distribution. This was translated into +the corresponding C file xinterp.c by the RTL translator rtt with the +command 'rtt -x interp.r'. Now this C file is edited into a file +compiled into a single C function called icall, taking two descriptors +(a procedure and a list of arguments) and returning an integer code. +The effect of calling icall is to apply the procedure to its arguments, +and restore the state of the interpreter, leaving the result of the +call just beyond the stack pointer for retrieval. + +The contents of xinterp.c consist of some global variables and a +function interp containing the interpreter loop. The global variable +declarations are all modified by prefixing them with 'extern', so that +they now simply refer to those used by the interpreter loop inside +iconx. The function interp that returns an integer signal and has two +parameters: an integer fsig used when the interpreter is called +recursively to simulate suspension, and cargp, a pointer into the Icon +stack. The function interp is renamed icall. + +Examination of src/runtime/init.r indicates that the signal 0 is passed +to interp when it is initially called non-recursively to start up +iconx. So fsig is removed from the parameter list and made a local +variable initialized to 0. Similarly cargp is made a local variable, +and icall is given two parameters theProc and arglist used to pass that +necessary for the call to Icon. Immediately after the initial +declarations inside icall, the Icon stack pointer sp is used to +initialize cargp to refer to the first descriptor on the stack beyond +sp, which is assigned the procedure desciptor parameter of icall. The +desciptor beyond that is assigned the argument list descriptor +parameter, and the stack pointer augmented to refer to its last word. A +new local variable result_sp is initialized to location on the stack of +the last word of the procedure descriptor. This is used by the +mechanism to return to C described below. Now the details of pushing +the procedure descriptor and the argument list descriptor onto the +stack are complete. + +The body of interp consists of some straight-line code followed by the +interpreter loop, which contains some code to get the next icode +instruction followed by a switch to jump to the correct code to execute +it, all inside and endless loop. Just before the loop starts, an +unconditional goto is inserted, jumping to a newly inserted label +called aptly 'apply' which is placed just after the switch label +(called Op_Apply in interp.r) which precedes the code to implement the +icode 'apply' instruction, that implements the apply operator (binary +"!") in Icon. This instruction expects to find a procedure descriptor +and a list descriptor on the stack, and then causes the icode +instructions of the procedure to be accordingly invoked. Now the +details of calling the procedure are complete. What is left to insert +is the mechanism to return to C. + +When the procedure that we called returns or fails, it will execute a +'pret' instruction or a 'pfail' instruction. However, these +instructions may also be executed by Icon procedures called from the +one we called. At the end of the code for 'pret' inside the switch in +the interpreter is a 'break' to leave the switch and go round to get +the next icode instruction. Just before that 'break' we can tell if our +procedure call is the one returning by comparing the Icon stack pointer +sp to the one we saved, result_sp, which our procedure call will have +restored sp to when it overwrote the procedure descriptor with the +result of the call. So if they are equal, we can clean up (decrement +ilevel, move sp just before the former procedure descriptor) and +return, finishing the call to icall. Now C can retrieve the result of +the call just beyond the stack pointer. The 'pfail' code is similar, +just before a jump to efail, which we do not execute since the context +of our call is not an Icon expression. C can determine success or +failure from the integer code returned. This completes the mechanism to +return to C. + + +4. Conclusions + +Overall this mechanism depends upon few things, mainly upon the fact +that when a procedure is called, the Icon stack below the part used for +the call is not modified during the call. Our copy of the interpreter +loop is identical to the original with the exception of the code added +for the C return mechanism, which is only exceptionally executed. And +the Icon procedure call mechanism itself will save and restore the +interpreter state apart from the stack pointer which we abuse at the +start and restore at the end. The compiled result with gcc was about 10 +Kbyte. A simple test confirmed that call and return occur in the +correct order, from Icon to C to Icon returning to C returning to Icon. + diff --git a/ipl/packs/loadfuncpp/doc/index.htm b/ipl/packs/loadfuncpp/doc/index.htm new file mode 100644 index 0000000..dad9df8 --- /dev/null +++ b/ipl/packs/loadfuncpp/doc/index.htm @@ -0,0 +1,87 @@ +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN"> +<HTML> + +<HEAD> + <META HTTP-EQUIV="Content-Type" CONTENT="text/html;CHARSET=iso-8859-1"> + <TITLE>loadfuncpp</TITLE> + <LINK REL="stylesheet" TYPE="text/css" HREF="loadfuncpp.css"> +</HEAD> + +<BODY> + +<CENTER> +<P> +<TABLE BORDER="0" WIDTH="700"> + <TR> + <TD WIDTH="100%"> + <H1 ALIGN="CENTER"><BR> + Loadfuncpp</H1> + <H2 ALIGN="CENTER">A Dynamic Library used to aid Adding <BR> + External Functions written in C++ to<BR> + <A HREF="http://www.cs.arizona.edu/icon/lb3.htm" target="_blank">The Icon Programming Language</A></H2> + <H3 ALIGN="CENTER">Carl Sturtivant, February 2010, <FONT COLOR="#FF9900">version 0.91alpha</FONT></H3> + <BLOCKQUOTE> + <H5><FONT COLOR="#FF9900"></FONT></H5> + <H3><FONT COLOR="#CC0000">Features</FONT></H3> + </BLOCKQUOTE> + <UL> + <LI><FONT COLOR="#FF9900">Works with the existing Icon runtime system with no modification</FONT> + <LI><FONT COLOR="#FF9900">Call Icon with call syntax from C++ and vice-versa, recursively</FONT> + <LI><FONT COLOR="#FF9900">Has a simple way to create new Icon datatypes by inheritance</FONT> + <LI><FONT COLOR="#FF9900">Write new Icon functions in C++ that suspend a sequence of results</FONT> + <LI><FONT COLOR="#FF9900">Iterate in C++ through result sequences generated by Icon</FONT> + <LI><FONT COLOR="#FF9900">All Icon functions, keywords and operators made available in C++</FONT> + <LI><FONT COLOR="#FF9900">Takes care of garbage collection safety automatically</FONT> + <H5></H5> + </UL> + <BLOCKQUOTE> + <BLOCKQUOTE> + <BLOCKQUOTE> + <BLOCKQUOTE> + <BLOCKQUOTE> + <H4><A HREF="manual.htm">documentation</A><BR> + <A HREF="loadfuncpp.htm">experimental binaries</A><BR> + <A HREF="compile.htm">compilation options</A></H4> + </BLOCKQUOTE> + </BLOCKQUOTE> + </BLOCKQUOTE> + </BLOCKQUOTE> + <H3>News</H3> + <BLOCKQUOTE> + <P>2010/2/10 (I am releasing this now having moved on to a new implementation of the language entirely.) There + are no known bugs, but bugs almost certainly exist. This pack needs systematic in-depth testing for subtle issues + connected to garbage collection. Specifically, the mechanism to call Icon from C++ pushes onto the top of the Icon + stack a region used by a copy of the interpreter loop that's used to execute the Icon procedure called from C++. + I have not investigated how the Icon stack is garbage collected, and this region does not extend the stack the + way that Icon does. If this proves unsafe for garbage collection, the stack region for such a call may have to + have suitable frames containing pointers to the lower part of the stack (or vice-versa) placed in it to repair + this deficiency. Also, the way garbage collection safety of Icon values in C++ variables is ensured is to use the + constructor to implicitly link them onto the far end of the main co-expression's safe list, and unlink them from + there using the destructor. This is almost certainly safe from the usual call and return mechanism in iconx for + protecting local variables, but needs testing and verification.<BR> + <BR> + 2009/1/20 fixed a bug where a call of any C++ external function that in turn calls Icon and afterIcon returns calls + Icon::runerr would not correctly report the name and arguments of said function in the resulting traceback. Upped + the version number to 0.91alpha.<BR> + <BR> + 2009/1/20 loadfuncpp now searches for a shared object on the path defined by the environment variable FPATH with + the icon/bin directory appended if you specify no path. FPATH undefined leads loadfuncpp to search the current + directory followed by the icon/bin directory.<BR> + <BR> + 2009/1/12 <FONT COLOR="#FF9900">loadfuncpp has been completely overhauled</FONT>, and the old version is now obsolete. + Many small functions have been added to eliminate ambiguities in programs that use loadfuncpp, and the central + class has been renamed and a class eliminated. Small pieces of missing functionality have been added. The documentation + has been modified accordingly. It is now close to it's final form, and in need of some serious beta testing, and + I have someone who has agreed to do that. Once this is done, loadfuncpp will be made available as a pack with the + Icon 9.5 source distribution. + </BLOCKQUOTE> + </BLOCKQUOTE> + </TD> + </TR> +</TABLE> + +</CENTER> + +</BODY> + +</HTML> diff --git a/ipl/packs/loadfuncpp/doc/isexternal.cpp b/ipl/packs/loadfuncpp/doc/isexternal.cpp new file mode 100644 index 0000000..ef5d219 --- /dev/null +++ b/ipl/packs/loadfuncpp/doc/isexternal.cpp @@ -0,0 +1,31 @@ + + +/* Example of a C++ extension to icon via loadfunc, + * without garbage collection difficulties. + * Type 'make iexample' to build. + * Carl Sturtivant, 2008/3/16 + */ + + +#include "loadfuncpp.h" +using namespace Icon; + +class myval: public external { + public: + virtual value name() { return "my external"; } +}; + +extern "C" int myext(value argv[]) { + argv[0] = new myval(); + return SUCCEEDED; +} + +extern "C" int ismine(value argv[]) { + if( argv[1].isExternal("my external") ) + argv[0] = "Yes!"; + else + argv[0] = "No!"; + return SUCCEEDED; +} + + diff --git a/ipl/packs/loadfuncpp/doc/isexternal.icn b/ipl/packs/loadfuncpp/doc/isexternal.icn new file mode 100644 index 0000000..bfa509a --- /dev/null +++ b/ipl/packs/loadfuncpp/doc/isexternal.icn @@ -0,0 +1,14 @@ + +link loadfuncpp + +procedure main() + myext := loadfuncpp("./isexternal.so", "myext", 0) + ismine := loadfuncpp("./isexternal.so", "ismine", 1) + x := myext() + write(image(x)) + write(image(type(x))) + write("is mine? ", ismine(x)) + write("is also mine? ", ismine(3)) +end + + diff --git a/ipl/packs/loadfuncpp/doc/iterate.cpp b/ipl/packs/loadfuncpp/doc/iterate.cpp new file mode 100644 index 0000000..9a57e59 --- /dev/null +++ b/ipl/packs/loadfuncpp/doc/iterate.cpp @@ -0,0 +1,34 @@ + +/* Example of a C++ extension to icon via loadfunc, + * without garbage collection difficulties. + * Type 'make iexample' to build. + * Carl Sturtivant, 2008/3/16 + */ + +#include "loadfuncpp.h" +using namespace Icon; + + +struct addup: public iterate { + safe total; + int count; + + addup(): total(0L), count(0) {} + + virtual void takeNext(const value& x) { + total = total + x; + } + virtual bool wantNext(const value& x) { + return ++count <= 10; + } +}; + + +extern "C" int sum10(value argv[]){ + addup sum; + sum.every(argv[1], argv[2]); + argv[0] = sum.total; + return SUCCEEDED; +} + + diff --git a/ipl/packs/loadfuncpp/doc/iterate.icn b/ipl/packs/loadfuncpp/doc/iterate.icn new file mode 100644 index 0000000..1fd1cb7 --- /dev/null +++ b/ipl/packs/loadfuncpp/doc/iterate.icn @@ -0,0 +1,13 @@ + +link loadfuncpp + + +procedure main() + sum10 := loadfuncpp("./iterate.so", "sum10", 2) + write( sum10(f,[]) ) +end + +procedure f() + suspend 1 to 15 +end + diff --git a/ipl/packs/loadfuncpp/doc/keyword.cpp b/ipl/packs/loadfuncpp/doc/keyword.cpp new file mode 100644 index 0000000..3e3bde8 --- /dev/null +++ b/ipl/packs/loadfuncpp/doc/keyword.cpp @@ -0,0 +1,16 @@ + +/* Example of a C++ extension to icon via loadfunc, + * without garbage collection difficulties. + * Type 'make iexample' to build. + * Carl Sturtivant, 2008/3/16 + */ + +#include "loadfuncpp.h" +using namespace Icon; + +extern "C" int assignprog(value argv[]) { + safe newname(argv[1]); + &progname = newname; + return FAILED; +} + diff --git a/ipl/packs/loadfuncpp/doc/keyword.icn b/ipl/packs/loadfuncpp/doc/keyword.icn new file mode 100644 index 0000000..0340f9c --- /dev/null +++ b/ipl/packs/loadfuncpp/doc/keyword.icn @@ -0,0 +1,10 @@ + +link loadfuncpp + + +procedure main() + assignprog := loadfuncpp("./keyword.so", "assignprog", 1) + assignprog("Silly") + write(&progname) +end + diff --git a/ipl/packs/loadfuncpp/doc/loadfuncpp.css b/ipl/packs/loadfuncpp/doc/loadfuncpp.css new file mode 100644 index 0000000..975cbcb --- /dev/null +++ b/ipl/packs/loadfuncpp/doc/loadfuncpp.css @@ -0,0 +1,41 @@ +body { background-color: #FFFFFF; + color: #0066CC; + font-family: Georgia, "Times New Roman", serif; +} +h1 { background-color: #CCFFFF; + color: #0099FF; + line-height: 200%; + font-family: Georgia, "Times New Roman", serif; +} +h2 { background-color: #CCFFFF; + color: #0099FF; + font-family: Georgia, "Times New Roman", serif; + line-height: 100% +} +h3 { background-color: #CCFFFF; + font-family: Georgia, "Times New Roman", serif; + line-height: 90% +} +h4 { background-color: #FFFFFF; + color: #FF9900; + font-family: Georgia, "Times New Roman", serif; + line-height: 100% +} +a {color: #333300; +} +p {font-size: 120%; +} +ul {font-weight: bold; +} +#wrapper { width: 850px; + margin-left: auto; + margin-right: auto; +} +.nav { font-weight: bold; + font-size: 1.25em; +} +#footer {font-size: .75em; + font-style: italic; +} + + diff --git a/ipl/packs/loadfuncpp/doc/loadfuncpp.h b/ipl/packs/loadfuncpp/doc/loadfuncpp.h new file mode 100644 index 0000000..934bca9 --- /dev/null +++ b/ipl/packs/loadfuncpp/doc/loadfuncpp.h @@ -0,0 +1,470 @@ + +/* C++ support for easy extensions to icon via loadfunc, + * without garbage collection difficulties. + * Include this and link to iload.cpp which + * contains the necessary glue. + * See iexample.cpp for typical use. + * Carl Sturtivant, 2008/3/17 + */ + +#include<new> +#include <cstdio> + +enum kind { Null, Integer, BigInteger, Real, Cset, File, Procedure, Record, List, + Set=10, Table=12, String, Constructor, Coexpression=18, External, Variable }; + +enum special_value { NullString, StringLiteral, NewString, NullChar, Illegal }; + +enum { + SUCCEEDED = 7, // Icon function call returned: A_Continue + FAILED = 1 // Icon function call failed: A_Resume +}; + +class value; //Icon value (descriptor) +class safe; //for garbage-collection-safe Icon valued C++ variables and parameters of all kinds +class keyword; //Icon keyword represented as an object with unary & +class variadic; //for garbage-collection-safe variadic function argument lists +class proc_block; //block specifying a procedure to iconx +class external_block; //block specifying an external value to iconx +class external_ftable; //function pointers specifying external value behavior to iconx +class external; //C++ Object specifying an external value + +typedef int iconfunc(value argv[]); //type of icon built in functions or operators with a fixed number of arguments +typedef int iconfvbl(int argc, value argv[]); //type of icon built in functions with a variable number of arguments + +extern const value nullvalue; //for default arguments +extern const value nullstring; +extern const value nullchar; +extern const value illegal; //for unwanted trailing arguments +extern void syserror(const char*); //fatal termination Icon-style with error message +#define Fs_Read 0001 /* file open for reading */ +#define Fs_Write 0002 /* file open for writing */ +extern value IconFile(int fd, int status, char* fname); //make an Icon file descriptor + +namespace Icon { +//all keywords excepting &fail, &cset (avoiding a name collision with function cset) +extern keyword allocated; +extern keyword ascii; +extern keyword clock; +extern keyword collections; +extern keyword current; +extern keyword date; +extern keyword dateline; +extern keyword digits; +extern keyword dump; +extern keyword e; +extern keyword error; +extern keyword errornumber; +extern keyword errortext; +extern keyword errorvalue; +extern keyword errout; +extern keyword features; +extern keyword file; +extern keyword host; +extern keyword input; +extern keyword lcase; +extern keyword letters; +extern keyword level; +extern keyword line; +extern keyword main; +extern keyword null; +extern keyword output; +extern keyword phi; +extern keyword pi; +extern keyword pos; +extern keyword progname; +extern keyword random; +extern keyword regions; +extern keyword source; +extern keyword storage; +extern keyword subject; +extern keyword time; +extern keyword trace; +extern keyword ucase; +extern keyword version; +}; //namespace Icon + +static void initialize_keywords(); + +class keyword { //objects representing Icon keywords + friend void initialize_keywords(); + iconfunc* f; + public: + safe operator&(); //get the keyword's value (could be an Icon 'variable') +}; + + +class value { //a descriptor with class +//data members modelled after 'typedef struct { word dword, vword; } descriptor;' from icall.h + private: + long dword; + long vword; + public: + friend class safe; + friend value IconFile(FILE* fd, int status, char* fname); + value(); //&null + value(special_value, const char* text = ""); + value(int argc, value* argv); //makes a list of parameters passed in from Icon + value(int); + value(long); + value(float); + value(double); + value(char*); + value(const char*); + value(proc_block&); + value(proc_block*); + value(external*); + operator int(); + operator long(); + operator float(); + operator double(); + operator char*(); + operator external*(); + operator proc_block*() const; + bool operator==(const value&) const; + value& dereference(); + value intify(); + bool isNull(); + bool notNull(); + bool isExternal(const value&); + value size() const; + kind type(); + bool toString(); //attempted conversion in place + bool toCset(); + bool toInteger(); + bool toReal(); + bool toNumeric(); + value subscript(const value&) const; //produces an Icon 'variable' + value& assign(const value&); //dereferences Icon style + value put(value x = nullvalue); + value push(value x = nullvalue); + void dump() const; + void printimage() const; + int compare(const value&) const; //comparator-style result: used for Icon sorting + value negative() const; // -x + value complement() const; // ~x + value refreshed() const; // ^x + value random() const; // ?x + value plus(const value&) const; + value minus(const value&) const; + value multiply(const value&) const; + value divide(const value&) const; + value remainder(const value&) const; + value power(const value&) const; + value union_(const value&) const; // x ++ y + value intersection(const value&) const; // x ** y + value difference(const value&) const; // x -- y + value concatenate(const value&) const; // x || y + value listconcatenate(const value&) const;// x ||| y + value slice(const value&, const value&) const; // x[y:z] + value& swap(value&); // x :=: y + value activate(const value& y = nullvalue) const; // y @ x ('*this' is activated) + value apply(const value&) const; // x!y (must return, not fail or suspend) +}; //class value + + +class generator { +//class to inherit from for defining loadable functions that are generators + public: + int generate(value argv[]); //call to suspend everything produced by next() + protected: //override these, and write a constructor + virtual bool hasNext(); + virtual value giveNext(); +}; //class generator + + +class iterate { +//class to inherit from for iterating over f!arg or !x + public: + void every(const value& g, const value& arg); //perform the iteration over g!arg + void bang(const value& x); //perform the iteration over !x + //override these, write a constructor and the means of recovering the answer + virtual bool wantNext(const value& x); + virtual void takeNext(const value& x); +}; + + + +class safe_variable { +//data members modelled after 'struct tend_desc' from rstructs.h + friend class value; + friend inline int safecall_0(iconfunc*, value&); + friend inline int safecall_1(iconfunc*, value&, const value&); + friend inline int safecall_2(iconfunc*, value&, const value&, const value&); + friend inline int safecall_3(iconfunc*, value&, const value&, const value&, const value&); + friend inline int safecall_4(iconfunc*, value&, const value&, const value&, const value&, const value&); + friend inline int safecall_5(iconfunc*, value&, const value&, const value&, const value&, const value&, const value&); + friend inline int safecall_6(iconfunc*, value&, const value&, const value&, const value&, const value&, const value&, const value&); + friend inline int safecall_v0(iconfvbl*, value&); + friend inline int safecall_v1(iconfvbl*, value&, const value&); + friend inline int safecall_v2(iconfvbl*, value&, const value&, const value&); + friend inline int safecall_v3(iconfvbl*, value&, const value&, const value&, const value&); + friend inline int safecall_vbl(iconfvbl*,safe&, const variadic&); + protected: + safe_variable *previous; + int num; + value val; + safe_variable(); + safe_variable(int); + safe_variable(long); + safe_variable(double); + safe_variable(value); + safe_variable(proc_block&); + safe_variable(proc_block*); + safe_variable(int, value*); + inline void push(safe_variable*& tendlist, int numvalues=1); + inline void pop(safe_variable*& tendlist); +}; //class safe_variable + + +class variadic: public safe_variable { + public: + variadic(int); + variadic(long); + variadic(float); + variadic(double); + variadic(char*); + variadic(value); + variadic(const safe&); + variadic(const safe&, const safe&); + variadic& operator,(const safe&); + operator value(); + ~variadic(); +}; //class variadic + + +class external_block { +//modelled on 'struct b_external' in icon/src/h/rstructs.h + friend class external; + friend class value; + static long extra_bytes; //silent extra parameter to new + long title; + long blksize; + long id; + external_ftable* funcs; + external* val; + static void* operator new(size_t); //allocated by iconx + static void operator delete(void*); //do nothing + external_block(); +}; + +class external { + friend class value; + static external_block* blockptr; //silent extra result of new + protected: + long id; + public: + static void* operator new(size_t); //allocated by new external_block() + static void operator delete(void*); //do nothing + external(); + virtual ~external() {} //root class + virtual long compare(external*); + virtual value name(); + virtual external* copy(); + virtual value image(); +}; + + +class safe: public safe_variable { +//use for a garbage collection safe icon valued safe C++ variable + friend class variadic; + friend class global; + public: + safe(); //&null + safe(const safe&); + safe(int); + safe(long); + safe(float); + safe(double); + safe(char*); + safe(const value&); + safe(const variadic&); + safe(proc_block&); + safe(proc_block*); + safe(int, value*); //from parameters sent in from Icon + ~safe(); + safe& operator=(const safe&); + //augmenting assignments here + safe& operator+=(const safe&); + safe& operator-=(const safe&); + safe& operator*=(const safe&); + safe& operator/=(const safe&); + safe& operator%=(const safe&); + safe& operator^=(const safe&); + safe& operator&=(const safe&); + safe& operator|=(const safe&); + // ++ and -- here + safe& operator++(); + safe& operator--(); + safe operator++(int); + safe operator--(int); + //conversion to value + operator value() const; + //procedure call + safe operator()(); + safe operator()(const safe&); + safe operator()(const safe& x1, const safe& x2, + const safe& x3 = illegal, const safe& x4 = illegal, + const safe& x5 = illegal, const safe& x6 = illegal, + const safe& x7 = illegal, const safe& x8 = illegal); + safe operator[](const safe&); + + friend safe operator*(const safe&); //size + friend safe operator-(const safe&); + friend safe operator~(const safe&); //set complement + friend safe operator+(const safe&, const safe&); + friend safe operator-(const safe&, const safe&); + friend safe operator*(const safe&, const safe&); + friend safe operator/(const safe&, const safe&); + friend safe operator%(const safe&, const safe&); + friend safe operator^(const safe&, const safe&); //exponentiation + friend safe operator|(const safe&, const safe&); //union + friend safe operator&(const safe&, const safe&); //intersection + friend safe operator&&(const safe&, const safe&); //set or cset difference + friend safe operator||(const safe&, const safe&); //string concatenation + friend bool operator<(const safe&, const safe&); + friend bool operator>(const safe&, const safe&); + friend bool operator<=(const safe&, const safe&); + friend bool operator>=(const safe&, const safe&); + friend bool operator==(const safe&, const safe&); + friend bool operator!=(const safe&, const safe&); + friend variadic operator,(const safe&, const safe&); //variadic argument list construction + + safe slice(const safe&, const safe&); // x[y:z] + safe apply(const safe&); // x ! y + safe listcat(const safe&); // x ||| y + safe& swap(safe&); // x :=: y + safe create(); // create !x + safe create(const safe&); // create x!y + safe activate(const safe& y = nullvalue); // y@x + safe refresh(); // ^x + safe random(); // ?x + safe dereference(); // .x + bool isIllegal() const; //is an illegal value used for trailing arguments +}; //class safe + + +//Icon built-in functions +namespace Icon { + safe abs(const safe&); + safe acos(const safe&); + safe args(const safe&); + safe asin(const safe&); + safe atan(const safe&, const safe&); + safe center(const safe&, const safe&, const safe&); + safe char_(const safe&); + safe chdir(const safe&); + safe close(const safe&); + safe collect(); + safe copy(const safe&); + safe cos(const safe&); + safe cset(const safe&); + safe delay(const safe&); + safe delete_(const safe&, const safe&); + safe detab(const variadic&); + safe detab( const safe& x1, const safe& x2, + const safe& x3=illegal, const safe& x4=illegal, + const safe& x5=illegal, const safe& x6=illegal, + const safe& x7=illegal, const safe& x8=illegal ); + safe display(const safe&, const safe&); + safe dtor(const safe&); + safe entab(const variadic&); + safe entab( const safe& x1, const safe& x2, + const safe& x3=illegal, const safe& x4=illegal, + const safe& x5=illegal, const safe& x6=illegal, + const safe& x7=illegal, const safe& x8=illegal ); + safe errorclear(); + safe exit(const safe&); + safe exp(const safe&); + safe flush(const safe&); + safe function(); //generative: returns a list + safe get(const safe&); + safe getch(); + safe getche(); + safe getenv(const safe&); + safe iand(const safe&, const safe&); + safe icom(const safe&); + safe image(const safe&); + safe insert(const safe&, const safe&, const safe&); + safe integer(const safe&); + safe ior(const safe&, const safe&); + safe ishift(const safe&, const safe&); + safe ixor(const safe&, const safe&); + safe kbhit(); + safe left(const safe&, const safe&, const safe&); + safe list(const safe&, const safe&); + safe loadfunc(const safe&, const safe&); + safe log(const safe&); + safe map(const safe&, const safe&, const safe&); + safe member(const safe&, const safe&); + safe name(const safe&); + safe numeric(const safe&); + safe open(const safe&, const safe&); + safe ord(const safe&); + safe pop(const safe&); + safe proc(const safe&, const safe&); + safe pull(const safe&); + safe push(const variadic&); + safe push( const safe& x1, const safe& x2, + const safe& x3=illegal, const safe& x4=illegal, + const safe& x5=illegal, const safe& x6=illegal, + const safe& x7=illegal, const safe& x8=illegal ); + safe put(const variadic&); + safe put( const safe& x1, const safe& x2, + const safe& x3=illegal, const safe& x4=illegal, + const safe& x5=illegal, const safe& x6=illegal, + const safe& x7=illegal, const safe& x8=illegal ); + safe read(const safe&); + safe reads(const safe&, const safe&); + safe real(const safe&); + safe remove(const safe&); + safe rename(const safe&, const safe&); + safe repl(const safe&, const safe&); + safe reverse(const safe&); + safe right(const safe&, const safe&, const safe&); + safe rtod(const safe&); + safe runerr(const safe&, const safe&); + safe runerr(const safe&); + safe seek(const safe&, const safe&); + safe serial(const safe&); + safe set(const safe&); + safe sin(const safe&); + safe sort(const safe&, const safe&); + safe sortf(const safe&, const safe&); + safe sqrt(const safe&); + safe stop(); + safe stop(const variadic&); + safe stop( const safe& x1, const safe& x2, + const safe& x3=illegal, const safe& x4=illegal, + const safe& x5=illegal, const safe& x6=illegal, + const safe& x7=illegal, const safe& x8=illegal ); + safe string(const safe&); + safe system(const safe&); + safe table(const safe&); + safe tan(const safe&); + safe trim(const safe&, const safe&); + safe type(const safe&); + safe variable(const safe&); + safe where(const safe&); + safe write(); + safe write(const variadic&); + safe write( const safe& x1, const safe& x2, + const safe& x3=illegal, const safe& x4=illegal, + const safe& x5=illegal, const safe& x6=illegal, + const safe& x7=illegal, const safe& x8=illegal ); + safe writes(const variadic&); + safe writes( const safe& x1, const safe& x2, + const safe& x3=illegal, const safe& x4=illegal, + const safe& x5=illegal, const safe& x6=illegal, + const safe& x7=illegal, const safe& x8=illegal ); + //generative functions follow, crippled to return a single value + safe any(const safe&, const safe&, const safe&, const safe&); + safe many(const safe&, const safe&, const safe&, const safe&); + safe upto(const safe&, const safe&, const safe&, const safe&); + safe find(const safe&, const safe&, const safe&, const safe&); + safe match(const safe&, const safe&, const safe&, const safe&); + safe bal(const safe&, const safe&, const safe&, const safe&, const safe&, const safe&); + safe move(const safe&); + safe tab(const safe&); +}; //namespace Icon + diff --git a/ipl/packs/loadfuncpp/doc/loadfuncpp.htm b/ipl/packs/loadfuncpp/doc/loadfuncpp.htm new file mode 100644 index 0000000..50fc4b8 --- /dev/null +++ b/ipl/packs/loadfuncpp/doc/loadfuncpp.htm @@ -0,0 +1,42 @@ +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN"> +<HTML> + +<HEAD> + <META HTTP-EQUIV="Content-Type" CONTENT="text/html;CHARSET=iso-8859-1"> + <TITLE>loadfuncpp</TITLE> + <LINK REL="stylesheet" TYPE="text/css" HREF="loadfuncpp.css"> +</HEAD> + +<BODY> + +<H3></H3> +<CENTER> +<P> +<TABLE BORDER="0" WIDTH="700"> + <TR> + <TD WIDTH="100%"> + <H1 ALIGN="CENTER"><BR> + Loadfuncpp</H1> + <H2 ALIGN="CENTER">Experimental Binary Distribution</H2> + <H3 ALIGN="CENTER">Carl Sturtivant, February 2010</H3> + <BLOCKQUOTE> + <BLOCKQUOTE> + <P>All versions are in the public domain as of now.<BR> + <BR> + <FONT COLOR="#FF9900">All versions are provisional, experimental and hacked off at speed</FONT>; sane behavior + is no more than probable so <B><FONT COLOR="#CC0000">use at your own risk</FONT></B><FONT COLOR="#CC0000">.</FONT></P> + + <P>Read the <A HREF="manual.htm#Installation" target="_blank">documentation</A> for information on installation + and use. Everything is simplest if all shared objects are placed in the icon/bin directory and all linkable Icon + (.u1/.u2 files) are placed in the icon/lib directory. + </BLOCKQUOTE> + </BLOCKQUOTE> + </TD> + </TR> +</TABLE> + +</CENTER> + +</BODY> + +</HTML> diff --git a/ipl/packs/loadfuncpp/doc/makelist.cpp b/ipl/packs/loadfuncpp/doc/makelist.cpp new file mode 100644 index 0000000..90b8c5d --- /dev/null +++ b/ipl/packs/loadfuncpp/doc/makelist.cpp @@ -0,0 +1,16 @@ + +/* Example of a C++ extension to icon via loadfunc, + * without garbage collection difficulties. + * Type 'make iexample' to build. + * Carl Sturtivant, 2008/3/16 + */ + +#include "loadfuncpp.h" +using namespace Icon; + +extern "C" int makelist(int argc, value argv[]) { + safe arglist(argc, argv); + argv[0] = arglist; + return SUCCEEDED; +} + diff --git a/ipl/packs/loadfuncpp/doc/makelist.icn b/ipl/packs/loadfuncpp/doc/makelist.icn new file mode 100644 index 0000000..e5e4cd8 --- /dev/null +++ b/ipl/packs/loadfuncpp/doc/makelist.icn @@ -0,0 +1,10 @@ + +link loadfuncpp + + +procedure main() + makelist := loadfuncpp("./makelist.so", "makelist") + write(image( ls := makelist(1,2,3) )) + every write(!ls) +end + diff --git a/ipl/packs/loadfuncpp/doc/manual.htm b/ipl/packs/loadfuncpp/doc/manual.htm new file mode 100644 index 0000000..38046e1 --- /dev/null +++ b/ipl/packs/loadfuncpp/doc/manual.htm @@ -0,0 +1,1558 @@ +<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN"> +<HTML> + +<HEAD> + <META HTTP-EQUIV="Content-Type" CONTENT="text/html;CHARSET=iso-8859-1"> + <TITLE>loadfuncpp</TITLE> + <LINK REL="stylesheet" TYPE="text/css" HREF="loadfuncpp.css"> +</HEAD> + +<BODY> + +<CENTER> +<P> +<TABLE BORDER="0" WIDTH="700"> + <TR> + <TD WIDTH="100%"> + <H1 ALIGN="CENTER"><BR> + Loadfuncpp</H1> + <H2 ALIGN="CENTER">How to Write External Functions and Libraries<BR> + for <A HREF="http://www.cs.arizona.edu/icon/lb3.htm" target="_blank">The Icon Programming Language</A> in C++</H2> + <H3 ALIGN="CENTER">Carl Sturtivant, February 2010, <FONT COLOR="#FF9900">version 0.91alpha</FONT></H3> + <BLOCKQUOTE> + <H2><A NAME="Contents"></A>Contents</H2> + <UL> + <LI><A HREF="#Contents">Contents</A> + <LI><A HREF="#Summary">Summary</A> + <LI><A HREF="#Installation">Installation</A> + <UL> + <LI><A HREF="#CorrectIconInstallation">Correct Icon Installation</A> + <LI><A HREF="#DefaultPlacement">Default Placement of Loadfuncpp Files</A> + <LI><A HREF="#AlternativePlacement">Alternative Placement of Loadfuncpp Files</A> + <LI><A HREF="#LoadfuncppInstallationTest">Loadfuncpp Installation Test</A> + </UL> + <LI><A HREF="#Manual">Manual</A> + <UL> + <LI><A HREF="#Writing">Writing, Loading and Calling an External Function</A> + <LI><A HREF="#Working">Working with Icon Values</A> + <UL> + <LI><A HREF="#Initialization">Assignment & Initialization</A> + <LI><A HREF="#Operations">Icon Operations</A> + <LI><A HREF="#Functions">Icon Built-in Functions</A> + <LI><A HREF="#Keywords">Icon Keywords</A> + <LI><A HREF="#Types">Types, Conversions and Errors</A> + </UL> + <LI><A HREF="#Variadic">Variadic Functions and Dynamic List Construction</A> + <LI><A HREF="#Calling">Calling Icon from C++</A> + <LI><A HREF="#Generators">Working with Generators</A> + <UL> + <LI><A HREF="#Generate">Writing External Functions that are Generators</A> + <LI><A HREF="#Iterate">Calling Icon Procedures that are Generators in C++</A> + <LI><A HREF="#Bang">Iterating over Exploded Structures in C++</A> + <LI><A HREF="#Coexpressions">Working with Coexpressions in C++</A> + </UL> + <LI><A HREF="#Externals">Working with External Values</A> + <LI><A HREF="#Records">Using Icon Records as Objects</A> + </UL> + </UL> + <H2><A NAME="Summary"></A>Summary</H2> + <P>Since 1996 a new function for Version 9 of <A HREF="http://www.cs.arizona.edu/icon/" target="_blank">Icon</A> + could be written in C following a certain <A HREF="http://www.cs.arizona.edu/icon/current/cfuncs.htm" target="_blank">interface</A>, + and compiled into a shared library, where such is a <A HREF="http://www.ibm.com/developerworks/library/l-shobj/" + target="_blank">shared object</A> (.so) under Unix-like operating systems. More recently this has been implemented + using dynamically linked libraries (DLLs) under <A HREF="http://www.cs.arizona.edu/icon/v950/relnotes.htm" + target="_blank">cygwin</A>. The library could then be dynamically loaded by an Icon program calling the built-in + function <A HREF="http://www.cs.arizona.edu/icon/current/cfuncs.htm" target="_blank">loadfunc</A> which is passed + the location and name of the library and the name of the C function desired, and which returns an Icon function + that can subsequently be called. A suite of useful <A HREF="http://www.cs.arizona.edu/icon/library/fcfuncs.htm" + target="_blank">examples</A> of this technique is a part of the distribution of Icon.</P> + <P>Writing a significantly complex external function for use by <A HREF="http://www.cs.arizona.edu/icon/current/cfuncs.htm" + target="_blank">loadfunc</A> is potentially difficult for two reasons. First, an Icon structure (or other value, + string, list, set, table, et cetera) referred to solely by variables inside external code could be garbage collected + by Icon. Second, working directly with Icon data more complex than numbers, strings and files requires a thorough + understanding of the <A HREF="http://www.cs.arizona.edu/icon/ftp/doc/ib1up.pdf" target="_blank">implementation + of Icon</A>. The Icon runtime system is implemented in an <A HREF="http://www.cs.arizona.edu/icon/ftp/doc/ipd261.pdf" + target="_blank">extension of C</A> that is automatically translated into C. The design of the Icon virtual machine + is not object oriented, and contains a great deal of straight-line code. Icon structures are operated upon as combinations + of complex linked blocks. Writing code to work directly with such is lengthy, error prone and time consuming.</P> + <P>Loadfuncpp is a tool that makes writing external functions for Icon a relatively simple matter, requiring very + little understanding of the implementation of the Icon virtual machine. Loadfuncpp exploits the close compatibility + of C and C++ to provide a clean abstract interface to Icon. External functions for Icon are declared with C linkage, + and the Icon virtual machine requires no modification to use external functions written using loadfuncpp.</P> + <P>Beginning C++ programmers with programming experience in other languages should have little difficulty with + using loadfuncpp. It is not necessary to use templates, exceptions, or RTTI to use loadfuncpp. Little beyond some + C experience plus how to define a simple class with virtual and non-virtual member functions is needed to use loadfuncpp. + So C programmers with OOP experience but without C++ experience will also find loadfuncpp not difficult to use.</P> + <P>Loadfuncpp makes extensive use of operator overloading and other techniques to provide in C++ essentially the + same suite of operations, functions and capabilities that are available to the Icon programmer in Icon. The use + of these facilities in C++ is at most an order of magnitude more difficult than the corresponding Icon, and is + often much easier than that. These facilities include the ability to write external functions that suspend a sequence + of results, and the ability to call an Icon procedure that returns a value, which may in turn call a function that + calls Icon recursively in the same fashion.</P> + <P>These facilities also include the ability to create, activate and refresh coexpressions, the ability to write + external functions that are new string matching or string analysis functions, and the ability to work with all kinds + of Icon data as if they were built-in types. Loadfuncpp also provides garbage collection safety as a matter of + course, largely transparently to the C++ programmer. Loadfuncpp also provides a simple way to add new datatypes + to Icon using the new <A HREF="http://www.cs.arizona.edu/icon/v950/extlvals.htm" target="_blank">external values</A> + added to Icon version 9.5 in 2008. These are used extensively by loadfuncpp, and so loadfuncpp cannot be used with + versions of Icon prior to 9.5.</P> + <P>Loadfuncpp consists of three shared libraries (iload.so, loadnogpx.so and iloadgpx.so) normally placed in the + icon/bin directory (all are actually DLLs under cygwin despite the .so filename extension, and import library called + iload.a is used to link to them under cygwin) together with a small amount of Icon in loadfuncpp.icn, compiled + into loadfuncpp.u1 and loadfuncpp.u2 (using 'icont -c loadfuncpp.icn') which are normally placed in the icon/lib + directory. Loadfuncpp may then be used by an Icon program by adding the line 'link loadfuncpp' which makes the + function loadfuncpp available to Icon.</P> + <P>The function loadfuncpp is used in place of loadfunc to dynamically load external functions written to use the + loadfuncpp interface. The library containing loadfuncpp is itself loaded by an implicit call to loadfunc. The first + call to loadfuncpp loads iload.so (and also loads iloadgpx.so if the Icon installation supports graphics and iloadnogpx.so + if not) and replaces loadfuncpp by an external function in iload.so of the same name. This sequence of events makes + the C++ interface in iload.so available to all libraries subsequently loaded by Icon through calls of loadfuncpp.</P> + <H2><A NAME="Installation"></A>Installation</H2> + <P>Installation of Loadfuncpp is in three parts. First ensuring a correct Icon installation. Second placing the + loadfuncpp files appropriately. And third, ensuring that environment variables are set appropriately if the default + locations of loadfuncpp files are not used.</P> + <H3><A NAME="CorrectIconInstallation"></A>Correct Icon Installation</H3> + <P>You will need to install Icon version 9.5 Loadfuncpp to run. To verify you are running the correct version of + Icon, use `<A HREF="http://www.cs.arizona.edu/icon/refernce/icontx.htm#icont" target="_blank">icont</A> -V` and + `<A HREF="http://www.cs.arizona.edu/icon/refernce/icontx.htm#iconx" target="_blank">iconx</A> -V`. + <H3><A NAME="DefaultPlacement"></A>Default Placement of Loadfuncpp Files</H3> + <P>Loadfuncpp consists of the following files. Starting now (2010/2/8) loadfuncpp is available as an <A HREF="loadfuncpp.htm" + target="_blank">experimental source distribution.</A> I intend to do no further work on it. Use <I>make</I> and + examine the following files. + <BLOCKQUOTE> + <P> + <TABLE BORDER="0" WIDTH="585"> + <TR> + <TD WIDTH="26%"> + <P>iload.so + </TD> + <TD WIDTH="74%"> + <P>C++ part of the loadfuncpp interface to <A HREF="http://www.cs.arizona.edu/icon/refernce/icontx.htm#iconx" target="_blank">iconx</A> + </TD> + </TR> + <TR> + <TD WIDTH="26%"> + <P>loadfuncpp.icn + </TD> + <TD WIDTH="74%"> + <P>Icon part of the loadfuncpp interface to <A HREF="http://www.cs.arizona.edu/icon/refernce/icontx.htm#iconx" + target="_blank">iconx</A> + </TD> + </TR> + <TR> + <TD WIDTH="26%"> + <P>iloadgpx.so + </TD> + <TD WIDTH="74%"> + <P>C++ interface needed with the graphics build of Icon + </TD> + </TR> + <TR> + <TD WIDTH="26%"> + <P>iloadnogpx.so + </TD> + <TD WIDTH="74%"> + <P>C++ interface needed with the non-graphics build of Icon + </TD> + </TR> + <TR> + <TD WIDTH="26%"> + <P>loadfuncpp.h + </TD> + <TD WIDTH="74%"> + <P>C++ header for writing new external functions + </TD> + </TR> + </TABLE> +</P> + </BLOCKQUOTE> + <P>The default installation of these files is as follows. (Here we assume that the directory containing your Icon + installation is called icon.) I recommend that you use these locations unless there is a compelling reason not + to.</P> + <P> + <TABLE BORDER="0" WIDTH="585"> + <TR> + <TD WIDTH="26%"> + <P>iload.so + </TD> + <TD WIDTH="74%"> + <P>icon/bin + </TD> + </TR> + <TR> + <TD WIDTH="26%"> + <P>iload.a + </TD> + <TD WIDTH="74%"> + <P>icon/bin (cygwin only) + </TD> + </TR> + <TR> + <TD WIDTH="26%"> + <P>loadfuncpp.u1 + </TD> + <TD WIDTH="74%"> + <P>icon/lib (from loadfuncpp.icn) + </TD> + </TR> + <TR> + <TD WIDTH="26%"> + <P>loadfuncpp.u2 + </TD> + <TD WIDTH="74%"> + <P>icon/lib (from loadfuncpp.icn) + </TD> + </TR> + <TR> + <TD WIDTH="26%"> + <P>iloadgpx.so + </TD> + <TD WIDTH="74%"> + <P>icon/bin + </TD> + </TR> + <TR> + <TD WIDTH="26%"> + <P>iloadnogpx.so + </TD> + <TD WIDTH="74%"> + <P>icon/bin + </TD> + </TR> + <TR> + <TD WIDTH="26%"> + <P>loadfuncpp.h + </TD> + <TD WIDTH="74%"> + <P>wherever is convenient to #include in C++ source + </TD> + </TR> + </TABLE> +<BR> + Under <I>cygwin only</I> there is one additional file used when <A HREF="compile.htm" target="_blank">linking</A> + a dynamic library that uses loadfuncpp. This is the windows import library iload.a, and is most naturally placed + in the same directory as iload.so, as it contains the information necessary to link against it. + <H3><A NAME="AlternativePlacement"></A>Alternative Placement of Loadfuncpp Files</H3> + <P>Alternatively, you can place iload.so and iloadgpx.so anywhere you please and set the environment variable FPATH + to include the directories containing iload.so and iloadgpx.so. FPATH should be a space or colon separated string + of locations. You can compile loadfuncpp.icn using `icont -c loadfuncpp.icn` and place the resulting files (loadfuncpp.u1 + and loadfuncpp.u2) in any directory and set the environment variable IPATH to include that directory. IPATH should + also be a space or colon separated string of locations. + <H3><A NAME="LoadfuncppInstallationTest"></A>Loadfuncpp Installation Test</H3> + <P>Once loadfuncpp is installed, you may test your installation by creating a small new external function and load + and call it from Icon. Here's how.</P> + <P> + <UL> + <LI>Create a new directory, place a copy of loadfuncpp.h in it and work there + <LI>Edit a new file called (say) hello.cpp to contain the following code + <P> + <TABLE BORDER="0" WIDTH="312"> + <TR> + <TD WIDTH="312"> + <PRE><FONT COLOR="black" FACE="Courier New, Courier">#include "loadfuncpp.h" + +extern "C" int hello(value argv[]) { + argv[0] = "Hello World"; + return SUCCEEDED; +}</FONT></PRE> + </TD> + </TR> + </TABLE> + + <LI>Compile hello.cpp into a shared object hello.so using one of these <A HREF="compile.htm" target="_blank">compiler + options</A> + <LI>Edit a new file called (say) hello.icn to contain the following code and ensure that hello.so is in the same + directory + <P> + <TABLE BORDER="0" WIDTH="392"> + <TR> + <TD WIDTH="392"> + <PRE><FONT COLOR="black" FACE="Courier New, Courier">link loadfuncpp + +procedure main() + hello := loadfuncpp("./hello.so", "hello", 0) + write( hello() ) +end</FONT></PRE> + </TD> + </TR> + </TABLE> + + <LI>Compile hello.icn by typing `icont hello.icn` and run it by typing `./hello` and you should get the output + <FONT COLOR="black">Hello World</FONT> appearing in the console. + </UL> + </BLOCKQUOTE> + <BLOCKQUOTE ALIGN="CENTER"> + <UL> + <P> + </UL> + <P> + </BLOCKQUOTE> + <BLOCKQUOTE> + <H2><A NAME="Manual"></A>Manual</H2> + <P>This manual assumes that you have a <A HREF="#Installation">working installation</A> of Loadfuncpp and Icon + as described above. An installation of Icon alone is not sufficient, nor can Loadfuncpp be used with any Icon version + prior to 9.5, as it relies upon the presence of <A HREF="http://www.cs.arizona.edu/icon/v950/extlvals.htm" + target="_blank">external values</A> which are first implemented as a part of that version.</P> + <H3><A NAME="Writing"></A>Writing, Loading and Calling a new External Function</H3> + </BLOCKQUOTE> + <BLOCKQUOTE ALIGN="CENTER"> + <P>A new Icon external function written in C++ takes one of the following forms. + </BLOCKQUOTE> + <BLOCKQUOTE> + <BLOCKQUOTE> + <P> + <TABLE BORDER="0" WIDTH="432"> + <TR> + <TD WIDTH="432"> + <PRE><FONT COLOR="black" FACE="Courier New, Courier">#include "loadfuncpp.h" + +extern "C" int fixed_arity(value argv[]) { + // ... has a fixed number of arguments + return SUCCEEDED; //or FAILED +} + +extern "C" int variable_arity(int argc, value argv[]){ + // ... has a variable number of arguments + return SUCCEEDED; //or FAILED +}</FONT></PRE> + </TD> + </TR> + </TABLE> +</P> + </BLOCKQUOTE> + <P>The C++ type 'value' is an Icon value (called a <A HREF="http://www.cs.arizona.edu/icon/current/cfuncs.htm" target="_blank">descriptor</A>), + representing null or an integer, real, string, cset, list, table, set, file, procedure, coexpression, record, <A + HREF="http://www.cs.arizona.edu/icon/v950/extlvals.htm" target="_blank">external value</A> or an Icon <A HREF="#Variable">variable</A>. + When such a function is called from Icon, its arguments are passed in the array argv starting from argv[1], and + argv[0] is taken to be the value returned to Icon by the function. In the function variable_arity the number of + arguments is also passed in argc. So the following is a one argument external function that returns its only argument. + <BLOCKQUOTE> + <P> + <TABLE BORDER="0" WIDTH="432"> + <TR> + <TD WIDTH="432"> + <PRE><FONT COLOR="black" FACE="Courier New, Courier">#include "loadfuncpp.h" + +extern "C" int ident(value argv[]) { + argv[0] = argv[1]; + return SUCCEEDED; +}</FONT></PRE> + </TD> + </TR> + </TABLE> +</P> + </BLOCKQUOTE> + <P>The int returned to C++ is a signal to Icon indicating whether the call succeeded or failed. These are represented + by the constants SUCCEEDED and FAILED respectively, defined in loadfuncpp.h. However there is also a simple mechanism + in loadfuncpp to write <A HREF="#Generate">external functions that suspend a sequence of values</A> when called + in Icon.</P> + <P>Functions <A HREF="compile.htm" target="_blank">compiled into a shared object</A> are loaded into Icon by calls + of loadfuncpp. Such calls indicate to Icon whether the loaded function has a variable or a fixed number of arguments, + and if the latter, how many. For example the preceding functions might be loaded into Icon as follows if the body + of fixed_arity was written to use two arguments. + <BLOCKQUOTE> + <P> + <TABLE BORDER="0" WIDTH="464"> + <TR> + <TD WIDTH="464"> + <PRE><FONT COLOR="black" FACE="Courier New, Courier">link loadfuncpp + +procedure main() + fixed := loadfuncpp("./mylib.so", "fixed_arity", 2) + variadic := loadfuncpp("./mylib.so", "variable_arity") + #fixed and variadic now contain Icon functions + #and may be treated like any other such values +end</FONT></PRE> + </TD> + </TR> + </TABLE> +</P> + </BLOCKQUOTE> + <P>If the number of arguments is not specified when loading a function of fixed <A HREF="http://en.wikipedia.org/wiki/Arity">arity</A> + then calling the result from Icon will lead to a memory violation. (Similar behavior will likely occur if a function + of variable arity is loaded with a specific arity specified, or if too small an arity is specified for a fixed + arity function.) Beware!<BR> + <BR> + A relative or absolute path to the shared object may be used as the first argument to loadfuncpp, in which case + loadfuncpp will look exactly where specified for it and nowhere else. <B>Alternatively, just the filename of the + shared object may be specified, in which case Icon will search FPATH for the file.</B> If FPATH is not set in the + environment Icon runs in, then iconx defines FPATH to consist of the current directory followed by the icon/bin + directory. If FPATH is set in the environment Icon is run in, then iconx appends the icon/bin directory. In either + case FPATH should be a space or colon separated series of directories, with no spaces in their paths. (This restriction + will be cleaned up "soon".)</P> + <P>All of the C++ in this manual requires '#include "loadfuncpp.h"' and all of the Icon requires 'link + loadfuncpp'. Hereafter this will be assumed implicitly.</P> + <P>Here is an external function of no arguments that returns null, represented in C++ by the constant nullvalue. + <BLOCKQUOTE> + <P> + <TABLE BORDER="0" WIDTH="432"> + <TR> + <TD WIDTH="432"> + <PRE><FONT COLOR="black" FACE="Courier New, Courier">extern "C" int dull(value argv[]){ + argv[0] = nullvalue; + return SUCCEEDED; +}</FONT></PRE> + </TD> + </TR> + </TABLE> +</P> + </BLOCKQUOTE> + <P>If this is compiled into the shared object 'dull.so' in the current directory then it might be called by Icon + as follows. + <BLOCKQUOTE> + <P> + <TABLE BORDER="0" WIDTH="464"> + <TR> + <TD WIDTH="464"> + <PRE><FONT COLOR="black" FACE="Courier New, Courier">dull := loadfuncpp("./dull.so", "dull", 0) +write(image( dull() ))</FONT></PRE> + </TD> + </TR> + </TABLE> +</P> + </BLOCKQUOTE> + <P>The value of argv[0] when an external function is called is of type procedure, and is the Icon value representing + the external function being called. So failure to assign to argv[0] means that Icon loads a function that returns + itself.</P> + <P>The C++ class <B>value</B> is intended to be used primarily in the interface to Icon. Icon structures in variables + of this class are not safe from garbage collection. Icon does guarantee that argv[] is garbage collection safe + however.</P> + <H3><A NAME="Working"></A>Working with Icon values</H3> + <P>Variables of the C++ class <B>safe</B> are intended to hold Icon values with guaranteed garbage collection safety. + The interface to Icon is largely available through the class safe. Most computation with Icon values in external + functions may be implemented through use of the <A HREF="#Operations">overloaded operators</A> in using this class, + along with its member functions that represent <A HREF="#Operations">additional Icon operators</A>. Loadfuncpp + also provides the <A HREF="#Keywords">Icon keywords</A> and in the namespace '<A HREF="#Builtin">Icon</A>' provides + a C++ variant of each of the <A HREF="#Functions">built-in functions in Icon</A>.</P> + <H4><A NAME="Initialization"></A>Assignment and Initialization among safe and value</H4> + <P>Assignment of a safe to a safe has the semantics of an Icon assignment. Specifically, if the left operand contains + an Icon value that is an <A NAME="Variable"></A>Icon <FONT COLOR="black">variable</FONT> (i.e. an Icon value used + to refer to the storage containing another Icon value so that the latter can be modified) then the assignment modifies + the value referred to by that Icon variable, not the C++ variable whose value is the Icon variable.</P> + <P>Assignment is possible among the classes safe and value, and has simple semantics: even values that are Icon + variables are copied. Initialization of variables of the class safe is possible from any of safe and value, with + the same simple semantics. In both cases the semantics is the same as Icon assignment, except in the case of an + Icon variable, which is merely copied, so that the variable assigned or initialized now contains the same Icon + variable. This lack of dereferencing is useful if an external function needs to return an Icon variable, in the + same way that an Icon procedure may.</P> + </BLOCKQUOTE> + <BLOCKQUOTE ALIGN="CENTER"> + <P>A variable of class safe may also be initialized from an array of values as follows. + </BLOCKQUOTE> + <BLOCKQUOTE> + <BLOCKQUOTE> + <P> + <TABLE BORDER="0" WIDTH="432"> + <TR> + <TD WIDTH="432"> + <PRE><FONT COLOR="black" FACE="Courier New, Courier">extern "C" int makelist(int argc, value argv[]){ + safe arglist(argc, argv); + argv[0] = arglist; + return SUCCEEDED; +}</FONT></PRE> + </TD> + </TR> + </TABLE> +</P> + </BLOCKQUOTE> + <P>Such initialization creates an Icon list containing the values in the array starting from position 1. So the + above function called from Icon returns a list of its arguments.</P> + <P>A variable of class safe may be initialized by or assigned a C string, which causes an Icon string that is a + copy of the original to be created, so that the original can safely be modified or destroyed later. If such copying + is unwanted because the C string is a literal or constant, then the two argument value constructor may be used + as follows. + <BLOCKQUOTE> + <P> + <TABLE BORDER="0" WIDTH="432"> + <TR> + <TD WIDTH="432"> + <PRE><FONT COLOR="black" FACE="Courier New, Courier">extern "C" int f(value argv[]){ + safe text = value(StringLiteral, "Hello"); + // ... + return SUCCEEDED; +}</FONT></PRE> + </TD> + </TR> + </TABLE> +</P> + </BLOCKQUOTE> + <P>A variable of class safe may also be initialized by or assigned a C++ long or int causing the creation of an + Icon integer. Similarly initialization or assignment of a double causes the creation of an Icon real.</P> + <H4><A NAME="Operations"></A>Icon operations on variables of class safe</H4> + <P>Here is a table of the overloaded operators and member functions implementing Icon operators for the class safe. + These are listed with their Icon equivalents, and with a note of any restrictions or extensions. The <A HREF="#Bang">unary + ! operator</A> in Icon is a generator and is supplied through loadfuncpp by <A HREF="#Bang">other means</A>.</P> + </BLOCKQUOTE> + <BLOCKQUOTE ALIGN="CENTER"> + <P> + <TABLE BORDER="0" WIDTH="585"> + <TR> + <TH COLSPAN="2"> + <P><FONT SIZE="2" FACE="Courier New, Courier">functions of safe for Icon operators</FONT> + </TH> + <TD WIDTH="271"> + <P><FONT SIZE="2" FACE="Courier New, Courier"> </FONT> + </TD> + </TR> + <TR> + <TH WIDTH="130"> + <P><FONT SIZE="2" FACE="Courier New, Courier">unary</FONT> + </TH> + <TH WIDTH="164"> + <P><FONT SIZE="2" FACE="Courier New, Courier">Icon equivalent</FONT> + </TH> + <TD WIDTH="271"> + <P><FONT SIZE="2" FACE="Courier New, Courier"> </FONT> + </TD> + </TR> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">*x</FONT> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">*x</FONT> + </TD> + <TD WIDTH="271"> + <P> + </TD> + </TR> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">~x</FONT> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">~x</FONT> + </TD> + <TD WIDTH="271"> + <P> + </TD> + </TR> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">-x</FONT> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">-x</FONT> + </TD> + <TD WIDTH="271"> + <P><FONT SIZE="2" FACE="Courier New, Courier"> </FONT> + </TD> + </TR> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">++x</FONT> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">x +:= 1</FONT> + </TD> + <TD WIDTH="271"> + <P><FONT SIZE="2" FACE="Courier New, Courier"> </FONT> + </TD> + </TR> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">--x</FONT> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">x -:= 1</FONT> + </TD> + <TD WIDTH="271"> + <P><FONT SIZE="2" FACE="Courier New, Courier"> </FONT> + </TD> + </TR> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><B><FONT SIZE="2" FACE="Courier New, Courier">binary</FONT></B> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><B><FONT SIZE="2" FACE="Courier New, Courier">Icon equivalent</FONT></B> + </TD> + <TD WIDTH="271"> + <P><FONT SIZE="2" FACE="Courier New, Courier"> </FONT> + </TD> + </TR> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">=</FONT> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">:=</FONT> + </TD> + <TD WIDTH="271"> + <P><FONT SIZE="2" FACE="Courier New, Courier"> </FONT> + </TD> + </TR> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">+= -= *=</FONT> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">+:= -:= *:=</FONT> + </TD> + <TD WIDTH="271"> + <P><FONT SIZE="2" FACE="Courier New, Courier"> </FONT> + </TD> + </TR> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">/= %= ^=</FONT> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">/:= %:= ^:=</FONT> + </TD> + <TD WIDTH="271"> + <P> + </TD> + </TR> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">+</FONT> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">+</FONT> + </TD> + <TD WIDTH="271"> + <P><FONT SIZE="2" FACE="Courier New, Courier"> </FONT> + </TD> + </TR> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">-</FONT> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">-</FONT> + </TD> + <TD WIDTH="271"> + <P><FONT SIZE="2" FACE="Courier New, Courier"> </FONT> + </TD> + </TR> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">*</FONT> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">*</FONT> + </TD> + <TD WIDTH="271"> + <P><FONT SIZE="2" FACE="Courier New, Courier"> </FONT> + </TD> + </TR> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">/</FONT> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">/</FONT> + </TD> + <TD WIDTH="271"> + <P><FONT SIZE="2" FACE="Courier New, Courier"> </FONT> + </TD> + </TR> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">%</FONT> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">%</FONT> + </TD> + <TD WIDTH="271"> + <P><FONT SIZE="2" FACE="Courier New, Courier"> </FONT> + </TD> + </TR> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">x^y</FONT> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">x^y</FONT> + </TD> + <TD WIDTH="271"> + <P><FONT SIZE="2" FACE="Courier New, Courier"> </FONT> + </TD> + </TR> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">x | y</FONT> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">x ++ y</FONT> + </TD> + <TD WIDTH="271"> + <P><FONT SIZE="2" FACE="Courier New, Courier"> </FONT> + </TD> + </TR> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">x & y</FONT> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">x ** y</FONT> + </TD> + <TD WIDTH="271"> + <P><FONT SIZE="2" FACE="Courier New, Courier"> </FONT> + </TD> + </TR> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">x && y</FONT> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">x -- y</FONT> + </TD> + <TD WIDTH="271"> + <P><FONT SIZE="2" FACE="Courier New, Courier"> </FONT> + </TD> + </TR> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">x || y</FONT> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">x || y</FONT> + </TD> + <TD WIDTH="271"> + <P><FONT SIZE="2" FACE="Courier New, Courier"> </FONT> + </TD> + </TR> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">|=</FONT> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">++:=</FONT> + </TD> + <TD WIDTH="271"> + <P> + </TD> + </TR> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">&=</FONT> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">**:=</FONT> + </TD> + <TD WIDTH="271"> + <P> + </TD> + </TR> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">==</FONT> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">===</FONT> + </TD> + <TD WIDTH="271"> + <P><FONT SIZE="2" FACE="Courier New, Courier"> </FONT> + </TD> + </TR> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">!=</FONT> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">~===</FONT> + </TD> + <TD WIDTH="271"> + <P><FONT SIZE="2" FACE="Courier New, Courier"> </FONT> + </TD> + </TR> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">< > <= >=</FONT> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><B><FONT SIZE="2" FACE="Courier New, Courier">none</FONT></B> + </TD> + <TD WIDTH="271"> + <P><A HREF="#Compare"><FONT SIZE="2" FACE="Courier New, Courier">The comparison used when sorting</FONT></A> + </TD> + </TR> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">x[y]</FONT> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">x[y]</FONT> + </TD> + <TD WIDTH="271"> + <P> + </TD> + </TR> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><B><FONT SIZE="2" FACE="Courier New, Courier">variadic</FONT></B> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><B><FONT SIZE="2" FACE="Courier New, Courier">Icon Equivalent</FONT></B> + </TD> + <TD WIDTH="271"> + <P> + </TD> + </TR> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">x(...)</FONT> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">x(...)</FONT> + </TD> + <TD WIDTH="271"> + <P><A HREF="#Call"><FONT SIZE="2" FACE="Courier New, Courier">Icon procedure call</FONT></A> + </TD> + </TR> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">(a,b ...)</FONT> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">[a,b ...]</FONT> + </TD> + <TD WIDTH="271"> + <P><A HREF="#Variadic"><FONT SIZE="2" FACE="Courier New, Courier">Variadic list construction</FONT></A> + </TD> + </TR> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><B><FONT SIZE="2" FACE="Courier New, Courier">member function</FONT></B> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><B><FONT SIZE="2" FACE="Courier New, Courier">Icon equivalent</FONT></B> + </TD> + <TD WIDTH="271"> + <P><FONT SIZE="2" FACE="Courier New, Courier"> </FONT> + </TD> + </TR> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">x.slice(y,z) </FONT> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">x[y:z]</FONT> + </TD> + <TD WIDTH="271"> + <P><FONT SIZE="2" FACE="Courier New, Courier"> </FONT> + </TD> + </TR> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">x.apply(y)</FONT> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">x ! y</FONT> + </TD> + <TD WIDTH="271"> + <P><A HREF="#Call"><FONT SIZE="2" FACE="Courier New, Courier">Apply Icon procedure to arguments</FONT></A> + </TD> + </TR> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">x.listcat(y)</FONT> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">x ||| y</FONT> + </TD> + <TD WIDTH="271"> + <P> + </TD> + </TR> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">x.swap(y)</FONT> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">x :=: y</FONT> + </TD> + <TD WIDTH="271"> + <P> + </TD> + </TR> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">x.create()</FONT> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">create !x</FONT> + </TD> + <TD WIDTH="271"> + <P><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier"> </FONT> + </TD> + </TR> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">x.create(y)</FONT> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">create x ! y</FONT> + </TD> + <TD WIDTH="271"> + <P> + </TD> + </TR> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">x.activate(y)</FONT> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">y@x</FONT> + </TD> + <TD WIDTH="271"> + <P><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">y defaults to &null</FONT> + </TD> + </TR> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">x.refresh()</FONT> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">^x</FONT> + </TD> + <TD WIDTH="271"> + <P> + </TD> + </TR> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">x.random()</FONT> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">?x</FONT> + </TD> + <TD WIDTH="271"> + <P> + </TD> + </TR> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">x.dereference()</FONT> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">.x</FONT> + </TD> + <TD WIDTH="271"> + <P> + </TD> + </TR> + </TABLE> +</P> + </BLOCKQUOTE> + <BLOCKQUOTE> + <H4><A NAME="Functions"></A>Icon Built-in Functions</H4> + <P>All of the functions built in to Icon are available in C++ in the namespace 'Icon'. The C++ counterpart of an + Icon built-in function returns &null if the original function would have failed. Those functions that are generators + have been made to produce a single result. Those functions that are <A HREF="#Variadic">variadic</A> have been + made C++ compatible too; with a small number of arguments this can usually safely be ignored. The table below lists + each C++ variant of each Icon function that is a generator, along with a comment indicating how it has been modified + for C++ compatibility.</P> + </BLOCKQUOTE> + <BLOCKQUOTE ALIGN="CENTER"> + <P> + <TABLE BORDER="0" WIDTH="551"> + <TR> + <TH WIDTH="96"> + <P><FONT SIZE="2" FACE="Courier New, Courier">Function</FONT> + </TH> + <TD WIDTH="441"> + <P> + </TD> + </TR> + <TR> + <TD WIDTH="96"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">bal</FONT> + </TD> + <TD WIDTH="441"> + <P><FONT SIZE="2" FACE="Courier New, Courier">returns the first result generated only</FONT> + </TD> + </TR> + <TR> + <TD WIDTH="96"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">find</FONT> + </TD> + <TD WIDTH="441"> + <P><FONT SIZE="2" FACE="Courier New, Courier">returns the first result generated only</FONT> + </TD> + </TR> + <TR> + <TD WIDTH="96"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">function</FONT> + </TD> + <TD WIDTH="441"> + <P><FONT SIZE="2" FACE="Courier New, Courier">returns a list of the results originally generated</FONT> + </TD> + </TR> + <TR> + <TD WIDTH="96"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">key</FONT> + </TD> + <TD WIDTH="441"> + <P><FONT SIZE="2" FACE="Courier New, Courier">returns a list of the results originally generated</FONT> + </TD> + </TR> + <TR> + <TD WIDTH="96"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">move</FONT> + </TD> + <TD WIDTH="441"> + <P><FONT SIZE="2" FACE="Courier New, Courier">cannot be resumed</FONT> + </TD> + </TR> + <TR> + <TD WIDTH="96"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">tab</FONT> + </TD> + <TD WIDTH="441"> + <P><FONT SIZE="2" FACE="Courier New, Courier">cannot be resumed</FONT> + </TD> + </TR> + <TR> + <TD WIDTH="96"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">upto</FONT> + </TD> + <TD WIDTH="441"> + <P><FONT SIZE="2" FACE="Courier New, Courier">returns the first result generated only</FONT> + </TD> + </TR> + </TABLE> +</P> + </BLOCKQUOTE> + <BLOCKQUOTE> + <P>Here is an example of the use of such Icon built-in functions in a new external function. The following function + returns the set of its arguments.</P> + <BLOCKQUOTE> + <P> + <TABLE BORDER="0" WIDTH="432"> + <TR> + <TD WIDTH="432"> + <PRE><FONT COLOR="black" FACE="Courier New, Courier">extern "C" int makeset(int argc, value argv[]){ + safe arglist(argc, argv); + argv[0] = Icon::set(arglist); + return SUCCEEDED; +}</FONT></PRE> + </TD> + </TR> + </TABLE> +</P> + </BLOCKQUOTE> + <H4><A NAME="Keywords"></A>Icon Keywords</H4> + <P>All of the Icon keywords have been made available apart from &cset (to avoid a possible name collision), + and &fail. The keywords are implemented through a keyword class with the unary '&' operator overloaded + and are used thus in C++, as in the following example.</P> + <BLOCKQUOTE> + <P> + <TABLE BORDER="0" WIDTH="432"> + <TR> + <TD WIDTH="432"> + <PRE><FONT COLOR="black" FACE="Courier New, Courier">extern "C" int assignprog(value argv[]){ + safe newname(argv[1]); + &progname = newname; //Icon assignment semantics + return FAILED; +}</FONT></PRE> + </TD> + </TR> + </TABLE> +</P> + </BLOCKQUOTE> + <P>The preceding function assigns a new value to the keyword &progname, just as in Icon. In all cases a keyword + is used with the unary '&' operator, and therefore appears just as in an Icon program. The keywords that are + generators in Icon produce a list of values in C++.</P> + <H4><A NAME="Types"></A>Types, Conversions and Errors</H4> + <P>A well designed external function will probably do some type checking and conversions of its arguments, and + perhaps give a run-time error if they are problematic.</P> + <P>The member function <FONT COLOR="black">type()</FONT> in the value class returns one of the following constants + indicating its Icon type: <FONT COLOR="black">Null</FONT>, <FONT COLOR="black">Integer</FONT>, <A HREF="#BigInteger">BigInteger</A>, + <FONT COLOR="black">Real</FONT>, <FONT COLOR="black">Cset</FONT>, <FONT COLOR="black">File</FONT>, <FONT COLOR="black">Procedure</FONT>, + <FONT COLOR="black">Record</FONT>, <FONT COLOR="black">List</FONT>, <FONT COLOR="black">Set</FONT>, <FONT COLOR="black">Table</FONT>, + <FONT COLOR="black">String</FONT>, <FONT COLOR="black">Constructor</FONT>, <FONT COLOR="black">Coexpression</FONT>, + <FONT COLOR="black">External</FONT>, or <A HREF="#Variable">Variable</A>. Constructor means a record constructor, + and <A HREF="#BigInteger">BigInteger</A> is an integer with a binary representation larger than a machine word.</P> + <P>The member functions <FONT COLOR="black">isNull()</FONT> and <FONT COLOR="black">notNull()</FONT> in the value + class each return a boolean indicating whether or not the Icon type is null. The member functions <FONT COLOR="black">toInteger()</FONT>, + <FONT COLOR="black">toReal()</FONT>, <FONT COLOR="black">toNumeric()</FONT>, <FONT COLOR="black">toString()</FONT> + and <FONT COLOR="black">toCset()</FONT> in the value class each endeavors to perform a conversion in place to the + corresponding type following the same conventions as Icon. Each returns a boolean indicating whether the conversion + succeeded. If the conversion failed, then the Icon value remains unchanged. These functions are intended for use + with the arguments of an external function supplied to C++ before they are converted to the class safe and the + real computation begins. (The use of these functions on the entries in argv[] is garbage-collection safe because + Icon protects argv[].) For example to check that we have a string where we would need one as follows. + <BLOCKQUOTE> + <P> + <TABLE BORDER="0" WIDTH="432"> + <TR> + <TD WIDTH="432"> + <PRE><FONT COLOR="black" FACE="Courier New, Courier">extern "C" int assignprog(value argv[]){ + if( !argv[1].toString() ) { + Icon::runerr(103, argv[1]); + return FAILED; //in case &error is set + } + safe newname(argv[1]); + &progname = newname; //Icon assignment semantics + return FAILED; +}</FONT></PRE> + </TD> + </TR> + </TABLE> +</P> + </BLOCKQUOTE> + <P>The function <FONT COLOR="black">syserror(const char*)</FONT> unconditionally and fatally terminates execution + with an Icon style error message referring to the point of execution in Icon together with the error message supplied + as a C string argument. This nicely complements <FONT COLOR="black">Icon::runerr</FONT>.<BR> + <BR> + To avoid problems with C++ conversion/overloading ambiguities, the class safe has been provided with a conversion + to the class value only, and no conversions to the types char*, int, long or double. On the other hand, the value + class has such conversions and so an explicit conversion to value can be used in many contexts to permit an implicit + conversion to a built-in type. See below for details.<BR> + <BR> + The overloaded operators for the class safe defining much of Icon's repertoire in C++ have been defined outside + the class safe, with the exception of those such as assignment, subscripting and call that C++ insists be non-static + member functions, and almost all such as well as all other member functions have parameters of type safe only. + This is so that the wide repertoire of conversions of other types to safe defined by loadfuncpp may be of maximum + utility.<BR> + <BR> + Conversions of char*, double, int and long to safe as well as value are defined, those from the built-in types + creating copies on the Icon heap. Specifically, the conversion from char* to safe or to value assumes a null terminated + C string, and produces a correspondingly copied Icon string.<BR> + <BR> + Conversions of value to long and double have been defined. These behave as expected for Icon integers and reals + respectively, but perform no conversions within Icon values (from integer to real or vice-versa). <BR> + <BR> + There is also a conversion from value to char* defined. This does <I>not</I> make a C string, but rather simply + produces a pointer to the start of an Icon string, which is not null terminated, and can move in the event of a + garbage collection. If null termination is desired, then concatenate the loadfuncpp constant value nullchar before + converting to char*, and if a copy outside of Icon is needed, then you will have to explicitly make one. Here is + an example. + <BLOCKQUOTE> + <P> + <TABLE BORDER="0" WIDTH="432"> + <TR> + <TD WIDTH="432"> + <PRE><FONT COLOR="black" FACE="Courier New, Courier">extern "C" int assignprog(value argv[]){ + if( !argv[1].toString() ) { + Icon::runerr(103, argv[1]); + return FAILED; //in case &error is set + } + safe newname(argv[1]); + char* s = value(newname || nullchar); //can move + char sbuf[100]; + sprintf(sbuf, "%s", s); + //use the local copy sbuf + //... +}</FONT></PRE> + </TD> + </TR> + </TABLE> + + </BLOCKQUOTE> + <P>The non-member functions <FONT COLOR="black">bytestointeger</FONT> and <FONT COLOR="black">integertobytes</FONT> + are useful to overtly convert to and from Icon integers of any size (i.e. type <FONT COLOR="black">Integer</FONT> + or <A HREF="#BigInteger">BigInteger</A> behind the scenes). Both functions take a value and return a value. In + this context Icon strings are considered to be representations of natural numbers. Each character is considered + a base 256 digit in the obvious way, and the digits are defined to be in order from most to least significant. + The empty string represents zero. <FONT COLOR="black">bytestointeger</FONT> takes such a string and produces the + corresponding Icon integer. <FONT COLOR="black">integertobytes</FONT> takes an Icon integer and produces an Icon + string representing its absolute value in the preceding sense. Neither function attempts type conversions, so for + meaningful results they must be passed respectively a string value and an integer value.<BR> + <BR> + The non-member functions <FONT COLOR="black">base64</FONT>, <FONT COLOR="black">base64tointeger</FONT> and <FONT + COLOR="black">base64tostring</FONT> are useful to overtly convert strings and integers of any size to and from + the commonly used <A HREF="http://www.faqs.org/rfcs/rfc3548.html">base64</A> encoding. Each function takes a value + and returns a value, and none attempts any type conversion of its arguments. <FONT COLOR="black">base64</FONT> + may be passed an Icon integer or string and produces a string containing the base64 encoding thereof. The sign + of an integer is ignored, so the base64 encoding of its absolute value is produced. <FONT COLOR="black">base64tointeger</FONT> + may be passed an Icon string that is a strict base64 encoding in which case it returns the corresponding Icon integer, + and similarly <FONT COLOR="black">base64tostring</FONT> may be passed an Icon string that is a strict base64 encoding + in which case it returns the corresponding Icon string. By strict base64 encoding is meant that the string's length + is a multiple of four, that the end of the string is a sequence of between zero and two "=" characters + (used to pad the file length to a multiple of four when encoding), and apart from that the remaining characters + in the string are either lower or upper case letters, or digits, or the characters "/" and "+". + Failure to supply a string containing a strict base64 encoding to either function will cause null to be returned.</P> + <H3><A NAME="Variadic"></A><A HREF="http://en.wikipedia.org/wiki/Variadic_function">Variadic Functions</A> and + Dynamic List Construction</H3> + <P>Some built-in Icon functions take an arbitrary number of arguments. Unfortunately, C++ as of the present standard + has no convenient way to define a function with an arbitrary number of arguments of the same type. So variadic + functions included in the namespace 'Icon' such as <FONT COLOR="black">writes</FONT> are defined in two versions. + The first has at most eight arguments, with defaults and glue code to account for fewer being supplied. This takes + care of most uses of such functions.</P> + <P>The second uses a single argument of the class variadic, which is a wrapper for an Icon list of the arguments. + The operator ',' (comma) has been overloaded so as to combine two locals into a variadic, and to combine a variadic + and a safe so as to append the safe's value to the variadic's list. A variadic has a conversion to safe that in + effect removes the wrapper, and there are other sundry conversions and overloads of comma. These enable lists to + be constructed in place, providing a syntactic equivalent of things like <FONT COLOR="black">[x,y,z]</FONT> in + Icon, namely <FONT COLOR="black">(x,y,z)</FONT> in C++. The second implementation of writes may then be called + as <FONT COLOR="black">writes((x,y,z))</FONT>. The second pair of parentheses is necessary as comma is not regarded + as an operator by C++ when it is in a parameter list. Here is an example of the use of dynamic list construction.</P> + <BLOCKQUOTE> + <P> + <TABLE BORDER="0" WIDTH="432"> + <TR> + <TD WIDTH="432"> + <PRE><FONT COLOR="black" FACE="Courier New, Courier">extern "C" int divide(value argv[]){ + safe x(argv[1]), y(argv[2]); + argv[0] = (x / y, x % y); + return SUCCEEDED; +}</FONT></PRE> + </TD> + </TR> + </TABLE> +</P> + </BLOCKQUOTE> + <H3><A NAME="Calling"></A>Calling Icon from C++</H3> + <P>The class safe has overloaded the function call operator '()' so that a safe may be called with function call + syntax. If the value of the safe is an Icon procedure (or function or record constructor) the effect is to call + Icon from C++. There are two kinds of restrictions on these calls.</P> + <P>The first restriction is because C++ requires a specific <A HREF="http://en.wikipedia.org/wiki/Arity" target="_blank">arity</A> + when overloading the function call operator, and has no convenient way to handle an arbitrary number of parameters + of the same type. This restriction is the same one affecting the calling of <A HREF="#Variadic">variadic functions</A>, + and is overcome in the same way with <A HREF="#Variadic">two implementations</A>. One with a single argument of + class variadic necessitating <A HREF="#Variadic">two pairs of parentheses</A> when the call is made, and the other + with up to eight arguments and useful for most procedure calls.</P> + <P>The second restriction is because there are three ways Icon can pass control back to a caller: by returning + a value, by failing and by suspending a value. However, there is only one way for C++ to receive control back from + a call it has made: by a value (possibly void) being returned. For this reason a call of an Icon procedure from + C++ will return &null if the procedure fails, and will return rather than suspend if the procedure suspends + a value. In either case, the call always returns cleanly with a single value. It is possible to <A HREF="#Iterate">iterate + through the values suspended by an Icon procedure</A> in C++ through a different mechanism.</P> + <H3><A NAME="Generators"></A>Working with Generators from C++</H3> + <P>Generators and the flow of control in Icon have no counterpart in C++. Nevertheless, it is useful to be able + to both implement generators for Icon in C++, and iterate through generator sequences produced by Icon in C++, + as well as create coexpressions in C++. All these facilities are provided by loadfuncpp.</P> + <H4><A NAME="Generate"></A>Writing External Functions that are Generators</H4> + <P>Here is an example of a generator function written in C++. It is a C++ implementation of the built-in Icon function + <FONT COLOR="black">seq</FONT>, without the restriction to machine size integers.</P> + <BLOCKQUOTE> + <P> + <TABLE BORDER="0" WIDTH="456"> + <TR> + <TD WIDTH="456"> + <PRE><FONT COLOR="black" FACE="Courier New, Courier">class sequence: public generator { + safe current, inc; + public: + sequence(local start, local increment) { + current = start - increment; + inc = increment; + } + virtual bool hasNext() { + return true; + } + virtual value giveNext() { + return current += inc; + } +}; + +extern "C" int seq2(value argv[]){ + sequence seq(argv[1], argv[2]); + return seq.generate(argv); +}</FONT></PRE> + </TD> + </TR> + </TABLE> +</P> + </BLOCKQUOTE> + <P>This exemplifies all the features of loadfuncpp that enable generator functions to be written. First a C++ version + of the generator is written as a class that inherits from the loadfuncpp class generator. Some data members are + added to maintain state as generation occurs, and a constructor is written to initialize those data members. Finally + the virtual functions <FONT COLOR="black">hasNext()</FONT> and <FONT COLOR="black">giveNext()</FONT> with exactly + the above prototypes are overloaded. The sequence generated by an object of this class is defined to be that produced + by repeatedly calling <FONT COLOR="black">hasNext()</FONT> to determine if there is a next member of the sequence, + and if there is, calling <FONT COLOR="black">giveNext()</FONT> to get it.</P> + <P>Now the external function itself simply creates a generator object of the above class, presumably using values + passed to it from Icon to initialize that object's state. Then the inherited member function <FONT COLOR="black">generate</FONT> + is called, passing the original argument array for technical reasons, and the signal it returns is passed back + to Icon. The effect of this call is to iterate through the calls of <FONT COLOR="black">giveNext()</FONT> while + <FONT COLOR="black">hasNext()</FONT> returns true, suspending the results produced by each call of <FONT COLOR="black">giveNext()</FONT> + to Icon. In a nutshell the call to <FONT COLOR="black">generate</FONT> suspends the sequence of results produced + by the object to Icon. The reason that <FONT COLOR="black">generate</FONT> needs to be passed argv is that it needs + to send its results to Icon by assigning to argv[0], in just as a single result is passed back.</P> + <H4><A NAME="Iterate"></A>Calling Icon Procedures that are Generators from C++</H4> + <P>Here is an example of how to iterate over the results of a call of an Icon procedure. In the example the procedure + to be called and its argument list are presumed to be the arguments passed to the external function, which then + computes the sum of the first ten results suspended by the call, or the sum of all the results if less than ten + results are computed.</P> + <BLOCKQUOTE> + <P> + <TABLE BORDER="0" WIDTH="456"> + <TR> + <TD WIDTH="456"> + <PRE><FONT COLOR="black" FACE="Courier New, Courier">class addup: public iterate { + public: + safe total; + int count; + + addup(): total(0), count(0) {} + + virtual void takeNext(const value& x) { + total += x; + } + virtual bool wantNext(const value& x) { + return ++count <= 10; + } +}; + +extern "C" int sum10(value argv[]){ + addup sum; + sum.every(argv[1], argv[2]); + argv[0] = sum.total; + return SUCCEEDED; +}</FONT></PRE> + </TD> + </TR> + </TABLE> +</P> + </BLOCKQUOTE> + <P>This exemplifies all the features of loadfuncpp that enable the results of a call to Icon to be iterated over + in C++. First a class representing the loop that will iterate over the generator sequence is written, inheriting + from the loadfuncpp class iterate. The data members of that class model the variables used in the loop, and the + constructor models the initialization of those loop variables. It is convenient that these be public along with + everything else; the class could be declared as a struct to achieve this. The two inherited virtual member functions + <FONT COLOR="black">wantNext()</FONT> and <FONT COLOR="black">takeNext()</FONT> with exactly the above prototypes + are then overridden. The function <FONT COLOR="black">wantNext()</FONT> models the loop condition: it returns true + if the loop will process the next result produced by the generator, and false if the loop should be terminated. + The function <FONT COLOR="black">takeNext()</FONT> models the loop body: it will be passed each result produced + by the generator, and may modify the loop variables accordingly.</P> + <P>Now the external function itself simply creates an object of this class, using the constructor to initialize + the loop variables, or simply assigning to them directly. This models setup code before the loop proper starts. + Then the inherited member function <FONT COLOR="black">every</FONT> is called with the generator function and its + argument list as arguments to the call. The call of <FONT COLOR="black">every</FONT> models executing the loop + body by calling the generator function applied to its argument list and repeatedly alternately calling <FONT COLOR="black">wantNext()</FONT> + to see if the loop should continue and <FONT COLOR="black">takeNext()</FONT> to pass the loop body the next result + produced by the call to Icon. The loop is terminated either by <FONT COLOR="black">wantNext()</FONT> returning + false or by the sequence of results generated by the call to Icon coming to an end, whichever occurs first.</P> + <H4><A NAME="Bang"></A>Iterating over Exploded Structures in C++</H4> + <P>This feature of loadfuncpp enables iteration over the results that would be generated in Icon by an expression + of the form <FONT COLOR="black">!x</FONT>, with one important difference: if <FONT COLOR="black">x</FONT> is a + table, then the results iterated over are those that would be produced by the Icon expression <FONT COLOR="black">key(x)</FONT>. + The technique use to perform such an iteration is almost identical to that used to <A HREF="#Iterate">iterate over + the results of a call to an Icon procedure</A>. The only difference is that a different inherited member function + (<FONT COLOR="black">bang</FONT>) is called to run the iteration. Here is an example that sums the first ten elements + of a list by quite unnecessarily using this technique.</P> + <BLOCKQUOTE> + <P> + <TABLE BORDER="0" WIDTH="456"> + <TR> + <TD WIDTH="456"> + <PRE><FONT COLOR="black" FACE="Courier New, Courier">class addup: public iterate { + public: + safe total; + int count; + + addup(): total(0), count(0) {} + + virtual void takeNext(const value& x) { + total += x; + } + virtual bool wantNext(const value& x) { + return ++count <= 10; + } +}; + +extern "C" int sumlist(value argv[]) { + addup sum; + sum.bang(argv[1]); + argv[0] = sum.total; + return SUCCEEDED; +}</FONT></PRE> + </TD> + </TR> + </TABLE> +</P> + </BLOCKQUOTE> + <H4><A NAME="Coexpressions"></A>Working with Coexpressions in C++</H4> + <P>There are a handful of member functions in the class safe that provide an essentially complete set of operations + on coexpressions. These are straightforward to use and are summarized here.</P> + </BLOCKQUOTE> + <BLOCKQUOTE ALIGN="CENTER"> + <P> + <TABLE BORDER="0"> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><B><FONT SIZE="2" FACE="Courier New, Courier">safe function</FONT></B> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><B><FONT SIZE="2" FACE="Courier New, Courier">Icon equivalent</FONT></B> + </TD> + <TD WIDTH="271"> + <P> + </TD> + </TR> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">x.create()</FONT> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">create !x</FONT> + </TD> + <TD WIDTH="271"> + <P><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier"> </FONT> + </TD> + </TR> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">x.create(y)</FONT> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">create x!y</FONT> + </TD> + <TD WIDTH="271"> + <P> + </TD> + </TR> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">x.activate(y)</FONT> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">y@x</FONT> + </TD> + <TD WIDTH="271"> + <P><FONT SIZE="2" FACE="Courier New, Courier">y defaults to &null</FONT> + </TD> + </TR> + <TR> + <TD WIDTH="130"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">x.refresh()</FONT> + </TD> + <TD WIDTH="164"> + <P ALIGN="CENTER"><FONT SIZE="2" COLOR="black" FACE="Courier New, Courier">^x</FONT> + </TD> + <TD WIDTH="271"> + <P> + </TD> + </TR> + </TABLE> +</P> + </BLOCKQUOTE> + <BLOCKQUOTE> + <H3><A NAME="Externals"></A>Working with <A HREF="http://www.cs.arizona.edu/icon/v950/extlvals.htm" target="_blank">External + Values</A></H3> + <P>A new kind of external value is easily defined and used via inheritance from the loadfuncpp class external, + which permanently hides the low level machinery of the <A HREF="http://www.cs.arizona.edu/icon/v950/extlvals.htm" + target="_blank">C specification</A>. Here is an example of such that illustrates the use of the available features.</P> + <BLOCKQUOTE> + <P> + <TABLE BORDER="0" WIDTH="456"> + <TR> + <TD WIDTH="456"> + <PRE><FONT COLOR="black" FACE="Courier New, Courier">class Widget: public external { + long state; + public: + Widget(long x): state(x) {} + + virtual value name() { + return "Widget"; + } + virtual external* copy() { + return new Widget(state); + } + virtual value image() { + char sbuf[100]; + sprintf(sbuf, "Widget_%ld(%ld)", id, state); + return value(NewString, sbuf); + } + virtual long compare(external* ep) { + //negative:less, zero:equal, positive:greater + Widget* wp = (Widget*)ep; + return this->state - wp->state; + } +}; + +extern "C" int widget(value argv[]) { + if( argv[1].type() != Integer ) { + Icon::runerr(101, argv[1]); + return FAILED; + } + argv[0] = new Widget(argv[1]); + return SUCCEEDED; +} + +extern "C" int widgetint(value argv[]) { + if( argv[1].type() != External ) { + Icon::runerr(131, argv[1]); + return FAILED; + } + if( !argv[1].isExternal("Widget") ) { + Icon::runerr(132, argv[1]); + return FAILED; + } + external* ep = argv[1]; //implied conversion + Widget* wp = (Widget*)ep; //can move if GC occurs! + argv[0] = ep->state; + return SUCCEEDED; +}</FONT></PRE> + </TD> + </TR> + </TABLE> +</P> + </BLOCKQUOTE> + <P>The example defines an external function <FONT COLOR="black">widget</FONT> that returns an external value to + Icon, and an external function <FONT COLOR="black">widgetint</FONT> that returns an integer extracted from a Widget + to Icon. Of course a real library would have in addition a number of external functions to work with Widgets; these + could call additional member functions in the Widget class to do the necessary work.</P> + <P>Overriding the inherited virtual functions <FONT COLOR="black">name()</FONT>, <FONT COLOR="black">copy()</FONT>, + <FONT COLOR="black">image()</FONT> and <FONT COLOR="black">compare()</FONT> automatically redefines the behavior + respectively of the built-in Icon functions type, copy and image and the Icon operators === and ~=== when applied + to Widgets, as well as the order for sorting Widgets among themselves in Icon. Such overriding is optional, and + the defaults defined in the <A HREF="http://www.cs.arizona.edu/icon/v950/extlvals.htm" target="_blank">C specification</A> + will apply otherwise. Specifically, the default copy is not to copy but to return the original.</P> + <P>There are automatic conversions to and from <FONT COLOR="black">external*</FONT> so that new widgets may be + assigned to values or safes, and vice versa when appropriate. The operator new has been overloaded so that an external + is allocated by Icon as a part of an Icon external block on the Icon heap. The class external has a protected data + member <FONT COLOR="black">id</FONT> that contains the serial number of the external value (assigned by Icon when + it allocates the external block). Using <FONT COLOR="black">id</FONT> may be convenient when overriding the <FONT + COLOR="black">image()</FONT> member function, as above.</P> + <P>External blocks are assumed by Icon not to contain any Icon <A HREF="http://www.cs.arizona.edu/icon/current/cfuncs.htm" + target="_blank">descriptors</A>, so do not declare any data members of the classes value or safe when inheriting + from external, unless you wish to invite disaster when a garbage collection occurs. Take into account that external + blocks may be relocated or garbage collected by Icon. It is not possible to arrange for a destructor or anything + else to be called when that occurs. If calling a destructor is essential, then place a pointer to the real object + in the external object, and allocate and manage the real object yourself.</P> + <H3><A NAME="Records"></A>Using Icon Records as Objects</H3> + <P>A new procedure that is a copy of another with an Icon record bound to it may be created by calling the procedure + <FONT COLOR="black">bindself</FONT>. The new procedure behaves exactly as the old one, except that a call of the + procedure <FONT COLOR="black">self</FONT> from within it returns the record attached to it by <FONT COLOR="black">bindself</FONT>. + This enables a record to contain a procedure that behaves like a method by virtue of being bound to it, as illustrated + by the following example. + <BLOCKQUOTE> + <P> + <TABLE BORDER="0" WIDTH="496"> + <TR> + <TD WIDTH="496"> + <PRE><FONT COLOR="black" FACE="Courier New, Courier">link loadfuncpp + +record object(val, print) + +procedure print() + obj := self() | fail + write( obj.val ) +end + +procedure newObject(x) + obj := object(x) #don't assign print method yet + #print will be a copy bound to the record it's embedded in + obj.print := bindself(print, obj) + return obj +end + +procedure main() + obj := newObject("Hello") + obj.print() +end</FONT></PRE> + </TD> + </TR> + </TABLE> + + </BLOCKQUOTE> + <P>Note that <FONT COLOR="black">self</FONT> fails if called from a procedure that is not bound to a record i.e. + one that has not been returned by <FONT COLOR="black">bindself</FONT>. It is possible to use bindself to bind a + record to a procedure that already has a record bound to it. This simply replaces the bound record, which is useful + for copying records that are to be treated as objects in this way, e.g. when copying a prototype object when simulating + an object based inheritance scheme. + </BLOCKQUOTE> + </TD> + </TR> +</TABLE> + +</CENTER> + +</BODY> + +</HTML> diff --git a/ipl/packs/loadfuncpp/doc/object.cpp b/ipl/packs/loadfuncpp/doc/object.cpp new file mode 100644 index 0000000..a8ac211 --- /dev/null +++ b/ipl/packs/loadfuncpp/doc/object.cpp @@ -0,0 +1,15 @@ + +/* Example of a C++ extension to icon via loadfunc, + * without garbage collection difficulties. + * Type 'make iexample' to build. + * Carl Sturtivant, 2008/3/16 + */ + +#include "loadfuncpp.h" +using namespace Icon; + +extern "C" int dummy(value argv[]) { + return SUCCEEDED; +} + + diff --git a/ipl/packs/loadfuncpp/doc/object.icn b/ipl/packs/loadfuncpp/doc/object.icn new file mode 100644 index 0000000..5fe2ba4 --- /dev/null +++ b/ipl/packs/loadfuncpp/doc/object.icn @@ -0,0 +1,23 @@ + +link loadfuncpp + +record object(val, print) + +procedure print() + obj := self() | fail + write( obj.val ) +end + +procedure newObject(x) + obj := object(x) #don't assign print method yet + #print will be a copy bound to the record it's embedded in + obj.print := bindself(print, obj) + return obj +end + +procedure main() + obj := newObject("Hello") + obj.print() +end + + diff --git a/ipl/packs/loadfuncpp/examples/Makefile b/ipl/packs/loadfuncpp/examples/Makefile new file mode 100644 index 0000000..06bfc3f --- /dev/null +++ b/ipl/packs/loadfuncpp/examples/Makefile @@ -0,0 +1,51 @@ + +#Automatically generated from Makefile.mak and examples.txt by ../savex.icn + +ifndef TARGET + +ifneq ($(strip $(shell g++ -v 2>&1 | grep "darwin")),) +TARGET=mac +else +ifneq ($(strip $(shell g++ -v 2>&1 | grep "cygwin")),) +TARGET=cygwin +else +TARGET=other +endif +endif + +endif + + +FLAGS_cygwin = /opt/icon/bin/iload.a -Wl,--enable-auto-import +FLAGS_other = + +SHARED_mac = -bundle -undefined suppress +SHARED_cygwin = -shared +SHARED_other = -shared + +IMPLIB_cygwin = -Wl,--out-implib=iload.a +PIC_other = -fPIC +PIC_mac = -flat_namespace + + + +EXAMPLES = callicon.exe coexp.exe extwidget.exe iterate.exe iterate2.exe iterate3.exe jmexample.exe kwd_vbl.exe methodcall.exe mkexternal.exe runerr.exe stop.exe +DYNAMICS = callicon.so coexp.so extwidget.so iterate.so iterate2.so iterate3.so jmexample.so kwd_vbl.so methodcall.so mkexternal.so runerr.so stop.so + +%.so : %.cpp loadfuncpp.h loadfuncpp.u1 + g++ $(SHARED_$(TARGET)) $(PIC_$(TARGET)) -o $@ $< $(FLAGS_$(TARGET)) + +%.exe : %.icn %.so iload.so + icont -so $@ $* + +default: $(DYNAMICS) $(EXAMPLES) + +.PHONY : iload.so loadfuncpp.h loadfuncpp.u1 + +loadfuncpp.h : ../loadfuncpp.h + cp ../loadfuncpp.h ./ + +test : clean default + +clean : + rm -f *.exe *.so *.o *% *~ core .#* *.u? diff --git a/ipl/packs/loadfuncpp/examples/Makefile.mak b/ipl/packs/loadfuncpp/examples/Makefile.mak new file mode 100644 index 0000000..28c87a3 --- /dev/null +++ b/ipl/packs/loadfuncpp/examples/Makefile.mak @@ -0,0 +1,34 @@ + +ifndef TARGET +ifneq ($(strip $(shell g++ -v 2>&1 | grep "cygwin")),) +TARGET=cygwin +else +TARGET=other +endif +endif + +FLAGS_cygwin = /opt/icon/bin/iload.a -Wl,--enable-auto-import +FLAGS_other = + +PIC_other = -fPIC + +EXAMPLES = #exe# +DYNAMICS = #so# + +%.so : %.cpp loadfuncpp.h loadfuncpp.u1 + g++ -shared $(PIC_$(TARGET)) -o $@ $< $(FLAGS_$(TARGET)) + +%.exe : %.icn %.so iload.so + icont -so $@ $* + +default: $(DYNAMICS) $(EXAMPLES) + +.PHONY : iload.so loadfuncpp.h loadfuncpp.u1 + +loadfuncpp.h : ../loadfuncpp.h + cp ../loadfuncpp.h ./ + +test : clean default + +clean : + rm -f *.exe *.so *.o *% *~ core .#* diff --git a/ipl/packs/loadfuncpp/examples/arglist.cpp b/ipl/packs/loadfuncpp/examples/arglist.cpp new file mode 100644 index 0000000..a62d347 --- /dev/null +++ b/ipl/packs/loadfuncpp/examples/arglist.cpp @@ -0,0 +1,18 @@ + +/* Example of a C++ extension to icon via loadfunc, + * without garbage collection difficulties. + * Type 'make <platform>' to build. + * For available <platform>s type 'make'. + * Carl Sturtivant, 2007/9/25 + */ + +#include "loadfuncpp.h" + + +extern "C" int iexample(int argc, value argv[]) { + safe x(argc, argv); //make the arguments into an Icon list + argv[0] = x; + return SUCCEEDED; +} + + diff --git a/ipl/packs/loadfuncpp/examples/arglist.icn b/ipl/packs/loadfuncpp/examples/arglist.icn new file mode 100644 index 0000000..bb17a46 --- /dev/null +++ b/ipl/packs/loadfuncpp/examples/arglist.icn @@ -0,0 +1,7 @@ + +procedure main() + loadfunc("./iload.so", "loadfuncpp") + f := loadfunc("./iexample.so", "iexample") + every write( !( f(1,2,3,4) ) ) +end + diff --git a/ipl/packs/loadfuncpp/examples/callicon.cpp b/ipl/packs/loadfuncpp/examples/callicon.cpp new file mode 100644 index 0000000..7d0a224 --- /dev/null +++ b/ipl/packs/loadfuncpp/examples/callicon.cpp @@ -0,0 +1,18 @@ + +/* Example of a C++ extension to icon via loadfunc, + * without garbage collection difficulties. + * Type 'make <platform>' to build. + * For available <platform>s type 'make'. + * Carl Sturtivant, 2007/9/25 + */ + +#include "loadfuncpp.h" + + + +extern "C" int iexample(int argc, value argv[]) { + argv[0] = argv[1].apply(argv[2]); + return SUCCEEDED; +} + + diff --git a/ipl/packs/loadfuncpp/examples/callicon.icn b/ipl/packs/loadfuncpp/examples/callicon.icn new file mode 100644 index 0000000..c3e10ee --- /dev/null +++ b/ipl/packs/loadfuncpp/examples/callicon.icn @@ -0,0 +1,24 @@ + +link loadfuncpp + +procedure main() + icall := loadfuncpp("./callicon.so", "iexample") + + write( icall(f, ["Argument passed"]) ) +end + +procedure f(arg) + write(arg) + write("Called from C++") + every write( g(arg) ) + x := create g(arg) + while writes(@x) + write() + return "Result string!" +end + +procedure g(arg) + suspend !arg +end + + diff --git a/ipl/packs/loadfuncpp/examples/carl.icn b/ipl/packs/loadfuncpp/examples/carl.icn new file mode 100644 index 0000000..2d7c6a4 --- /dev/null +++ b/ipl/packs/loadfuncpp/examples/carl.icn @@ -0,0 +1,50 @@ + +#here's cat in icon (line by line): + +procedure main() + while write(read()) #fails when eof +end + +#here's writing out the command line arguments + +procedure main(arg) #passed a list of strings + every write( !arg) # ! (bang) makes a generator sequence +end + +#here's finding all lines in standard input containing "frog" + +procedure main() + while line := read() do line ? #string matching subject is line + if find("frog") then write(line) +end + +#here's finding the text on each line that contains "frog" that +#lies before the first occurrence of "frog" + +procedure main() + while line := read() do line ? #string matching subject is line + write( tab(find("frog")) ) +end + +#here's generating the first 1000 squares + +procedure main() + every write( squares() ) \1000 #truncate generator to 1000 results +end + +procedure squares() + n := 0 + repeat { + n +:= 1 + suspend n^2 #shoot out next element of generator sequence + } +end + +procedure main() + (n := 1) | |( n +:= 1, n^2 ) +end + +#So that +procedure main() + every write( (n := 1) | |( n +:= 1, n^2 ) ) \1000 +end diff --git a/ipl/packs/loadfuncpp/examples/coexp.cpp b/ipl/packs/loadfuncpp/examples/coexp.cpp new file mode 100644 index 0000000..6c3b1d1 --- /dev/null +++ b/ipl/packs/loadfuncpp/examples/coexp.cpp @@ -0,0 +1,20 @@ + +/* Example of a C++ extension to icon via loadfunc, + * without garbage collection difficulties. + * Type 'make <platform>' to build. + * For available <platform>s type 'make'. + * Carl Sturtivant, 2007/9/25 + */ + +#include "loadfuncpp.h" + +extern "C" int activate(int argc, value argv[]) { + argv[0] = argv[1].activate(); + return SUCCEEDED; +} + +extern "C" int refresh(int argc, value argv[]) { + argv[0] = argv[1].refreshed(); + return SUCCEEDED; +} + diff --git a/ipl/packs/loadfuncpp/examples/coexp.icn b/ipl/packs/loadfuncpp/examples/coexp.icn new file mode 100644 index 0000000..5f38014 --- /dev/null +++ b/ipl/packs/loadfuncpp/examples/coexp.icn @@ -0,0 +1,15 @@ + +link loadfuncpp + +procedure main() + activate := loadfuncpp("./coexp.so", "activate") + refresh := loadfuncpp("./coexp.so", "refresh") + x := create 1 to 7 + @x + @x + write( activate(x) ) + x := refresh(x) + write( activate(x) ) +end + + diff --git a/ipl/packs/loadfuncpp/examples/compare.icn b/ipl/packs/loadfuncpp/examples/compare.icn new file mode 100644 index 0000000..c6823ec --- /dev/null +++ b/ipl/packs/loadfuncpp/examples/compare.icn @@ -0,0 +1,7 @@ + +procedure main() + loadfunc("./iload.so", "loadfuncpp") + f := loadfunc("./iexample.so", "iexample") + write( f(100,10) ) +end + diff --git a/ipl/packs/loadfuncpp/examples/examples.txt b/ipl/packs/loadfuncpp/examples/examples.txt new file mode 100644 index 0000000..40eb40a --- /dev/null +++ b/ipl/packs/loadfuncpp/examples/examples.txt @@ -0,0 +1,12 @@ +callicon +coexp +extwidget +iterate +iterate2 +iterate3 +jmexample +kwd_vbl +methodcall +mkexternal +runerr +stop diff --git a/ipl/packs/loadfuncpp/examples/extwidget.cpp b/ipl/packs/loadfuncpp/examples/extwidget.cpp new file mode 100644 index 0000000..bb42364 --- /dev/null +++ b/ipl/packs/loadfuncpp/examples/extwidget.cpp @@ -0,0 +1,35 @@ + +/* Example of a C++ extension to icon via loadfunc, + * without garbage collection difficulties. + * Type 'make iexample' to build. + * Carl Sturtivant, 2008/3/16 + */ + +#include "loadfuncpp.h" +using namespace Icon; + +#include <cstdio> + +class Widget: public external { + long state; + public: + Widget(long x): state(x) {} + + virtual value name() { + return "Widget"; + } + virtual external* copy() { + return new Widget(state); + } + virtual value image() { + char sbuf[100]; + sprintf(sbuf, "Widget_%ld(%ld)", id, state); + return value(NewString, sbuf); + } +}; + +extern "C" int iexample(int argc, value argv[]) { + argv[0] = new Widget(99); + return SUCCEEDED; +} + diff --git a/ipl/packs/loadfuncpp/examples/extwidget.icn b/ipl/packs/loadfuncpp/examples/extwidget.icn new file mode 100644 index 0000000..b924fd7 --- /dev/null +++ b/ipl/packs/loadfuncpp/examples/extwidget.icn @@ -0,0 +1,14 @@ + +link loadfuncpp + +procedure main() + iexample := loadfuncpp("./extwidget.so", "iexample") + external := iexample() + external2 := copy(external) + write( type(external) ) + write( image(external) ) + write( type(external2) ) + write( image(external2) ) +end + + diff --git a/ipl/packs/loadfuncpp/examples/factorials.icn b/ipl/packs/loadfuncpp/examples/factorials.icn new file mode 100644 index 0000000..908ea97 --- /dev/null +++ b/ipl/packs/loadfuncpp/examples/factorials.icn @@ -0,0 +1,27 @@ +procedure main () + every n := 1 to 10 do { + write (n, "! = ", memoized_factorial ( n ) ); + } + n := 135; write(n, "! = ", memoized_factorial ( n ) ); + n := 155; write(n, "! = ", memoized_factorial ( n ) ); +end +procedure memoized_factorial ( k ) + static results; + static k_limit; + static k_old; + initial { + results := [1]; + k_limit := 10 ^ 5; + k_old := 1; + } + if (k < k_limit) then { + while (k > *results) do results := results ||| list(*results) + every n := (k_old + 1) to k do { + results[n] := n * results[n - 1]; + } + k_old := k; + return results[k]; + } else { + return ((k / &e) ^ n) * sqrt(2 * &pi * n); + } +end diff --git a/ipl/packs/loadfuncpp/examples/hello.icn b/ipl/packs/loadfuncpp/examples/hello.icn new file mode 100644 index 0000000..5a24d9a --- /dev/null +++ b/ipl/packs/loadfuncpp/examples/hello.icn @@ -0,0 +1,3 @@ +procedure main () + write ( "Yarrr, matey, bilge the yardarm!" ); +end diff --git a/ipl/packs/loadfuncpp/examples/hexwords.icn b/ipl/packs/loadfuncpp/examples/hexwords.icn new file mode 100644 index 0000000..43c35ca --- /dev/null +++ b/ipl/packs/loadfuncpp/examples/hexwords.icn @@ -0,0 +1,18 @@ +procedure printable(word) + if ("" == word) then { + return ""; + } else { + return map(map(word, "oOiIzZeEsStT", "001122335577"), &lcase, &ucase); + } +end +procedure main(arg) + word_file := "/usr/share/dict/words"; + find := '0123456789abcdefABCDEFoOiIzZeEsStT'; + usage := "Finds all the words in a word file that can be written using /^[A-Fa-f0-9$/"; + words := open(word_file) | stop("Unable to open: " || word_file) + while word := trim(read(words)) do { + if ('' == word -- find) then { + write(printable(word) || " " || word); + } + } +end diff --git a/ipl/packs/loadfuncpp/examples/hexwords_oneline.icn b/ipl/packs/loadfuncpp/examples/hexwords_oneline.icn new file mode 100644 index 0000000..6e11041 --- /dev/null +++ b/ipl/packs/loadfuncpp/examples/hexwords_oneline.icn @@ -0,0 +1,8 @@ +procedure printable(word) + return "" == word | map(map(word, "oOiIzZeEsStT", "001122335577"), &lcase, &ucase); +end +procedure main() + find := '0123456789abcdefABCDEFoOiIzZeEsS'; + words := open(word_file := "/usr/share/dict/words") | stop("Unable to open: " || word_file); + every write(printable( | 1 ( | (word := trim(read(words))) , not("" == word) , ('' == word -- find)))); +end diff --git a/ipl/packs/loadfuncpp/examples/iterate.cpp b/ipl/packs/loadfuncpp/examples/iterate.cpp new file mode 100644 index 0000000..9f60d13 --- /dev/null +++ b/ipl/packs/loadfuncpp/examples/iterate.cpp @@ -0,0 +1,26 @@ + +/* Example of a C++ extension to icon via loadfunc, + * without garbage collection difficulties. + * Type 'make iexample' to build. + * Carl Sturtivant, 2008/3/16 + */ + +#include "loadfuncpp.h" +using namespace Icon; + + +struct addup: public iterate { + safe total; + addup(): total((long)0) {} + virtual void takeNext(const value& x) { + total = total + x; + } +}; + +extern "C" int iexample(int argc, value argv[]) { + addup sum; + sum.every(argv[1], argv[2]); + argv[0] = sum.total; + return SUCCEEDED; +} + diff --git a/ipl/packs/loadfuncpp/examples/iterate.icn b/ipl/packs/loadfuncpp/examples/iterate.icn new file mode 100644 index 0000000..0d6de0e --- /dev/null +++ b/ipl/packs/loadfuncpp/examples/iterate.icn @@ -0,0 +1,13 @@ + +link loadfuncpp + + +procedure main() + total := loadfuncpp("./iterate.so", "iexample") + write( total(g, [1,2,3,4,5]) ) +end + +procedure g(ls[]) + suspend !ls +end + diff --git a/ipl/packs/loadfuncpp/examples/iterate2.cpp b/ipl/packs/loadfuncpp/examples/iterate2.cpp new file mode 100644 index 0000000..c32bdf9 --- /dev/null +++ b/ipl/packs/loadfuncpp/examples/iterate2.cpp @@ -0,0 +1,31 @@ + +/* Example of a C++ extension to icon via loadfunc, + * without garbage collection difficulties. + * Type 'make iexample' to build. + * Carl Sturtivant, 2008/3/16 + */ + +#include "loadfuncpp.h" +using namespace Icon; + + +struct addup: public iterate { + safe total; + int count; + addup(): total((long)0), count(0) {} + + virtual void takeNext(const value& x) { + total = total + x; + } + virtual bool wantNext(const value& x) { + return ++count <= 3; + } +}; + +extern "C" int iexample(int argc, value argv[]) { + addup sum; + sum.every(argv[1], argv[2]); + argv[0] = sum.total; + return SUCCEEDED; +} + diff --git a/ipl/packs/loadfuncpp/examples/iterate2.icn b/ipl/packs/loadfuncpp/examples/iterate2.icn new file mode 100644 index 0000000..3863ba1 --- /dev/null +++ b/ipl/packs/loadfuncpp/examples/iterate2.icn @@ -0,0 +1,13 @@ + +link loadfuncpp + + +procedure main() + total := loadfuncpp("./iterate2.so", "iexample") + write( total(g, [1,2,3,4,5]) ) +end + +procedure g(ls[]) + suspend !ls +end + diff --git a/ipl/packs/loadfuncpp/examples/iterate3.cpp b/ipl/packs/loadfuncpp/examples/iterate3.cpp new file mode 100644 index 0000000..1b1dd70 --- /dev/null +++ b/ipl/packs/loadfuncpp/examples/iterate3.cpp @@ -0,0 +1,32 @@ + +/* Example of a C++ extension to icon via loadfunc, + * without garbage collection difficulties. + * Type 'make iexample' to build. + * Carl Sturtivant, 2008/3/16 + */ + +#include "loadfuncpp.h" +using namespace Icon; + + +struct addup: public iterate { + safe total; + int count; + addup(): total((long)0) { + count = 0; + } + virtual void takeNext(const value& x) { + total = total + x; + } + virtual bool wantNext(const value& x) { + return ++count <= 3; + } +}; + +extern "C" int iexample(value argv[]) { + addup sum; + sum.bang(argv[1]); + argv[0] = sum.total; + return SUCCEEDED; +} + diff --git a/ipl/packs/loadfuncpp/examples/iterate3.icn b/ipl/packs/loadfuncpp/examples/iterate3.icn new file mode 100644 index 0000000..1f6414d --- /dev/null +++ b/ipl/packs/loadfuncpp/examples/iterate3.icn @@ -0,0 +1,9 @@ + +link loadfuncpp + + +procedure main() + total := loadfuncpp("./iterate3.so", "iexample", 1) #arity present + write( total([1,2,3,4,5]) ) +end + diff --git a/ipl/packs/loadfuncpp/examples/jmexample.cpp b/ipl/packs/loadfuncpp/examples/jmexample.cpp new file mode 100644 index 0000000..a367fd5 --- /dev/null +++ b/ipl/packs/loadfuncpp/examples/jmexample.cpp @@ -0,0 +1,52 @@ + +/* Example of a C++ extension to icon via loadfunc, + * without garbage collection difficulties. + * Type 'make <platform>' to build. + * For available <platform>s type 'make'. + * Carl Sturtivant, 2007/9/25 + */ + +#include "loadfuncpp.h" + +enum { JMUP, JMDOWN }; +class sequence: public generator { + long count; + long limit; + int direction; + bool hasNext() { + switch(direction) { + case JMUP: + return count <= limit; + case JMDOWN: + return count >= limit; + default: + return false; + } + } + value giveNext() { + switch(direction) { + case JMUP: + return count++; + case JMDOWN: + return count--; + default: + return nullvalue; + } + } + public: + sequence(value start, value end) { + count = start; + limit = end; + direction = ((count < limit) ? JMUP : JMDOWN); + }; +}; + +extern "C" int jm_test_1(int argc, value argv[]) { + if( argc != 2 ) { + return FAILED; + } + sequence s(argv[1], argv[2]); + return s.generate(argv); +} + + diff --git a/ipl/packs/loadfuncpp/examples/jmexample.icn b/ipl/packs/loadfuncpp/examples/jmexample.icn new file mode 100644 index 0000000..d2cc973 --- /dev/null +++ b/ipl/packs/loadfuncpp/examples/jmexample.icn @@ -0,0 +1,8 @@ + +link loadfuncpp + +procedure main() + f := loadfuncpp("./jmexample.so", "jm_test_1") + every write(f(1, 10) | f(10, 1) | f(10, 10) | f(-1, 1)) +end + diff --git a/ipl/packs/loadfuncpp/examples/kwd_vbl.cpp b/ipl/packs/loadfuncpp/examples/kwd_vbl.cpp new file mode 100644 index 0000000..d754304 --- /dev/null +++ b/ipl/packs/loadfuncpp/examples/kwd_vbl.cpp @@ -0,0 +1,17 @@ + +/* Example of a C++ extension to icon via loadfunc, + * without garbage collection difficulties. + * Type 'make iexample' to build. + * Carl Sturtivant, 2007/9/25 + */ + +#include "loadfuncpp.h" +using namespace Icon; + +extern "C" int iexample(int argc, value argv[]) { + safe y = argv[1]; + &progname = y; + argv[0] = &progname; + return SUCCEEDED; +} + diff --git a/ipl/packs/loadfuncpp/examples/kwd_vbl.icn b/ipl/packs/loadfuncpp/examples/kwd_vbl.icn new file mode 100644 index 0000000..4d4c9e8 --- /dev/null +++ b/ipl/packs/loadfuncpp/examples/kwd_vbl.icn @@ -0,0 +1,10 @@ + +link loadfuncpp + +procedure main() + keyword := loadfuncpp("./kwd_vbl.so", "iexample") + x := keyword("frog") + write(&progname) +end + + diff --git a/ipl/packs/loadfuncpp/examples/loadfuncpp.h b/ipl/packs/loadfuncpp/examples/loadfuncpp.h new file mode 100644 index 0000000..5704f60 --- /dev/null +++ b/ipl/packs/loadfuncpp/examples/loadfuncpp.h @@ -0,0 +1,481 @@ + +/* C++ support for easy extensions to icon via loadfunc, + * without garbage collection difficulties. + * Include this and link to iload.cpp which + * contains the necessary glue. + * See iexample.cpp for typical use. + * Carl Sturtivant, 2008/3/17 + */ + +#include<new> +#include<cstdio> + +enum kind { Null, Integer, BigInteger, Real, Cset, File, Procedure, Record, List, + Set=10, Table=12, String, Constructor, Coexpression=18, External, Variable }; + +enum special_value { NullString, StringLiteral, NewString, NullChar, Illegal }; + +enum { + SUCCEEDED = 7, // Icon function call returned: A_Continue + FAILED = 1 // Icon function call failed: A_Resume +}; + +class value; //Icon value (descriptor) +class safe; //for garbage-collection-safe Icon valued C++ variables and parameters of all kinds +class keyword; //Icon keyword represented as an object with unary & +class variadic; //for garbage-collection-safe variadic function argument lists +class proc_block; //block specifying a procedure to iconx +class external_block; //block specifying an external value to iconx +class external_ftable; //function pointers specifying external value behavior to iconx +class external; //C++ Object specifying an external value + +typedef int iconfunc(value argv[]); //type of icon built in functions or operators with a fixed number of arguments +typedef int iconfvbl(int argc, value argv[]); //type of icon built in functions with a variable number of arguments + +extern const value nullvalue; //for default arguments +extern const value nullstring; +extern const value nullchar; +extern const value illegal; //for unwanted trailing arguments +extern void syserror(const char*); //fatal termination Icon-style with error message +#define Fs_Read 0001 // file open for reading +#define Fs_Write 0002 // file open for writing +extern value IconFile(int fd, int status, char* fname); //make an Icon file descriptor +extern value integertobytes(value); //get the bytes of an Icon long integer as an Icon string (ignore sign) +extern value bytestointeger(value); //get the bytes of a new Icon long integer from an Icon string +extern value base64(value); //convert string or integer to base64 encoding (string) +extern value base64tointeger(value); //decode base64 string to integer +extern value base64tostring(value); //decode base64 string to string + +namespace Icon { +//all keywords excepting &fail, &cset (avoiding a name collision with function cset) +extern keyword allocated; +extern keyword ascii; +extern keyword clock; +extern keyword collections; +extern keyword current; +extern keyword date; +extern keyword dateline; +extern keyword digits; +extern keyword dump; +extern keyword e; +extern keyword error; +extern keyword errornumber; +extern keyword errortext; +extern keyword errorvalue; +extern keyword errout; +extern keyword features; +extern keyword file; +extern keyword host; +extern keyword input; +extern keyword lcase; +extern keyword letters; +extern keyword level; +extern keyword line; +extern keyword main; +extern keyword null; +extern keyword output; +extern keyword phi; +extern keyword pi; +extern keyword pos; +extern keyword progname; +extern keyword random; +extern keyword regions; +extern keyword source; +extern keyword storage; +extern keyword subject; +extern keyword time; +extern keyword trace; +extern keyword ucase; +extern keyword version; +}; //namespace Icon + +static void initialize_keywords(); + +class keyword { //objects representing Icon keywords + friend void initialize_keywords(); + iconfunc* f; + public: + safe operator&(); //get the keyword's value (could be an Icon 'variable') +}; + + +class value { //a descriptor with class +//data members modelled after 'typedef struct { word dword, vword; } descriptor;' from icall.h + private: + long dword; + long vword; + public: + friend class safe; + friend value IconFile(FILE* fd, int status, char* fname); + friend value integertobytes(value); + friend value bytestointeger(value); + friend value base64(value); + friend value base64tointeger(value); + friend value base64tostring(value); + value(); //&null + value(special_value, const char* text = ""); + value(int argc, value* argv); //makes a list of parameters passed in from Icon + value(int); + value(long); + value(float); + value(double); + value(char*); + value(const char*); + value(const char*, long); + value(proc_block&); + value(proc_block*); + value(external*); + operator int(); + operator long(); + operator float(); + operator double(); + operator char*(); + operator external*(); + operator proc_block*() const; + bool operator==(const value&) const; + value& dereference(); + value intify(); + bool isNull(); + bool notNull(); + bool isExternal(const value&); + value size() const; + kind type(); + bool toString(); //attempted conversion in place + bool toCset(); + bool toInteger(); + bool toReal(); + bool toNumeric(); + value subscript(const value&) const; //produces an Icon 'variable' + value& assign(const value&); //dereferences Icon style + value put(value x = nullvalue); + value push(value x = nullvalue); + void dump() const; + void printimage() const; + int compare(const value&) const; //comparator-style result: used for Icon sorting + value negative() const; // -x + value complement() const; // ~x + value refreshed() const; // ^x + value random() const; // ?x + value plus(const value&) const; + value minus(const value&) const; + value multiply(const value&) const; + value divide(const value&) const; + value remainder(const value&) const; + value power(const value&) const; + value union_(const value&) const; // x ++ y + value intersection(const value&) const; // x ** y + value difference(const value&) const; // x -- y + value concatenate(const value&) const; // x || y + value listconcatenate(const value&) const;// x ||| y + value slice(const value&, const value&) const; // x[y:z] + value& swap(value&); // x :=: y + value activate(const value& y = nullvalue) const; // y @ x ('*this' is activated) + value apply(const value&) const; // x!y (must return, not fail or suspend) +}; //class value + + +class generator { +//class to inherit from for defining loadable functions that are generators + public: + int generate(value argv[]); //call to suspend everything produced by next() + protected: //override these, and write a constructor + virtual bool hasNext(); + virtual value giveNext(); +}; //class generator + + +class iterate { +//class to inherit from for iterating over f!arg or !x + public: + void every(const value& g, const value& arg); //perform the iteration over g!arg + void bang(const value& x); //perform the iteration over !x + //override these, write a constructor and the means of recovering the answer + virtual bool wantNext(const value& x); + virtual void takeNext(const value& x); +}; + + + +class safe_variable { +//data members modelled after 'struct tend_desc' from rstructs.h + friend class value; + friend inline int safecall_0(iconfunc*, value&); + friend inline int safecall_1(iconfunc*, value&, const value&); + friend inline int safecall_2(iconfunc*, value&, const value&, const value&); + friend inline int safecall_3(iconfunc*, value&, const value&, const value&, const value&); + friend inline int safecall_4(iconfunc*, value&, const value&, const value&, const value&, const value&); + friend inline int safecall_5(iconfunc*, value&, const value&, const value&, const value&, const value&, const value&); + friend inline int safecall_6(iconfunc*, value&, const value&, const value&, const value&, const value&, const value&, const value&); + friend inline int safecall_v0(iconfvbl*, value&); + friend inline int safecall_v1(iconfvbl*, value&, const value&); + friend inline int safecall_v2(iconfvbl*, value&, const value&, const value&); + friend inline int safecall_v3(iconfvbl*, value&, const value&, const value&, const value&); + friend inline int safecall_vbl(iconfvbl*,safe&, const variadic&); + protected: + safe_variable *previous; + int num; + value val; + safe_variable(); + safe_variable(int); + safe_variable(long); + safe_variable(double); + safe_variable(value); + safe_variable(proc_block&); + safe_variable(proc_block*); + safe_variable(int, value*); + inline void push(safe_variable*& tendlist, int numvalues=1); + inline void pop(safe_variable*& tendlist); +}; //class safe_variable + + +class variadic: public safe_variable { + public: + variadic(int); + variadic(long); + variadic(float); + variadic(double); + variadic(char*); + variadic(value); + variadic(const safe&); + variadic(const safe&, const safe&); + variadic& operator,(const safe&); + operator value(); + ~variadic(); +}; //class variadic + + +class external_block { +//modelled on 'struct b_external' in icon/src/h/rstructs.h + friend class external; + friend class value; + static long extra_bytes; //silent extra parameter to new + long title; + long blksize; + long id; + external_ftable* funcs; + external* val; + static void* operator new(size_t); //allocated by iconx + static void operator delete(void*); //do nothing + external_block(); +}; + +class external { + friend class value; + static external_block* blockptr; //silent extra result of new + protected: + long id; + public: + static void* operator new(size_t); //allocated by new external_block() + static void operator delete(void*); //do nothing + external(); + virtual ~external() {} //root class + virtual long compare(external*); + virtual value name(); + virtual external* copy(); + virtual value image(); +}; + + +class safe: public safe_variable { +//use for a garbage collection safe icon valued safe C++ variable + friend class variadic; + friend class global; + public: + safe(); //&null + safe(const safe&); + safe(int); + safe(long); + safe(float); + safe(double); + safe(char*); + safe(const value&); + safe(const variadic&); + safe(proc_block&); + safe(proc_block*); + safe(int, value*); //from parameters sent in from Icon + ~safe(); + safe& operator=(const safe&); + //augmenting assignments here + safe& operator+=(const safe&); + safe& operator-=(const safe&); + safe& operator*=(const safe&); + safe& operator/=(const safe&); + safe& operator%=(const safe&); + safe& operator^=(const safe&); + safe& operator&=(const safe&); + safe& operator|=(const safe&); + // ++ and -- here + safe& operator++(); + safe& operator--(); + safe operator++(int); + safe operator--(int); + //conversion to value + operator value() const; + //procedure call + safe operator()(); + safe operator()(const safe&); + safe operator()(const safe& x1, const safe& x2, + const safe& x3 = illegal, const safe& x4 = illegal, + const safe& x5 = illegal, const safe& x6 = illegal, + const safe& x7 = illegal, const safe& x8 = illegal); + safe operator[](const safe&); + + friend safe operator*(const safe&); //size + friend safe operator-(const safe&); + friend safe operator~(const safe&); //set complement + friend safe operator+(const safe&, const safe&); + friend safe operator-(const safe&, const safe&); + friend safe operator*(const safe&, const safe&); + friend safe operator/(const safe&, const safe&); + friend safe operator%(const safe&, const safe&); + friend safe operator^(const safe&, const safe&); //exponentiation + friend safe operator|(const safe&, const safe&); //union + friend safe operator&(const safe&, const safe&); //intersection + friend safe operator&&(const safe&, const safe&); //set or cset difference + friend safe operator||(const safe&, const safe&); //string concatenation + friend bool operator<(const safe&, const safe&); + friend bool operator>(const safe&, const safe&); + friend bool operator<=(const safe&, const safe&); + friend bool operator>=(const safe&, const safe&); + friend bool operator==(const safe&, const safe&); + friend bool operator!=(const safe&, const safe&); + friend variadic operator,(const safe&, const safe&); //variadic argument list construction + + safe slice(const safe&, const safe&); // x[y:z] + safe apply(const safe&); // x ! y + safe listcat(const safe&); // x ||| y + safe& swap(safe&); // x :=: y + safe create(); // create !x + safe create(const safe&); // create x!y + safe activate(const safe& y = nullvalue); // y@x + safe refresh(); // ^x + safe random(); // ?x + safe dereference(); // .x + bool isIllegal() const; //is an illegal value used for trailing arguments +}; //class safe + + +//Icon built-in functions +namespace Icon { + safe abs(const safe&); + safe acos(const safe&); + safe args(const safe&); + safe asin(const safe&); + safe atan(const safe&, const safe&); + safe center(const safe&, const safe&, const safe&); + safe char_(const safe&); + safe chdir(const safe&); + safe close(const safe&); + safe collect(); + safe copy(const safe&); + safe cos(const safe&); + safe cset(const safe&); + safe delay(const safe&); + safe delete_(const safe&, const safe&); + safe detab(const variadic&); + safe detab( const safe& x1, const safe& x2, + const safe& x3=illegal, const safe& x4=illegal, + const safe& x5=illegal, const safe& x6=illegal, + const safe& x7=illegal, const safe& x8=illegal ); + safe display(const safe&, const safe&); + safe dtor(const safe&); + safe entab(const variadic&); + safe entab( const safe& x1, const safe& x2, + const safe& x3=illegal, const safe& x4=illegal, + const safe& x5=illegal, const safe& x6=illegal, + const safe& x7=illegal, const safe& x8=illegal ); + safe errorclear(); + safe exit(const safe&); + safe exp(const safe&); + safe flush(const safe&); + safe function(); //generative: returns a list + safe get(const safe&); + safe getch(); + safe getche(); + safe getenv(const safe&); + safe iand(const safe&, const safe&); + safe icom(const safe&); + safe image(const safe&); + safe insert(const safe&, const safe&, const safe&); + safe integer(const safe&); + safe ior(const safe&, const safe&); + safe ishift(const safe&, const safe&); + safe ixor(const safe&, const safe&); + safe kbhit(); + safe left(const safe&, const safe&, const safe&); + safe list(const safe&, const safe&); + safe loadfunc(const safe&, const safe&); + safe log(const safe&); + safe map(const safe&, const safe&, const safe&); + safe member(const safe&, const safe&); + safe name(const safe&); + safe numeric(const safe&); + safe open(const safe&, const safe&); + safe ord(const safe&); + safe pop(const safe&); + safe proc(const safe&, const safe&); + safe pull(const safe&); + safe push(const variadic&); + safe push( const safe& x1, const safe& x2, + const safe& x3=illegal, const safe& x4=illegal, + const safe& x5=illegal, const safe& x6=illegal, + const safe& x7=illegal, const safe& x8=illegal ); + safe put(const variadic&); + safe put( const safe& x1, const safe& x2, + const safe& x3=illegal, const safe& x4=illegal, + const safe& x5=illegal, const safe& x6=illegal, + const safe& x7=illegal, const safe& x8=illegal ); + safe read(const safe&); + safe reads(const safe&, const safe&); + safe real(const safe&); + safe remove(const safe&); + safe rename(const safe&, const safe&); + safe repl(const safe&, const safe&); + safe reverse(const safe&); + safe right(const safe&, const safe&, const safe&); + safe rtod(const safe&); + safe runerr(const safe&, const safe&); + safe runerr(const safe&); + safe seek(const safe&, const safe&); + safe serial(const safe&); + safe set(const safe&); + safe sin(const safe&); + safe sort(const safe&, const safe&); + safe sortf(const safe&, const safe&); + safe sqrt(const safe&); + safe stop(); + safe stop(const variadic&); + safe stop( const safe& x1, const safe& x2, + const safe& x3=illegal, const safe& x4=illegal, + const safe& x5=illegal, const safe& x6=illegal, + const safe& x7=illegal, const safe& x8=illegal ); + safe string(const safe&); + safe system(const safe&); + safe table(const safe&); + safe tan(const safe&); + safe trim(const safe&, const safe&); + safe type(const safe&); + safe variable(const safe&); + safe where(const safe&); + safe write(); + safe write(const variadic&); + safe write( const safe& x1, const safe& x2, + const safe& x3=illegal, const safe& x4=illegal, + const safe& x5=illegal, const safe& x6=illegal, + const safe& x7=illegal, const safe& x8=illegal ); + safe writes(const variadic&); + safe writes( const safe& x1, const safe& x2, + const safe& x3=illegal, const safe& x4=illegal, + const safe& x5=illegal, const safe& x6=illegal, + const safe& x7=illegal, const safe& x8=illegal ); + //generative functions follow, crippled to return a single value + safe any(const safe&, const safe&, const safe&, const safe&); + safe many(const safe&, const safe&, const safe&, const safe&); + safe upto(const safe&, const safe&, const safe&, const safe&); + safe find(const safe&, const safe&, const safe&, const safe&); + safe match(const safe&, const safe&, const safe&, const safe&); + safe bal(const safe&, const safe&, const safe&, const safe&, const safe&, const safe&); + safe move(const safe&); + safe tab(const safe&); +}; //namespace Icon + diff --git a/ipl/packs/loadfuncpp/examples/methodcall.cpp b/ipl/packs/loadfuncpp/examples/methodcall.cpp new file mode 100644 index 0000000..0f13195 --- /dev/null +++ b/ipl/packs/loadfuncpp/examples/methodcall.cpp @@ -0,0 +1,18 @@ + +/* Example of a C++ extension to icon via loadfunc, + * without garbage collection difficulties. + * Type 'make iexample' to build. + * Carl Sturtivant, 2008/3/16 + */ + +#include "loadfuncpp.h" +using namespace Icon; + +#include<cstdio> + +extern "C" int iexample(int argc, value argv[]) { + + + return SUCCEEDED; +} + diff --git a/ipl/packs/loadfuncpp/examples/methodcall.icn b/ipl/packs/loadfuncpp/examples/methodcall.icn new file mode 100644 index 0000000..ab48d06 --- /dev/null +++ b/ipl/packs/loadfuncpp/examples/methodcall.icn @@ -0,0 +1,23 @@ + +link loadfuncpp + + +record thing(val, method) + +procedure method(x) + object := self() | stop("not bound to a record") + object.val := x +end + +procedure main() + + obj := thing() + obj.method := bindself(method, obj) + + write(image(obj.method)) + + obj.method(99) + + write( obj.val ) +end + diff --git a/ipl/packs/loadfuncpp/examples/mkexternal.cpp b/ipl/packs/loadfuncpp/examples/mkexternal.cpp new file mode 100644 index 0000000..39c9b84 --- /dev/null +++ b/ipl/packs/loadfuncpp/examples/mkexternal.cpp @@ -0,0 +1,15 @@ + +/* Example of a C++ extension to icon via loadfunc, + * without garbage collection difficulties. + * Type 'make iexample' to build. + * Carl Sturtivant, 2007/9/25 + */ + +#include "loadfuncpp.h" +using namespace Icon; + +extern "C" int iexample(int argc, value argv[]) { + argv[0] = new external(); + return SUCCEEDED; +} + diff --git a/ipl/packs/loadfuncpp/examples/mkexternal.icn b/ipl/packs/loadfuncpp/examples/mkexternal.icn new file mode 100644 index 0000000..ec388cf --- /dev/null +++ b/ipl/packs/loadfuncpp/examples/mkexternal.icn @@ -0,0 +1,14 @@ + +link loadfuncpp + +procedure main() + iexample := loadfuncpp("./mkexternal.so", "iexample") + external := iexample() + external2 := copy(external) + write( type(external) ) + write( image(external) ) + write( type(external2) ) + write( image(external2) ) +end + + diff --git a/ipl/packs/loadfuncpp/examples/newprimes.icn b/ipl/packs/loadfuncpp/examples/newprimes.icn new file mode 100644 index 0000000..4f2391a --- /dev/null +++ b/ipl/packs/loadfuncpp/examples/newprimes.icn @@ -0,0 +1,4 @@ +procedure main() + #limit to the first 10000 primes + every write(!(p := 1, a := [2])| 1(|(p +:= 2), not(p % !a = 0), put(a, p))) \1000 +end diff --git a/ipl/packs/loadfuncpp/examples/numbernamer.icn b/ipl/packs/loadfuncpp/examples/numbernamer.icn new file mode 100644 index 0000000..1996c8d --- /dev/null +++ b/ipl/packs/loadfuncpp/examples/numbernamer.icn @@ -0,0 +1,61 @@ + +procedure main(arg) + every write( number(!arg, 0) ) +end + +procedure number(n, state) + static small, large, units + initial { + small := ["one", "two", "three", "four", "five", "six", "seven", "eight", + "nine", "ten", "eleven", "twelve", "thirteen", "fourteen", + "fifteen", "sixteen", "seventeen", "eighteen", "nineteen"] + large := ["ten", "twenty", "thirty", "forty", "fifty", "sixty", + "seventy", "eighty", "ninety"] + units := ["thousand", "million", "billion", "trillion", "quadrillion", + "quintillion", "sextillion", "septillion", "octillion", "nonillion"] + } + n := integer(n) | fail + if 0 = n then return "zero" + if 0 > n then return "minus " || number(-n) + if 20 > n then return small[n] + if 100 > n then { + x := n / 10 + r := n % 10 + if (0 = r) then { + return large[x] + } else { + return large[x] || "-" || number(r, state) + } + } + if (1000 > n) then { + x := n / 100 + r := n % 100 + if (0 = r) then { + return number(x, 1) || " hundred" + } else { + if (0 = state) then { + return number(x, 1) || " hundred and " || number(r, 1) + } else { + return number(x, 1) || " hundred " || number(r, 1) + } + } + } + + every i := 1 to *units do { + j := (*units - i + 1) + k := j * 3 + m := 10^k + x := n / m + r := n % m + if (0 < x) then { + if (0 = r) then { + return number(x, 1) || " " || units[j] + } else if ( 100 > r) then { + return number(x, 1) || " " || units[j] || " and " || number(r, 1) + } else { + return number(x, 1) || " " || units[j] || ", " || number(r, 0) + } + } + } + return "Error NaN: " || n +end diff --git a/ipl/packs/loadfuncpp/examples/primes.icn b/ipl/packs/loadfuncpp/examples/primes.icn new file mode 100644 index 0000000..ecbd1f1 --- /dev/null +++ b/ipl/packs/loadfuncpp/examples/primes.icn @@ -0,0 +1,26 @@ +procedure main() + #limit to the first x primes + local x; + x := 20; + every write(!(p := 1, a := [2])| 1(|(p +:= 2), not(p % !a = 0), put(a, p))) \x + list_primes(x); +end + +procedure list_primes(prime_limit) + local p; + local a; + local s; + initial { + p := 1; + a := [2]; + } + until (prime_limit <= *a) do { + p +:= 2; + s := sqrt(p); + + if (not(p % !a = 0)) then { + put(a, p); + } + } + every write(!a) +end diff --git a/ipl/packs/loadfuncpp/examples/runerr.cpp b/ipl/packs/loadfuncpp/examples/runerr.cpp new file mode 100644 index 0000000..e572133 --- /dev/null +++ b/ipl/packs/loadfuncpp/examples/runerr.cpp @@ -0,0 +1,31 @@ + +/* Example of a C++ extension to icon via loadfunc, + * without garbage collection difficulties. + * Type 'make iexample' to build. + * Carl Sturtivant, 2007/9/25 + */ + +#include "loadfuncpp.h" + +#include<stdio.h> + +extern "C" int iexample(value argv[]) { + safe callme(argv[1]), text(argv[2]); + printf("Calling callme\n"); + callme(); + printf("Callme returned\n"); + printf("Calling callme\n"); + callme(); + printf("Callme returned\n"); + //Icon::runerr(123, text); + return FAILED; +} + +extern "C" int iexample2(value argv[]) { + //Icon::display(&Icon::level, &Icon::output); + safe nextcall(argv[1]), rerr(argv[2]); + nextcall(); + rerr(123, "Bye!"); + //Icon::runerr(123, "Bye!"); + return FAILED; +} diff --git a/ipl/packs/loadfuncpp/examples/runerr.icn b/ipl/packs/loadfuncpp/examples/runerr.icn new file mode 100644 index 0000000..8c39c9a --- /dev/null +++ b/ipl/packs/loadfuncpp/examples/runerr.icn @@ -0,0 +1,32 @@ + +link loadfuncpp + +procedure main() + x := [1,2,3] + main2() +end + +global newdisplay + +procedure main2() + newrunerr := loadfuncpp("runerr.so", "iexample", 2) + newdisplay := loadfuncpp("runerr.so", "iexample2", 2) +#&trace := -1 + newrunerr(callme, "Hello!") + write("We don't get here!") +end + +procedure callme() + initial { + write("callme() called! first time!") + return + } + write("callme() called for second time!") + newdisplay(nextcall, runerr) + #runerr(123, "callme error termination!") + return +end + +procedure nextcall() + write("Call to nextcall") +end diff --git a/ipl/packs/loadfuncpp/examples/stop.cpp b/ipl/packs/loadfuncpp/examples/stop.cpp new file mode 100644 index 0000000..74373dd --- /dev/null +++ b/ipl/packs/loadfuncpp/examples/stop.cpp @@ -0,0 +1,16 @@ + +/* Example of a C++ extension to icon via loadfunc, + * without garbage collection difficulties. + * Type 'make iexample' to build. + * Carl Sturtivant, 2007/9/25 + */ + +#include "loadfuncpp.h" +using namespace Icon; + +extern "C" int iexample(int argc, value argv[]) { + safe x = argv[1]; + stop(x); + return SUCCEEDED; +} + diff --git a/ipl/packs/loadfuncpp/examples/stop.icn b/ipl/packs/loadfuncpp/examples/stop.icn new file mode 100644 index 0000000..6177bad --- /dev/null +++ b/ipl/packs/loadfuncpp/examples/stop.icn @@ -0,0 +1,10 @@ + +link loadfuncpp + +procedure main() + newstop := loadfuncpp("./stop.so", "iexample") + newstop("Stop!") + write("We don't get here!") +end + + diff --git a/ipl/packs/loadfuncpp/examples/sums.icn b/ipl/packs/loadfuncpp/examples/sums.icn new file mode 100644 index 0000000..062fceb --- /dev/null +++ b/ipl/packs/loadfuncpp/examples/sums.icn @@ -0,0 +1,8 @@ +procedure main() + local n, sum # Declare two local variables + sum := 0 # Set the sum to zero + every n := 1 to 5 do # For n equal to 1, 2, 3, 4, 5 ... + sum := sum + n; # ...add n to the sum + + write ( "The sum of all numbers from 1 to 5 is ", sum ); +end diff --git a/ipl/packs/loadfuncpp/examples/sums2.icn b/ipl/packs/loadfuncpp/examples/sums2.icn new file mode 100644 index 0000000..a5c136e --- /dev/null +++ b/ipl/packs/loadfuncpp/examples/sums2.icn @@ -0,0 +1,6 @@ +procedure main() + local sum; + sum := 0; + every sum +:= 1 to 5 + write ( "The sum of all numbers from 1 to 5 is ", sum ); +end diff --git a/ipl/packs/loadfuncpp/hex.txt b/ipl/packs/loadfuncpp/hex.txt new file mode 100644 index 0000000..d5f438c --- /dev/null +++ b/ipl/packs/loadfuncpp/hex.txt @@ -0,0 +1 @@ +2d3a674a9265858a427fb642aaf89a62 diff --git a/ipl/packs/loadfuncpp/iexample.cpp b/ipl/packs/loadfuncpp/iexample.cpp new file mode 100644 index 0000000..f51a794 --- /dev/null +++ b/ipl/packs/loadfuncpp/iexample.cpp @@ -0,0 +1,27 @@ + +#include "loadfuncpp.h" + +extern "C" int integertobytes(value argv[]) { + argv[0] = integertobytes(argv[1]); + return SUCCEEDED; +} + +extern "C" int bytestointeger(value argv[]) { + argv[0] = bytestointeger(argv[1]); + return SUCCEEDED; +} + +extern "C" int base64(value argv[]) { + argv[0] = base64(argv[1]); + return SUCCEEDED; +} + +extern "C" int base64tostring(value argv[]) { + argv[0] = base64tostring(argv[1]); + return SUCCEEDED; +} + +extern "C" int base64tointeger(value argv[]) { + argv[0] = base64tointeger(argv[1]); + return SUCCEEDED; +} diff --git a/ipl/packs/loadfuncpp/iexample.icn b/ipl/packs/loadfuncpp/iexample.icn new file mode 100644 index 0000000..1d615f3 --- /dev/null +++ b/ipl/packs/loadfuncpp/iexample.icn @@ -0,0 +1,37 @@ + +link loadfuncpp + +global integertobytes, bytestointeger, base64, base64tostring, base64tointeger + +procedure main() + integertobytes := loadfuncpp("iexample.so", "integertobytes", 1) + bytestointeger := loadfuncpp("iexample.so", "bytestointeger", 1) + base64 := loadfuncpp("iexample.so", "base64", 1) + base64tostring := loadfuncpp("iexample.so", "base64tostring", 1) + base64tointeger := loadfuncpp("iexample.so", "base64tointeger", 1) + + #test1() + test2() + #test3() +end + +procedure test3() + while write(base64tointeger(base64(integer(read())))) +end + +procedure test2() + while write(base64tostring(base64(read()))) +end + +procedure test1() + i := 16rBEADEDCEDEDBEEFEDCEDEDBEADEDBEEFED + + s := "\x00" || integertobytes(i) + ii := bytestointeger(s) + ss := integertobytes(ii) + + write( image(s) ) + write( image(ss) ) + write(i) + write(ii) +end diff --git a/ipl/packs/loadfuncpp/iload.cpp b/ipl/packs/loadfuncpp/iload.cpp new file mode 100644 index 0000000..2a39c3a --- /dev/null +++ b/ipl/packs/loadfuncpp/iload.cpp @@ -0,0 +1,2669 @@ + + +/* C++ support for easy extensions to icon via loadfunc, + * without garbage collection difficulties. + * Include loadfuncpp.h and link dynamically to + * this, which contains the necessary glue. + * See iexample.cpp for typical use. + * Carl Sturtivant, 2008/3/17 + */ + +#include <cstdio> +#include <cstring> + +#include "loadfuncpp.h" +#include "iload.h" + + +/* + * References to the part of loadfuncpp written in Icon + */ + +//variables to refer to the Icon procedures in loadfuncpp.icn +static value _loadfuncpp_pathfind; +static value _loadfuncpp_reduce; +static value _loadfuncpp_create; +static value _loadfuncpp_activate; +static value _loadfuncpp_kcollections; +static value _loadfuncpp_kfeatures; +static value _loadfuncpp_kregions; +static value _loadfuncpp_kstorage; +static value _loadfuncpp_function; +static value _loadfuncpp_key; +static value _loadfuncpp_bang; +static value _loadfuncpp_any; +static value _loadfuncpp_many; +static value _loadfuncpp_upto; +static value _loadfuncpp_find; +static value _loadfuncpp_match; +static value _loadfuncpp_bal; +static value _loadfuncpp_move; +static value _loadfuncpp_tab; +static value _loadfuncpp_apply; + +static void initialize_procs() { //called below, on load + _loadfuncpp_pathfind = Value::libproc("_loadfuncpp_pathfind"); + _loadfuncpp_reduce = Value::libproc("_loadfuncpp_reduce"); + _loadfuncpp_create = Value::libproc("_loadfuncpp_create"); + _loadfuncpp_activate = Value::libproc("_loadfuncpp_activate"); + _loadfuncpp_kcollections = Value::libproc("_loadfuncpp_kcollections"); + _loadfuncpp_kfeatures = Value::libproc("_loadfuncpp_kfeatures"); + _loadfuncpp_kregions = Value::libproc("_loadfuncpp_kregions"); + _loadfuncpp_kstorage = Value::libproc("_loadfuncpp_kstorage"); + _loadfuncpp_function = Value::libproc("_loadfuncpp_function"); + _loadfuncpp_key = Value::libproc("_loadfuncpp_key"); + _loadfuncpp_bang = Value::libproc("_loadfuncpp_bang"); + _loadfuncpp_any = Value::libproc("_loadfuncpp_any"); + _loadfuncpp_many = Value::libproc("_loadfuncpp_many"); + _loadfuncpp_upto = Value::libproc("_loadfuncpp_upto"); + _loadfuncpp_find = Value::libproc("_loadfuncpp_find"); + _loadfuncpp_match = Value::libproc("_loadfuncpp_match"); + _loadfuncpp_bal = Value::libproc("_loadfuncpp_bal"); + _loadfuncpp_move = Value::libproc("_loadfuncpp_move"); + _loadfuncpp_tab = Value::libproc("_loadfuncpp_tab"); + _loadfuncpp_apply = Value::libproc("_loadfuncpp_apply"); +} + +//callbacks to Icon for generative keywords and functions +static int K_collections(value* argv) { + argv[0] = _loadfuncpp_kcollections.apply(Value::list()); + return SUCCEEDED; +} + +static int K_features(value* argv) { + argv[0] = _loadfuncpp_kfeatures.apply(Value::list()); + return SUCCEEDED; +} + +static int K_regions(value* argv) { + argv[0] = _loadfuncpp_kregions.apply(Value::list()); + return SUCCEEDED; +} + +static int K_storage(value* argv) { + argv[0] = _loadfuncpp_kstorage.apply(Value::list()); + return SUCCEEDED; +} + +static int Z_function(value* argv) { + argv[0] = _loadfuncpp_function.apply(Value::list()); + return SUCCEEDED; +} + +static int Z_key(value* argv) { + value arg(1,argv); + argv[0] = _loadfuncpp_key.apply(arg); + return SUCCEEDED; +} + +static int Z_any(value* argv) { + value arg(4,argv); + argv[0] = _loadfuncpp_any.apply(arg); + return SUCCEEDED; +} + +static int Z_many(value* argv) { + value arg(4,argv); + argv[0] = _loadfuncpp_many.apply(arg); + return SUCCEEDED; +} + +static int Z_upto(value* argv) { + value arg(4,argv); + argv[0] = _loadfuncpp_upto.apply(arg); + return SUCCEEDED; +} + +static int Z_find(value* argv) { + value arg(4,argv); + argv[0] = _loadfuncpp_find.apply(arg); + return SUCCEEDED; +} + +static int Z_match(value* argv) { + value arg(4,argv); + argv[0] = _loadfuncpp_match.apply(arg); + return SUCCEEDED; +} + +static int Z_bal(value* argv) { + value arg(6,argv); + argv[0] = _loadfuncpp_bal.apply(arg); + return SUCCEEDED; +} + +static int Z_move(value* argv) { + value arg(1,argv); + argv[0] = _loadfuncpp_move.apply(arg); + return SUCCEEDED; +} + +static int Z_tab(value* argv) { + value arg(1,argv); + argv[0] = _loadfuncpp_tab.apply(arg); + return SUCCEEDED; +} + + + +/* + * Keywords and their initialization + */ + +namespace Icon { +//all non-graphics keywords excepting &fail, &cset (name collision with function cset) +keyword allocated; +keyword ascii; +keyword clock; +keyword collections; +keyword current; +keyword date; +keyword dateline; +keyword digits; +keyword dump; +keyword e; +keyword error; +keyword errornumber; +keyword errortext; +keyword errorvalue; +keyword errout; +keyword features; +keyword file; +keyword host; +keyword input; +keyword lcase; +keyword letters; +keyword level; +keyword line; +keyword main; +keyword null; +keyword output; +keyword phi; +keyword pi; +keyword pos; +keyword progname; +keyword random; +keyword regions; +keyword source; +keyword storage; +keyword subject; +keyword time; +keyword trace; +keyword ucase; +keyword version; +}; //namespace Icon + + +static void initialize_keywords() { + Icon::allocated.f = Kallocated; + Icon::ascii.f = Kascii; + Icon::clock.f = Kclock; + Icon::collections.f = K_collections; //generative: K_ + Icon::current.f = Kcurrent; + Icon::date.f = Kdate; + Icon::dateline.f = Kdateline; + Icon::digits.f = Kdigits; + Icon::dump.f = Kdump; + Icon::e.f = Ke; + Icon::error.f = Kerror; + Icon::errornumber.f = Kerrornumber; + Icon::errortext.f = Kerrortext; + Icon::errorvalue.f = Kerrorvalue; + Icon::errout.f = Kerrout; + Icon::features.f = K_features; //generative: K_ + Icon::file.f = Kfile; + Icon::host.f = Khost; + Icon::input.f = Kinput; + Icon::lcase.f = Klcase; + Icon::letters.f = Kletters; + Icon::level.f = Klevel; + Icon::line.f = Kline; + Icon::main.f = Kmain; + Icon::null.f = Knull; + Icon::output.f = Koutput; + Icon::phi.f = Kphi; + Icon::pi.f = Kpi; + Icon::pos.f = Kpos; + Icon::progname.f = Kprogname; + Icon::random.f = Krandom; + Icon::regions.f = K_regions; //generative: K_ + Icon::source.f = Ksource; + Icon::storage.f = K_storage; //generative: K_ + Icon::subject.f = Ksubject; + Icon::time.f = Ktime; + Icon::trace.f = Ktrace; + Icon::ucase.f = Kucase; + Icon::version.f = Kversion; +} + +safe keyword::operator&() { + value result; + safecall_0(*f, result); + return result; +} + +/* + * Implementation of the value class. + */ + +const value nullstring(NullString); +const value nullvalue; //statically initialized by default to &null +const value nullchar(NullChar); +const value illegal(Illegal); + +value::value() { +//default initialization is to &null + dword = D_Null; + vword = 0; +} + +value::value(special_value sv, const char *text) { + switch( sv ) { + case NullString: + dword = 0; + vword = (long)""; + break; + case StringLiteral: + dword = strlen(text); + vword = (long)text; + break; + case NewString: + dword = strlen(text); + vword = (long)alcstr((char*)text, dword); + break; + case NullChar: + dword = 1; + vword = (long)"\0"; + break; + case Illegal: + dword = D_Illegal; + vword = 0; + break; + default: + dword = D_Null; + vword = 0; + } +} + +value::value(int argc, value* argv) { //assumes these are passed in from Icon + safe argv0 = argv[0]; //which guarantees their GC safety + Ollist(argc, argv); + *this = argv[0]; + argv[0] = argv0; +} + +value::value(int n) { + dword = D_Integer; + vword = n; +} + +value::value(long n) { + dword = D_Integer; + vword = n; +} + +value::value(float x) { + dword = D_Real; + vword = (long)alcreal(x); +} + +value::value(double x) { + dword = D_Real; + vword = (long)alcreal(x); +} + +value::value(char* s) { + dword = strlen(s); + vword = (long)alcstr(s, dword); +} + +value::value(const char* s) { + dword = strlen(s); + vword = (long)alcstr((char*)s, dword); +} + +value::value(const char* s, long len) { + dword = len; + vword = (long)alcstr((char*)s, dword); +} + +value::value(proc_block& pb) { + dword = D_Proc; + vword = (long)&pb; +} + +value::value(proc_block* pbp) { + dword = D_Proc; + vword = (long)pbp; +} + +value::value(external* ep) { + char* ptr = (char*)ep - sizeof(external_block)/sizeof(char); + dword = D_External; + vword = (long)ptr; +} + +value::operator int() { + if( this->type() != Integer ) + syserror("loadfuncpp: int cannot be produced from non-Integer"); + return vword; +} + +value::operator long() { + if( this->type() != Integer ) + syserror("loadfuncpp: long cannot be produced from non-Integer"); + return vword; +} + +value::operator float() { + if( this->type() != Real ) + syserror("loadfuncpp: double cannot be produced from non-Real"); + return getdbl(this); +} + +value::operator double() { + if( this->type() != Real ) + syserror("loadfuncpp: double cannot be produced from non-Real"); + return getdbl(this); +} + +value::operator char*() { + if( this->type() != String ) + syserror("loadfuncpp: char* cannot be produced from non-String"); + return (char*)vword; +} + +value::operator external*() { + if( dword != D_External ) return 0; //too ruthless + return (external*)((external_block*)vword + 1); +} + +value::operator proc_block*() const { + if( dword != D_Proc ) return 0; //too ruthless + return (proc_block*)vword; +} + +void value::dump() const { + fprintf(stderr, "\n%lx\n%lx\n", dword, vword); + fflush(stderr); +} + +bool value::operator==(const value& v) const { + return dword==v.dword && vword==v.vword; +} + +value& value::dereference() { + deref(this, this); //dereference in place + return *this; +} + +value value::intify() { //integer representation of vword pointer + switch( this->type() ) { + default: + return vword; + case Null: case Integer: case Real: + return nullvalue; + } +} + +bool value::isNull() { + return (dword & TypeMask) == T_Null; +} + +bool value::notNull() { + return (dword & TypeMask) != T_Null; +} + +value value::size() const { + value result; + safecall_1(&Osize, result, *this); + return result; +} + +kind value::type() { + if( !( dword & F_Nqual ) ) return String; + if( dword & F_Var ) return Variable; + return kind(dword & TypeMask); +} + +bool value::toCset() { + return safecall_1(&Zcset, *this, *this) == SUCCEEDED; +} + +bool value::toInteger() { + return safecall_1(&Zinteger, *this, *this) == SUCCEEDED; +} + +bool value::toReal() { + return safecall_1(&Zreal, *this, *this) == SUCCEEDED; +} + +bool value::toNumeric() { + return safecall_1(&Znumeric, *this, *this) == SUCCEEDED; +} + +bool value::toString() { + return safecall_1(&Zstring, *this, *this) == SUCCEEDED; +} + +value value::subscript(const value& v) const { + value result; + safecall_2(&Osubsc, result, *this, v); + return result; +} + +value& value::assign(const value& v) { + if( dword & F_Var ) //lhs value is an Icon 'Variable' + safecall_2(&Oasgn, *this, *this, v); + else { + dword = v.dword; + vword = v.vword; + deref(this,this); //in case rhs is an Icon 'Variable' + } + return *this; +} + +value value::put(value x) { + value result; + safecall_v2(&Zput, result, *this, x); + return result; +} + +value value::push(value x) { + value result; + safecall_v2(&Zpush, result, *this, x); + return result; +} + +void value::printimage() const { + value result; + safecall_1(&Zimage, result, *this); + safecall_v1(&Zwrites, result, result); +} + +int value::compare(const value& x) const { + return anycmp(this, &x); +} + +value value::negative() const { + value result; + if( safecall_1(&Oneg, result, *this) == FAILED ) + return nullvalue; + return result; +} + +value value::complement() const { + value result; + if( safecall_1(&Ocompl, result, *this) == FAILED ) + return nullvalue; + return result; +} + +value value::refreshed() const { + value result; + if( safecall_1(&Orefresh, result, *this) == FAILED ) + return nullvalue; + return result; +} + +value value::random() const { + value result; + if( safecall_1(&Orandom, result, *this) == FAILED ) + return nullvalue; + return result; +} + +value value::plus(const value& x) const { + value result; + if( safecall_2(&Oplus, result, *this, x) == FAILED ) + return nullvalue; + return result; +} + +value value::minus(const value& x) const { + value result; + if( safecall_2(&Ominus, result, *this, x) == FAILED ) + return nullvalue; + return result; +} + +value value::multiply(const value& x) const { + value result; + if( safecall_2(&Omult, result, *this, x) == FAILED ) + return nullvalue; + return result; +} + +value value::divide(const value& x) const { + value result; + if( safecall_2(&Odivide, result, *this, x) == FAILED ) + return nullvalue; + return result; +} + +value value::remainder(const value& x) const { + value result; + if( safecall_2(&Omod, result, *this, x) == FAILED ) + return nullvalue; + return result; +} + +value value::power(const value& x) const { + value result; + if( safecall_2(&Opowr, result, *this, x) == FAILED ) + return nullvalue; + return result; +} + +value value::union_(const value& x) const { + value result; + if( safecall_2(&Ounion, result, *this, x) == FAILED ) + return nullvalue; + return result; +} + +value value::intersection(const value& x) const { + value result; + if( safecall_2(&Ointer, result, *this, x) == FAILED ) + return nullvalue; + return result; +} + +value value::difference(const value& x) const { + value result; + if( safecall_2(&Odiff, result, *this, x) == FAILED ) + return nullvalue; + return result; +} + +value value::concatenate(const value& x) const { + value result; + if( safecall_2(&Ocater, result, *this, x) == FAILED ) + return nullvalue; + return result; +} + +value value::listconcatenate(const value& x) const { + value result; + if( safecall_2(&Olconcat, result, *this, x) == FAILED ) + return nullvalue; + return result; +} + +value value::slice(const value& x, const value& y) const { + value result; + if( safecall_3(&Osect, result, *this, x, y) == FAILED ) + return nullvalue; + return result; +} + +value& value::swap(value& x) { + safecall_2(&Oswap, *this, *this, x); + return *this; +} + +value value::activate(const value& x) const { + value arg = Value::pair(*this, x); + return _loadfuncpp_activate.apply(arg); +} + +value value::apply(const value& x) const { + return Value::call(*this, x); +} + + + +/* + * Implementation of the generator class + */ + +int generator::generate(value argv[]) { +//suspend all values generated and return the eventual signal + int signal = FAILED; + while( this->hasNext() && signal == FAILED ) { + argv[0] = this->giveNext(); + signal = interp(SUSPEND, argv); + } + return signal; +} + +bool generator::hasNext() { return false; } //empty sequence for the root class +value generator::giveNext() { return nullvalue; } + + + +/* + * Implementation of class iterate + */ + +class wrap: public external { //an iterate object as Icon data + public: + iterate* data; + wrap(iterate* ip): data(ip) {} +}; + +extern "C" int update_iteration(value argv[]) { + external* ep = argv[1]; + iterate* ip = ((wrap*)ep)->data; + argv[0] = nullvalue; + if( ip->wantNext(argv[2]) ) { + ip->takeNext(argv[2]); + return SUCCEEDED; + } + else return FAILED; +} + +static proc_block updatepb("update_iteration", &update_iteration, 2); +static value update(updatepb); + +void iterate::every(const value& g, const value& arg) { + value nullary(new wrap(this)); + variadic v(nullary); + _loadfuncpp_reduce.apply((v,update,g,arg)); +} + +void iterate::bang(const value& x) { + value nullary(new wrap(this)); + variadic v(nullary); + _loadfuncpp_bang.apply((v,update,x)); +} + +bool iterate::wantNext(const value& v) { return true; } //use whole sequence +void iterate::takeNext(const value& v) {} + + + +/* + * Implementation of the safe_variable class + */ +safe_variable::safe_variable() : val() {}; + +safe_variable::safe_variable(int n) : val(n) {}; + +safe_variable::safe_variable(long n) : val(n) {}; + +safe_variable::safe_variable(double x) : val(x) {}; + +safe_variable::safe_variable(value v) : val(v) {}; + +safe_variable::safe_variable(proc_block& pb) : val(pb) {}; + +safe_variable::safe_variable(proc_block* pbp) : val(pbp) {}; + +safe_variable::safe_variable(int argc, value* argv) : val(argc, argv) {}; + +inline void safe_variable::push(safe_variable*& tendlist, int numvalues) { + previous = tendlist; + num = numvalues; + tendlist = this; +} + +inline void safe_variable::pop(safe_variable*& tendlist) { + if( tendlist == this ) { //we are at the head of the tend list + tendlist = tendlist->previous; //pop us off + return; + } +#if 0 + if( tendlist == tend ) //warning is for safe tend list only + { + fprintf(stderr, "loadfuncpp warning: pop needed from interior of tended list\n"); + fflush(stderr); + } +#endif + safe_variable *last = 0, *current = tendlist; + do { //search tendlist + last = current; + current = current->previous; + } while( current != this && current != 0); + if( current == 0 ) + syserror("loadfuncpp bug: failed to find variable on tended list so as to remove it."); + last->previous = current->previous; //slice us out +} + + + +/* + * Implementation of the variadic class (variable length argument list) + */ + +variadic::variadic(int n) { + value v(n); + val = Value::list(1, v); + push(global_tend); +} + +variadic::variadic(long n) { + value v(n); + val = Value::list(1, v); + push(global_tend); +} + +variadic::variadic(float x) { + value v(x); + val = Value::list(1, v); + push(global_tend); +} + +variadic::variadic(double x) { + value v(x); + val = Value::list(1, v); + push(global_tend); +} + +variadic::variadic(char* s) { + value v(s); + val = Value::list(1, v); + push(global_tend); +} + +variadic::variadic(value v) { + val = Value::list(1, v); + push(global_tend); +} + +variadic::variadic(const safe& x) { + val = Value::list(1, x.val); + push(global_tend); +} + +variadic::variadic(const safe& x, const safe& y) { + val = Value::pair(x, y); + push(global_tend); +} + +variadic& variadic::operator,(const safe& x) { + val.put(x.val); + return *this; +} + +variadic::operator value() { + return val; +} + +variadic::~variadic() { pop(global_tend); } + + +/* + * Implementation of the safe class + */ + +safe::safe() : safe_variable() { push(global_tend); } + +safe::safe(const safe& x) : safe_variable(x.val) { push(global_tend); } + +safe::safe(int n) : safe_variable(n) { push(global_tend); } + +safe::safe(long n) : safe_variable(n) { push(global_tend); } + +safe::safe(float x) : safe_variable(x) { push(global_tend); } + +safe::safe(double x) : safe_variable(x) { push(global_tend); } + +safe::safe(char* s) : safe_variable(s) { push(global_tend); } + +safe::safe(const value& v) : safe_variable(v) { push(global_tend); } + +safe::safe(const variadic& v) : safe_variable(v) { push(global_tend); } + +safe::safe(proc_block& pb) : safe_variable(pb) { push(global_tend); } + +safe::safe(proc_block* pbp) : safe_variable(pbp) { push(global_tend); } + +safe::safe(int argc, value* argv) : safe_variable(argc, argv) { push(global_tend); } + +safe::~safe() { pop(global_tend); } + +safe& safe::operator=(const safe& x) { + val.assign(x.val); //Icon style assignment + return *this; +} + +safe& safe::operator^=(const safe& x) { + *this = *this ^ x; + return *this; +} + +safe& safe::operator+=(const safe& x) { + *this = *this + x; + return *this; +} + +safe& safe::operator-=(const safe& x) { + *this = *this - x; + return *this; +} + +safe& safe::operator*=(const safe& x) { + *this = *this * x; + return *this; +} + +safe& safe::operator/=(const safe& x) { + *this = *this / x; + return *this; +} + +safe& safe::operator%=(const safe& x) { + *this = *this % x; + return *this; +} + +safe& safe::operator&=(const safe& x) { + *this = *this & x; + return *this; +} + +safe& safe::operator|=(const safe& x) { + *this = *this | x; + return *this; +} + +safe& safe::operator++() { + *this -= 1; + return *this; +} + +safe& safe::operator--() { + *this += 1; + return *this; +} + +safe safe::operator++(int) { + safe temp(*this); + *this += 1; + return temp; +} + +safe safe::operator--(int) { + safe temp(*this); + *this -= 1; + return temp; +} + +safe::operator value() const { + return val; //low-level copy +} + +safe safe::operator() () { + value empty = Value::list(); + return this->apply(empty); +} + +safe safe::operator() (const safe& x) { + value singleton = Value::list(1, x); + return this->apply(singleton); +} + +safe safe::operator()(const safe& x1, const safe& x2, + const safe& x3, const safe& x4, + const safe& x5, const safe& x6, + const safe& x7, const safe& x8 ) { + if( x3.isIllegal() ) + return this->apply( (x1,x2) ); + if( x4.isIllegal() ) + return this->apply( (x1,x2,x3) ); + if( x5.isIllegal() ) + return this->apply( (x1,x2,x3,x4) ); + if( x6.isIllegal() ) + return this->apply( (x1,x2,x3,x4,x5) ); + if( x7.isIllegal() ) + return this->apply( (x1,x2,x3,x4,x5,x6) ); + if( x8.isIllegal() ) + return this->apply( (x1,x2,x3,x4,x5,x6,x7) ); + return this->apply( (x1,x2,x3,x4,x5,x6,x7,x8) ); +} + +safe safe::operator[](const safe& x) { + return val.subscript(x.val); +} + +safe operator*(const safe& x){ + return x.val.size(); +} + +safe operator-(const safe& x){ + return x.val.negative(); +} + +safe operator~(const safe& x){ //set complement + return x.val.complement(); +} + +safe operator+(const safe& x, const safe& y){ + return x.val.plus(y.val); +} + +safe operator-(const safe& x, const safe& y){ + return x.val.minus(y.val); +} + +safe operator*(const safe& x, const safe& y){ + return x.val.multiply(y.val); +} + +safe operator/(const safe& x, const safe& y){ + return x.val.divide(y.val); +} + +safe operator%(const safe& x, const safe& y){ + return x.val.remainder(y.val); +} + +safe operator^(const safe& x, const safe& y){ //exponentiation + return x.val.power(y.val); +} + +safe operator|(const safe& x, const safe& y){ //union + return x.val.union_(y.val); +} + +safe operator&(const safe& x, const safe& y){ //intersection + return x.val.intersection(y.val); +} + +safe operator&&(const safe& x, const safe& y){ //set or cset difference + return x.val.difference(y.val); +} + +safe operator||(const safe& x, const safe& y){ //string concatenation + return x.val.concatenate(y.val); +} + +bool operator<(const safe& x, const safe& y){ + return x.val.compare(y.val) < 0; +} + +bool operator>(const safe& x, const safe& y){ + return x.val.compare(y.val) > 0; +} + +bool operator<=(const safe& x, const safe& y){ + return x.val.compare(y.val) <= 0; +} + +bool operator>=(const safe& x, const safe& y){ + return x.val.compare(y.val) >= 0; +} + +bool operator==(const safe& x, const safe& y){ + return x.val.compare(y.val) == 0; +} + +bool operator!=(const safe& x, const safe& y){ + return x.val.compare(y.val) != 0; +} + +variadic operator,(const safe& x, const safe& y){ //variadic argument list construction + return variadic(x.val, y.val); +} + +safe safe::slice(const safe& y, const safe& z){ // x[y:z] + return this->val.slice(y, z); +} + +safe safe::apply(const safe& y){ // x ! y + safe result; + result = _loadfuncpp_apply.apply( (this->val, y.val) ); + return result; +} + +safe safe::listcat(const safe& y){ // x ||| y + value x(*this); + return x.listconcatenate(y); +} + +safe& safe::swap(safe& y){ // x :=: y + value& x(this->val); + value& yv(y.val); + x.swap(yv); + return *this; +} + +safe safe::create(){ // create !x + return _loadfuncpp_create.apply(Value::list(1, *this)); +} + +safe safe::create(const safe& y){ // create x!y + return _loadfuncpp_create.apply(Value::pair(*this, y)); +} + +safe safe::activate(const safe& y){ // y@x + return _loadfuncpp_activate.apply(Value::pair(*this, y)); +} + +safe safe::refresh(){ // ^x + return this->val.refreshed(); +} + +safe safe::random(){ // ?x + return this->val.random(); +} + +safe safe::dereference(){ // .x + value var(this->val); + var.dereference(); + return var; +} + +bool safe::isIllegal() const { + return this->val == illegal; +} + + + +/* + * iconx callback support + */ + +inline int safecall_0(iconfunc *F, value& out) { + struct { + safe_variable tend; //contains an additional unused value + value stack[1]; + } vars; + vars.stack[0] = nullvalue; + vars.tend.push(tend,2); + int result = F(vars.stack); + if( result == SUCCEEDED ) + out = vars.stack[0]; + vars.tend.pop(tend); + return result; +} + +inline int safecall_1(iconfunc *F, value& out, const value& x1) { + struct { + safe_variable tend; //contains an additional unused value + value stack[2]; + } vars; + vars.stack[0] = nullvalue; + vars.stack[1] = x1; + vars.tend.push(tend,3); + int result = F(vars.stack); + if( result == SUCCEEDED ) + out = vars.stack[0]; + vars.tend.pop(tend); + return result; +} + +inline int safecall_2(iconfunc *F, value& out, const value& x1, const value& x2) { + struct { + safe_variable tend; //contains an additional unused value + value stack[3]; + } vars; + vars.stack[0] = nullvalue; + vars.stack[1] = x1; + vars.stack[2] = x2; + vars.tend.push(tend,4); + int result = F(vars.stack); + if( result == SUCCEEDED ) + out = vars.stack[0]; + vars.tend.pop(tend); + return result; +} + +inline int safecall_3(iconfunc *F, value& out, const value& x1, const value& x2, const value& x3) { + struct { + safe_variable tend; //contains an additional unused value + value stack[4]; + } vars; + vars.stack[0] = nullvalue; + vars.stack[1] = x1; + vars.stack[2] = x2; + vars.stack[3] = x3; + vars.tend.push(tend,5); + int result = F(vars.stack); + if( result == SUCCEEDED ) + out = vars.stack[0]; + vars.tend.pop(tend); + return result; +} + +inline int safecall_4(iconfunc *F, value& out, const value& x1, const value& x2, const value& x3, const value& x4) { + struct { + safe_variable tend; //contains an additional unused value + value stack[5]; + } vars; + vars.stack[0] = nullvalue; + vars.stack[1] = x1; + vars.stack[2] = x2; + vars.stack[3] = x3; + vars.stack[4] = x4; + vars.tend.push(tend,6); + int result = F(vars.stack); + if( result == SUCCEEDED ) + out = vars.stack[0]; + vars.tend.pop(tend); + return result; +} + +inline int safecall_5(iconfunc *F, value& out, const value& x1, const value& x2, const value& x3, const value& x4, const value& x5) { + struct { + safe_variable tend; //contains an additional unused value + value stack[6]; + } vars; + vars.stack[0] = nullvalue; + vars.stack[1] = x1; + vars.stack[2] = x2; + vars.stack[3] = x3; + vars.stack[4] = x4; + vars.stack[5] = x5; + vars.tend.push(tend,7); + int result = F(vars.stack); + if( result == SUCCEEDED ) + out = vars.stack[0]; + vars.tend.pop(tend); + return result; +} + +inline int safecall_6(iconfunc *F, value& out, const value& x1, const value& x2, const value& x3, const value& x4, const value& x5, const value& x6) { + struct { + safe_variable tend; //contains an additional unused value + value stack[7]; + } vars; + vars.stack[0] = nullvalue; + vars.stack[1] = x1; + vars.stack[2] = x2; + vars.stack[3] = x3; + vars.stack[4] = x4; + vars.stack[5] = x5; + vars.stack[6] = x6; + vars.tend.push(tend,8); + int result = F(vars.stack); + if( result == SUCCEEDED ) + out = vars.stack[0]; + vars.tend.pop(tend); + return result; +} + +inline int safecall_v0(iconfvbl *F, value& out) { + struct { + safe_variable tend; //contains an additional unused value + value stack[1]; + } vars; + vars.stack[0] = nullvalue; + vars.tend.push(tend,2); + int result = F(0, vars.stack); + if( result == SUCCEEDED ) + out = vars.stack[0]; + vars.tend.pop(tend); + return result; +} + +inline int safecall_v1(iconfvbl *F, value& out, const value& x1) { + struct { + safe_variable tend; //contains an additional unused value + value stack[2]; + } vars; + vars.stack[0] = nullvalue; + vars.stack[1]= x1; + vars.tend.push(tend,3); + int result = F(1, vars.stack); + if( result == SUCCEEDED ) + out = vars.stack[0]; + vars.tend.pop(tend); + return result; +} + +inline int safecall_v2(iconfvbl *F, value& out, const value& x1, const value& x2) { + struct { + safe_variable tend; //contains an additional unused value + value stack[3]; + } vars; + vars.stack[0] = nullvalue; + vars.stack[1] = x1; + vars.stack[2] = x2; + vars.tend.push(tend,4); + int result = F(2, vars.stack); + if( result == SUCCEEDED ) + out = vars.stack[0]; + vars.tend.pop(tend); + return result; +} + +inline int safecall_v3(iconfvbl *F, value& out, const value& x1, const value& x2, const value& x3) { + struct { + safe_variable tend; //contains an additional unused value + value stack[4]; + } vars; + vars.stack[0] = nullvalue; + vars.stack[1] = x1; + vars.stack[2] = x2; + vars.stack[3] = x3; + vars.tend.push(tend,5); + int result = F(3, vars.stack); + if( result == SUCCEEDED ) + out = vars.stack[0]; + vars.tend.pop(tend); + return result; +} + +inline int safecall_vbl(iconfvbl* F, safe& out, const variadic& arg) { + int argc = arg.val.size(); + //C++ makes allocating trailing variable sized arrays + //inside structs difficult, so do this C-style + safe_variable* pvars = (safe_variable*)malloc(sizeof(safe_variable)+(argc+1)*sizeof(value)); + value* stack = (value*)(pvars + 1); //get past the safe_variable at the start of the block + stack[0] = nullvalue; + for(int i=1; i<=argc; ++i) + stack[i] = arg.val.subscript(i).dereference(); + pvars->push(tend, argc+2); + int result = F(argc, stack); + if( result == SUCCEEDED ) + out = stack[0]; + pvars->pop(tend); + free(pvars); +} + + + +/* + * Procedure related + */ + +//Icon procedure block: used to make new Icon procedures as values to return + +proc_block::proc_block(value procname, iconfvbl *function) { + init(procname); + nparam = -1; //a variable number of arguments + entryp = function; +} + +proc_block::proc_block(value procname, iconfunc *function, int arity) { + init(procname); + nparam = arity; + entryp = (iconfvbl*)function; +} + +proc_block::proc_block(value procname, iconfvbl *function, int arity) { + init(procname); + nparam = -1; //a variable number of arguments + entryp = function; +} + +long proc_block::extra_bytes = 0; + +extern long extl_ser; //serial number counter for alcexternal + +static void* alcproc(long nbytes) { + proc_block* pbp = (proc_block*)alcexternal(nbytes, 0, 0); //a hack for now + --extl_ser; + pbp->title = T_Proc; + pbp->blksize = nbytes; + return (void*)pbp; +} + +void* proc_block::operator new(size_t nbytes) { //allocated in Icon's block region + return alcproc(nbytes + extra_bytes); +} + +void proc_block::operator delete(void*) { + return; //do nothing +} + +proc_block::proc_block(proc_block* pbp) { + *this = *pbp; //copy the C++ legitimate part +} + +proc_block* proc_block::bind(proc_block* pbp, const value& rec) { + extra_bytes = pbp->blksize - sizeof(proc_block) + sizeof(value); //one more slot + proc_block* ans = new proc_block(pbp); // copies the C++ legitimate part + ans->blksize = sizeof(proc_block) + extra_bytes; + extra_bytes = 0; + int nsafe = ans->ndynam + ans->nparam; + for( int pos=1; pos<nsafe; pos++) //copy the remainder + ans->lnames[pos] = pbp->lnames[pos]; + ans->lnames[nsafe] = rec; //set the last array slot to rec + ans->pname = "bound to record"; //improve this to use the proc name and rec image + return ans; +} + +extern "C" int bindself(value argv[]) { + if( argv[1].type() != Procedure || + argv[2].type() != Record ) { + argv[0] = nullvalue; + return FAILED; + } + argv[0] = proc_block::bind(argv[1], argv[2]); + return SUCCEEDED; +} + + + +/* + * External values related + */ + +extern "C" { //these call virtual functions, so only one function list needed + static int extcmp(int argc, value argv[]) { + external *ep = argv[1], *ep2 = argv[2]; + argv[0] = ep->compare(ep2); + return 0; + } + static int extcopy(int argc, value argv[]) { + external* ep = argv[1]; + argv[0] = ep->copy(); + return 0; + } + static int extname(int argc, value argv[]) { + external* ep = argv[1]; + argv[0] = ep->name(); + return 0; + } + static int extimage(int argc, value argv[]) { + external* ep = argv[1]; + argv[0] = ep->image(); + return 0; + } +}; //end extern "C" + +static void initialize_ftable(); //just below + +static struct external_ftable { //C callback table for all C++ made external values + iconfvbl* cmp; + iconfvbl* copy; + iconfvbl* name; + iconfvbl* image; + external_ftable() { initialize_ftable(); } +} ftable; + +static void initialize_ftable() { + ftable.cmp = &extcmp; + ftable.copy = &extcopy; + ftable.name = &extname; + ftable.image = &extimage; +} + +long external_block::extra_bytes; //silent extra parameter to external_block::new + +static void* external_block::operator new(size_t nbytes) { + return alcexternal(nbytes + extra_bytes, &ftable, 0); //extra_bytes for C++ external +} + +static void external_block::operator delete(void* p) { + return; //don't delete +} + +external_block::external_block() { + //val = (external*)((long*)&val + 1); //add a trashable pointer to the (to be appended) external + val = 0; +} + +external_block* external::blockptr; //silent extra result of external::new for external() + +static void* external::operator new(size_t nbytes) { + external_block::extra_bytes = nbytes; //pass our requirements to external_block::new + blockptr = new external_block(); //with extra_bytes; pass our requirements to external() + char* ptr = (char*)blockptr + sizeof(external_block)/sizeof(char); //beginning of extra_bytes + return (void*)ptr; //where the external will be appended +} + +static void external::operator delete(void* p) { + return; //don't delete +} + +external::external() { + id = blockptr->id; //set by new +} + +external* external::copy() { + return this; +} + +value external::image() { //need new string every time! + char sbuf[100]; + long vptr = *((long*)this); + sprintf(sbuf, "external_%ld(%lX)", id, vptr); + return value(NewString, sbuf); +} + +value external::name() { + return value(StringLiteral, "external"); +} + +long external::compare(external* ep) { + return this->id - ep->id; +} + +bool value::isExternal(const value& type) { //needs external_block declaration + if( dword != D_External ) return false; + value result; + external_block* ebp = (external_block*)vword; + iconfvbl* name = (ebp->funcs)->name; + value stack[2]; + stack[1] = *this; + name(1, stack); + return !stack[0].compare(type); +} + + + +/* + * Startup code (on load) + */ + +//new variant of loadfunc sidestepping loadfunc's glue, a three argument function + +extern "C" int loadfuncpp(value argv[]) { //three arguments + if( argv[3].isNull() ) argv[3]=-1; + //assumption: a path is specified iff a slash or backslash is in the filename, + if( argv[1].toString() ) { + safe fname(argv[1]), fullname; + int ispath = value( *(Icon::cset(fname) & Icon::cset((char*)"\\/")) ); + if( !ispath ) { //search FPATH for the file + fullname = _loadfuncpp_pathfind.apply((fname, Icon::getenv((char*)"FPATH"))); + if( fullname == nullvalue ) { + Icon::runerr(216, argv[1]); + return FAILED; + } + argv[1] = value(fullname); + } + } + return rawloadfuncpp(argv); +} + +static void replace_loadfunc() { + static proc_block pb("loadfuncpp", loadfuncpp, 3); //three arguments + value proc(pb), var = Value::variable("loadfunc"); + var.assign(proc); +} + +//set up a tend list for global variables on the tail of &main's +struct safe_tend { //struct with isomorphic data footprint to a safe_variable + safe_variable *previous; + int num; + value val; +} sentinel; + +safe_variable*& global_tend = sentinel.previous; + +static void add_to_end(safe_variable*& tend_list) { + safe_tend *last = 0, *current = (safe_tend*)tend_list; + while( current != 0 ) { + last = current; + current = (safe_tend*)(current->previous); + } + if( last == 0 ) tend_list = (safe_variable*)&sentinel; + else last->previous = (safe_variable*)&sentinel; +} + +static void make_global_tend_list() { + sentinel.previous = 0; + sentinel.num = 1; + sentinel.val = nullvalue; + if( k_current == k_main ) add_to_end(tend); //add to the active tend list + else add_to_end( ((coexp_block*)(long(k_main)))->es_tend ); +} + +struct load { + load() { //startup code here + replace_loadfunc(); //store loadfuncpp in global loadfunc temporarily + make_global_tend_list(); + initialize_procs(); + initialize_keywords(); +//fprintf(stderr, "\nStartup code ran!\n");fflush(stderr); + } +}; +static load startup; //force static initialization so as to run startup code + + + +/* + * Useful helper functions + */ + +namespace Value { + +value pair(value x, value y) { + value newlist; + if( safecall_v2(&Ollist, newlist, x, y) == FAILED ) + return nullvalue; + return newlist; +} + +value list(value n, value init) { + value newlist; + if( safecall_2(&Zlist, newlist, n, init) == FAILED ) + return nullvalue; + return newlist; +} + +void runerr(value n, value x) { + value v; + safecall_v2(&Zrunerr, v, n, x); +} + +value set(value list) { + value newset; + if( safecall_1(&Zset, newset, list) == FAILED ) + return nullvalue; + return newset; +} + +value table(value init) { + value newtable; + if( safecall_1(&Ztable, newtable, init) == FAILED ) + return nullvalue; + return newtable; +} + +value variable(value name) { + value var; + if( safecall_1(&Zvariable, var, name) == FAILED ) + return nullvalue; + return var; +} + +value proc(value name, value arity) { + value procedure; + if( safecall_2(&Zproc, procedure, name, arity) == FAILED ) + return nullvalue; + return procedure; +} + +value libproc(value name, value arity) { + value procedure; + if( safecall_2(&Zproc, procedure, name, arity) == SUCCEEDED ) + return procedure; + syserror("loadfuncpp: unable to find required Icon procedure through 'link loadfunc'\n"); + return nullvalue; +} + +}; //namespace Value + + + +/* + * Built-in Icon functions + */ +namespace Icon { +safe abs(const safe& x1) { + value result; + safecall_1(&Zabs, result, x1); + return result; +} + +safe acos(const safe& x1) { + value result; + safecall_1(&Zacos, result, x1); + return result; +} + +safe args(const safe& x1) { + value result; + safecall_1(&Zargs, result, x1); + return result; +} + +safe asin(const safe& x1) { + value result; + safecall_1(&Zasin, result, x1); + return result; +} + +safe atan(const safe& x1, const safe& x2) { + value result; + safecall_2(&Zatan, result, x1, x2); + return result; +} + +safe center(const safe& x1, const safe& x2, const safe& x3) { + value result; + safecall_3(&Zcenter, result, x1, x2, x3); + return result; +} + +safe char_(const safe& x1) { + value result; + safecall_1(&Zchar, result, x1); + return result; +} + +safe chdir(const safe& x1) { + value result; + safecall_1(&Zchdir, result, x1); + return result; +} + +safe close(const safe& x1) { + value result; + safecall_1(&Zclose, result, x1); + return result; +} + +safe collect() { + value result; + safecall_0(&Zcollect, result); + return result; +} + +safe copy(const safe& x1) { + value result; + safecall_1(&Zcopy, result, x1); + return result; +} + +safe cos(const safe& x1) { + value result; + safecall_1(&Zcos, result, x1); + return result; +} + +safe cset(const safe& x1) { + value result; + safecall_1(&Zcset, result, x1); + return result; +} + +safe delay(const safe& x1) { + value result; + safecall_1(&Zdelay, result, x1); + return result; +} + +safe delete_(const safe& x1, const safe& x2) { + value result; + safecall_2(&Zdelete, result, x1, x2); + return result; +} + +safe detab(const variadic& x1) { + safe result; + safecall_vbl(&Zdetab, result, x1); + return result; +} + +safe detab( const safe& x1, const safe& x2, + const safe& x3, const safe& x4, + const safe& x5, const safe& x6, + const safe& x7, const safe& x8 ) { + if( x3.isIllegal() ) + return detab( (x1,x2) ); + if( x4.isIllegal() ) + return detab( (x1,x2,x3) ); + if( x5.isIllegal() ) + return detab( (x1,x2,x3,x4) ); + if( x6.isIllegal() ) + return detab( (x1,x2,x3,x4,x5) ); + if( x7.isIllegal() ) + return detab( (x1,x2,x3,x4,x5,x6) ); + if( x8.isIllegal() ) + return detab( (x1,x2,x3,x4,x5,x6,x7) ); + return detab( (x1,x2,x3,x4,x5,x6,x7,x8) ); +} + +safe display(const safe& x1, const safe& x2) { + value result; + safecall_2(&Zdisplay, result, x1, x2); + return result; +} + +safe dtor(const safe& x1) { + value result; + safecall_1(&Zdtor, result, x1); + return result; +} + +safe entab(const variadic& x1) { + safe result; + safecall_vbl(&Zentab, result, x1); + return result; +} + +safe errorclear() { + value result; + safecall_0(&Zerrorclear, result); + return result; +} + +safe exit(const safe& x1) { + value result; + safecall_1(&Zexit, result, x1); + return result; +} + +safe exp(const safe& x1) { + value result; + safecall_1(&Zexp, result, x1); + return result; +} + +safe flush(const safe& x1) { + value result; + safecall_1(&Zflush, result, x1); + return result; +} + +safe function() { + value result; + safecall_0(&Z_function, result); //generative: Z_ + return result; +} + +safe get(const safe& x1) { + value result; + safecall_1(&Zget, result, x1); + return result; +} + +safe getch() { + value result; + safecall_0(&Zgetch, result); + return result; +} + +safe getche() { + value result; + safecall_0(&Zgetche, result); + return result; +} + +safe getenv(const safe& x1) { + value result; + safecall_1(&Zgetenv, result, x1); + return result; +} + +safe iand(const safe& x1, const safe& x2) { + value result; + safecall_2(&Ziand, result, x1, x2); + return result; +} + +safe icom(const safe& x1) { + value result; + safecall_1(&Zicom, result, x1); + return result; +} + +safe image(const safe& x1) { + value result; + safecall_1(&Zimage, result, x1); + return result; +} + +safe insert(const safe& x1, const safe& x2, const safe& x3) { + value result; + safecall_3(&Zinsert, result, x1, x2, x3); + return result; +} + +safe integer(const safe& x1) { + value result; + safecall_1(&Zinteger, result, x1); + return result; +} + +safe ior(const safe& x1, const safe& x2) { + value result; + safecall_2(&Zior, result, x1, x2); + return result; +} + +safe ishift(const safe& x1, const safe& x2) { + value result; + safecall_2(&Zishift, result, x1, x2); + return result; +} + +safe ixor(const safe& x1, const safe& x2) { + value result; + safecall_2(&Zixor, result, x1, x2); + return result; +} + +safe kbhit() { + value result; + safecall_0(&Zkbhit, result); + return result; +} + +safe key(const safe& x1) { + value result; + safecall_1(&Z_key, result, x1); //generative: Z_ + return result; +} + +safe left(const safe& x1, const safe& x2, const safe& x3) { + value result; + safecall_3(&Zleft, result, x1, x2, x3); + return result; +} + +safe list(const safe& x1, const safe& x2) { + value result; + safecall_2(&Zlist, result, x1, x2); + return result; +} + +safe loadfunc(const safe& x1, const safe& x2) { + value result; + safecall_2(&Zloadfunc, result, x1, x2); + return result; +} + +safe log(const safe& x1) { + value result; + safecall_1(&Zlog, result, x1); + return result; +} + +safe map(const safe& x1, const safe& x2, const safe& x3) { + value result; + safecall_3(&Zmap, result, x1, x2, x3); + return result; +} + +safe member(const safe& x1, const safe& x2) { + value result; + safecall_2(&Zmember, result, x1, x2); + return result; +} + +safe name(const safe& x1) { + value result; + safecall_1(&Zname, result, x1); + return result; +} + +safe numeric(const safe& x1) { + value result; + safecall_1(&Znumeric, result, x1); + return result; +} + +safe open(const safe& x1, const safe& x2) { + value result; + safecall_2(&Zopen, result, x1, x2); + return result; +} + +safe ord(const safe& x1) { + value result; + safecall_1(&Zord, result, x1); + return result; +} + +safe pop(const safe& x1) { + value result; + safecall_1(&Zpop, result, x1); + return result; +} + +safe proc(const safe& x1, const safe& x2) { + value result; + safecall_2(&Zproc, result, x1, x2); + return result; +} + +safe pull(const safe& x1) { + value result; + safecall_1(&Zpull, result, x1); + return result; +} + +safe push(const variadic& x1) { + safe result; + safecall_vbl(&Zpush, result, x1); + return result; +} + +safe push( const safe& x1, const safe& x2, + const safe& x3, const safe& x4, + const safe& x5, const safe& x6, + const safe& x7, const safe& x8 ) { + if( x3.isIllegal() ) + return push( (x1,x2) ); + if( x4.isIllegal() ) + return push( (x1,x2,x3) ); + if( x5.isIllegal() ) + return push( (x1,x2,x3,x4) ); + if( x6.isIllegal() ) + return push( (x1,x2,x3,x4,x5) ); + if( x7.isIllegal() ) + return push( (x1,x2,x3,x4,x5,x6) ); + if( x8.isIllegal() ) + return push( (x1,x2,x3,x4,x5,x6,x7) ); + return push( (x1,x2,x3,x4,x5,x6,x7,x8) ); +} + +safe put(const variadic& x1) { + safe result; + safecall_vbl(&Zput, result, x1); + return result; +} + +safe put( const safe& x1, const safe& x2, + const safe& x3, const safe& x4, + const safe& x5, const safe& x6, + const safe& x7, const safe& x8 ) { + if( x3.isIllegal() ) + return put( (x1,x2) ); + if( x4.isIllegal() ) + return put( (x1,x2,x3) ); + if( x5.isIllegal() ) + return put( (x1,x2,x3,x4) ); + if( x6.isIllegal() ) + return put( (x1,x2,x3,x4,x5) ); + if( x7.isIllegal() ) + return put( (x1,x2,x3,x4,x5,x6) ); + if( x8.isIllegal() ) + return put( (x1,x2,x3,x4,x5,x6,x7) ); + return put( (x1,x2,x3,x4,x5,x6,x7,x8) ); +} + +safe read(const safe& x1) { + value result; + safecall_1(&Zread, result, x1); + return result; +} + +safe reads(const safe& x1, const safe& x2) { + value result; + safecall_2(&Zreads, result, x1, x2); + return result; +} + +safe real(const safe& x1) { + value result; + safecall_1(&Zreal, result, x1); + return result; +} + +safe remove(const safe& x1) { + value result; + safecall_1(&Zremove, result, x1); + return result; +} + +safe rename(const safe& x1, const safe& x2) { + value result; + safecall_2(&Zrename, result, x1, x2); + return result; +} + +safe repl(const safe& x1, const safe& x2) { + value result; + safecall_2(&Zrepl, result, x1, x2); + return result; +} + +safe reverse(const safe& x1) { + value result; + safecall_1(&Zreverse, result, x1); + return result; +} + +safe right(const safe& x1, const safe& x2, const safe& x3) { + value result; + safecall_3(&Zright, result, x1, x2, x3); + return result; +} + +safe rtod(const safe& x1) { + value result; + safecall_1(&Zrtod, result, x1); + return result; +} + +safe runerr(const safe& x1, const safe& x2) { + value result; + safecall_v2(&Zrunerr, result, x1, x2); + return result; +} + +safe runerr(const safe& x1) { + value result; + safecall_v1(&Zrunerr, result, x1); + return result; +} + +safe seek(const safe& x1, const safe& x2) { + value result; + safecall_2(&Zseek, result, x1, x2); + return result; +} + +safe serial(const safe& x1) { + value result; + safecall_1(&Zserial, result, x1); + return result; +} + +safe set(const safe& x1) { + value result; + safecall_1(&Zset, result, x1); + return result; +} + +safe sin(const safe& x1) { + value result; + safecall_1(&Zsin, result, x1); + return result; +} + +safe sort(const safe& x1, const safe& x2) { + value result; + safecall_2(&Zsort, result, x1, x2); + return result; +} + +safe sortf(const safe& x1, const safe& x2) { + value result; + safecall_2(&Zsortf, result, x1, x2); + return result; +} + +safe sqrt(const safe& x1) { + value result; + safecall_1(&Zsqrt, result, x1); + return result; +} + +safe stop() { + safe result, nullarg; + safecall_vbl(&Zstop, result, nullarg); + return result; +} + +safe stop(const variadic& x1) { + safe result; + safecall_vbl(&Zstop, result, x1); + return result; +} + +safe stop( const safe& x1, const safe& x2, + const safe& x3, const safe& x4, + const safe& x5, const safe& x6, + const safe& x7, const safe& x8 ) { + if( x3.isIllegal() ) + return stop( (x1,x2) ); + if( x4.isIllegal() ) + return stop( (x1,x2,x3) ); + if( x5.isIllegal() ) + return stop( (x1,x2,x3,x4) ); + if( x6.isIllegal() ) + return stop( (x1,x2,x3,x4,x5) ); + if( x7.isIllegal() ) + return stop( (x1,x2,x3,x4,x5,x6) ); + if( x8.isIllegal() ) + return stop( (x1,x2,x3,x4,x5,x6,x7) ); + return stop( (x1,x2,x3,x4,x5,x6,x7,x8) ); +} + +safe string(const safe& x1) { + value result; + safecall_1(&Zstring, result, x1); + return result; +} + +safe system(const safe& x1) { + value result; + safecall_1(&Zsystem, result, x1); + return result; +} + +safe table(const safe& x1) { + value result; + safecall_1(&Ztable, result, x1); + return result; +} + +safe tan(const safe& x1) { + value result; + safecall_1(&Ztan, result, x1); + return result; +} + +safe trim(const safe& x1, const safe& x2) { + value result; + safecall_2(&Ztrim, result, x1, x2); + return result; +} + +safe type(const safe& x1) { + value result; + safecall_1(&Ztype, result, x1); + return result; +} + +safe variable(const safe& x1) { + value result; + safecall_1(&Zvariable, result, x1); + return result; +} + +safe where(const safe& x1) { + value result; + safecall_1(&Zwhere, result, x1); + return result; +} + +safe write() { + safe result, nullarg; + safecall_vbl(&Zwrite, result, nullarg); + return result; +} + +safe write(const variadic& x1) { + safe result; + safecall_vbl(&Zwrite, result, x1); + return result; +} + +safe write( const safe& x1, const safe& x2, + const safe& x3, const safe& x4, + const safe& x5, const safe& x6, + const safe& x7, const safe& x8 ) { + if( x3.isIllegal() ) + return write( (x1,x2) ); + if( x4.isIllegal() ) + return write( (x1,x2,x3) ); + if( x5.isIllegal() ) + return write( (x1,x2,x3,x4) ); + if( x6.isIllegal() ) + return write( (x1,x2,x3,x4,x5) ); + if( x7.isIllegal() ) + return write( (x1,x2,x3,x4,x5,x6) ); + if( x8.isIllegal() ) + return write( (x1,x2,x3,x4,x5,x6,x7) ); + return write( (x1,x2,x3,x4,x5,x6,x7,x8) ); +} + +safe writes(const variadic& x1) { + safe result; + safecall_vbl(&Zwrites, result, x1); + return result; +} + +safe writes( const safe& x1, const safe& x2, + const safe& x3, const safe& x4, + const safe& x5, const safe& x6, + const safe& x7, const safe& x8 ) { + if( x3.isIllegal() ) + return writes( (x1,x2) ); + if( x4.isIllegal() ) + return writes( (x1,x2,x3) ); + if( x5.isIllegal() ) + return writes( (x1,x2,x3,x4) ); + if( x6.isIllegal() ) + return writes( (x1,x2,x3,x4,x5) ); + if( x7.isIllegal() ) + return writes( (x1,x2,x3,x4,x5,x6) ); + if( x8.isIllegal() ) + return writes( (x1,x2,x3,x4,x5,x6,x7) ); + return writes( (x1,x2,x3,x4,x5,x6,x7,x8) ); +} + +//generative functions crippled to return a single value follow + +safe any(const safe& x1, const safe& x2=nullvalue, const safe& x3=nullvalue, const safe& x4=nullvalue) { + value result; + safecall_4(&Z_any, result, x1, x2, x3, x4); + return result; +} + +safe many(const safe& x1, const safe& x2=nullvalue, const safe& x3=nullvalue, const safe& x4=nullvalue) { + value result; + safecall_4(&Z_many, result, x1, x2, x3, x4); + return result; +} + +safe upto(const safe& x1, const safe& x2=nullvalue, const safe& x3=nullvalue, const safe& x4=nullvalue) { + value result; + safecall_4(&Z_upto, result, x1, x2, x3, x4); + return result; +} + +safe find(const safe& x1, const safe& x2=nullvalue, const safe& x3=nullvalue, const safe& x4=nullvalue) { + value result; + safecall_4(&Z_find, result, x1, x2, x3, x4); + return result; +} + +safe match(const safe& x1, const safe& x2=nullvalue, const safe& x3=nullvalue, const safe& x4=nullvalue) { + value result; + safecall_4(&Z_match, result, x1, x2, x3, x4); + return result; +} + +safe bal(const safe& x1, const safe& x2=nullvalue, const safe& x3=nullvalue, const safe& x4=nullvalue, const safe& x5=nullvalue, const safe& x6=nullvalue) { + value result; + safecall_6(&Z_bal, result, x1, x2, x3, x4, x5, x6); + return result; +} + +safe move(const safe& x1) { + value result; + safecall_1(&Z_move, result, x1); + return result; +} + +safe tab(const safe& x1) { + value result; + safecall_1(&Z_tab, result, x1); + return result; +} + +}; //namespace Icon + +/* + * Useful functions + */ + +//pass this on to external libraries, so they don't have to link against iconx (cygwin) +void syserror(const char* s) { syserr((char *)s); } + +value IconFile(FILE* fd, int status, char* fname) { + value answer, filename(NewString, fname); + answer.dword = D_File; + answer.vword = (long)alcfile(fd, status, &filename); + return answer; +} + +//large integer related and base64 related functions follow + +struct bignum { //after b_bignum in rstructs.h + long title; + long blksize; + long msd, lsd; + int sign; + unsigned int digit[1]; +}; + +//Endian/wordsize nonsense follows, to help get at bytes in the digits of Icon BigIntegers + +//repair moves the non-zero bytes we care about in a DIGIT (see rlrgint.r) +//that are in the least significant half of the bytes of a uint +//into the left hand end (in RAM) of the unint in big endian order + +//for solaris that does not define this macro +#ifndef BYTE_ORDER +#define BYTE_ORDER 4321 +#endif + +#if BYTE_ORDER==1234 || BYTE_ORDER==4321 +const int DIGITBYTES=2; + +#if BYTE_ORDER==1234 +inline unsigned int repair(unsigned int x) { + return (x & 0x0000FF00) >> 8 | (x & 0x000000FF) << 8; +} +inline long bigendian(long n) { + n = (n & 0xFFFF0000) >> 16 | (n & 0x0000FFFF) << 16; + return (n & 0xFF00FF00) >> 8 | (n & 0x00FF00FF) << 8; +} +#endif + +#if BYTE_ORDER==4321 +inline unsigned int repair(unsigned int x) { + return x << 2; +} +inline long bigendian(long n) { + return n; +} +#endif + +#endif + +#if BYTE_ORDER==12345678 || BYTE_ORDER==87654321 +const int DIGITBYTES=4; + +#if BYTE_ORDER==12345678 +inline unsigned int repair(unsigned int x) { + x = (x & 0x00000000FFFF0000) >> 16 | (x & 0x000000000000FFFF) << 16; + return (x & 0x00000000FF00FF00) >> 8 | (x & 0x0000000000FF00FF) << 8; +} +inline long bigendian(long n) { + n = (n & 0xFFFFFFFF00000000) >> 32 | (n & 0x00000000FFFFFFFF) << 32; + n = (n & 0xFFFF0000FFFF0000) >> 16 | (n & 0x0000FFFF0000FFFF) << 16; + return (n & 0xFF00FF00FF00FF00) >> 8 | (n & 0x00FF00FF00FF00FF) << 8; +} +#endif + +#if BYTE_ORDER==87654321 +inline unsigned int repair(unsigned int x) { + return x << 4; +} +inline long bigendian(long n) { + return n; +} +#endif + +#endif + +value integertobytes(value bigint){ //get the bytes of an Icon long integer as an Icon string (ignore sign) + safe n(bigint); + if( n == 0 ) return nullchar; + switch( bigint.type() ) { + case Integer: { + long x = bigint; + x = bigendian(x); + char *sbuf = (char *)&x; + int len = sizeof(long); + while( !*sbuf ) { //skip leading zeros in base 256 + ++sbuf; + --len; + } + return value(sbuf, len); + break; + } + case BigInteger: { + bignum *bp = ((bignum*)(bigint.vword)); + unsigned int current; + long pos = 0, len = (bp->lsd - bp->msd + 1) * DIGITBYTES; + char *source, *buf = new char[len], *sbuf; + sbuf = buf; + for(long i = bp->msd; i <= bp->lsd; ++i) { + current = repair(bp->digit[i]); + source = (char *)¤t; + for(int b=0; b < DIGITBYTES; ++b) + sbuf[pos++] = source[b]; + } + while( !*sbuf ) { //skip leading zeros in base 256 + ++sbuf; + --len; + } + value bytestring(sbuf, len); + delete[] buf; + return bytestring; + } + default: + return nullvalue; + } +} + +value bytestointeger(value bytestring){ //get the bytes of a new Icon long integer from an Icon string + if( bytestring.type() != String ) return nullvalue; + while( *(char*)bytestring.vword == 0 && bytestring.dword != 0 ) { //skip leading zeros + --bytestring.dword; + ++bytestring.vword; + } + safe s(bytestring); + long size = value(*s); + if( size == 0 ) return 0; + unsigned char *bytes = (unsigned char *)((char*)bytestring); + long n = 0; + if( size < sizeof(long) || //doesn't overflow a signed long + (size == sizeof(long) && ( bytes[0] <= 0x7F )) ) { + for(int i = 0; i < size; ++i) + n = (n << 8) + bytes[i]; + return n; + } + static const int RATIO = sizeof(unsigned int)/2; + long len = (size + RATIO - 1)/RATIO; //number of digits + bignum *bp = (bignum *)alcbignum(len); + bytestring = s; //in case the allocation caused a garbage collection + bytes = (unsigned char *)((char*)bytestring); + long pos = 0; + const int FIRST = len*RATIO==size ? RATIO : len*RATIO-size; //bytes in the first digit + n = 0; + for(int p=0; p < FIRST; ++p) + n = (n << 8) + bytes[pos++]; + bp->digit[0] = n; + for(long i = bp->msd + 1; i <= bp->lsd; ++i) { + n = 0; + for(int p=0; p < RATIO; ++p) + n = (n << 8) + bytes[pos++]; + bp->digit[i] = n; + } + value answer; + answer.dword = D_Lrgint; + answer.vword = (long)bp; + return answer; +} + +//base64 utilities +typedef unsigned char uchar; +static char chr[] = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"; + +//3 bytes -> four base64 chars +inline void threetofour(uchar *three, uchar* four) { + unsigned long n = three[0]; + n = (((n << 8) + three[1]) << 8) + three[2]; + four[3] = chr[n & 0x3F]; + n = n >> 6; + four[2] = chr[n & 0x3F]; + n = n >> 6; + four[1] = chr[n & 0x3F]; + n = n >> 6; + four[0] = chr[n & 0x3F]; +} + +//two trailing bytes -> four base64 chars +inline void twotofour(uchar *three, uchar* four) { + unsigned long n = three[0]; + n = ((n << 8) + three[1]) << 2; + four[3] = '='; + four[2] = chr[n & 0x3F]; + n = n >> 6; + four[1] = chr[n & 0x3F]; + n = n >> 6; + four[0] = chr[n & 0x3F]; +} + +//one trailing byte -> four base64 chars +inline void onetofour(uchar *three, uchar* four) { + unsigned long n = three[0]; + n = n << 4; + four[3] = four[2] = '='; + four[1] = chr[n & 0x3F]; + n = n >> 6; + four[0] = chr[n & 0x3F]; +} + +//convert to base64, return the length of the encoded string +inline long b64(char *in, long len, char* out) { + char *start = out; + long num = len/3; + int rem = len%3; + for(long i = 0; i < num; ++i) { + threetofour((uchar*)in, (uchar*)out); + in += 3; + out += 4; + } + switch( rem ) { + case 1: + onetofour((uchar*)in, (uchar*)out); + out += 4; + break; + case 2: + twotofour((uchar*)in, (uchar*)out); + out += 4; + break; + } + return out - start; +} + +//constant denoting an invalid character in a putative base64 encoding +static const int NONSENSE = -1; + +//convert a base64 char into its corresponding 6 bits +inline int undo(uchar ch) { + switch( ch ) { + default: return NONSENSE; + case 'A': return 0; case 'B': return 1; case 'C': return 2; case 'D': return 3; + case 'E': return 4; case 'F': return 5; case 'G': return 6; case 'H': return 7; + case 'I': return 8; case 'J': return 9; case 'K': return 10; case 'L': return 11; + case 'M': return 12; case 'N': return 13; case 'O': return 14; case 'P': return 15; + case 'Q': return 16; case 'R': return 17; case 'S': return 18; case 'T': return 19; + case 'U': return 20; case 'V': return 21; case 'W': return 22; case 'X': return 23; + case 'Y': return 24; case 'Z': return 25; case 'a': return 26; case 'b': return 27; + case 'c': return 28; case 'd': return 29; case 'e': return 30; case 'f': return 31; + case 'g': return 32; case 'h': return 33; case 'i': return 34; case 'j': return 35; + case 'k': return 36; case 'l': return 37; case 'm': return 38; case 'n': return 39; + case 'o': return 40; case 'p': return 41; case 'q': return 42; case 'r': return 43; + case 's': return 44; case 't': return 45; case 'u': return 46; case 'v': return 47; + case 'w': return 48; case 'x': return 49; case 'y': return 50; case 'z': return 51; + case '0': return 52; case '1': return 53; case '2': return 54; case '3': return 55; + case '4': return 56; case '5': return 57; case '6': return 58; case '7': return 59; + case '8': return 60; case '9': return 61; case '+': return 62; case '/': return 63; + } +} + +//four base64 chars -> three bytes +inline long unfour(uchar* four, uchar* three) { + int ch; + if( (ch = undo(four[0])) == NONSENSE ) return NONSENSE; + long n = ch; + if( (ch = undo(four[1])) == NONSENSE ) return NONSENSE; + n = (n << 6) + ch; + if( (ch = undo(four[2])) == NONSENSE ) return NONSENSE; + n = (n << 6) + ch; + if( (ch = undo(four[3])) == NONSENSE ) return NONSENSE; + n = (n << 6) + ch; + three[2] = n & 0xFF; + n = n >> 8; + three[1] = n & 0xFF; + three[0] = n >> 8; +} + +//decode a base64 string; return NONSENSE if anything doesn't make strict sense +inline long unb64(char* in, long len, char* out) { + char* start = out; + if( len == 0 ) return 0; + if( len%4 != 0 ) return NONSENSE; + int last = 0; + if( in[len-1] == '=' ) { + last = 1; + if( in[len-2] == '=' ) last = 2; + } + if( last ) len -= 4; + + for(long i = 0; i < len/4; ++i) { + if( unfour((uchar*)in, (uchar*)out) == NONSENSE ) + return NONSENSE; + in += 4; + out += 3; + } + long n; + int ch0, ch1, ch2; + switch( last ) { + case 1: + if( (ch0 = undo((uchar)in[0])) == NONSENSE ) + return NONSENSE; + if( (ch1 = undo((uchar)in[1])) == NONSENSE ) + return NONSENSE; + if( (ch2 = undo((uchar)in[2])) == NONSENSE ) + return NONSENSE; + n = ((((ch0 << 6) + ch1) << 6) + ch2) >> 2; + out[1] = n & 0xFF; + out[0] = n >> 8; + out += 2; + break; + case 2: + if( (ch0 = undo((uchar)in[0])) == NONSENSE ) + return NONSENSE; + if( (ch1 = undo((uchar)in[1])) == NONSENSE ) + return NONSENSE; + n = (ch0 << 6) + ch1; + out[0] = n >> 4; + out += 1; + break; + } + return out - start; +} + +//convert string or integer to base64 string +value base64(value x) { + switch( x.type() ) { + default: + return nullvalue; + case Integer: + case BigInteger: + x = integertobytes(x); + case String: { + char* enc = new char[4*x.dword/3+8]; //safety first + long len = b64((char*)x.vword, x.dword, enc); + value answer(enc, len); + delete[] enc; + return answer; + } + } +} + +//decode base64 encoding of a string +value base64tostring(value s) { + if( s.type() != String || + s.dword % 4 != 0) + return nullvalue; + if( s.dword == 0 ) return nullstring; + long len; + char* dec = new char[3 * s.dword/4]; //safety first + if( (len = unb64((char*)s.vword, s.dword, dec)) == NONSENSE ) { + delete[] dec; + return nullvalue; + } + value answer(dec, len); + delete[] dec; + return answer; +} + +//decode base64 encoding of an integer +value base64tointeger(value s) { + return bytestointeger(base64tostring(s)); +} + + + +/* + * 1. Calling Icon from C++ (mostly in iloadgpx.cpp and iloadnogpx.cpp) + * 2. loadfuncpp itself + * 3. binding records to procedure blocks + */ + +namespace ifload { +//remove interference with icon/src/h/rt.h +#undef D_Null +#undef D_Integer +#undef D_Lrgint +#undef D_Real +#undef D_File +#undef D_Proc +#undef D_External +#undef Fs_Read +#undef Fs_Write +#undef F_Nqual +#undef F_Var + +#include "xfload.cpp" //inline linkage --- three argument raw loadfunc +}; //end namespace ifload; put things that need Icon's rt.h included by xfload.cpp below here + +//call to the modified loadfunc in xfload.cpp +static int rawloadfuncpp(value argv[]) { + return ifload::Z_loadfunc((ifload::dptr)argv); +} + + +//get the record from the bottom of an extended procedure block +//(procedure bound to record) obtained from the procedure that +//called our procedure self(). Fail if no record is bound. +extern "C" int getbinding(value* argv) { + value* pp = (value*)((ifload::pfp)->pf_argp); //get saved procedure + if( pp==0 ) syserror("loadfuncpp bug: attempt to find caller of self() failed!"); + proc_block* pbp = *pp; + int nsafe = pbp->ndynam + pbp->nparam; + if( (pbp->blksize) - sizeof(proc_block) == (nsafe-1) * sizeof(value) ) { + argv[0] = nullvalue; + return FAILED; + } + argv[0] = pbp->lnames[nsafe]; + return SUCCEEDED; +} + + +#if __CYGWIN__ //cygwin linkage problem workaround +namespace icall { + using namespace ifload; + //icall assigned from whichever of iloadgpx.so and iloadnogpx.so is loaded, on load thereof +extern "C" { + typedef int icallfunction(dptr procptr, dptr arglistptr, dptr result); +}; + icallfunction *icall2; +}; + +value Value::call(const value& proc, const value& arglist) { + value result; + (*(icall::icall2))( (icall::dptr)(&proc), (icall::dptr)(&arglist), (icall::dptr)(&result) ); + return result; +} +#endif //cygwin linkage problem workaround + diff --git a/ipl/packs/loadfuncpp/iload.h b/ipl/packs/loadfuncpp/iload.h new file mode 100644 index 0000000..7b9c693 --- /dev/null +++ b/ipl/packs/loadfuncpp/iload.h @@ -0,0 +1,342 @@ + +/* C++ support for easy extensions to icon via loadfunc, + * without garbage collection difficulties. + * Include loadfuncpp.h and link dynamically to + * iload.cpp, which contains the necessary glue. + * See iexample.cpp for typical use. + * Carl Sturtivant, 2008/3/17 + */ + + +#include <climits> +#include <cstdlib> + +#if LONG_MAX == 2147483647L //32 bit icon implementation word +#define D_Null 0xA0000000 +#define D_Integer 0xA0000001 +#define D_Lrgint 0xB0000002 +#define D_Real 0xB0000003 +#define D_File 0xB0000005 +#define D_Proc 0xB0000006 +#define D_External 0xB0000013 +#define D_Illegal 0xA0000063 +#define F_Nqual 0x80000000 +#define F_Var 0x40000000 +#else //64 bit icon implementation word +#define D_Null 0xA000000000000000 +#define D_Integer 0xA000000000000001 +#define D_Lrgint 0xB000000000000002 +#define D_Real 0xB000000000000003 +#define D_File 0xB000000000000005 +#define D_Proc 0xB000000000000006 +#define D_External 0xB000000000000013 +#define D_Illegal 0xA000000000000063 +#define F_Nqual 0x8000000000000000 +#define F_Var 0x4000000000000000 +#endif + +#define T_Null 0 // null value +#define T_Integer 1 // integer +#define T_Lrgint 2 // long integer +#define T_Real 3 // real number +#define T_Cset 4 // cset +#define T_File 5 // file +#define T_Proc 6 // procedure +#define T_Record 7 // record +#define T_List 8 // list +#define T_Set 10 // set +#define T_Table 12 // table +#define T_Coexpr 18 // coexpression +#define T_External 19 // external value + +#define TypeMask 63 // type mask + +#define SUSPEND 1 // Call the interpreter suspending from a C function: G_Csusp + +extern "C" { //callbacks in iconx + +void deref(value*, value*); //dereference an icon 'variable' descriptor +char* alcstr(char*, int); //allocate an icon string by copying +char *alcreal(double); //allocate double by copying +char *alcbignum(long); //allocate Icon large integer block w/ given number of DIGITS +double getdbl(value*); //retrieve double +char* alcfile(FILE *fp, int stat, value *name); +int anycmp(const value*, const value*); //comparator used when sorting in Icon +//alcexternal in iconx for Icon 9.5 and above +external* alcexternal(long nbytes, external_ftable* ftable, external* ep); + +void syserr(char*); //fatally terminate Icon-style with error message + +int interp(int fsig, value *cargp); //the Icon interpreter, called recursively when suspending + + +//the prototypes of all icon functions and operators in iconx needed to do the dirty work +iconfunc Oasgn; +iconfunc Osubsc; +iconfunc Osize; +iconfunc Oneg; +iconfunc Ocompl; +iconfunc Orefresh; +iconfunc Orandom; +iconfunc Oplus; +iconfunc Ominus; +iconfunc Omult; +iconfunc Odivide; +iconfunc Omod; +iconfunc Opowr; +iconfunc Ounion; +iconfunc Ointer; +iconfunc Odiff; +iconfunc Ocater; +iconfunc Olconcat; +iconfunc Osect; +iconfunc Oswap; + +iconfvbl Ollist; + +iconfunc Zloadfunc; +iconfunc Zproc; +iconfunc Zvariable; + +iconfunc Zlist; +iconfunc Zset; +iconfunc Ztable; + +iconfunc Zstring; +iconfunc Zcset; +iconfunc Zinteger; +iconfunc Zreal; +iconfunc Znumeric; + +iconfvbl Zput; +iconfvbl Zpush; + +iconfvbl Zrunerr; +iconfvbl Zwrites; +iconfunc Zimage; + +iconfunc Zabs; +iconfunc Zacos; +iconfunc Zargs; +iconfunc Zasin; +iconfunc Zatan; +iconfunc Zcenter; +iconfunc Zchar; +iconfunc Zchdir; +iconfunc Zclose; +iconfunc Zcollect; +iconfunc Zcopy; +iconfunc Zcos; +iconfunc Zdelay; +iconfunc Zdelete; +iconfunc Zdisplay; +iconfunc Zdtor; +iconfunc Zerrorclear; +iconfunc Zexit; +iconfunc Zexp; +iconfunc Zflush; +iconfunc Zget; +iconfunc Zgetch; +iconfunc Zgetche; +iconfunc Zgetenv; +iconfunc Ziand; +iconfunc Zicom; +iconfunc Zinsert; +iconfunc Zior; +iconfunc Zishift; +iconfunc Zixor; +iconfunc Zkbhit; +iconfunc Zleft; +iconfunc Zlog; +iconfunc Zmap; +iconfunc Zmember; +iconfunc Zname; +iconfunc Zopen; +iconfunc Zord; +iconfunc Zpop; +iconfunc Zpull; +iconfunc Zread; +iconfunc Zreads; +iconfunc Zremove; +iconfunc Zrename; +iconfunc Zrepl; +iconfunc Zreverse; +iconfunc Zright; +iconfunc Zrtod; +iconfunc Zseek; +iconfunc Zserial; +iconfunc Zsin; +iconfunc Zsort; +iconfunc Zsortf; +iconfunc Zsqrt; +iconfunc Zsystem; +iconfunc Ztan; +iconfunc Ztrim; +iconfunc Ztype; +iconfunc Zwhere; + +iconfvbl Zdetab; +iconfvbl Zentab; +iconfvbl Zpush; +iconfvbl Zput; +iconfvbl Zstop; +iconfvbl Zwrite; + +iconfunc Kallocated; +iconfunc Kascii; +iconfunc Kclock; +//iconfunc Kcol; +iconfunc Kcollections; +//iconfunc Kcolumn; +//iconfunc Kcontrol; +iconfunc Kcset; +iconfunc Kcurrent; +iconfunc Kdate; +iconfunc Kdateline; +iconfunc Kdigits; +iconfunc Kdump; +iconfunc Ke; +iconfunc Kerror; +iconfunc Kerrornumber; +iconfunc Kerrortext; +iconfunc Kerrorvalue; +iconfunc Kerrout; +//iconfunc Keventcode; +//iconfunc Keventsource; +//iconfunc Keventvalue; +iconfunc Kfail; +iconfunc Kfeatures; +iconfunc Kfile; +iconfunc Khost; +iconfunc Kinput; +//iconfunc Kinterval; +iconfunc Klcase; +//iconfunc Kldrag; +iconfunc Kletters; +iconfunc Klevel; +iconfunc Kline; +//iconfunc Klpress; +//iconfunc Klrelease; +iconfunc Kmain; +//iconfunc Kmdrag; +//iconfunc Kmeta; +//iconfunc Kmpress; +//iconfunc Kmrelease; +iconfunc Knull; +iconfunc Koutput; +iconfunc Kphi; +iconfunc Kpi; +iconfunc Kpos; +iconfunc Kprogname; +iconfunc Krandom; +//iconfunc Krdrag; +iconfunc Kregions; +iconfunc Kresize; +//iconfunc Krow; +//iconfunc Krpress; +//iconfunc Krrelease; +//iconfunc Kshift; +iconfunc Ksource; +iconfunc Kstorage; +iconfunc Ksubject; +iconfunc Ktime; +iconfunc Ktrace; +iconfunc Kucase; +iconfunc Kversion; +iconfunc Kwindow; +//iconfunc Kx; +//iconfunc Ky; + +} //end extern "C" + +struct proc_block { + long title; /* T_Proc */ + long blksize; /* size of block */ + iconfvbl *entryp; /* entry point for C routine */ + long nparam; /* number of parameters */ + long ndynam; /* number of dynamic locals */ + long nstatic; /* number of static locals */ + long fstatic; /* index (in global table) of first static */ + value pname; /* procedure name (string qualifier) */ + value lnames[1]; /* list of local names (qualifiers) */ + private: + inline void init(value procname) { + title = T_Proc; + blksize = sizeof(proc_block); + ndynam = -1; //treat as a built-in function + nstatic = 0; + fstatic = 0; + pname = procname; + lnames[0] = nullstring; + } + static long extra_bytes; + public: + proc_block(value procname, iconfvbl *function); + proc_block(value procname, iconfunc *function, int arity); + proc_block(value procname, iconfvbl *function, int arity); + proc_block(proc_block*); + static proc_block* bind(proc_block*, const value&); + static void* operator new(size_t); //allocated by iconx + static void operator delete(void*); //do nothing +}; + +struct coexp_block { + long title; + long size; + long id; + coexp_block* next; + void* es_pfp; + void* es_efp; + void* es_gfp; + safe_variable* es_tend; + value* es_argp; + //... +}; + +// name/proc-block table of built-in functions +struct pstrnm { char* pstrep; proc_block *pblock; }; +extern pstrnm pntab[]; //table of original procedure blocks (src/runtime/data.r) +extern int pnsize; //size of said table +extern "C" { +int dp_pnmcmp(struct pstrmn*, value*); //comparison function +char* qsearch(char*, char*, int, int, int (*)(struct pstrmn*, value*)); //search for a name +} + +inline int safecall_0(iconfunc*, value&); +inline int safecall_1(iconfunc*, value&, const value&); +inline int safecall_2(iconfunc*, value&, const value&, const value&); +inline int safecall_3(iconfunc*, value&, const value&, const value&, const value&); +inline int safecall_4(iconfunc*, value&, const value&, const value&, const value&, const value&); +inline int safecall_5(iconfunc*, value&, const value&, const value&, const value&, const value&, const value&); +inline int safecall_6(iconfunc*, value&, const value&, const value&, const value&, const value&, const value&, const value&); +inline int safecall_v0(iconfvbl*, value&); +inline int safecall_v1(iconfvbl*, value&, const value&); +inline int safecall_v2(iconfvbl*, value&, const value&, const value&); +inline int safecall_v3(iconfvbl*, value&, const value&, const value&, const value&); +inline int safecall_vbl(iconfvbl*,safe&, const variadic&); + +//iconx GC tend list +extern safe_variable* tend; +//our global GC tend list +extern safe_variable*& global_tend; + +extern value k_current, k_main; //descriptors for ¤t and &main + +//useful helper functions +namespace Value { + value list(value n = (long)0, value init = nullvalue); + value pair(value, value); + value set(value list=nullvalue); + void runerr(value i, value x = nullvalue); + value table(value init = nullvalue); + value variable(value name); + value proc(value name, value arity = nullvalue); + value libproc(value name, value arity = nullvalue); + value call(const value& proc, const value& arglist); + value create(const value&, const value&); // create x!y + value reduce(const value&, const value&, const value&, const value&); +}; //end namespace Value + +//raw call to the modified three argument loadfunc +static int rawloadfuncpp(value argv[]); + diff --git a/ipl/packs/loadfuncpp/iloadgpx.cpp b/ipl/packs/loadfuncpp/iloadgpx.cpp new file mode 100644 index 0000000..fa774f0 --- /dev/null +++ b/ipl/packs/loadfuncpp/iloadgpx.cpp @@ -0,0 +1,64 @@ + + +#include "loadfuncpp.h" +#include "iload.h" + +#define GPX 1 //enables polling for events when calling Icon from C++ + +namespace icall { +//remove interference with icon/src/h/rt.h +#undef D_Null +#undef D_Integer +#undef D_Lrgint +#undef D_Real +#undef D_File +#undef D_Proc +#undef D_External +#undef Fs_Read +#undef Fs_Write +#undef F_Nqual +#undef F_Var + +#include "xinterp.cpp" + +#ifdef __CYGWIN__ +extern "C" { + typedef int icallfunction(dptr procptr, dptr arglistptr, dptr result); +}; + extern icallfunction *icall2; +#endif //cywgin + +}; + +#ifdef __CYGWIN__ + +//linking constraints make us do our own linking +class linkicall { + public: + linkicall() { //assign our icall to a function pointer in iload.so + icall::icall2 = &(icall::icall); + } +}; +static linkicall load; + +#else //not cygwin +//call an Icon procedure that always returns a value and never suspends +value Value::call(const value& proc, const value& arglist) { + value result; + icall::icall( (icall::dptr)(&proc), (icall::dptr)(&arglist), (icall::dptr)(&result) ); + return result; +} + +#endif //not cywgin + +//succeed if graphics are present, fail otherwise +extern "C" int iconx_graphics(value argv[]) { + argv[0] = nullvalue; + return SUCCEEDED; +} + +//put Icon graphics keywords and functions here +//plus access to the event queue for new I/O events associated with sockets + + + diff --git a/ipl/packs/loadfuncpp/iloadnogpx.cpp b/ipl/packs/loadfuncpp/iloadnogpx.cpp new file mode 100644 index 0000000..de1f25f --- /dev/null +++ b/ipl/packs/loadfuncpp/iloadnogpx.cpp @@ -0,0 +1,63 @@ + + +#include "loadfuncpp.h" +#include "iload.h" + +#define GPX 0 //prevents polling for events when calling Icon from C++ + +namespace icall { +//remove interference with icon/src/h/rt.h +#undef D_Null +#undef D_Integer +#undef D_Lrgint +#undef D_Real +#undef D_File +#undef D_Proc +#undef D_External +#undef Fs_Read +#undef Fs_Write +#undef F_Nqual +#undef F_Var + +#include "xinterp.cpp" + +#ifdef __CYGWIN__ +extern "C" { + typedef int icallfunction(dptr procptr, dptr arglistptr, dptr result); +}; + extern icallfunction *icall2; +#endif //cywgin + +}; + +#ifdef __CYGWIN__ + +//linking constraints make us do our own linking +class linkicall { + public: + linkicall() { //assign our icall to a function pointer in iload.so + icall::icall2 = &(icall::icall); + } +}; +static linkicall load; + +#else //not cygwin + +//call an Icon procedure that always returns a value and never suspends +value Value::call(const value& proc, const value& arglist) { + value result; + icall::icall( (icall::dptr)(&proc), (icall::dptr)(&arglist), (icall::dptr)(&result) ); + return result; +} + +#endif //not cywgin + +//succeed if graphics are present, fail otherwise +extern "C" int iconx_graphics(value argv[]) { + return FAILED; +} + + + + + diff --git a/ipl/packs/loadfuncpp/loadfuncpp.h b/ipl/packs/loadfuncpp/loadfuncpp.h new file mode 100644 index 0000000..5704f60 --- /dev/null +++ b/ipl/packs/loadfuncpp/loadfuncpp.h @@ -0,0 +1,481 @@ + +/* C++ support for easy extensions to icon via loadfunc, + * without garbage collection difficulties. + * Include this and link to iload.cpp which + * contains the necessary glue. + * See iexample.cpp for typical use. + * Carl Sturtivant, 2008/3/17 + */ + +#include<new> +#include<cstdio> + +enum kind { Null, Integer, BigInteger, Real, Cset, File, Procedure, Record, List, + Set=10, Table=12, String, Constructor, Coexpression=18, External, Variable }; + +enum special_value { NullString, StringLiteral, NewString, NullChar, Illegal }; + +enum { + SUCCEEDED = 7, // Icon function call returned: A_Continue + FAILED = 1 // Icon function call failed: A_Resume +}; + +class value; //Icon value (descriptor) +class safe; //for garbage-collection-safe Icon valued C++ variables and parameters of all kinds +class keyword; //Icon keyword represented as an object with unary & +class variadic; //for garbage-collection-safe variadic function argument lists +class proc_block; //block specifying a procedure to iconx +class external_block; //block specifying an external value to iconx +class external_ftable; //function pointers specifying external value behavior to iconx +class external; //C++ Object specifying an external value + +typedef int iconfunc(value argv[]); //type of icon built in functions or operators with a fixed number of arguments +typedef int iconfvbl(int argc, value argv[]); //type of icon built in functions with a variable number of arguments + +extern const value nullvalue; //for default arguments +extern const value nullstring; +extern const value nullchar; +extern const value illegal; //for unwanted trailing arguments +extern void syserror(const char*); //fatal termination Icon-style with error message +#define Fs_Read 0001 // file open for reading +#define Fs_Write 0002 // file open for writing +extern value IconFile(int fd, int status, char* fname); //make an Icon file descriptor +extern value integertobytes(value); //get the bytes of an Icon long integer as an Icon string (ignore sign) +extern value bytestointeger(value); //get the bytes of a new Icon long integer from an Icon string +extern value base64(value); //convert string or integer to base64 encoding (string) +extern value base64tointeger(value); //decode base64 string to integer +extern value base64tostring(value); //decode base64 string to string + +namespace Icon { +//all keywords excepting &fail, &cset (avoiding a name collision with function cset) +extern keyword allocated; +extern keyword ascii; +extern keyword clock; +extern keyword collections; +extern keyword current; +extern keyword date; +extern keyword dateline; +extern keyword digits; +extern keyword dump; +extern keyword e; +extern keyword error; +extern keyword errornumber; +extern keyword errortext; +extern keyword errorvalue; +extern keyword errout; +extern keyword features; +extern keyword file; +extern keyword host; +extern keyword input; +extern keyword lcase; +extern keyword letters; +extern keyword level; +extern keyword line; +extern keyword main; +extern keyword null; +extern keyword output; +extern keyword phi; +extern keyword pi; +extern keyword pos; +extern keyword progname; +extern keyword random; +extern keyword regions; +extern keyword source; +extern keyword storage; +extern keyword subject; +extern keyword time; +extern keyword trace; +extern keyword ucase; +extern keyword version; +}; //namespace Icon + +static void initialize_keywords(); + +class keyword { //objects representing Icon keywords + friend void initialize_keywords(); + iconfunc* f; + public: + safe operator&(); //get the keyword's value (could be an Icon 'variable') +}; + + +class value { //a descriptor with class +//data members modelled after 'typedef struct { word dword, vword; } descriptor;' from icall.h + private: + long dword; + long vword; + public: + friend class safe; + friend value IconFile(FILE* fd, int status, char* fname); + friend value integertobytes(value); + friend value bytestointeger(value); + friend value base64(value); + friend value base64tointeger(value); + friend value base64tostring(value); + value(); //&null + value(special_value, const char* text = ""); + value(int argc, value* argv); //makes a list of parameters passed in from Icon + value(int); + value(long); + value(float); + value(double); + value(char*); + value(const char*); + value(const char*, long); + value(proc_block&); + value(proc_block*); + value(external*); + operator int(); + operator long(); + operator float(); + operator double(); + operator char*(); + operator external*(); + operator proc_block*() const; + bool operator==(const value&) const; + value& dereference(); + value intify(); + bool isNull(); + bool notNull(); + bool isExternal(const value&); + value size() const; + kind type(); + bool toString(); //attempted conversion in place + bool toCset(); + bool toInteger(); + bool toReal(); + bool toNumeric(); + value subscript(const value&) const; //produces an Icon 'variable' + value& assign(const value&); //dereferences Icon style + value put(value x = nullvalue); + value push(value x = nullvalue); + void dump() const; + void printimage() const; + int compare(const value&) const; //comparator-style result: used for Icon sorting + value negative() const; // -x + value complement() const; // ~x + value refreshed() const; // ^x + value random() const; // ?x + value plus(const value&) const; + value minus(const value&) const; + value multiply(const value&) const; + value divide(const value&) const; + value remainder(const value&) const; + value power(const value&) const; + value union_(const value&) const; // x ++ y + value intersection(const value&) const; // x ** y + value difference(const value&) const; // x -- y + value concatenate(const value&) const; // x || y + value listconcatenate(const value&) const;// x ||| y + value slice(const value&, const value&) const; // x[y:z] + value& swap(value&); // x :=: y + value activate(const value& y = nullvalue) const; // y @ x ('*this' is activated) + value apply(const value&) const; // x!y (must return, not fail or suspend) +}; //class value + + +class generator { +//class to inherit from for defining loadable functions that are generators + public: + int generate(value argv[]); //call to suspend everything produced by next() + protected: //override these, and write a constructor + virtual bool hasNext(); + virtual value giveNext(); +}; //class generator + + +class iterate { +//class to inherit from for iterating over f!arg or !x + public: + void every(const value& g, const value& arg); //perform the iteration over g!arg + void bang(const value& x); //perform the iteration over !x + //override these, write a constructor and the means of recovering the answer + virtual bool wantNext(const value& x); + virtual void takeNext(const value& x); +}; + + + +class safe_variable { +//data members modelled after 'struct tend_desc' from rstructs.h + friend class value; + friend inline int safecall_0(iconfunc*, value&); + friend inline int safecall_1(iconfunc*, value&, const value&); + friend inline int safecall_2(iconfunc*, value&, const value&, const value&); + friend inline int safecall_3(iconfunc*, value&, const value&, const value&, const value&); + friend inline int safecall_4(iconfunc*, value&, const value&, const value&, const value&, const value&); + friend inline int safecall_5(iconfunc*, value&, const value&, const value&, const value&, const value&, const value&); + friend inline int safecall_6(iconfunc*, value&, const value&, const value&, const value&, const value&, const value&, const value&); + friend inline int safecall_v0(iconfvbl*, value&); + friend inline int safecall_v1(iconfvbl*, value&, const value&); + friend inline int safecall_v2(iconfvbl*, value&, const value&, const value&); + friend inline int safecall_v3(iconfvbl*, value&, const value&, const value&, const value&); + friend inline int safecall_vbl(iconfvbl*,safe&, const variadic&); + protected: + safe_variable *previous; + int num; + value val; + safe_variable(); + safe_variable(int); + safe_variable(long); + safe_variable(double); + safe_variable(value); + safe_variable(proc_block&); + safe_variable(proc_block*); + safe_variable(int, value*); + inline void push(safe_variable*& tendlist, int numvalues=1); + inline void pop(safe_variable*& tendlist); +}; //class safe_variable + + +class variadic: public safe_variable { + public: + variadic(int); + variadic(long); + variadic(float); + variadic(double); + variadic(char*); + variadic(value); + variadic(const safe&); + variadic(const safe&, const safe&); + variadic& operator,(const safe&); + operator value(); + ~variadic(); +}; //class variadic + + +class external_block { +//modelled on 'struct b_external' in icon/src/h/rstructs.h + friend class external; + friend class value; + static long extra_bytes; //silent extra parameter to new + long title; + long blksize; + long id; + external_ftable* funcs; + external* val; + static void* operator new(size_t); //allocated by iconx + static void operator delete(void*); //do nothing + external_block(); +}; + +class external { + friend class value; + static external_block* blockptr; //silent extra result of new + protected: + long id; + public: + static void* operator new(size_t); //allocated by new external_block() + static void operator delete(void*); //do nothing + external(); + virtual ~external() {} //root class + virtual long compare(external*); + virtual value name(); + virtual external* copy(); + virtual value image(); +}; + + +class safe: public safe_variable { +//use for a garbage collection safe icon valued safe C++ variable + friend class variadic; + friend class global; + public: + safe(); //&null + safe(const safe&); + safe(int); + safe(long); + safe(float); + safe(double); + safe(char*); + safe(const value&); + safe(const variadic&); + safe(proc_block&); + safe(proc_block*); + safe(int, value*); //from parameters sent in from Icon + ~safe(); + safe& operator=(const safe&); + //augmenting assignments here + safe& operator+=(const safe&); + safe& operator-=(const safe&); + safe& operator*=(const safe&); + safe& operator/=(const safe&); + safe& operator%=(const safe&); + safe& operator^=(const safe&); + safe& operator&=(const safe&); + safe& operator|=(const safe&); + // ++ and -- here + safe& operator++(); + safe& operator--(); + safe operator++(int); + safe operator--(int); + //conversion to value + operator value() const; + //procedure call + safe operator()(); + safe operator()(const safe&); + safe operator()(const safe& x1, const safe& x2, + const safe& x3 = illegal, const safe& x4 = illegal, + const safe& x5 = illegal, const safe& x6 = illegal, + const safe& x7 = illegal, const safe& x8 = illegal); + safe operator[](const safe&); + + friend safe operator*(const safe&); //size + friend safe operator-(const safe&); + friend safe operator~(const safe&); //set complement + friend safe operator+(const safe&, const safe&); + friend safe operator-(const safe&, const safe&); + friend safe operator*(const safe&, const safe&); + friend safe operator/(const safe&, const safe&); + friend safe operator%(const safe&, const safe&); + friend safe operator^(const safe&, const safe&); //exponentiation + friend safe operator|(const safe&, const safe&); //union + friend safe operator&(const safe&, const safe&); //intersection + friend safe operator&&(const safe&, const safe&); //set or cset difference + friend safe operator||(const safe&, const safe&); //string concatenation + friend bool operator<(const safe&, const safe&); + friend bool operator>(const safe&, const safe&); + friend bool operator<=(const safe&, const safe&); + friend bool operator>=(const safe&, const safe&); + friend bool operator==(const safe&, const safe&); + friend bool operator!=(const safe&, const safe&); + friend variadic operator,(const safe&, const safe&); //variadic argument list construction + + safe slice(const safe&, const safe&); // x[y:z] + safe apply(const safe&); // x ! y + safe listcat(const safe&); // x ||| y + safe& swap(safe&); // x :=: y + safe create(); // create !x + safe create(const safe&); // create x!y + safe activate(const safe& y = nullvalue); // y@x + safe refresh(); // ^x + safe random(); // ?x + safe dereference(); // .x + bool isIllegal() const; //is an illegal value used for trailing arguments +}; //class safe + + +//Icon built-in functions +namespace Icon { + safe abs(const safe&); + safe acos(const safe&); + safe args(const safe&); + safe asin(const safe&); + safe atan(const safe&, const safe&); + safe center(const safe&, const safe&, const safe&); + safe char_(const safe&); + safe chdir(const safe&); + safe close(const safe&); + safe collect(); + safe copy(const safe&); + safe cos(const safe&); + safe cset(const safe&); + safe delay(const safe&); + safe delete_(const safe&, const safe&); + safe detab(const variadic&); + safe detab( const safe& x1, const safe& x2, + const safe& x3=illegal, const safe& x4=illegal, + const safe& x5=illegal, const safe& x6=illegal, + const safe& x7=illegal, const safe& x8=illegal ); + safe display(const safe&, const safe&); + safe dtor(const safe&); + safe entab(const variadic&); + safe entab( const safe& x1, const safe& x2, + const safe& x3=illegal, const safe& x4=illegal, + const safe& x5=illegal, const safe& x6=illegal, + const safe& x7=illegal, const safe& x8=illegal ); + safe errorclear(); + safe exit(const safe&); + safe exp(const safe&); + safe flush(const safe&); + safe function(); //generative: returns a list + safe get(const safe&); + safe getch(); + safe getche(); + safe getenv(const safe&); + safe iand(const safe&, const safe&); + safe icom(const safe&); + safe image(const safe&); + safe insert(const safe&, const safe&, const safe&); + safe integer(const safe&); + safe ior(const safe&, const safe&); + safe ishift(const safe&, const safe&); + safe ixor(const safe&, const safe&); + safe kbhit(); + safe left(const safe&, const safe&, const safe&); + safe list(const safe&, const safe&); + safe loadfunc(const safe&, const safe&); + safe log(const safe&); + safe map(const safe&, const safe&, const safe&); + safe member(const safe&, const safe&); + safe name(const safe&); + safe numeric(const safe&); + safe open(const safe&, const safe&); + safe ord(const safe&); + safe pop(const safe&); + safe proc(const safe&, const safe&); + safe pull(const safe&); + safe push(const variadic&); + safe push( const safe& x1, const safe& x2, + const safe& x3=illegal, const safe& x4=illegal, + const safe& x5=illegal, const safe& x6=illegal, + const safe& x7=illegal, const safe& x8=illegal ); + safe put(const variadic&); + safe put( const safe& x1, const safe& x2, + const safe& x3=illegal, const safe& x4=illegal, + const safe& x5=illegal, const safe& x6=illegal, + const safe& x7=illegal, const safe& x8=illegal ); + safe read(const safe&); + safe reads(const safe&, const safe&); + safe real(const safe&); + safe remove(const safe&); + safe rename(const safe&, const safe&); + safe repl(const safe&, const safe&); + safe reverse(const safe&); + safe right(const safe&, const safe&, const safe&); + safe rtod(const safe&); + safe runerr(const safe&, const safe&); + safe runerr(const safe&); + safe seek(const safe&, const safe&); + safe serial(const safe&); + safe set(const safe&); + safe sin(const safe&); + safe sort(const safe&, const safe&); + safe sortf(const safe&, const safe&); + safe sqrt(const safe&); + safe stop(); + safe stop(const variadic&); + safe stop( const safe& x1, const safe& x2, + const safe& x3=illegal, const safe& x4=illegal, + const safe& x5=illegal, const safe& x6=illegal, + const safe& x7=illegal, const safe& x8=illegal ); + safe string(const safe&); + safe system(const safe&); + safe table(const safe&); + safe tan(const safe&); + safe trim(const safe&, const safe&); + safe type(const safe&); + safe variable(const safe&); + safe where(const safe&); + safe write(); + safe write(const variadic&); + safe write( const safe& x1, const safe& x2, + const safe& x3=illegal, const safe& x4=illegal, + const safe& x5=illegal, const safe& x6=illegal, + const safe& x7=illegal, const safe& x8=illegal ); + safe writes(const variadic&); + safe writes( const safe& x1, const safe& x2, + const safe& x3=illegal, const safe& x4=illegal, + const safe& x5=illegal, const safe& x6=illegal, + const safe& x7=illegal, const safe& x8=illegal ); + //generative functions follow, crippled to return a single value + safe any(const safe&, const safe&, const safe&, const safe&); + safe many(const safe&, const safe&, const safe&, const safe&); + safe upto(const safe&, const safe&, const safe&, const safe&); + safe find(const safe&, const safe&, const safe&, const safe&); + safe match(const safe&, const safe&, const safe&, const safe&); + safe bal(const safe&, const safe&, const safe&, const safe&, const safe&, const safe&); + safe move(const safe&); + safe tab(const safe&); +}; //namespace Icon + diff --git a/ipl/packs/loadfuncpp/loadfuncpp.icn b/ipl/packs/loadfuncpp/loadfuncpp.icn new file mode 100644 index 0000000..318ee99 --- /dev/null +++ b/ipl/packs/loadfuncpp/loadfuncpp.icn @@ -0,0 +1,241 @@ + +procedure loadfuncpp(fname, entry, arity) +#the first call loads the glue library, and loads and assigns the external loadfuncpp + local iload, fpath, oldloadfunc, real_loadfunc + real_loadfunc := _loadfuncpp_proc("loadfunc") + iload := _loadfuncpp_iload() + oldloadfunc := loadfunc #catch22: loadfunc cannot correctly return loadfuncpp + real_loadfunc(iload, "loadfuncpp") #implicitly assigns loadfuncpp to loadfunc on load + loadfuncpp := loadfunc #replace this loadfuncpp with the one loaded + loadfunc := oldloadfunc #put the old loadfunc back + self(iload) #initialize self from iload.so; calls loadfuncpp + bindself(iload) #initialize bindself from iload.so; calls loadfuncpp + loadfuncpp(_loadfuncpp_iloadgpx(), "iconx_graphics", 0) #calling Icon + return loadfuncpp(fname, entry, arity) #call the new loadfuncpp just loaded +end + +procedure self() + static getbinding + initial { + getbinding := loadfuncpp(_loadfuncpp_iload(), "getbinding", 0) | + stop("loadfuncpp: support function 'getbinding' not found in iload.so") + fail + } + return getbinding() #must be called from self() +end + +procedure bindself(proc, rec) + bindself := loadfuncpp(_loadfuncpp_iload(), "bindself", 2) | + stop("loadfuncpp: support functon 'bindself' not found in iload.so") + return bindself(proc, rec) +end + +invocable "_loadfuncpp_pathfind", "_loadfuncpp_reduce", "_loadfuncpp_create", + "_loadfuncpp_activate", "_loadfuncpp_kcollections", "_loadfuncpp_kfeatures", + "_loadfuncpp_kregions", "_loadfuncpp_kstorage", "_loadfuncpp_function", + "_loadfuncpp_bang", "_loadfuncpp_apply", "_loadfuncpp_any", "_loadfuncpp_many", + "_loadfuncpp_upto", "_loadfuncpp_find", "_loadfuncpp_match", "_loadfuncpp_bal", + "_loadfuncpp_move", "_loadfuncpp_tab", "_loadfuncpp_proc", "_loadfuncpp_key", + "_loadfuncpp_iload", "_loadfuncpp_iloadgpx" + +procedure _loadfuncpp_iload() + local getenv, fpath + static iload + initial { + getenv := _loadfuncpp_proc("getenv") + iload := _loadfuncpp_pathfind("iload.so", fpath:= getenv("FPATH")) | + stop("Cannot find iload.so on FPATH where \nFPATH=", fpath) + } + return iload +end + +procedure _loadfuncpp_iloadgpx() + local getenv, fpath, libname + static iloadgpx + initial { + if \Event then libname := "iloadgpx.so" else libname := "iloadnogpx.so" + getenv := _loadfuncpp_proc("getenv") + iloadgpx := _loadfuncpp_pathfind(libname, fpath:= getenv("FPATH")) | + stop("Cannot find ", libname, " on FPATH where \nFPATH=", fpath) + } + return iloadgpx +end + +procedure _loadfuncpp_pathfind(fname, path, psep) + local f, dir, fullname + static close, open, tab, upto, trim, many, pos + initial { + close := _loadfuncpp_proc("close") + open := _loadfuncpp_proc("open") + tab := _loadfuncpp_proc("tab") + upto := _loadfuncpp_proc("upto") + trim := _loadfuncpp_proc("trim") + many := _loadfuncpp_proc("many") + pos := _loadfuncpp_proc("pos") + } + /psep := ' :' #good for cygwin, unix variants (including OS X) + fname ? { + if ="/" & close(open(fname)) then + return fname #full absolute path works + while tab(upto('/') + 1) + fname := tab(0) #get final component of path + } + /path := "" + path := ". " || path + path ? while not pos(0) do { + dir := tab(upto(psep) | 0) + fullname := trim(dir, '/') || "/" || fname + if close(open(fullname)) then + return fullname + tab(many(psep)) + } + return #must return +end + +procedure _loadfuncpp_reduce(nullary, binary, g, arg) + local result + result := nullary + every binary(result, g!arg) + return result +end + +procedure _loadfuncpp_create(g, arg) + return create g!arg +end + +procedure _loadfuncpp_activate(coexp, val) + return val@coexp | &null +end + +procedure _loadfuncpp_kcollections() + local ls + ls := [] + every put(ls, &collections) + return ls +end + +procedure _loadfuncpp_kfeatures() + local ls + ls := [] + every put(ls, &features) + return ls +end + +procedure _loadfuncpp_kregions() + local ls + ls := [] + every put(ls, ®ions) + return ls +end + +procedure _loadfuncpp_kstorage() + local ls + ls := [] + every put(ls, &storage) + return ls +end + +procedure _loadfuncpp_function() + local ls + static function + initial function := _loadfuncpp_proc("function") + ls := [] + every put(ls, function()) + return ls +end + +procedure _loadfuncpp_key(t) + local ls + static key + initial key := _loadfuncpp_proc("key") + ls := [] + every put(ls, key(t)) + return ls +end + +procedure _loadfuncpp_bang(nullary, binary, x) + local result + result := nullary + if type(x)=="table" + then every binary(result, key(x)) + else every binary(result, !x) + return result +end + +procedure _loadfuncpp_any(c,s,i1,i2) + static any + initial any := _loadfuncpp_proc("any") + return any(c,s,i1,i2) | &null +end + +procedure _loadfuncpp_many(c,s,i1,i2) + static many + initial many := _loadfuncpp_proc("many") + return many(c,s,i1,i2) | &null +end + +procedure _loadfuncpp_upto(c,s,i1,i2) + static upto + initial upto := _loadfuncpp_proc("upto") + return upto(c,s,i1,i2) | &null +end + +procedure _loadfuncpp_find(s1,s2,i1,i2) + static find + initial find := _loadfuncpp_proc("find") + return find(s1,s2,i1,i2) | &null +end + +procedure _loadfuncpp_match(s1,s2,i1,i2) + static match + initial match := _loadfuncpp_proc("match") + return match(s1,s2,i1,i2) | &null +end + +procedure _loadfuncpp_bal(c1,c2,c3,s,i1,i2) + static bal + initial bal := _loadfuncpp_proc("bal") + return bal(c1,c2,c3,s,i1,i2) | &null +end + +procedure _loadfuncpp_move(i) + static move + initial move := _loadfuncpp_proc("move") + return move(i) | &null +end + +procedure _loadfuncpp_tab(i) + static tab + initial tab := _loadfuncpp_proc("tab") + return tab(i) | &null +end + +procedure _loadfuncpp_apply(f, arg) + return f!arg | &null +end + +#use to find built-in functions so they can be nobbled +#prior to the first call of loadfuncpp without affecting us +#this is a defensive measure to protect a reasonable programmer +#NOT an attempt to be secure against all ways to subvert loadfuncpp +procedure _loadfuncpp_proc(function) + static Proc + local errmsg + initial { + #called when procedure loadfuncpp is first called to load the real loadfuncpp + errmsg := "loadfuncpp: built-in function 'proc' not found" + Proc := proc("proc",0) | stop(errmsg) + image(Proc)=="function proc" | stop(errmsg) + args(Proc)=2 | stop(errmsg) + Proc("proc",0)===Proc | stop(errmsg) #good enough, not perfect + } + return Proc(function,0) | &null +end + + + + + + + + diff --git a/ipl/packs/loadfuncpp/loadfuncpp_build.sh b/ipl/packs/loadfuncpp/loadfuncpp_build.sh new file mode 100755 index 0000000..60b85ae --- /dev/null +++ b/ipl/packs/loadfuncpp/loadfuncpp_build.sh @@ -0,0 +1,32 @@ +#!/bin/bash + +set -o verbose #echo on + +#loadfuncpp itself +make clean +make + +pushd cgi +make +popd + +#pushd icondb +#make +#popd + +pushd socket +make clean +make +popd + +pushd system +make clean +make +popd + +pushd openssl +make clean +make +popd + +set +o verbose #echo off diff --git a/ipl/packs/loadfuncpp/savex.icn b/ipl/packs/loadfuncpp/savex.icn new file mode 100644 index 0000000..7000f5d --- /dev/null +++ b/ipl/packs/loadfuncpp/savex.icn @@ -0,0 +1,41 @@ + +procedure main(arg) + usage := "Copies iexample.icn and iexample.cpp to doc/<name>.icn\n" || + "and <name>.cpp to doc/<name>.cpp\nUsage: savex <name>" + exname := !arg | stop(usage) + examples := open("doc/examples.txt") | stop("Unable to open doc/examples.txt") + template := open("doc/Makefile.mak") | stop("Unable to open doc/Makefile.mak") + makefile := open("doc/Makefile", "w") | stop("Unable to open doc/Makefile") + in := open("iexample.icn") | stop("Unable to open iexample.icn") + out := open("doc/"||exname||".icn", "w") | stop("Unable to open "||exname||".icn") + ls := [exname] + while put(ls, ""~==trim(read(examples), ' \t')) + ls := sort(ls) + write(makefile, "\n#Automatically generated from Makefile.mak and examples.txt by ../savex.icn") + while line := read(template) do line ? { + if writes(makefile, tab(find("#exe#"))) then { + every writes(makefile, !ls, ".exe ") + write(makefile) + next + } + if writes(makefile, tab(find("#so#"))) then { + every writes(makefile, !ls, ".so ") + write(makefile) + next + } + write(makefile, line) + } + while line := read(in) do line ? { + if p := find("iexample.so") then { + writes(out, tab(p)) + writes(out, exname) + ="iexample" + write(out, tab(0)) + } else write(out, line) + } + every close(examples|template|makefile|in|out) + system("cp iexample.cpp doc/" || exname || ".cpp") + examples := open("doc/examples.txt", "w") | stop("Unable to open doc/examples.txt") + every write(examples, !ls) +end + diff --git a/ipl/packs/loadfuncpp/xfload.cpp b/ipl/packs/loadfuncpp/xfload.cpp new file mode 100644 index 0000000..2120248 --- /dev/null +++ b/ipl/packs/loadfuncpp/xfload.cpp @@ -0,0 +1,239 @@ +/* + * Sun Mar 23 09:43:59 2008 + * This file was produced by + * rtt: Icon Version 9.5.a-C, Autumn, 2007 + */ +// and then modified by cs + + +#define COMPILER 0 +extern "C" { +#include RTT +} + +//#line 42 "fload.r" + +//int glue(); //cs +//int makefunc(dptr d, char *name, int (*func)()); //cs +//int Zloadfunc (dptr r_args); //cs +//FncBlock(loadfunc, 2, 0) //cs + +//cs new makefunc that allocates a proc_block +static int newmakefunc(dptr d, char *name, int (*func)(), int arity) { + value nom(NewString,name); + proc_block* pbp; + if( arity < 0 ) pbp = new proc_block(nom, (iconfvbl*)func); + else pbp = new proc_block(nom, (iconfunc*)func, arity); + if( pbp==0 ) return 0; + d->dword = D_Proc; + d->vword.bptr = (union block *)pbp; + return 1; +} +//cs end of new makefunc + +//int Zloadfunc(r_args) //cs +//dptr r_args; //cs +inline int Z_loadfunc(dptr r_args) //cs + { + if (!cnv_c_str(&(r_args[1]), &(r_args[1]))) { + { + err_msg( + +//#line 50 "fload.r" + + 103, &(r_args[1])); + return A_Resume; + } + } + +//#line 51 "fload.r" + + if (!cnv_c_str(&(r_args[2]), &(r_args[2]))) { + { + err_msg( + +//#line 52 "fload.r" + + 103, &(r_args[2])); + return A_Resume; + } + } +//cs new third parameter: arity + C_integer r_i2; + if (!cnv_c_int(&(r_args[3]), &(r_i2))) { + err_msg(101, &(r_args[3])); + return A_Resume; + } +//cs end new third arity parameter + +//#line 58 "fload.r" + + { + int (*func)(); + static char *curfile; + static void *handle; + char *funcname2; + +//#line 67 "fload.r" + + if (!handle || !curfile || strcmp(r_args[1].vword.sptr, curfile) != 0) { + if (curfile) + free((pointer)curfile); + curfile = salloc(r_args[1].vword.sptr); + handle = dlopen(r_args[1].vword.sptr, 1 | RTLD_GLOBAL); + } + +//#line 76 "fload.r" + + if (handle) { + func = (int (*)())dlsym(handle, r_args[2].vword.sptr); + if (!func) { + +//#line 83 "fload.r" + + //funcname2 = malloc(strlen(r_args[2].vword.sptr) + 2); //cs + funcname2 = (char*)malloc(strlen(r_args[2].vword.sptr) + 2); //cs + if (funcname2) { + *funcname2 = '_'; + strcpy(funcname2 + 1, r_args[2].vword.sptr); + func = (int (*)())dlsym(handle, funcname2); + free(funcname2); + } + } + } + if (!handle || !func) { + //fprintf(stderr, "\nloadfunc(\"%s\",\"%s\"): %s\n", //cs + fprintf(stderr, "\nloadfuncpp(\"%s\",\"%s\"): %s\n", //cs + r_args[1].vword.sptr, r_args[2].vword.sptr, dlerror()); + { + err_msg( + +//#line 95 "fload.r" + + 216, NULL); + return A_Resume; + } + } + +// if (!makefunc(&r_args[0], r_args[2].vword.sptr, func)) //cs + if (!newmakefunc(&r_args[0], r_args[2].vword.sptr, func, r_i2)) //cs + { + err_msg( + +//#line 101 "fload.r" + + 305, NULL); + return A_Resume; + } + { + return A_Continue; + } + } + } + + +#if 0 //cs --- not used: we use a proc_block constructor, and no glue + +//#line 111 "fload.r" + +int makefunc(d, name, func) +dptr d; +char *name; +int (*func)(); + { + struct b_proc *blk; + + blk = (struct b_proc *)malloc(sizeof(struct b_proc)); + if (!blk) + return 0; + blk->title = T_Proc; + blk->blksize = sizeof(struct b_proc); + +//#line 127 "fload.r" + + blk->entryp.ccode = glue; + +//#line 130 "fload.r" + + blk->nparam = -1; + blk->ndynam = -1; + blk->nstatic = 0; + blk->fstatic = 0; + blk->pname.dword = strlen(name); + blk->pname.vword.sptr = salloc(name); + blk->lnames[0].dword = 0; + blk->lnames[0].vword.sptr = (char *)func; + + d->dword = D_Proc; + d->vword.bptr = (union block *)blk; + return 1; + } + +//#line 190 "fload.r" + +int glue(argc, dargv) +int argc; +dptr dargv; + { + int status, (*func)(); + struct b_proc *blk; + struct descrip r; + struct { + struct tend_desc *previous; + int num; + struct descrip d[1]; + } r_tend; + + r_tend.d[0].dword = D_Null; + r_tend.num = 1; + r_tend.previous = tend; + tend = (struct tend_desc *)&r_tend; + +//#line 199 "fload.r" + + blk = (struct b_proc *)dargv[0].vword.bptr; + func = (int (*)())blk->lnames[0].vword.sptr; + + r_tend.d[0] = dargv[0]; + dargv[0] = nulldesc; + status = (*func)(argc, dargv); + + if (status == 0) { + tend = r_tend.previous; + +//#line 207 "fload.r" + + return A_Continue; + } + +//#line 208 "fload.r" + + if (status < 0) { + tend = r_tend.previous; + +//#line 209 "fload.r" + + return A_Resume; + } + r = dargv[0]; + dargv[0] = r_tend.d[0]; + if (((r).dword == D_Null)) + do {err_msg((int)status, NULL);{ + tend = r_tend.previous; + return A_Resume; + } + } + while (0); + +//#line 215 "fload.r" + + do {err_msg((int)status, &r);{ + tend = r_tend.previous; + return A_Resume; + } + } + while (0); + } + +#endif //cs unused + diff --git a/ipl/packs/loadfuncpp/xinterp.cpp b/ipl/packs/loadfuncpp/xinterp.cpp new file mode 100644 index 0000000..dba8f27 --- /dev/null +++ b/ipl/packs/loadfuncpp/xinterp.cpp @@ -0,0 +1,1647 @@ +/* + * Tue Feb 12 18:19:56 2008 + * This file was produced by + * rtt: Icon Version 9.5.a-C, Autumn, 2007 + */ +//and then modified by cs + + +extern "C" { //cs + +#define COMPILER 0 +#include RTT + +//#line 8 "interp.r" + +extern fptr fncentry[]; + +//#line 22 "interp.r" + +//word lastop; +extern word lastop; //cs + +//#line 28 "interp.r" + +//struct ef_marker *efp; +extern struct ef_marker *efp; //cs +//struct gf_marker *gfp; +extern struct gf_marker *gfp; //cs +//inst ipc; +extern inst ipc; //cs +//word *sp = NULL; +extern word *sp; //cs + +//int ilevel; +extern int ilevel; //cs +//struct descrip value_tmp; +extern struct descrip value_tmp; //cs +//struct descrip eret_tmp; +extern struct descrip eret_tmp; //cs + +//int coexp_act; +extern int coexp_act; //cs + +//#line 40 "interp.r" + +//dptr xargp; +extern dptr xargp; //cs +//word xnargs; +extern word xnargs; //cs + +//#line 155 "interp.r" + +//int interp(fsig, cargp) +//int fsig; +//dptr cargp; +static int icall(dptr procptr, dptr arglistptr, dptr result) //cs + { + register word opnd; + register word *rsp; + register dptr rargp; + register struct ef_marker *newefp; + register struct gf_marker *newgfp; + register word *wd; + register word *firstwd, *lastwd; + word *oldsp; + int type, signal, args; +// extern int (*optab[])(); + extern int (*optab[])(dptr); //cs +// extern int (*keytab[])(); + extern int (*keytab[])(dptr); //cs + struct b_proc *bproc; + word savedlastop = lastop; //cs --- so that Icon::runerr works as expected through ttrace + dptr oldxargp = xargp; //cs --- save the arguments passed to the C++ function calling Icon + int oldxnargs = xnargs; //cs --- ditto + dptr lval; //cs + int fsig = 0; //cs + dptr cargp = (dptr)(sp+1); //cs + dptr return_cargp = cargp; //cs + word *saved_sp = sp; //cs + word *return_sp = sp + 2; //cs + + cargp[0] = *procptr; //cs + cargp[1] = *arglistptr; //cs + sp += 4; //cs + +//#line 189 "interp.r" + + if (BlkLoc(k_current) == BlkLoc(k_main) && + ((char *)sp + PerilDelta) > (char *)stackend) + fatalerr(301, NULL); + +//#line 195 "interp.r" + +#if GPX //cs + if (!pollctr--) { + pollctr = pollevent(); + if (pollctr == -1) fatalerr(141, NULL); + } +#endif + +//#line 201 "interp.r" + + ilevel++; + + rsp = sp;; + +//#line 215 "interp.r" + + if (fsig == G_Csusp) { + +//#line 218 "interp.r" + + oldsp = rsp; + +//#line 223 "interp.r" + + newgfp = (struct gf_marker *)(rsp + 1); + newgfp->gf_gentype = fsig; + newgfp->gf_gfp = gfp; + newgfp->gf_efp = efp; + newgfp->gf_ipc = ipc; + rsp += ((sizeof(struct gf_smallmarker) + sizeof(word) - 1) / sizeof(word)); + +//#line 235 "interp.r" + + if (gfp != 0) { + if (gfp->gf_gentype == G_Psusp) + firstwd = (word *)gfp + ((sizeof((*gfp)) + sizeof(word) - 1) / sizeof(word)); + else + firstwd = (word *)gfp + ((sizeof(struct gf_smallmarker) + sizeof(word) - 1) / sizeof(word)); + } + else + firstwd = (word *)efp + ((sizeof((*efp)) + sizeof(word) - 1) / sizeof(word)); + lastwd = (word *)cargp + 1; + +//#line 249 "interp.r" + + for (wd = firstwd; wd <= lastwd; wd++) + *++rsp = *wd; + gfp = newgfp; + } + +//#line 257 "interp.r" + + goto apply; //cs + + for (; ; ) { + +//#line 330 "interp.r" + + lastop = (word)(*ipc.op++); + + if( rsp < return_sp ) //cs + syserror("loadfuncpp: call of Icon from C++ must return a value, yet failed instead"); + +//#line 348 "interp.r" + + switch ((int)lastop) { + +//#line 359 "interp.r" + + case 51: + ipc.op[-1] = (90); + PushValSP(rsp, D_Cset); + opnd = (*ipc.opnd++); + opnd += (word)ipc.opnd; + ipc.opnd[-1] = (opnd); + PushValSP(rsp, opnd); + break; + + case 90: + PushValSP(rsp, D_Cset); + PushValSP(rsp, (*ipc.opnd++)); + break; + + case 60: + PushValSP(rsp, D_Integer); + PushValSP(rsp, (*ipc.opnd++)); + break; + + case 75: + ipc.op[-1] = (91); + PushValSP(rsp, D_Real); + opnd = (*ipc.opnd++); + opnd += (word)ipc.opnd; + PushValSP(rsp, opnd); + ipc.opnd[-1] = (opnd); + break; + + case 91: + PushValSP(rsp, D_Real); + PushValSP(rsp, (*ipc.opnd++)); + break; + + case 77: + ipc.op[-1] = (92); + PushValSP(rsp, (*ipc.opnd++)); + opnd = (word)strcons + (*ipc.opnd++); + ipc.opnd[-1] = (opnd); + PushValSP(rsp, opnd); + break; + + case 92: + PushValSP(rsp, (*ipc.opnd++)); + PushValSP(rsp, (*ipc.opnd++)); + break; + +//#line 407 "interp.r" + + case 81: + PushValSP(rsp, D_Var); + PushValSP(rsp, &glbl_argp[(*ipc.opnd++) + 1]); + break; + + case 84: + ipc.op[-1] = (93); + PushValSP(rsp, D_Var); + opnd = (*ipc.opnd++); + PushValSP(rsp, &globals[opnd]); + ipc.opnd[-1] = ((word)&globals[opnd]); + break; + + case 93: + PushValSP(rsp, D_Var); + PushValSP(rsp, (*ipc.opnd++)); + break; + + case 83: + PushValSP(rsp, D_Var); + PushValSP(rsp, &pfp->pf_locals[(*ipc.opnd++)]); + break; + + case 82: + ipc.op[-1] = (94); + PushValSP(rsp, D_Var); + opnd = (*ipc.opnd++); + PushValSP(rsp, &statics[opnd]); + ipc.opnd[-1] = ((word)&statics[opnd]); + break; + + case 94: + PushValSP(rsp, D_Var); + PushValSP(rsp, (*ipc.opnd++)); + break; + +//#line 448 "interp.r" + + case 4: + case 19: + case 23: + case 34: + case 37: + +//#line 65 "interp.r" + + rargp = (dptr)(rsp - 1) - 1; + xargp = rargp; + sp = rsp;; + +//#line 453 "interp.r" + + ; + Deref(rargp[1]); + +//#line 85 "interp.r" + + if ((*(optab[lastop]))(rargp) == A_Resume) { + +//#line 89 "interp.r" + + goto efail_noev; + } + rsp = (word *)rargp + 1; + +//#line 95 "interp.r" + + break; + +//#line 455 "interp.r" + + ; + + case 43: + +//#line 65 "interp.r" + + rargp = (dptr)(rsp - 1) - 1; + xargp = rargp; + sp = rsp;; + +//#line 458 "interp.r" + + ; + Deref(rargp[1]); + +//#line 85 "interp.r" + + if ((*(optab[lastop]))(rargp) == A_Resume) { + +//#line 89 "interp.r" + + goto efail_noev; + } + rsp = (word *)rargp + 1; + +//#line 95 "interp.r" + + break; + +//#line 460 "interp.r" + + ; + + case 21: + case 22: + +//#line 65 "interp.r" + + rargp = (dptr)(rsp - 1) - 1; + xargp = rargp; + sp = rsp;; + +//#line 464 "interp.r" + + ; + +//#line 85 "interp.r" + + if ((*(optab[lastop]))(rargp) == A_Resume) { + +//#line 89 "interp.r" + + goto efail_noev; + } + rsp = (word *)rargp + 1; + +//#line 95 "interp.r" + + break; + +//#line 465 "interp.r" + + ; + + case 32: + PushNullSP(rsp); + +//#line 65 "interp.r" + + rargp = (dptr)(rsp - 1) - 2; + xargp = rargp; + sp = rsp;; + +//#line 85 "interp.r" + + if ((*(optab[lastop]))(rargp) == A_Resume) { + +//#line 89 "interp.r" + + goto efail_noev; + } + rsp = (word *)rargp + 1; + +//#line 95 "interp.r" + + break; + +//#line 474 "interp.r" + + case 40: + +//#line 65 "interp.r" + + rargp = (dptr)(rsp - 1) - 1; + xargp = rargp; + sp = rsp;; + +//#line 475 "interp.r" + + ; + Deref(rargp[1]); + +//#line 105 "interp.r" + + signal = (*(optab[lastop]))(rargp); + goto C_rtn_term; + +//#line 477 "interp.r" + + ; + + case 2: + PushNullSP(rsp); + +//#line 65 "interp.r" + + rargp = (dptr)(rsp - 1) - 2; + xargp = rargp; + sp = rsp;; + +//#line 481 "interp.r" + + ; + +//#line 105 "interp.r" + + signal = (*(optab[lastop]))(rargp); + goto C_rtn_term; + +//#line 482 "interp.r" + + ; + +//#line 486 "interp.r" + + case 3: + case 5: + case 6: + case 8: + case 9: + case 16: + case 17: + case 18: + case 31: + case 42: + case 30: + case 7: + case 10: + case 11: + case 12: + case 13: + case 14: + case 15: + case 20: + case 24: + case 25: + case 26: + case 27: + case 29: + case 28: + +//#line 65 "interp.r" + + rargp = (dptr)(rsp - 1) - 2; + xargp = rargp; + sp = rsp;; + +//#line 511 "interp.r" + + ; + Deref(rargp[1]); + Deref(rargp[2]); + +//#line 85 "interp.r" + + if ((*(optab[lastop]))(rargp) == A_Resume) { + +//#line 89 "interp.r" + + goto efail_noev; + } + rsp = (word *)rargp + 1; + +//#line 95 "interp.r" + + break; + +//#line 514 "interp.r" + + ; + + case 1: + +//#line 65 "interp.r" + + rargp = (dptr)(rsp - 1) - 2; + xargp = rargp; + sp = rsp;; + +//#line 517 "interp.r" + + ; + +//#line 85 "interp.r" + + if ((*(optab[lastop]))(rargp) == A_Resume) { + +//#line 89 "interp.r" + + goto efail_noev; + } + rsp = (word *)rargp + 1; + +//#line 95 "interp.r" + + break; + +//#line 518 "interp.r" + + ; + + case 39: + PushNullSP(rsp); + +//#line 65 "interp.r" + + rargp = (dptr)(rsp - 1) - 3; + xargp = rargp; + sp = rsp;; + +//#line 522 "interp.r" + + ; + +//#line 85 "interp.r" + + if ((*(optab[lastop]))(rargp) == A_Resume) { + +//#line 89 "interp.r" + + goto efail_noev; + } + rsp = (word *)rargp + 1; + +//#line 95 "interp.r" + + break; + +//#line 523 "interp.r" + + ; + + case 38: + PushNullSP(rsp); + +//#line 65 "interp.r" + + rargp = (dptr)(rsp - 1) - 3; + xargp = rargp; + sp = rsp;; + +//#line 527 "interp.r" + + ; + +//#line 85 "interp.r" + + if ((*(optab[lastop]))(rargp) == A_Resume) { + +//#line 89 "interp.r" + + goto efail_noev; + } + rsp = (word *)rargp + 1; + +//#line 95 "interp.r" + + break; + +//#line 528 "interp.r" + + ; + +//#line 531 "interp.r" + + case 33: + +//#line 65 "interp.r" + + rargp = (dptr)(rsp - 1) - 2; + xargp = rargp; + sp = rsp;; + +//#line 532 "interp.r" + + ; + +//#line 105 "interp.r" + + signal = (*(optab[lastop]))(rargp); + goto C_rtn_term; + +//#line 533 "interp.r" + + ; + + case 35: + PushNullSP(rsp); + +//#line 65 "interp.r" + + rargp = (dptr)(rsp - 1) - 3; + xargp = rargp; + sp = rsp;; + +//#line 537 "interp.r" + + ; + +//#line 105 "interp.r" + + signal = (*(optab[lastop]))(rargp); + goto C_rtn_term; + +//#line 538 "interp.r" + + ; + +//#line 542 "interp.r" + + case 36: + PushNullSP(rsp); + +//#line 65 "interp.r" + + rargp = (dptr)(rsp - 1) - 4; + xargp = rargp; + sp = rsp;; + +//#line 544 "interp.r" + + ; + +//#line 85 "interp.r" + + if ((*(optab[lastop]))(rargp) == A_Resume) { + +//#line 89 "interp.r" + + goto efail_noev; + } + rsp = (word *)rargp + 1; + +//#line 95 "interp.r" + + break; + +//#line 545 "interp.r" + + ; + +//#line 548 "interp.r" + + case 41: + +//#line 65 "interp.r" + + rargp = (dptr)(rsp - 1) - 3; + xargp = rargp; + sp = rsp;; + +//#line 549 "interp.r" + + ; + Deref(rargp[1]); + Deref(rargp[2]); + Deref(rargp[3]); + +//#line 105 "interp.r" + + signal = (*(optab[lastop]))(rargp); + goto C_rtn_term; + +//#line 553 "interp.r" + + ; + + case 98: + +//#line 559 "interp.r" + +#if GPX //cs + if (!pollctr--) { + sp = rsp;; + pollctr = pollevent(); + rsp = sp;; + if (pollctr == -1) fatalerr(141, NULL); + } +#endif + +//#line 570 "interp.r" + + break; + +//#line 573 "interp.r" + + case 108: + { + +//#line 583 "interp.r" + + break; + } + + case 64: + +//#line 590 "interp.r" + +#if GPX //cs + if (!pollctr--) { + sp = rsp;; + pollctr = pollevent(); + rsp = sp;; + if (pollctr == -1) fatalerr(141, NULL); + } +#endif + +//#line 606 "interp.r" + + break; + +//#line 610 "interp.r" + + case 44: + PushDescSP(rsp, k_subject); + PushValSP(rsp, D_Integer); + PushValSP(rsp, k_pos); + +//#line 79 "interp.r" + + rargp = (dptr)(rsp - 1) - 2; + xargp = rargp; + sp = rsp;; + +//#line 614 "interp.r" + + ; + + signal = Obscan(2, rargp); + + goto C_rtn_term; + + case 55: + +//#line 79 "interp.r" + + rargp = (dptr)(rsp - 1) - 1; + xargp = rargp; + sp = rsp;; + +//#line 621 "interp.r" + + ; + + signal = Oescan(1, rargp); + + goto C_rtn_term; + +//#line 629 "interp.r" + + case 89: { + apply: //cs + union block *bp; + int i, j; + + value_tmp = *(dptr)(rsp - 1); + Deref(value_tmp); + switch (Type(value_tmp)) { + case T_List: { + rsp -= 2; + bp = BlkLoc(value_tmp); + args = (int)bp->list.size; + +//#line 647 "interp.r" + + if (BlkLoc(k_current) == BlkLoc(k_main) && + ((char *)sp + args * sizeof(struct descrip) > + (char *)stackend)) + fatalerr(301, NULL); + +//#line 653 "interp.r" + + for (bp = bp->list.listhead; + +//#line 657 "interp.r" + + bp != NULL; + + bp = bp->lelem.listnext) { + for (i = 0; i < bp->lelem.nused; i++) { + j = bp->lelem.first + i; + if (j >= bp->lelem.nslots) + j -= bp->lelem.nslots; + PushDescSP(rsp, bp->lelem.lslots[j]); + } + } + goto invokej; + } + + case T_Record: { + rsp -= 2; + bp = BlkLoc(value_tmp); + args = bp->record.recdesc->proc.nfields; + for (i = 0; i < args; i++) { + PushDescSP(rsp, bp->record.fields[i]); + } + goto invokej; + } + + default: { + + xargp = (dptr)(rsp - 3); + err_msg(126, &value_tmp); + goto efail; + } + } + } + + case 61: { + args = (int)(*ipc.opnd++); + invokej: + { + int nargs; + dptr carg; + + sp = rsp;; + type = invoke(args, &carg, &nargs); + rsp = sp;; + + if (type == I_Fail) + goto efail_noev; + if (type == I_Continue) + break; + else { + + rargp = carg; + +//#line 712 "interp.r" + +#if GPX //cs + pollctr >>= 1; + if (!pollctr) { + sp = rsp;; + pollctr = pollevent(); + rsp = sp;; + if (pollctr == -1) fatalerr(141, NULL); + } +#endif + +//#line 726 "interp.r" + + bproc = (struct b_proc *)BlkLoc(*rargp); + +//#line 734 "interp.r" + + if (type == I_Vararg) { +// int (*bfunc)(); + int (*bfunc)(int, dptr); //cs +// bfunc = bproc->entryp.ccode; + bfunc = (int (*)(int,dptr))(bproc->entryp.ccode); + +//#line 741 "interp.r" + + signal = (*bfunc)(nargs, rargp); + } + else + +//#line 746 "interp.r" + + { +// int (*bfunc)(); + int (*bfunc)(dptr); +// bfunc = bproc->entryp.ccode; + bfunc = (int (*)(dptr))(bproc->entryp.ccode); + +//#line 753 "interp.r" + + signal = (*bfunc)(rargp); + } + +//#line 767 "interp.r" + + goto C_rtn_term; + } + } + } + + case 62: + + PushNullSP(rsp); + opnd = (*ipc.opnd++); + +//#line 79 "interp.r" + + rargp = (dptr)(rsp - 1) - 0; + xargp = rargp; + sp = rsp;; + +//#line 776 "interp.r" + + ; + + signal = (*(keytab[(int)opnd]))(rargp); + goto C_rtn_term; + + case 65: + opnd = (*ipc.opnd++); + +//#line 79 "interp.r" + + rargp = (dptr)(rsp - 1) - opnd; + xargp = rargp; + sp = rsp;; + +//#line 793 "interp.r" + + ; + +//#line 796 "interp.r" + + { + int i; + for (i = 1; i <= opnd; i++) + Deref(rargp[i]); + } + + signal = Ollist((int)opnd, rargp); + + goto C_rtn_term; + +//#line 808 "interp.r" + + case 67: + ipc.op[-1] = (96); + opnd = (*ipc.opnd++); + opnd += (word)ipc.opnd; + ipc.opnd[-1] = (opnd); + newefp = (struct ef_marker *)(rsp + 1); + newefp->ef_failure.opnd = (word *)opnd; + goto mark; + + case 96: + newefp = (struct ef_marker *)(rsp + 1); + newefp->ef_failure.opnd = (word *)(*ipc.opnd++); + mark: + newefp->ef_gfp = gfp; + newefp->ef_efp = efp; + newefp->ef_ilevel = ilevel; + rsp += ((sizeof((*efp)) + sizeof(word) - 1) / sizeof(word)); + efp = newefp; + gfp = 0; + break; + + case 85: + mark0: + newefp = (struct ef_marker *)(rsp + 1); + newefp->ef_failure.opnd = 0; + newefp->ef_gfp = gfp; + newefp->ef_efp = efp; + newefp->ef_ilevel = ilevel; + rsp += ((sizeof((*efp)) + sizeof(word) - 1) / sizeof(word)); + efp = newefp; + gfp = 0; + break; + + case 78: + +//#line 849 "interp.r" + + gfp = efp->ef_gfp; + rsp = (word *)efp - 1; + +//#line 855 "interp.r" + + Unmark_uw: + if (efp->ef_ilevel < ilevel) { + --ilevel; + + sp = rsp;; + +//#line 866 "interp.r" + + return A_Unmark_uw; + } + + efp = efp->ef_efp; + break; + +//#line 874 "interp.r" + + case 56: { + +//#line 879 "interp.r" + + oldsp = rsp; + newgfp = (struct gf_marker *)(rsp + 1); + newgfp->gf_gentype = G_Esusp; + newgfp->gf_gfp = gfp; + newgfp->gf_efp = efp; + newgfp->gf_ipc = ipc; + gfp = newgfp; + rsp += ((sizeof(struct gf_smallmarker) + sizeof(word) - 1) / sizeof(word)); + +//#line 892 "interp.r" + + if (efp->ef_gfp != 0) { + newgfp = (struct gf_marker *)(efp->ef_gfp); + if (newgfp->gf_gentype == G_Psusp) + firstwd = (word *)efp->ef_gfp + ((sizeof((*gfp)) + sizeof(word) - 1) / sizeof(word)); + else + firstwd = (word *)efp->ef_gfp + + ((sizeof(struct gf_smallmarker) + sizeof(word) - 1) / sizeof(word)); + } + else + firstwd = (word *)efp->ef_efp + ((sizeof((*efp)) + sizeof(word) - 1) / sizeof(word)); + lastwd = (word *)efp - 1; + efp = efp->ef_efp; + +//#line 909 "interp.r" + + for (wd = firstwd; wd <= lastwd; wd++) + *++rsp = *wd; + PushValSP(rsp, oldsp[-1]); + PushValSP(rsp, oldsp[0]); + break; + } + + case 66: { + struct descrip sval; + +//#line 924 "interp.r" + +// dptr lval = (dptr)((word *)efp - 2); + lval = (dptr)((word *)efp - 2); //cs + +//#line 929 "interp.r" + + if (--IntVal(*lval) > 0) { + +//#line 934 "interp.r" + + sval = *(dptr)(rsp - 1); + +//#line 941 "interp.r" + + if (efp->ef_gfp != 0) { + newgfp = (struct gf_marker *)(efp->ef_gfp); + if (newgfp->gf_gentype == G_Psusp) + firstwd = (word *)efp->ef_gfp + ((sizeof((*gfp)) + sizeof(word) - 1) / sizeof(word)); + else + firstwd = (word *)efp->ef_gfp + + ((sizeof(struct gf_smallmarker) + sizeof(word) - 1) / sizeof(word)); + } + else + firstwd = (word *)efp->ef_efp + ((sizeof((*efp)) + sizeof(word) - 1) / sizeof(word)); + lastwd = (word *)efp - 3; + if (gfp == 0) + gfp = efp->ef_gfp; + efp = efp->ef_efp; + +//#line 960 "interp.r" + + rsp -= 2; + for (wd = firstwd; wd <= lastwd; wd++) + *++rsp = *wd; + PushDescSP(rsp, sval); + } + else { + +//#line 973 "interp.r" + + *lval = *(dptr)(rsp - 1); + +//#line 981 "interp.r" + + gfp = efp->ef_gfp; + +//#line 987 "interp.r" + + Lsusp_uw: + if (efp->ef_ilevel < ilevel) { + --ilevel; + sp = rsp;; + +//#line 997 "interp.r" + + return A_Lsusp_uw; + } + rsp = (word *)efp - 1; + efp = efp->ef_efp; + } + break; + } + + case 72: { + +//#line 1015 "interp.r" + + struct descrip tmp; + dptr svalp; + struct b_proc *sproc; + +//#line 1025 "interp.r" + + svalp = (dptr)(rsp - 1); + if (Var(*svalp)) { + sp = rsp;; + retderef(svalp, (word *)glbl_argp, sp); + rsp = sp;; + } + +//#line 1035 "interp.r" + + oldsp = rsp; + newgfp = (struct gf_marker *)(rsp + 1); + newgfp->gf_gentype = G_Psusp; + newgfp->gf_gfp = gfp; + newgfp->gf_efp = efp; + newgfp->gf_ipc = ipc; + newgfp->gf_argp = glbl_argp; + newgfp->gf_pfp = pfp; + gfp = newgfp; + rsp += ((sizeof((*gfp)) + sizeof(word) - 1) / sizeof(word)); + +//#line 1051 "interp.r" + + if (pfp->pf_gfp != 0) { + newgfp = (struct gf_marker *)(pfp->pf_gfp); + if (newgfp->gf_gentype == G_Psusp) + firstwd = (word *)pfp->pf_gfp + ((sizeof((*gfp)) + sizeof(word) - 1) / sizeof(word)); + else + firstwd = (word *)pfp->pf_gfp + + ((sizeof(struct gf_smallmarker) + sizeof(word) - 1) / sizeof(word)); + } + else + firstwd = (word *)pfp->pf_efp + ((sizeof((*efp)) + sizeof(word) - 1) / sizeof(word)); + lastwd = (word *)glbl_argp - 1; + efp = efp->ef_efp; + +//#line 1068 "interp.r" + + for (wd = firstwd; wd <= lastwd; wd++) + *++rsp = *wd; + PushValSP(rsp, oldsp[-1]); + PushValSP(rsp, oldsp[0]); + --k_level; + if (k_trace) { + k_trace--; + sproc = (struct b_proc *)BlkLoc(*glbl_argp); + strace(&(sproc->pname), svalp); + } + +//#line 1083 "interp.r" + + if (pfp->pf_scan != NULL) { + +//#line 1089 "interp.r" + + tmp = k_subject; + k_subject = *pfp->pf_scan; + *pfp->pf_scan = tmp; + + tmp = *(pfp->pf_scan + 1); + IntVal(*(pfp->pf_scan + 1)) = k_pos; + k_pos = IntVal(tmp); + } + +//#line 1106 "interp.r" + + efp = pfp->pf_efp; + ipc = pfp->pf_ipc; + glbl_argp = pfp->pf_argp; + pfp = pfp->pf_pfp; + break; + } + +//#line 1115 "interp.r" + + case 54: { + +//#line 1124 "interp.r" + + eret_tmp = *(dptr)&rsp[-1]; + gfp = efp->ef_gfp; + Eret_uw: + +//#line 1131 "interp.r" + + if (efp->ef_ilevel < ilevel) { + --ilevel; + sp = rsp;; + +//#line 1140 "interp.r" + + return A_Eret_uw; + } + rsp = (word *)efp - 1; + efp = efp->ef_efp; + PushDescSP(rsp, eret_tmp); + break; + } + +//#line 1149 "interp.r" + + case 71: { + +//#line 1163 "interp.r" + + struct b_proc *rproc; + rproc = (struct b_proc *)BlkLoc(*glbl_argp); + +//#line 1173 "interp.r" + + *glbl_argp = *(dptr)(rsp - 1); + if (Var(*glbl_argp)) { + sp = rsp;; + retderef(glbl_argp, (word *)glbl_argp, sp); + rsp = sp;; + } + + --k_level; + if (k_trace) { + k_trace--; + rtrace(&(rproc->pname), glbl_argp); + } + Pret_uw: + if (pfp->pf_ilevel < ilevel) { + --ilevel; + sp = rsp;; + +//#line 1196 "interp.r" + + return A_Pret_uw; + } + +//#line 1203 "interp.r" + + rsp = (word *)glbl_argp + 1; + efp = pfp->pf_efp; + gfp = pfp->pf_gfp; + ipc = pfp->pf_ipc; + glbl_argp = pfp->pf_argp; + pfp = pfp->pf_pfp; + +//#line 1219 "interp.r" + +//cs return to C++ + if( rsp == return_sp ) { + --ilevel; + *result = *return_cargp; + sp = saved_sp; + lastop = savedlastop; + xargp = oldxargp; + xnargs = oldxnargs; + return 0; + } +//cs end return to C++ + break; + } + +//#line 1224 "interp.r" + + case 53: + efail: + +//#line 1229 "interp.r" + + efail_noev: + +//#line 1233 "interp.r" + + if (gfp == 0) { + +//#line 1251 "interp.r" + + ipc = efp->ef_failure; + gfp = efp->ef_gfp; + rsp = (word *)efp - 1; + efp = efp->ef_efp; + + if (ipc.op == 0) + goto efail; + break; + } + else + { + +//#line 1267 "interp.r" + + struct descrip tmp; + register struct gf_marker *resgfp = gfp; + + type = (int)resgfp->gf_gentype; + + if (type == G_Psusp) { + glbl_argp = resgfp->gf_argp; + if (k_trace) { + k_trace--; + sp = rsp;; + atrace(&(((struct b_proc *)BlkLoc(*glbl_argp))->pname)); + rsp = sp;; + } + } + ipc = resgfp->gf_ipc; + efp = resgfp->gf_efp; + gfp = resgfp->gf_gfp; + rsp = (word *)resgfp - 1; + if (type == G_Psusp) { + pfp = resgfp->gf_pfp; + +//#line 1292 "interp.r" + + if (pfp->pf_scan != NULL) { + tmp = k_subject; + k_subject = *pfp->pf_scan; + *pfp->pf_scan = tmp; + + tmp = *(pfp->pf_scan + 1); + IntVal(*(pfp->pf_scan + 1)) = k_pos; + k_pos = IntVal(tmp); + } + +//#line 1313 "interp.r" + + ++k_level; + } + + switch (type) { + +//#line 1336 "interp.r" + + case G_Csusp: + ; + --ilevel; + sp = rsp;; + +//#line 1344 "interp.r" + + return A_Resume; + + case G_Esusp: + ; + goto efail_noev; + + case G_Psusp: + ; + break; + } + + break; + } + + case 68: { + +//#line 1374 "interp.r" + + --k_level; + if (k_trace) { + k_trace--; + failtrace(&(((struct b_proc *)BlkLoc(*glbl_argp))->pname)); + } + Pfail_uw: + + if (pfp->pf_ilevel < ilevel) { + --ilevel; + sp = rsp;; + +//#line 1388 "interp.r" + + return A_Pfail_uw; + } + efp = pfp->pf_efp; + gfp = pfp->pf_gfp; + ipc = pfp->pf_ipc; + glbl_argp = pfp->pf_argp; + pfp = pfp->pf_pfp; + +//#line 1406 "interp.r" + + goto efail_noev; + } + +//#line 1410 "interp.r" + + case 45: + PushNullSP(rsp); + PushValSP(rsp, ((word *)efp)[-2]); + PushValSP(rsp, ((word *)efp)[-1]); + break; + + case 46: + opnd = (*ipc.opnd++); + opnd += (word)ipc.opnd; + efp->ef_failure.opnd = (word *)opnd; + break; + + case 52: + PushNullSP(rsp); + rsp[1] = rsp[-3]; + rsp[2] = rsp[-2]; + rsp += 2; + break; + + case 57: + PushValSP(rsp, D_Integer); + PushValSP(rsp, (*ipc.opnd++)); + +//#line 79 "interp.r" + + rargp = (dptr)(rsp - 1) - 2; + xargp = rargp; + sp = rsp;; + +//#line 1432 "interp.r" + + ; + + signal = Ofield(2, rargp); + + goto C_rtn_term; + + case 58: + ipc.op[-1] = (95); + opnd = (*ipc.opnd++); + opnd += (word)ipc.opnd; + ipc.opnd[-1] = (opnd); + ipc.opnd = (word *)opnd; + break; + + case 95: + opnd = (*ipc.opnd++); + ipc.opnd = (word *)opnd; + break; + + case 59: + *--ipc.op = 58; + opnd = sizeof((*ipc.op)) + sizeof((*rsp)); + opnd += (word)ipc.opnd; + ipc.opnd = (word *)opnd; + break; + + case 63: + +//#line 79 "interp.r" + + rargp = (dptr)(rsp - 1) - 0; + xargp = rargp; + sp = rsp;; + +//#line 1459 "interp.r" + + ; + + if (Olimit(0, rargp) == A_Resume) { + +//#line 1468 "interp.r" + + goto efail_noev; + } + else { + +//#line 1476 "interp.r" + + rsp = (word *)rargp + 1; + } + goto mark0; + +//#line 1486 "interp.r" + + case 69: + PushNullSP(rsp); + break; + + case 70: + rsp -= 2; + break; + + case 73: + PushValSP(rsp, D_Integer); + PushValSP(rsp, 1); + break; + + case 74: + PushValSP(rsp, D_Integer); + PushValSP(rsp, -1); + break; + + case 76: + rsp += 2; + rsp[-1] = rsp[-3]; + rsp[0] = rsp[-2]; + break; + +//#line 1512 "interp.r" + + case 50: + +//#line 1515 "interp.r" + + PushNullSP(rsp); + +//#line 79 "interp.r" + + rargp = (dptr)(rsp - 1) - 0; + xargp = rargp; + sp = rsp;; + +//#line 1516 "interp.r" + + ; + opnd = (*ipc.opnd++); + opnd += (word)ipc.opnd; + + signal = Ocreate((word *)opnd, rargp); + + goto C_rtn_term; + +//#line 1528 "interp.r" + + case 47: { + +//#line 1534 "interp.r" + + struct b_coexpr *ncp; + dptr dp; + + sp = rsp;; + dp = (dptr)(sp - 1); + xargp = dp - 2; + + Deref(*dp); + if (dp->dword != D_Coexpr) { + err_msg(118, dp); + goto efail; + } + + ncp = (struct b_coexpr *)BlkLoc(*dp); + + signal = activate((dptr)(sp - 3), ncp, (dptr)(sp - 3)); + rsp = sp;; + if (signal == A_Resume) + goto efail_noev; + else + rsp -= 2; + + break; + } + + case 49: { + +//#line 1564 "interp.r" + + struct b_coexpr *ncp; + + sp = rsp;; + ncp = popact((struct b_coexpr *)BlkLoc(k_current)); + + ++BlkLoc(k_current)->coexpr.size; + co_chng(ncp, (dptr)&sp[-1], NULL, A_Coret, 1); + rsp = sp;; + + break; + } + +//#line 1577 "interp.r" + + case 48: { + +//#line 1582 "interp.r" + + struct b_coexpr *ncp; + + sp = rsp;; + ncp = popact((struct b_coexpr *)BlkLoc(k_current)); + + co_chng(ncp, NULL, NULL, A_Cofail, 1); + rsp = sp;; + + break; + } + + case 86: + +//#line 1596 "interp.r" + + goto interp_quit; + +//#line 1599 "interp.r" + + default: { + char buf[50]; + + sprintf(buf, "unimplemented opcode: %ld (0x%08x)\n", + (long)lastop, lastop); + syserr(buf); + } + } + continue; + + C_rtn_term: + rsp = sp;; + + switch (signal) { + + case A_Resume: + +//#line 1622 "interp.r" + + goto efail_noev; + + case A_Unmark_uw: + +//#line 1631 "interp.r" + + goto Unmark_uw; + + case A_Lsusp_uw: + +//#line 1640 "interp.r" + + goto Lsusp_uw; + + case A_Eret_uw: + +//#line 1649 "interp.r" + + goto Eret_uw; + + case A_Pret_uw: + +//#line 1658 "interp.r" + + goto Pret_uw; + + case A_Pfail_uw: + +//#line 1667 "interp.r" + + goto Pfail_uw; + } + + rsp = (word *)rargp + 1; + +//#line 1682 "interp.r" + + continue; + } + + interp_quit: + --ilevel; + if (ilevel != 0) + syserror("interp: termination with inactive generators."); + + return 0; + } + +} //cs --- extern "C" diff --git a/ipl/packs/loadfuncpp/xinterp64.cpp b/ipl/packs/loadfuncpp/xinterp64.cpp new file mode 100644 index 0000000..63ffe37 --- /dev/null +++ b/ipl/packs/loadfuncpp/xinterp64.cpp @@ -0,0 +1,1642 @@ +/* + * Tue Feb 12 18:19:56 2008 + * This file was produced by + * rtt: Icon Version 9.5.a-C, Autumn, 2007 + */ +//and then modified by cs + + +extern "C" { //cs + +#define COMPILER 0 +#include RTT + +//#line 8 "interp.r" + +extern fptr fncentry[]; + +//#line 22 "interp.r" + +//word lastop; +extern word lastop; //cs + +//#line 28 "interp.r" + +//struct ef_marker *efp; +extern struct ef_marker *efp; //cs +//struct gf_marker *gfp; +extern struct gf_marker *gfp; //cs +//inst ipc; +extern inst ipc; //cs +//word *sp = NULL; +extern word *sp; //cs + +//int ilevel; +extern int ilevel; //cs +//struct descrip value_tmp; +extern struct descrip value_tmp; //cs +//struct descrip eret_tmp; +extern struct descrip eret_tmp; //cs + +//int coexp_act; +extern int coexp_act; //cs + +//#line 40 "interp.r" + +//dptr xargp; +extern dptr xargp; //cs +//word xnargs; +extern word xnargs; //cs + +//#line 155 "interp.r" + +//int interp(fsig, cargp) +//int fsig; +//dptr cargp; +static int icall(dptr procptr, dptr arglistptr, dptr result) //cs + { + register word opnd; + register word *rsp; + register dptr rargp; + register struct ef_marker *newefp; + register struct gf_marker *newgfp; + register word *wd; + register word *firstwd, *lastwd; + word *oldsp; + int type, signal, args; +// extern int (*optab[])(); + extern int (*optab[])(dptr); //cs +// extern int (*keytab[])(); + extern int (*keytab[])(dptr); //cs + struct b_proc *bproc; + dptr lval; //cs + int fsig = 0; //cs + dptr cargp = (dptr)(sp+1); //cs + dptr return_cargp = cargp; //cs + word *saved_sp = sp; //cs + word *return_sp = sp + 2; //cs + + cargp[0] = *procptr; //cs + cargp[1] = *arglistptr; //cs + sp += 4; //cs + +//#line 189 "interp.r" + + if (BlkLoc(k_current) == BlkLoc(k_main) && + ((char *)sp + PerilDelta) > (char *)stackend) + fatalerr(301, NULL); + +//#line 195 "interp.r" + +#if GPX //cs + if (!pollctr--) { + pollctr = pollevent(); + if (pollctr == -1) fatalerr(141, NULL); + } +#endif + +//#line 201 "interp.r" + + ilevel++; + + rsp = sp;; + +//#line 215 "interp.r" + + if (fsig == G_Csusp) { + +//#line 218 "interp.r" + + oldsp = rsp; + +//#line 223 "interp.r" + + newgfp = (struct gf_marker *)(rsp + 1); + newgfp->gf_gentype = fsig; + newgfp->gf_gfp = gfp; + newgfp->gf_efp = efp; + newgfp->gf_ipc = ipc; + rsp += ((sizeof(struct gf_smallmarker) + sizeof(word) - 1) / sizeof(word)); + +//#line 235 "interp.r" + + if (gfp != 0) { + if (gfp->gf_gentype == G_Psusp) + firstwd = (word *)gfp + ((sizeof((*gfp)) + sizeof(word) - 1) / sizeof(word)); + else + firstwd = (word *)gfp + ((sizeof(struct gf_smallmarker) + sizeof(word) - 1) / sizeof(word)); + } + else + firstwd = (word *)efp + ((sizeof((*efp)) + sizeof(word) - 1) / sizeof(word)); + lastwd = (word *)cargp + 1; + +//#line 249 "interp.r" + + for (wd = firstwd; wd <= lastwd; wd++) + *++rsp = *wd; + gfp = newgfp; + } + +//#line 257 "interp.r" + + goto apply; //cs + + for (; ; ) { + +//#line 330 "interp.r" + + lastop = (word)(*ipc.op++); + + if( rsp < return_sp ) //cs + syserror("loadfuncpp: call of Icon from C++ must return a value, yet failed instead"); + +//#line 348 "interp.r" + + switch ((int)lastop) { + +//#line 359 "interp.r" + + case 51: + ipc.op[-1] = (90); + PushValSP(rsp, D_Cset); + opnd = (*ipc.opnd++); + opnd += (word)ipc.opnd; + ipc.opnd[-1] = (opnd); + PushValSP(rsp, opnd); + break; + + case 90: + PushValSP(rsp, D_Cset); + PushValSP(rsp, (*ipc.opnd++)); + break; + + case 60: + PushValSP(rsp, D_Integer); + PushValSP(rsp, (*ipc.opnd++)); + break; + + case 75: + ipc.op[-1] = (91); + PushValSP(rsp, D_Real); + opnd = (*ipc.opnd++); + opnd += (word)ipc.opnd; + PushValSP(rsp, opnd); + ipc.opnd[-1] = (opnd); + break; + + case 91: + PushValSP(rsp, D_Real); + PushValSP(rsp, (*ipc.opnd++)); + break; + + case 77: + ipc.op[-1] = (92); + PushValSP(rsp, (*ipc.opnd++)); + opnd = (word)strcons + (*ipc.opnd++); + ipc.opnd[-1] = (opnd); + PushValSP(rsp, opnd); + break; + + case 92: + PushValSP(rsp, (*ipc.opnd++)); + PushValSP(rsp, (*ipc.opnd++)); + break; + +//#line 407 "interp.r" + + case 81: + PushValSP(rsp, D_Var); + PushValSP(rsp, &glbl_argp[(*ipc.opnd++) + 1]); + break; + + case 84: + ipc.op[-1] = (93); + PushValSP(rsp, D_Var); + opnd = (*ipc.opnd++); + PushValSP(rsp, &globals[opnd]); + ipc.opnd[-1] = ((word)&globals[opnd]); + break; + + case 93: + PushValSP(rsp, D_Var); + PushValSP(rsp, (*ipc.opnd++)); + break; + + case 83: + PushValSP(rsp, D_Var); + PushValSP(rsp, &pfp->pf_locals[(*ipc.opnd++)]); + break; + + case 82: + ipc.op[-1] = (94); + PushValSP(rsp, D_Var); + opnd = (*ipc.opnd++); + PushValSP(rsp, &statics[opnd]); + ipc.opnd[-1] = ((word)&statics[opnd]); + break; + + case 94: + PushValSP(rsp, D_Var); + PushValSP(rsp, (*ipc.opnd++)); + break; + +//#line 448 "interp.r" + + case 4: + case 19: + case 23: + case 34: + case 37: + +//#line 65 "interp.r" + + rargp = (dptr)(rsp - 1) - 1; + xargp = rargp; + sp = rsp;; + +//#line 453 "interp.r" + + ; + Deref(rargp[1]); + +//#line 85 "interp.r" + + if ((*(optab[lastop]))(rargp) == A_Resume) { + +//#line 89 "interp.r" + + goto efail_noev; + } + rsp = (word *)rargp + 1; + +//#line 95 "interp.r" + + break; + +//#line 455 "interp.r" + + ; + + case 43: + +//#line 65 "interp.r" + + rargp = (dptr)(rsp - 1) - 1; + xargp = rargp; + sp = rsp;; + +//#line 458 "interp.r" + + ; + Deref(rargp[1]); + +//#line 85 "interp.r" + + if ((*(optab[lastop]))(rargp) == A_Resume) { + +//#line 89 "interp.r" + + goto efail_noev; + } + rsp = (word *)rargp + 1; + +//#line 95 "interp.r" + + break; + +//#line 460 "interp.r" + + ; + + case 21: + case 22: + +//#line 65 "interp.r" + + rargp = (dptr)(rsp - 1) - 1; + xargp = rargp; + sp = rsp;; + +//#line 464 "interp.r" + + ; + +//#line 85 "interp.r" + + if ((*(optab[lastop]))(rargp) == A_Resume) { + +//#line 89 "interp.r" + + goto efail_noev; + } + rsp = (word *)rargp + 1; + +//#line 95 "interp.r" + + break; + +//#line 465 "interp.r" + + ; + + case 32: + PushNullSP(rsp); + +//#line 65 "interp.r" + + rargp = (dptr)(rsp - 1) - 2; + xargp = rargp; + sp = rsp;; + +//#line 85 "interp.r" + + if ((*(optab[lastop]))(rargp) == A_Resume) { + +//#line 89 "interp.r" + + goto efail_noev; + } + rsp = (word *)rargp + 1; + +//#line 95 "interp.r" + + break; + +//#line 474 "interp.r" + + case 40: + +//#line 65 "interp.r" + + rargp = (dptr)(rsp - 1) - 1; + xargp = rargp; + sp = rsp;; + +//#line 475 "interp.r" + + ; + Deref(rargp[1]); + +//#line 105 "interp.r" + + signal = (*(optab[lastop]))(rargp); + goto C_rtn_term; + +//#line 477 "interp.r" + + ; + + case 2: + PushNullSP(rsp); + +//#line 65 "interp.r" + + rargp = (dptr)(rsp - 1) - 2; + xargp = rargp; + sp = rsp;; + +//#line 481 "interp.r" + + ; + +//#line 105 "interp.r" + + signal = (*(optab[lastop]))(rargp); + goto C_rtn_term; + +//#line 482 "interp.r" + + ; + +//#line 486 "interp.r" + + case 3: + case 5: + case 6: + case 8: + case 9: + case 16: + case 17: + case 18: + case 31: + case 42: + case 30: + case 7: + case 10: + case 11: + case 12: + case 13: + case 14: + case 15: + case 20: + case 24: + case 25: + case 26: + case 27: + case 29: + case 28: + +//#line 65 "interp.r" + + rargp = (dptr)(rsp - 1) - 2; + xargp = rargp; + sp = rsp;; + +//#line 511 "interp.r" + + ; + Deref(rargp[1]); + Deref(rargp[2]); + +//#line 85 "interp.r" + + if ((*(optab[lastop]))(rargp) == A_Resume) { + +//#line 89 "interp.r" + + goto efail_noev; + } + rsp = (word *)rargp + 1; + +//#line 95 "interp.r" + + break; + +//#line 514 "interp.r" + + ; + + case 1: + +//#line 65 "interp.r" + + rargp = (dptr)(rsp - 1) - 2; + xargp = rargp; + sp = rsp;; + +//#line 517 "interp.r" + + ; + +//#line 85 "interp.r" + + if ((*(optab[lastop]))(rargp) == A_Resume) { + +//#line 89 "interp.r" + + goto efail_noev; + } + rsp = (word *)rargp + 1; + +//#line 95 "interp.r" + + break; + +//#line 518 "interp.r" + + ; + + case 39: + PushNullSP(rsp); + +//#line 65 "interp.r" + + rargp = (dptr)(rsp - 1) - 3; + xargp = rargp; + sp = rsp;; + +//#line 522 "interp.r" + + ; + +//#line 85 "interp.r" + + if ((*(optab[lastop]))(rargp) == A_Resume) { + +//#line 89 "interp.r" + + goto efail_noev; + } + rsp = (word *)rargp + 1; + +//#line 95 "interp.r" + + break; + +//#line 523 "interp.r" + + ; + + case 38: + PushNullSP(rsp); + +//#line 65 "interp.r" + + rargp = (dptr)(rsp - 1) - 3; + xargp = rargp; + sp = rsp;; + +//#line 527 "interp.r" + + ; + +//#line 85 "interp.r" + + if ((*(optab[lastop]))(rargp) == A_Resume) { + +//#line 89 "interp.r" + + goto efail_noev; + } + rsp = (word *)rargp + 1; + +//#line 95 "interp.r" + + break; + +//#line 528 "interp.r" + + ; + +//#line 531 "interp.r" + + case 33: + +//#line 65 "interp.r" + + rargp = (dptr)(rsp - 1) - 2; + xargp = rargp; + sp = rsp;; + +//#line 532 "interp.r" + + ; + +//#line 105 "interp.r" + + signal = (*(optab[lastop]))(rargp); + goto C_rtn_term; + +//#line 533 "interp.r" + + ; + + case 35: + PushNullSP(rsp); + +//#line 65 "interp.r" + + rargp = (dptr)(rsp - 1) - 3; + xargp = rargp; + sp = rsp;; + +//#line 537 "interp.r" + + ; + +//#line 105 "interp.r" + + signal = (*(optab[lastop]))(rargp); + goto C_rtn_term; + +//#line 538 "interp.r" + + ; + +//#line 542 "interp.r" + + case 36: + PushNullSP(rsp); + +//#line 65 "interp.r" + + rargp = (dptr)(rsp - 1) - 4; + xargp = rargp; + sp = rsp;; + +//#line 544 "interp.r" + + ; + +//#line 85 "interp.r" + + if ((*(optab[lastop]))(rargp) == A_Resume) { + +//#line 89 "interp.r" + + goto efail_noev; + } + rsp = (word *)rargp + 1; + +//#line 95 "interp.r" + + break; + +//#line 545 "interp.r" + + ; + +//#line 548 "interp.r" + + case 41: + +//#line 65 "interp.r" + + rargp = (dptr)(rsp - 1) - 3; + xargp = rargp; + sp = rsp;; + +//#line 549 "interp.r" + + ; + Deref(rargp[1]); + Deref(rargp[2]); + Deref(rargp[3]); + +//#line 105 "interp.r" + + signal = (*(optab[lastop]))(rargp); + goto C_rtn_term; + +//#line 553 "interp.r" + + ; + + case 98: + +//#line 559 "interp.r" + +#if GPX //cs + if (!pollctr--) { + sp = rsp;; + pollctr = pollevent(); + rsp = sp;; + if (pollctr == -1) fatalerr(141, NULL); + } +#endif + +//#line 570 "interp.r" + + break; + +//#line 573 "interp.r" + + case 108: + { + +//#line 583 "interp.r" + + break; + } + + case 64: + +//#line 590 "interp.r" + +#if GPX //cs + if (!pollctr--) { + sp = rsp;; + pollctr = pollevent(); + rsp = sp;; + if (pollctr == -1) fatalerr(141, NULL); + } +#endif + +//#line 606 "interp.r" + + break; + +//#line 610 "interp.r" + + case 44: + PushDescSP(rsp, k_subject); + PushValSP(rsp, D_Integer); + PushValSP(rsp, k_pos); + +//#line 79 "interp.r" + + rargp = (dptr)(rsp - 1) - 2; + xargp = rargp; + sp = rsp;; + +//#line 614 "interp.r" + + ; + + signal = Obscan(2, rargp); + + goto C_rtn_term; + + case 55: + +//#line 79 "interp.r" + + rargp = (dptr)(rsp - 1) - 1; + xargp = rargp; + sp = rsp;; + +//#line 621 "interp.r" + + ; + + signal = Oescan(1, rargp); + + goto C_rtn_term; + +//#line 629 "interp.r" + + case 89: { + apply: //cs + union block *bp; + int i, j; + + value_tmp = *(dptr)(rsp - 1); + Deref(value_tmp); + switch (Type(value_tmp)) { + case T_List: { + rsp -= 2; + bp = BlkLoc(value_tmp); + args = (int)bp->list.size; + +//#line 647 "interp.r" + + if (BlkLoc(k_current) == BlkLoc(k_main) && + ((char *)sp + args * sizeof(struct descrip) > + (char *)stackend)) + fatalerr(301, NULL); + +//#line 653 "interp.r" + + for (bp = bp->list.listhead; + +//#line 657 "interp.r" + + bp != NULL; + + bp = bp->lelem.listnext) { + for (i = 0; i < bp->lelem.nused; i++) { + j = bp->lelem.first + i; + if (j >= bp->lelem.nslots) + j -= bp->lelem.nslots; + PushDescSP(rsp, bp->lelem.lslots[j]); + } + } + goto invokej; + } + + case T_Record: { + rsp -= 2; + bp = BlkLoc(value_tmp); + args = bp->record.recdesc->proc.nfields; + for (i = 0; i < args; i++) { + PushDescSP(rsp, bp->record.fields[i]); + } + goto invokej; + } + + default: { + + xargp = (dptr)(rsp - 3); + err_msg(126, &value_tmp); + goto efail; + } + } + } + + case 61: { + args = (int)(*ipc.opnd++); + invokej: + { + int nargs; + dptr carg; + + sp = rsp;; + type = invoke(args, &carg, &nargs); + rsp = sp;; + + if (type == I_Fail) + goto efail_noev; + if (type == I_Continue) + break; + else { + + rargp = carg; + +//#line 712 "interp.r" + +#if GPX //cs + pollctr >>= 1; + if (!pollctr) { + sp = rsp;; + pollctr = pollevent(); + rsp = sp;; + if (pollctr == -1) fatalerr(141, NULL); + } +#endif + +//#line 726 "interp.r" + + bproc = (struct b_proc *)BlkLoc(*rargp); + +//#line 734 "interp.r" + + if (type == I_Vararg) { +// int (*bfunc)(); + int (*bfunc)(int, dptr); //cs +// bfunc = bproc->entryp.ccode; + bfunc = (int (*)(int,dptr))(bproc->entryp.ccode); + +//#line 741 "interp.r" + + signal = (*bfunc)(nargs, rargp); + } + else + +//#line 746 "interp.r" + + { +// int (*bfunc)(); + int (*bfunc)(dptr); +// bfunc = bproc->entryp.ccode; + bfunc = (int (*)(dptr))(bproc->entryp.ccode); + +//#line 753 "interp.r" + + signal = (*bfunc)(rargp); + } + +//#line 767 "interp.r" + + goto C_rtn_term; + } + } + } + + case 62: + + PushNullSP(rsp); + opnd = (*ipc.opnd++); + +//#line 79 "interp.r" + + rargp = (dptr)(rsp - 1) - 0; + xargp = rargp; + sp = rsp;; + +//#line 776 "interp.r" + + ; + + signal = (*(keytab[(int)opnd]))(rargp); + goto C_rtn_term; + + case 65: + opnd = (*ipc.opnd++); + +//#line 79 "interp.r" + + rargp = (dptr)(rsp - 1) - opnd; + xargp = rargp; + sp = rsp;; + +//#line 793 "interp.r" + + ; + +//#line 796 "interp.r" + + { + int i; + for (i = 1; i <= opnd; i++) + Deref(rargp[i]); + } + + signal = Ollist((int)opnd, rargp); + + goto C_rtn_term; + +//#line 808 "interp.r" + + case 67: + ipc.op[-1] = (96); + opnd = (*ipc.opnd++); + opnd += (word)ipc.opnd; + ipc.opnd[-1] = (opnd); + newefp = (struct ef_marker *)(rsp + 1); + newefp->ef_failure.opnd = (word *)opnd; + goto mark; + + case 96: + newefp = (struct ef_marker *)(rsp + 1); + newefp->ef_failure.opnd = (word *)(*ipc.opnd++); + mark: + newefp->ef_gfp = gfp; + newefp->ef_efp = efp; + newefp->ef_ilevel = ilevel; + rsp += ((sizeof((*efp)) + sizeof(word) - 1) / sizeof(word)); + efp = newefp; + gfp = 0; + break; + + case 85: + mark0: + newefp = (struct ef_marker *)(rsp + 1); + newefp->ef_failure.opnd = 0; + newefp->ef_gfp = gfp; + newefp->ef_efp = efp; + newefp->ef_ilevel = ilevel; + rsp += ((sizeof((*efp)) + sizeof(word) - 1) / sizeof(word)); + efp = newefp; + gfp = 0; + break; + + case 78: + +//#line 849 "interp.r" + + gfp = efp->ef_gfp; + rsp = (word *)efp - 1; + +//#line 855 "interp.r" + + Unmark_uw: + if (efp->ef_ilevel < ilevel) { + --ilevel; + + sp = rsp;; + +//#line 866 "interp.r" + + return A_Unmark_uw; + } + + efp = efp->ef_efp; + break; + +//#line 874 "interp.r" + + case 56: { + +//#line 879 "interp.r" + + oldsp = rsp; + newgfp = (struct gf_marker *)(rsp + 1); + newgfp->gf_gentype = G_Esusp; + newgfp->gf_gfp = gfp; + newgfp->gf_efp = efp; + newgfp->gf_ipc = ipc; + gfp = newgfp; + rsp += ((sizeof(struct gf_smallmarker) + sizeof(word) - 1) / sizeof(word)); + +//#line 892 "interp.r" + + if (efp->ef_gfp != 0) { + newgfp = (struct gf_marker *)(efp->ef_gfp); + if (newgfp->gf_gentype == G_Psusp) + firstwd = (word *)efp->ef_gfp + ((sizeof((*gfp)) + sizeof(word) - 1) / sizeof(word)); + else + firstwd = (word *)efp->ef_gfp + + ((sizeof(struct gf_smallmarker) + sizeof(word) - 1) / sizeof(word)); + } + else + firstwd = (word *)efp->ef_efp + ((sizeof((*efp)) + sizeof(word) - 1) / sizeof(word)); + lastwd = (word *)efp - 1; + efp = efp->ef_efp; + +//#line 909 "interp.r" + + for (wd = firstwd; wd <= lastwd; wd++) + *++rsp = *wd; + PushValSP(rsp, oldsp[-1]); + PushValSP(rsp, oldsp[0]); + break; + } + + case 66: { + struct descrip sval; + +//#line 924 "interp.r" + +// dptr lval = (dptr)((word *)efp - 2); + lval = (dptr)((word *)efp - 2); //cs + +//#line 929 "interp.r" + + if (--IntVal(*lval) > 0) { + +//#line 934 "interp.r" + + sval = *(dptr)(rsp - 1); + +//#line 941 "interp.r" + + if (efp->ef_gfp != 0) { + newgfp = (struct gf_marker *)(efp->ef_gfp); + if (newgfp->gf_gentype == G_Psusp) + firstwd = (word *)efp->ef_gfp + ((sizeof((*gfp)) + sizeof(word) - 1) / sizeof(word)); + else + firstwd = (word *)efp->ef_gfp + + ((sizeof(struct gf_smallmarker) + sizeof(word) - 1) / sizeof(word)); + } + else + firstwd = (word *)efp->ef_efp + ((sizeof((*efp)) + sizeof(word) - 1) / sizeof(word)); + lastwd = (word *)efp - 3; + if (gfp == 0) + gfp = efp->ef_gfp; + efp = efp->ef_efp; + +//#line 960 "interp.r" + + rsp -= 2; + for (wd = firstwd; wd <= lastwd; wd++) + *++rsp = *wd; + PushDescSP(rsp, sval); + } + else { + +//#line 973 "interp.r" + + *lval = *(dptr)(rsp - 1); + +//#line 981 "interp.r" + + gfp = efp->ef_gfp; + +//#line 987 "interp.r" + + Lsusp_uw: + if (efp->ef_ilevel < ilevel) { + --ilevel; + sp = rsp;; + +//#line 997 "interp.r" + + return A_Lsusp_uw; + } + rsp = (word *)efp - 1; + efp = efp->ef_efp; + } + break; + } + + case 72: { + +//#line 1015 "interp.r" + + struct descrip tmp; + dptr svalp; + struct b_proc *sproc; + +//#line 1025 "interp.r" + + svalp = (dptr)(rsp - 1); + if (Var(*svalp)) { + sp = rsp;; + retderef(svalp, (word *)glbl_argp, sp); + rsp = sp;; + } + +//#line 1035 "interp.r" + + oldsp = rsp; + newgfp = (struct gf_marker *)(rsp + 1); + newgfp->gf_gentype = G_Psusp; + newgfp->gf_gfp = gfp; + newgfp->gf_efp = efp; + newgfp->gf_ipc = ipc; + newgfp->gf_argp = glbl_argp; + newgfp->gf_pfp = pfp; + gfp = newgfp; + rsp += ((sizeof((*gfp)) + sizeof(word) - 1) / sizeof(word)); + +//#line 1051 "interp.r" + + if (pfp->pf_gfp != 0) { + newgfp = (struct gf_marker *)(pfp->pf_gfp); + if (newgfp->gf_gentype == G_Psusp) + firstwd = (word *)pfp->pf_gfp + ((sizeof((*gfp)) + sizeof(word) - 1) / sizeof(word)); + else + firstwd = (word *)pfp->pf_gfp + + ((sizeof(struct gf_smallmarker) + sizeof(word) - 1) / sizeof(word)); + } + else + firstwd = (word *)pfp->pf_efp + ((sizeof((*efp)) + sizeof(word) - 1) / sizeof(word)); + lastwd = (word *)glbl_argp - 1; + efp = efp->ef_efp; + +//#line 1068 "interp.r" + + for (wd = firstwd; wd <= lastwd; wd++) + *++rsp = *wd; + PushValSP(rsp, oldsp[-1]); + PushValSP(rsp, oldsp[0]); + --k_level; + if (k_trace) { + k_trace--; + sproc = (struct b_proc *)BlkLoc(*glbl_argp); + strace(&(sproc->pname), svalp); + } + +//#line 1083 "interp.r" + + if (pfp->pf_scan != NULL) { + +//#line 1089 "interp.r" + + tmp = k_subject; + k_subject = *pfp->pf_scan; + *pfp->pf_scan = tmp; + + tmp = *(pfp->pf_scan + 1); + IntVal(*(pfp->pf_scan + 1)) = k_pos; + k_pos = IntVal(tmp); + } + +//#line 1106 "interp.r" + + efp = pfp->pf_efp; + ipc = pfp->pf_ipc; + glbl_argp = pfp->pf_argp; + pfp = pfp->pf_pfp; + break; + } + +//#line 1115 "interp.r" + + case 54: { + +//#line 1124 "interp.r" + + eret_tmp = *(dptr)&rsp[-1]; + gfp = efp->ef_gfp; + Eret_uw: + +//#line 1131 "interp.r" + + if (efp->ef_ilevel < ilevel) { + --ilevel; + sp = rsp;; + +//#line 1140 "interp.r" + + return A_Eret_uw; + } + rsp = (word *)efp - 1; + efp = efp->ef_efp; + PushDescSP(rsp, eret_tmp); + break; + } + +//#line 1149 "interp.r" + + case 71: { + +//#line 1163 "interp.r" + + struct b_proc *rproc; + rproc = (struct b_proc *)BlkLoc(*glbl_argp); + +//#line 1173 "interp.r" + + *glbl_argp = *(dptr)(rsp - 1); + if (Var(*glbl_argp)) { + sp = rsp;; + retderef(glbl_argp, (word *)glbl_argp, sp); + rsp = sp;; + } + + --k_level; + if (k_trace) { + k_trace--; + rtrace(&(rproc->pname), glbl_argp); + } + Pret_uw: + if (pfp->pf_ilevel < ilevel) { + --ilevel; + sp = rsp;; + +//#line 1196 "interp.r" + + return A_Pret_uw; + } + +//#line 1203 "interp.r" + + rsp = (word *)glbl_argp + 1; + efp = pfp->pf_efp; + gfp = pfp->pf_gfp; + ipc = pfp->pf_ipc; + glbl_argp = pfp->pf_argp; + pfp = pfp->pf_pfp; + +//#line 1219 "interp.r" + +//cs return to C++ + if( rsp == return_sp ) { + //printf("Op_Pret caused a return to C++\n");fflush(stdout); + --ilevel; + *result = *return_cargp; + sp = saved_sp; + return 0; + } +//cs end return to C++ + break; + } + +//#line 1224 "interp.r" + + case 53: + efail: + +//#line 1229 "interp.r" + + efail_noev: + +//#line 1233 "interp.r" + + if (gfp == 0) { + +//#line 1251 "interp.r" + + ipc = efp->ef_failure; + gfp = efp->ef_gfp; + rsp = (word *)efp - 1; + efp = efp->ef_efp; + + if (ipc.op == 0) + goto efail; + break; + } + else + { + +//#line 1267 "interp.r" + + struct descrip tmp; + register struct gf_marker *resgfp = gfp; + + type = (int)resgfp->gf_gentype; + + if (type == G_Psusp) { + glbl_argp = resgfp->gf_argp; + if (k_trace) { + k_trace--; + sp = rsp;; + atrace(&(((struct b_proc *)BlkLoc(*glbl_argp))->pname)); + rsp = sp;; + } + } + ipc = resgfp->gf_ipc; + efp = resgfp->gf_efp; + gfp = resgfp->gf_gfp; + rsp = (word *)resgfp - 1; + if (type == G_Psusp) { + pfp = resgfp->gf_pfp; + +//#line 1292 "interp.r" + + if (pfp->pf_scan != NULL) { + tmp = k_subject; + k_subject = *pfp->pf_scan; + *pfp->pf_scan = tmp; + + tmp = *(pfp->pf_scan + 1); + IntVal(*(pfp->pf_scan + 1)) = k_pos; + k_pos = IntVal(tmp); + } + +//#line 1313 "interp.r" + + ++k_level; + } + + switch (type) { + +//#line 1336 "interp.r" + + case G_Csusp: + ; + --ilevel; + sp = rsp;; + +//#line 1344 "interp.r" + + return A_Resume; + + case G_Esusp: + ; + goto efail_noev; + + case G_Psusp: + ; + break; + } + + break; + } + + case 68: { + +//#line 1374 "interp.r" + + --k_level; + if (k_trace) { + k_trace--; + failtrace(&(((struct b_proc *)BlkLoc(*glbl_argp))->pname)); + } + Pfail_uw: + + if (pfp->pf_ilevel < ilevel) { + --ilevel; + sp = rsp;; + +//#line 1388 "interp.r" + + return A_Pfail_uw; + } + efp = pfp->pf_efp; + gfp = pfp->pf_gfp; + ipc = pfp->pf_ipc; + glbl_argp = pfp->pf_argp; + pfp = pfp->pf_pfp; + +//#line 1406 "interp.r" + + goto efail_noev; + } + +//#line 1410 "interp.r" + + case 45: + PushNullSP(rsp); + PushValSP(rsp, ((word *)efp)[-2]); + PushValSP(rsp, ((word *)efp)[-1]); + break; + + case 46: + opnd = (*ipc.opnd++); + opnd += (word)ipc.opnd; + efp->ef_failure.opnd = (word *)opnd; + break; + + case 52: + PushNullSP(rsp); + rsp[1] = rsp[-3]; + rsp[2] = rsp[-2]; + rsp += 2; + break; + + case 57: + PushValSP(rsp, D_Integer); + PushValSP(rsp, (*ipc.opnd++)); + +//#line 79 "interp.r" + + rargp = (dptr)(rsp - 1) - 2; + xargp = rargp; + sp = rsp;; + +//#line 1432 "interp.r" + + ; + + signal = Ofield(2, rargp); + + goto C_rtn_term; + + case 58: + ipc.op[-1] = (95); + opnd = (*ipc.opnd++); + opnd += (word)ipc.opnd; + ipc.opnd[-1] = (opnd); + ipc.opnd = (word *)opnd; + break; + + case 95: + opnd = (*ipc.opnd++); + ipc.opnd = (word *)opnd; + break; + + case 59: + *--ipc.op = 58; + opnd = sizeof((*ipc.op)) + sizeof((*rsp)); + opnd += (word)ipc.opnd; + ipc.opnd = (word *)opnd; + break; + + case 63: + +//#line 79 "interp.r" + + rargp = (dptr)(rsp - 1) - 0; + xargp = rargp; + sp = rsp;; + +//#line 1459 "interp.r" + + ; + + if (Olimit(0, rargp) == A_Resume) { + +//#line 1468 "interp.r" + + goto efail_noev; + } + else { + +//#line 1476 "interp.r" + + rsp = (word *)rargp + 1; + } + goto mark0; + +//#line 1486 "interp.r" + + case 69: + PushNullSP(rsp); + break; + + case 70: + rsp -= 2; + break; + + case 73: + PushValSP(rsp, D_Integer); + PushValSP(rsp, 1); + break; + + case 74: + PushValSP(rsp, D_Integer); + PushValSP(rsp, -1); + break; + + case 76: + rsp += 2; + rsp[-1] = rsp[-3]; + rsp[0] = rsp[-2]; + break; + +//#line 1512 "interp.r" + + case 50: + +//#line 1515 "interp.r" + + PushNullSP(rsp); + +//#line 79 "interp.r" + + rargp = (dptr)(rsp - 1) - 0; + xargp = rargp; + sp = rsp;; + +//#line 1516 "interp.r" + + ; + opnd = (*ipc.opnd++); + opnd += (word)ipc.opnd; + + signal = Ocreate((word *)opnd, rargp); + + goto C_rtn_term; + +//#line 1528 "interp.r" + + case 47: { + +//#line 1534 "interp.r" + + struct b_coexpr *ncp; + dptr dp; + + sp = rsp;; + dp = (dptr)(sp - 1); + xargp = dp - 2; + + Deref(*dp); + if (dp->dword != D_Coexpr) { + err_msg(118, dp); + goto efail; + } + + ncp = (struct b_coexpr *)BlkLoc(*dp); + + signal = activate((dptr)(sp - 3), ncp, (dptr)(sp - 3)); + rsp = sp;; + if (signal == A_Resume) + goto efail_noev; + else + rsp -= 2; + + break; + } + + case 49: { + +//#line 1564 "interp.r" + + struct b_coexpr *ncp; + + sp = rsp;; + ncp = popact((struct b_coexpr *)BlkLoc(k_current)); + + ++BlkLoc(k_current)->coexpr.size; + co_chng(ncp, (dptr)&sp[-1], NULL, A_Coret, 1); + rsp = sp;; + + break; + } + +//#line 1577 "interp.r" + + case 48: { + +//#line 1582 "interp.r" + + struct b_coexpr *ncp; + + sp = rsp;; + ncp = popact((struct b_coexpr *)BlkLoc(k_current)); + + co_chng(ncp, NULL, NULL, A_Cofail, 1); + rsp = sp;; + + break; + } + + case 86: + +//#line 1596 "interp.r" + + goto interp_quit; + +//#line 1599 "interp.r" + + default: { + char buf[50]; + + sprintf(buf, "unimplemented opcode: %ld (0x%08x)\n", + (long)lastop, lastop); + syserr(buf); + } + } + continue; + + C_rtn_term: + rsp = sp;; + + switch (signal) { + + case A_Resume: + +//#line 1622 "interp.r" + + goto efail_noev; + + case A_Unmark_uw: + +//#line 1631 "interp.r" + + goto Unmark_uw; + + case A_Lsusp_uw: + +//#line 1640 "interp.r" + + goto Lsusp_uw; + + case A_Eret_uw: + +//#line 1649 "interp.r" + + goto Eret_uw; + + case A_Pret_uw: + +//#line 1658 "interp.r" + + goto Pret_uw; + + case A_Pfail_uw: + +//#line 1667 "interp.r" + + goto Pfail_uw; + } + + rsp = (word *)rargp + 1; + +//#line 1682 "interp.r" + + continue; + } + + interp_quit: + --ilevel; + if (ilevel != 0) + syserror("interp: termination with inactive generators."); + + return 0; + } + +} //cs --- extern "C" |