diff options
Diffstat (limited to 'ipl/packs/loadfuncpp')
87 files changed, 11801 insertions, 0 deletions
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" |