Data commit
This commit is contained in:
Ingy döt Net
parent
7387c8f97b
commit
cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
3
Task/Call-a-foreign-language-function/00-META.yaml
Normal file
3
Task/Call-a-foreign-language-function/00-META.yaml
Normal file
|
|
@ -0,0 +1,3 @@
|
|||
---
|
||||
from: http://rosettacode.org/wiki/Call_a_foreign-language_function
|
||||
note: Programming environment operations
|
||||
16
Task/Call-a-foreign-language-function/00-TASK.txt
Normal file
16
Task/Call-a-foreign-language-function/00-TASK.txt
Normal file
|
|
@ -0,0 +1,16 @@
|
|||
;Task:
|
||||
Show how a [[Foreign function interface|foreign language function]] can be called from the language.
|
||||
|
||||
|
||||
As an example, consider calling functions defined in the [[C]] language. Create a string containing "Hello World!" of the string type typical to the language. Pass the string content to [[C]]'s <code>strdup</code>. The content can be copied if necessary. Get the result from <code>strdup</code> and print it using language means. Do not forget to free the result of <code>strdup</code> (allocated in the heap).
|
||||
|
||||
|
||||
;Notes:
|
||||
* It is not mandated if the [[C]] run-time library is to be loaded statically or dynamically. You are free to use either way.
|
||||
* [[C++]] and [[C]] solutions can take some other language to communicate with.
|
||||
* It is ''not'' mandatory to use <code>strdup</code>, especially if the foreign function interface being demonstrated makes that uninformative.
|
||||
|
||||
|
||||
;See also:
|
||||
* [[Use another language to call a function]]
|
||||
<br><br>
|
||||
|
|
@ -0,0 +1,30 @@
|
|||
org &0000 ;execution resets here after the 68000 resets the Z80 and sends a bus request.
|
||||
jr start
|
||||
|
||||
org &0038 ;in IM 1 mode, we jump here for an IRQ. But this isn't being used for this example, so we'll just silently return.
|
||||
reti
|
||||
|
||||
org &0060
|
||||
start:
|
||||
DI
|
||||
IM 1
|
||||
LD SP,&2000
|
||||
|
||||
|
||||
main: ;hardware non-maskable interrupt (NMI) jumps here (address &0066)
|
||||
|
||||
ld a,(&1F00) ;we'll only allow the 68000 to alter the contents of this memory address.
|
||||
or a
|
||||
jr z,main ;just keep looping until it's nonzero.
|
||||
|
||||
;by counting the bytes each instruction takes, it can be proven that this label points to &006C.
|
||||
;The call opcode takes 1 byte and the operand that follows takes two bytes.
|
||||
|
||||
smc:
|
||||
call &0000 ;we'll overwrite the operand at &006D-&006E with whatever function we want to call.
|
||||
|
||||
done:
|
||||
jp done ;loop until next reset
|
||||
|
||||
ExampleFunction: ;ADDR: &0072($A00072)
|
||||
ret ;for simplicity this does nothing but in reality you'd have it do something sound-related here.
|
||||
|
|
@ -0,0 +1,16 @@
|
|||
Z80_Call:
|
||||
MOVE.W #$100,$A11100 ;write: z80 reset
|
||||
.wait:
|
||||
BTST #8,$A11100 ;read: check bit 8 to see if the z80 is busy
|
||||
BNE .wait ;loop until not busy
|
||||
|
||||
|
||||
;now we write the function address
|
||||
;z80 is little-endian so we need to reverse the byte order.
|
||||
;also 68000 cannot safely write words at odd addresses so we need to write as bytes.
|
||||
|
||||
MOVE.B #$72,$A0006D
|
||||
MOVE.B #$00,$A0006E ;this changes the "call &0000" above to "call ExampleFunction"
|
||||
|
||||
MOVE.B #$FF,$A01F01 ;unlock the semaphore
|
||||
MOVE.W #0,$A11100 ;Z80 Bus Request - after this write, the Z80 will start executing code.
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
\ tell 8th what the function expects:
|
||||
"ZZ" "strdup" func: strdup
|
||||
"VZ" "free" func: free
|
||||
\ call the external funcs
|
||||
"abc" dup \ now we have two strings "abc" on the stack
|
||||
strdup .s cr \ after strdup, you'll have the new (but duplicate) string on the stack
|
||||
\ the ".s" will show both strings and you can see they are different items on the stack
|
||||
free \ let the c library free the string
|
||||
|
|
@ -0,0 +1,67 @@
|
|||
BEGIN
|
||||
MODE PASSWD = STRUCT (STRING name, passwd, INT uid, gid, STRING gecos, dir, shell);
|
||||
PROC getpwnam = (STRING name) PASSWD :
|
||||
BEGIN
|
||||
FILE c source;
|
||||
create (c source, stand out channel);
|
||||
putf (c source, ($gl$,
|
||||
"#include <sys/types.h>",
|
||||
"#include <pwd.h>",
|
||||
"#include <stdio.h>",
|
||||
"main ()",
|
||||
"{",
|
||||
" char name[256];",
|
||||
" scanf (""%s"", name);",
|
||||
" struct passwd *pass = getpwnam (name);",
|
||||
" if (pass == (struct passwd *) NULL) {",
|
||||
" putchar ('\n');",
|
||||
" } else {",
|
||||
" printf (""%s\n"", pass->pw_name);",
|
||||
" printf (""%s\n"", pass->pw_passwd);",
|
||||
" printf (""%d\n"", pass->pw_uid);",
|
||||
" printf (""%d\n"", pass->pw_gid);",
|
||||
" printf (""%s\n"", pass->pw_gecos);",
|
||||
" printf (""%s\n"", pass->pw_dir);",
|
||||
" printf (""%s\n"", pass->pw_shell);",
|
||||
" }",
|
||||
"}"
|
||||
));
|
||||
STRING source name = idf (c source);
|
||||
STRING bin name = source name + ".bin";
|
||||
INT child pid = execve child ("/usr/bin/gcc",
|
||||
("gcc", "-x", "c", source name, "-o", bin name),
|
||||
"");
|
||||
wait pid (child pid);
|
||||
PIPE p = execve child pipe (bin name, "Ding dong, a68g calling", "");
|
||||
put (write OF p, (name, newline));
|
||||
STRING line;
|
||||
PASSWD result;
|
||||
IF get (read OF p, (line, newline)); line = ""
|
||||
THEN
|
||||
result := ("", "", -1, -1, "", "", "")
|
||||
CO
|
||||
Return to sender, address unknown.
|
||||
No such number, no such zone.
|
||||
CO
|
||||
ELSE
|
||||
name OF result := line;
|
||||
get (read OF p, (passwd OF result, newline));
|
||||
get (read OF p, (uid OF result, newline));
|
||||
get (read OF p, (gid OF result, newline));
|
||||
get (read OF p, (gecos OF result, newline));
|
||||
get (read OF p, (dir OF result, newline));
|
||||
get (read OF p, (shell OF result, newline))
|
||||
FI;
|
||||
close (write OF p); CO Sundry cleaning up. CO
|
||||
close (read OF p);
|
||||
execve child ("/bin/rm", ("rm", "-f", source name, bin name), "");
|
||||
result
|
||||
END;
|
||||
PASSWD mr root = getpwnam ("root");
|
||||
IF name OF mr root = ""
|
||||
THEN
|
||||
print (("Oh dear, we seem to be rootless.", newline))
|
||||
ELSE
|
||||
printf (($2(g,":"), 2(g(0),":"), 2(g,":"), gl$, mr root))
|
||||
FI
|
||||
END
|
||||
|
|
@ -0,0 +1,52 @@
|
|||
/* ARM assembly Raspberry PI */
|
||||
/* program forfunction.s */
|
||||
|
||||
/* Constantes */
|
||||
.equ STDOUT, 1 @ Linux output console
|
||||
.equ EXIT, 1 @ Linux syscall
|
||||
.equ WRITE, 4 @ Linux syscall
|
||||
/* Initialized data */
|
||||
.data
|
||||
szString: .asciz "Hello word\n"
|
||||
|
||||
/* UnInitialized data */
|
||||
.bss
|
||||
|
||||
/* code section */
|
||||
.text
|
||||
.global main
|
||||
main: @ entry of program
|
||||
push {fp,lr} @ saves registers
|
||||
|
||||
ldr r0,iAdrszString @ string address
|
||||
bl strdup @ call function C
|
||||
@ return new pointer
|
||||
bl affichageMess @ display dup string
|
||||
bl free @ free heap
|
||||
|
||||
100: @ standard end of the program */
|
||||
mov r0, #0 @ return code
|
||||
pop {fp,lr} @restaur 2 registers
|
||||
mov r7, #EXIT @ request to exit program
|
||||
swi 0 @ perform the system call
|
||||
iAdrszString: .int szString
|
||||
|
||||
/******************************************************************/
|
||||
/* display text with size calculation */
|
||||
/******************************************************************/
|
||||
/* r0 contains the address of the message */
|
||||
affichageMess:
|
||||
push {r0,r1,r2,r7,lr} @ save registres
|
||||
mov r2,#0 @ counter length
|
||||
1: @ loop length calculation
|
||||
ldrb r1,[r0,r2] @ read octet start position + index
|
||||
cmp r1,#0 @ if 0 its over
|
||||
addne r2,r2,#1 @ else add 1 in the length
|
||||
bne 1b @ and loop
|
||||
@ so here r2 contains the length of the message
|
||||
mov r1,r0 @ address message in r1
|
||||
mov r0,#STDOUT @ code to write to the standard output Linux
|
||||
mov r7, #WRITE @ code call system "write"
|
||||
svc #0 @ call systeme
|
||||
pop {r0,r1,r2,r7,lr} @ restaur des 2 registres */
|
||||
bx lr @ return
|
||||
|
|
@ -0,0 +1,15 @@
|
|||
with Ada.Text_IO; use Ada.Text_IO;
|
||||
with Interfaces.C; use Interfaces.C;
|
||||
with Interfaces.C.Strings; use Interfaces.C.Strings;
|
||||
|
||||
procedure Test_C_Interface is
|
||||
function strdup (s1 : Char_Array) return Chars_Ptr;
|
||||
pragma Import (C, strdup, "_strdup");
|
||||
|
||||
S1 : constant String := "Hello World!";
|
||||
S2 : Chars_Ptr;
|
||||
begin
|
||||
S2 := strdup (To_C (S1));
|
||||
Put_Line (Value (S2));
|
||||
Free (S2);
|
||||
end Test_C_Interface;
|
||||
|
|
@ -0,0 +1,13 @@
|
|||
#include <aikido.h>
|
||||
extern "C" { // need C linkage
|
||||
|
||||
// define the function using a macro defined in aikido.h
|
||||
AIKIDO_NATIVE(strdup) {
|
||||
aikido::string *s = paras[0].str;
|
||||
char *p = strdup (s->c_str());
|
||||
aikido::string *result = new aikido::string(p);
|
||||
free (p);
|
||||
return result;
|
||||
}
|
||||
|
||||
}
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
native function strdup(s)
|
||||
println (strdup ("Hello World!"))
|
||||
|
|
@ -0,0 +1,14 @@
|
|||
native function strdup (s) // declare native
|
||||
native function free(p) // also need to free the result
|
||||
|
||||
var s = strdup ("hello world\n")
|
||||
var p = s // this is an integer type
|
||||
for (;;) {
|
||||
var ch = peek (p, 1) // read a single character
|
||||
if (ch == 0) {
|
||||
break
|
||||
}
|
||||
print (cast<char>(ch)) // print as a character
|
||||
p++
|
||||
}
|
||||
free (s) // done with the memory now
|
||||
|
|
@ -0,0 +1,13 @@
|
|||
// compile with:
|
||||
// clang -c -w mylib.c
|
||||
// clang -shared -o libmylib.dylib mylib.o
|
||||
|
||||
#include <stdio.h>
|
||||
|
||||
void sayHello(char* name){
|
||||
printf("Hello %s!\n", name);
|
||||
}
|
||||
|
||||
int doubleNum(int num){
|
||||
return num * 2;
|
||||
}
|
||||
|
|
@ -0,0 +1,14 @@
|
|||
; call an external function directly
|
||||
call.external: "mylib" 'sayHello ["John"]
|
||||
|
||||
; map an external function to a native one
|
||||
doubleNum: function [num][
|
||||
ensure -> integer? num
|
||||
call .external: "mylib"
|
||||
.expect: :integer
|
||||
'doubleNum @[num]
|
||||
]
|
||||
|
||||
loop 1..3 'x [
|
||||
print ["The double of" x "is" doubleNum x]
|
||||
]
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
; Example: Calls the Windows API function "MessageBox" and report which button the user presses.
|
||||
|
||||
WhichButton := DllCall("MessageBox", "int", "0", "str", "Press Yes or No", "str", "Title of box", "int", 4)
|
||||
MsgBox You pressed button #%WhichButton%.
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
SYS "LoadLibrary", "MSVCRT.DLL" TO msvcrt%
|
||||
SYS "GetProcAddress", msvcrt%, "_strdup" TO `strdup`
|
||||
SYS "GetProcAddress", msvcrt%, "free" TO `free`
|
||||
|
||||
SYS `strdup`, "Hello World!" TO address%
|
||||
PRINT $$address%
|
||||
SYS `free`, address%
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
FUNCTION MULTIPLY(X, Y)
|
||||
DOUBLE PRECISION MULTIPLY, X, Y
|
||||
|
|
@ -0,0 +1,42 @@
|
|||
#include <cstdlib> // for C memory management
|
||||
#include <string> // for C++ strings
|
||||
#include <iostream> // for output
|
||||
|
||||
// C functions must be defined extern "C"
|
||||
extern "C" char* strdup1(char const*);
|
||||
|
||||
// Fortran functions must also be defined extern "C" to prevent name
|
||||
// mangling; in addition, all fortran names are converted to lowercase
|
||||
// and get an undescore appended. Fortran takes all arguments by
|
||||
// reference, which translates to pointers in C and C++ (C++
|
||||
// references generally work, too, but that may depend on the C++
|
||||
// compiler)
|
||||
extern "C" double multiply_(double* x, double* y);
|
||||
|
||||
// to simplify the use and reduce the probability of errors, a simple
|
||||
// inline forwarder like this can be used:
|
||||
inline double multiply(double x, double y)
|
||||
{
|
||||
return multiply_(&x, &y);
|
||||
}
|
||||
|
||||
int main()
|
||||
{
|
||||
std::string msg = "The product of 3 and 5 is ";
|
||||
|
||||
// call to C function (note that this should not be assigned
|
||||
// directly to a C++ string, because strdup1 allocates memory, and
|
||||
// we would leak the memory if we wouldn't save the pointer itself
|
||||
char* msg2 = strdup1(msg.c_str());
|
||||
|
||||
// C strings can be directly output to std::cout, so we don't need
|
||||
// to put it back into a string to output it.
|
||||
std::cout << msg2;
|
||||
|
||||
// call the FORTRAN function (through the wrapper):
|
||||
std::cout << multiply(3, 5) << std::endl;
|
||||
|
||||
// since strdup1 allocates with malloc, it must be deallocated with
|
||||
// free, not delete, nor delete[], nor operator delete
|
||||
std::free(msg2);
|
||||
}
|
||||
|
|
@ -0,0 +1,24 @@
|
|||
#include <stdlib.h>
|
||||
#include <stdio.h>
|
||||
|
||||
int main(int argc,char** argv) {
|
||||
|
||||
int arg1 = atoi(argv[1]), arg2 = atoi(argv[2]), sum, diff, product, quotient, remainder ;
|
||||
|
||||
__asm__ ( "addl %%ebx, %%eax;" : "=a" (sum) : "a" (arg1) , "b" (arg2) );
|
||||
__asm__ ( "subl %%ebx, %%eax;" : "=a" (diff) : "a" (arg1) , "b" (arg2) );
|
||||
__asm__ ( "imull %%ebx, %%eax;" : "=a" (product) : "a" (arg1) , "b" (arg2) );
|
||||
|
||||
__asm__ ( "movl $0x0, %%edx;"
|
||||
"movl %2, %%eax;"
|
||||
"movl %3, %%ebx;"
|
||||
"idivl %%ebx;" : "=a" (quotient), "=d" (remainder) : "g" (arg1), "g" (arg2) );
|
||||
|
||||
printf( "%d + %d = %d\n", arg1, arg2, sum );
|
||||
printf( "%d - %d = %d\n", arg1, arg2, diff );
|
||||
printf( "%d * %d = %d\n", arg1, arg2, product );
|
||||
printf( "%d / %d = %d\n", arg1, arg2, quotient );
|
||||
printf( "%d %% %d = %d\n", arg1, arg2, remainder );
|
||||
|
||||
return 0 ;
|
||||
}
|
||||
|
|
@ -0,0 +1,16 @@
|
|||
#include <python2.7/Python.h>
|
||||
|
||||
int main()
|
||||
{
|
||||
Py_Initialize();
|
||||
PyRun_SimpleString("a = [3*x for x in range(1,11)]");
|
||||
|
||||
PyRun_SimpleString("print 'First 10 multiples of 3 : ' + str(a)");
|
||||
|
||||
PyRun_SimpleString("print 'Last 5 multiples of 3 : ' + str(a[5:])");
|
||||
|
||||
PyRun_SimpleString("print 'First 10 multiples of 3 in reverse order : ' + str(a[::-1])");
|
||||
|
||||
Py_Finalize();
|
||||
return 0;
|
||||
}
|
||||
|
|
@ -0,0 +1,25 @@
|
|||
cmake_minimum_required(VERSION 2.6)
|
||||
project("outer project" C)
|
||||
|
||||
# Compile cmDIV.
|
||||
try_compile(
|
||||
compiled_div # result variable
|
||||
${CMAKE_BINARY_DIR}/div # bindir
|
||||
${CMAKE_SOURCE_DIR}/div # srcDir
|
||||
div) # projectName
|
||||
if(NOT compiled_div)
|
||||
message(FATAL_ERROR "Failed to compile cmDIV")
|
||||
endif()
|
||||
|
||||
# Load cmDIV.
|
||||
load_command(DIV ${CMAKE_BINARY_DIR}/div)
|
||||
if(NOT CMAKE_LOADED_COMMAND_DIV)
|
||||
message(FATAL_ERROR "Failed to load cmDIV")
|
||||
endif()
|
||||
|
||||
# Try div() command.
|
||||
div(quot rem 2012 500)
|
||||
message("
|
||||
2012 / 500 = ${quot}
|
||||
2012 % 500 = ${rem}
|
||||
")
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
cmake_minimum_required(VERSION 2.6)
|
||||
project(div C)
|
||||
|
||||
# Find cmCPluginAPI.h
|
||||
include_directories(${CMAKE_ROOT}/include)
|
||||
|
||||
# Compile cmDIV from div-command.c
|
||||
add_library(cmDIV MODULE div-command.c)
|
||||
|
|
@ -0,0 +1,55 @@
|
|||
#include <cmCPluginAPI.h>
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
|
||||
static cmCAPI *api;
|
||||
|
||||
/*
|
||||
* Respond to DIV(quotient remainder numerator denominator).
|
||||
*/
|
||||
static int
|
||||
initial_pass(void *info, void *mf, int argc, char *argv[])
|
||||
{
|
||||
div_t answer;
|
||||
int count, i, j, n[2];
|
||||
char buf[512], c;
|
||||
|
||||
if (argc != 4) {
|
||||
api->SetError(info, "Wrong number of arguments");
|
||||
return 0; /* failure */
|
||||
}
|
||||
|
||||
/* Parse numerator and denominator. */
|
||||
for(i = 2, j = 0; i < 4; i++, j++) {
|
||||
count = sscanf(argv[i], "%d%1s", &n[j], &c);
|
||||
if (count != 1) {
|
||||
snprintf(buf, sizeof buf,
|
||||
"Not an integer: %s", argv[i]);
|
||||
api->SetError(info, buf);
|
||||
return 0; /* failure */
|
||||
}
|
||||
}
|
||||
|
||||
/* Call div(). */
|
||||
if (n[1] == 0) {
|
||||
api->SetError(info, "Division by zero");
|
||||
return 0; /* failure */
|
||||
}
|
||||
answer = div(n[0], n[1]);
|
||||
|
||||
/* Set variables to answer. */
|
||||
snprintf(buf, sizeof buf, "%d", answer.quot);
|
||||
api->AddDefinition(mf, argv[0], buf);
|
||||
snprintf(buf, sizeof buf, "%d", answer.rem);
|
||||
api->AddDefinition(mf, argv[1], buf);
|
||||
|
||||
return 1; /* success */
|
||||
}
|
||||
|
||||
CM_PLUGIN_EXPORT void
|
||||
DIVInit(cmLoadedCommandInfo *info)
|
||||
{
|
||||
info->Name = "DIV";
|
||||
info->InitialPass = initial_pass;
|
||||
api = info->CAPI;
|
||||
}
|
||||
|
|
@ -0,0 +1,27 @@
|
|||
identification division.
|
||||
program-id. foreign.
|
||||
|
||||
data division.
|
||||
working-storage section.
|
||||
01 hello.
|
||||
05 value z"Hello, world".
|
||||
01 duplicate usage pointer.
|
||||
01 buffer pic x(16) based.
|
||||
01 storage pic x(16).
|
||||
|
||||
procedure division.
|
||||
call "strdup" using hello returning duplicate
|
||||
on exception
|
||||
display "error calling strdup" upon syserr
|
||||
end-call
|
||||
if duplicate equal null then
|
||||
display "strdup returned null" upon syserr
|
||||
else
|
||||
set address of buffer to duplicate
|
||||
string buffer delimited by low-value into storage
|
||||
display function trim(storage)
|
||||
call "free" using by value duplicate
|
||||
on exception
|
||||
display "error calling free" upon syserr
|
||||
end-if
|
||||
goback.
|
||||
|
|
@ -0,0 +1 @@
|
|||
(JNIDemo/callStrdup "Hello World!")
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
(require '[net.n01se.clojure-jna :as jna])
|
||||
|
||||
(jna/invoke Integer c/strcmp "apple" "banana" ) ; returns -1
|
||||
|
||||
(jna/invoke Integer c/strcmp "banana" "apple" ) ; returns 1
|
||||
|
||||
(jna/invoke Integer c/strcmp "banana" "banana" ) ; returns 0
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
CL-USER> (let* ((string "Hello World!")
|
||||
(c-string (cffi:foreign-funcall "strdup" :string string :pointer)))
|
||||
(unwind-protect (write-line (cffi:foreign-string-to-lisp c-string))
|
||||
(cffi:foreign-funcall "free" :pointer c-string :void))
|
||||
(values))
|
||||
Hello World!
|
||||
; No value
|
||||
|
|
@ -0,0 +1,12 @@
|
|||
@[Link("c")] # name of library that is passed to linker. Not needed as libc is linked by stdlib.
|
||||
lib LibC
|
||||
fun free(ptr : Void*) : Void
|
||||
fun strdup(ptr : Char*) : Char*
|
||||
end
|
||||
|
||||
s1 = "Hello World!"
|
||||
p = LibC.strdup(s1) # returns Char* allocated by LibC
|
||||
s2 = String.new(p)
|
||||
LibC.free p # pointer can be freed as String.new(Char*) makes a copy of data
|
||||
|
||||
puts s2
|
||||
|
|
@ -0,0 +1,36 @@
|
|||
import std.stdio: writeln;
|
||||
import std.string: toStringz;
|
||||
import std.conv: to;
|
||||
|
||||
extern(C) {
|
||||
char* strdup(in char* s1);
|
||||
void free(void* ptr);
|
||||
}
|
||||
|
||||
void main() {
|
||||
// We could use char* here (as in D string literals are
|
||||
// null-terminated) but we want to comply with the "of the
|
||||
// string type typical to the language" part.
|
||||
// Note: D supports 0-values inside a string, C doesn't.
|
||||
auto input = "Hello World!";
|
||||
|
||||
// Method 1 (preferred):
|
||||
// toStringz converts D strings to null-terminated C strings.
|
||||
char* str1 = strdup(toStringz(input));
|
||||
|
||||
// Method 2:
|
||||
// D strings are not null-terminated, so we append '\0'.
|
||||
// .ptr returns a pointer to the 1st element of the array,
|
||||
// just as &array[0]
|
||||
// This has to be done because D dynamic arrays are
|
||||
// represented with: { size_t length; T* pointer; }
|
||||
char* str2 = strdup((input ~ '\0').ptr);
|
||||
|
||||
// We could have just used printf here, but the task asks to
|
||||
// "print it using language means":
|
||||
writeln("str1: ", to!string(str1));
|
||||
writeln("str2: ", to!string(str2));
|
||||
|
||||
free(str1);
|
||||
free(str2);
|
||||
}
|
||||
|
|
@ -0,0 +1 @@
|
|||
{$O myhello.obj}
|
||||
|
|
@ -0,0 +1 @@
|
|||
procedure Hello(S: PChar); stdcall; external;
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
FUNCTION: char* strdup ( c-string s ) ;
|
||||
|
||||
: my-strdup ( str -- str' )
|
||||
strdup [ utf8 alien>string ] [ (free) ] bi ;
|
||||
|
|
@ -0,0 +1,23 @@
|
|||
c-library cstrings
|
||||
|
||||
\c #include <string.h>
|
||||
c-function strdup strdup a -- a ( c-string -- duped string )
|
||||
c-function strlen strlen a -- n ( c-string -- length )
|
||||
|
||||
end-c-library
|
||||
|
||||
\ convenience function (not used here)
|
||||
: c-string ( addr u -- addr' )
|
||||
tuck pad swap move pad + 0 swap c! pad ;
|
||||
|
||||
create test s" testing" mem, 0 c,
|
||||
|
||||
test strdup value duped
|
||||
|
||||
test .
|
||||
test 7 type \ testing
|
||||
cr
|
||||
duped . \ different address
|
||||
duped dup strlen type \ testing
|
||||
|
||||
duped free throw \ gforth ALLOCATE and FREE map directly to C's malloc() and free()
|
||||
|
|
@ -0,0 +1,45 @@
|
|||
module c_api
|
||||
use iso_c_binding
|
||||
implicit none
|
||||
|
||||
interface
|
||||
function strdup(ptr) bind(C)
|
||||
import c_ptr
|
||||
type(c_ptr), value :: ptr
|
||||
type(c_ptr) :: strdup
|
||||
end function
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine free(ptr) bind(C)
|
||||
import c_ptr
|
||||
type(c_ptr), value :: ptr
|
||||
end subroutine
|
||||
end interface
|
||||
|
||||
interface
|
||||
function puts(ptr) bind(C)
|
||||
import c_ptr, c_int
|
||||
type(c_ptr), value :: ptr
|
||||
integer(c_int) :: puts
|
||||
end function
|
||||
end interface
|
||||
end module
|
||||
|
||||
program c_example
|
||||
use c_api
|
||||
implicit none
|
||||
|
||||
character(20), target :: str = "Hello, World!" // c_null_char
|
||||
type(c_ptr) :: ptr
|
||||
integer(c_int) :: res
|
||||
|
||||
ptr = strdup(c_loc(str))
|
||||
|
||||
res = puts(c_loc(str))
|
||||
res = puts(ptr)
|
||||
|
||||
print *, transfer(c_loc(str), 0_c_intptr_t), &
|
||||
transfer(ptr, 0_c_intptr_t)
|
||||
call free(ptr)
|
||||
end program
|
||||
|
|
@ -0,0 +1,20 @@
|
|||
' FB 1.05.0 Win64
|
||||
|
||||
'Using StrDup function in Shlwapi.dll
|
||||
Dim As Any Ptr library = DyLibLoad("Shlwapi")
|
||||
Dim strdup As Function (ByVal As Const ZString Ptr) As ZString Ptr
|
||||
strdup = DyLibSymbol(library, "StrDupA")
|
||||
|
||||
'Using LocalFree function in kernel32.dll
|
||||
Dim As Any Ptr library2 = DyLibLoad("kernel32")
|
||||
Dim localfree As Function (ByVal As Any Ptr) As Any Ptr
|
||||
localfree = DyLibSymbol(library2, "LocalFree")
|
||||
|
||||
Dim As ZString * 10 z = "duplicate" '' 10 characters including final zero byte
|
||||
Dim As Zstring Ptr pcz = strdup(@z) '' pointer to the duplicate string
|
||||
Print *pcz '' print duplicate string by dereferencing pointer
|
||||
localfree(pcz) '' free the memory which StrDup allocated internally
|
||||
pcz = 0 '' set pointer to null
|
||||
DyLibFree(library) '' unload first dll
|
||||
DyLibFree(library2) '' unload second fll
|
||||
End
|
||||
|
|
@ -0,0 +1,20 @@
|
|||
include "NSLog.incl"
|
||||
|
||||
BeginCDeclaration
|
||||
char *strdup(const char *src);
|
||||
EndC
|
||||
|
||||
BeginCFunction
|
||||
char *strdup(const char *src) {
|
||||
char *dst = malloc(strlen (src) + 1); // Space for length plus null
|
||||
if (dst == NULL) return NULL; // No memory
|
||||
strcpy(dst, src); // Copy the characters
|
||||
return dst; // Return the new string
|
||||
}
|
||||
EndC
|
||||
|
||||
BeginCCode
|
||||
NSLog( @"%s", strdup( "Hello, World!" ) );
|
||||
EndC
|
||||
|
||||
HandleEvents
|
||||
|
|
@ -0,0 +1,28 @@
|
|||
package main
|
||||
|
||||
// #include <string.h>
|
||||
// #include <stdlib.h>
|
||||
import "C"
|
||||
import (
|
||||
"fmt"
|
||||
"unsafe"
|
||||
)
|
||||
|
||||
func main() {
|
||||
// a go string
|
||||
go1 := "hello C"
|
||||
// allocate in C and convert from Go representation to C representation
|
||||
c1 := C.CString(go1)
|
||||
// go string can now be garbage collected
|
||||
go1 = ""
|
||||
// strdup, per task. this calls the function in the C library.
|
||||
c2 := C.strdup(c1)
|
||||
// free the source C string. again, this is free() in the C library.
|
||||
C.free(unsafe.Pointer(c1))
|
||||
// create a new Go string from the C copy
|
||||
go2 := C.GoString(c2)
|
||||
// free the C copy
|
||||
C.free(unsafe.Pointer(c2))
|
||||
// demonstrate we have string contents intact
|
||||
fmt.Println(go2)
|
||||
}
|
||||
|
|
@ -0,0 +1,16 @@
|
|||
// hare run -lc ffi.ha
|
||||
|
||||
use fmt;
|
||||
use strings;
|
||||
|
||||
@symbol("strdup") fn cstrdup(_: *const char) *char;
|
||||
@symbol("free") fn cfree(_: nullable *void) void;
|
||||
|
||||
export fn main() void = {
|
||||
let s = strings::to_c("Hello, World!");
|
||||
defer free(s);
|
||||
|
||||
let dup = cstrdup(s);
|
||||
fmt::printfln("{}", strings::fromc(dup))!;
|
||||
cfree(dup);
|
||||
};
|
||||
|
|
@ -0,0 +1,15 @@
|
|||
{-# LANGUAGE ForeignFunctionInterface #-}
|
||||
|
||||
import Foreign (free)
|
||||
import Foreign.C.String (CString, withCString, peekCString)
|
||||
|
||||
-- import the strdup function itself
|
||||
-- the "unsafe" means "assume this foreign function never calls back into Haskell and avoid extra bookkeeping accordingly"
|
||||
foreign import ccall unsafe "string.h strdup" strdup :: CString -> IO CString
|
||||
|
||||
testC = withCString "Hello World!" -- marshall the Haskell string "Hello World!" into a C string...
|
||||
(\s -> -- ... and name it s
|
||||
do s2 <- strdup s
|
||||
s2_hs <- peekCString s2 -- marshall the C string called s2 into a Haskell string named s2_hs
|
||||
putStrLn s2_hs
|
||||
free s2) -- s is automatically freed by withCString once done
|
||||
|
|
@ -0,0 +1,18 @@
|
|||
#include <string.h>
|
||||
#include "icall.h" // a header routine from the Unicon sources - provides helpful type-conversion macros
|
||||
|
||||
int strdup_wrapper (int argc, descriptor *argv)
|
||||
{
|
||||
ArgString (1); // check that the first argument is a string
|
||||
|
||||
RetString (strdup (StringVal(argv[1]))); // call strdup, convert and return result
|
||||
}
|
||||
|
||||
// and strcat, for a result that does not equal the input
|
||||
int strcat_wrapper (int argc, descriptor *argv)
|
||||
{
|
||||
ArgString (1);
|
||||
ArgString (2);
|
||||
char * result = strcat (StringVal(argv[1]), StringVal(argv[2]));
|
||||
RetString (result);
|
||||
}
|
||||
|
|
@ -0,0 +1,23 @@
|
|||
$define LIB "libstrdup-wrapper.so"
|
||||
|
||||
# the unicon wrapper to access the C function
|
||||
procedure strdup (str)
|
||||
static f
|
||||
initial {
|
||||
f := loadfunc (LIB, "strdup_wrapper") // pick out the wrapped function from the shared library
|
||||
}
|
||||
return f(str) // call the wrapped function
|
||||
end
|
||||
|
||||
procedure strcat (str1, str2)
|
||||
static f
|
||||
initial {
|
||||
f := loadfunc (LIB, "strcat_wrapper")
|
||||
}
|
||||
return f(str1, str2)
|
||||
end
|
||||
|
||||
procedure main ()
|
||||
write (strdup ("abc"))
|
||||
write (strcat ("abc", "def"))
|
||||
end
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
require 'dll'
|
||||
strdup=: 'msvcrt.dll _strdup >x *' cd <
|
||||
free=: 'msvcrt.dll free n x' cd <
|
||||
getstr=: free ] memr@,&0 _1
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
getstr@strdup 'Hello World!'
|
||||
Hello World!
|
||||
|
|
@ -0,0 +1,12 @@
|
|||
public class JNIDemo
|
||||
{
|
||||
static
|
||||
{ System.loadLibrary("JNIDemo"); }
|
||||
|
||||
public static void main(String[] args)
|
||||
{
|
||||
System.out.println(callStrdup("Hello World!"));
|
||||
}
|
||||
|
||||
private static native String callStrdup(String s);
|
||||
}
|
||||
|
|
@ -0,0 +1,21 @@
|
|||
/* DO NOT EDIT THIS FILE - it is machine generated */
|
||||
#include <jni.h>
|
||||
/* Header for class JNIDemo */
|
||||
|
||||
#ifndef _Included_JNIDemo
|
||||
#define _Included_JNIDemo
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
/*
|
||||
* Class: JNIDemo
|
||||
* Method: callStrdup
|
||||
* Signature: (Ljava/lang/String;)Ljava/lang/String;
|
||||
*/
|
||||
JNIEXPORT jstring JNICALL Java_JNIDemo_callStrdup
|
||||
(JNIEnv *, jclass, jstring);
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
#endif
|
||||
|
|
@ -0,0 +1,43 @@
|
|||
#include "string.h"
|
||||
#include "JNIDemo.h"
|
||||
|
||||
void throwByName(JNIEnv* env, const char* className, const char* msg)
|
||||
{
|
||||
jclass exceptionClass = (*env)->FindClass(env, className);
|
||||
if (exceptionClass != NULL)
|
||||
{
|
||||
(*env)->ThrowNew(env, exceptionClass, msg);
|
||||
(*env)->DeleteLocalRef(env, exceptionClass);
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
JNIEXPORT jstring JNICALL Java_JNIDemo_callStrdup(JNIEnv *env, jclass cls, jstring s)
|
||||
{
|
||||
const jbyte* utf8String;
|
||||
char* dupe;
|
||||
jstring dupeString;
|
||||
|
||||
if (s == NULL)
|
||||
{
|
||||
throwByName(env, "java/lang/NullPointerException", "String is null");
|
||||
return NULL;
|
||||
}
|
||||
|
||||
// Convert from UTF-16 to UTF-8 (C-style)
|
||||
utf8String = (*env)->GetStringUTFChars(env, s, NULL);
|
||||
|
||||
// Duplicate
|
||||
dupe = strdup(utf8String);
|
||||
|
||||
// Free the UTF-8 string back to the JVM
|
||||
(*env)->ReleaseStringUTFChars(env, s, utf8String);
|
||||
|
||||
// Convert the duplicate string from strdup to a Java String
|
||||
dupeString = (*env)->NewStringUTF(env, dupe);
|
||||
|
||||
// Free the duplicate c-string back to the C runtime heap
|
||||
free(dupe);
|
||||
|
||||
return dupeString;
|
||||
}
|
||||
|
|
@ -0,0 +1,28 @@
|
|||
#include <napi.h>
|
||||
#include <openssl/md5.h>
|
||||
|
||||
#include <iomanip>
|
||||
#include <iostream>
|
||||
#include <sstream>
|
||||
#include <string>
|
||||
using namespace Napi;
|
||||
|
||||
Napi::Value md5sum(const Napi::CallbackInfo& info) {
|
||||
std::string input = info[0].ToString();
|
||||
|
||||
unsigned char result[MD5_DIGEST_LENGTH];
|
||||
MD5((unsigned char*)input.c_str(), input.size(), result);
|
||||
|
||||
std::stringstream md5string;
|
||||
md5string << std::hex << std::setfill('0');
|
||||
for (const auto& byte : result) md5string << std::setw(2) << (int)byte;
|
||||
return String::New(info.Env(), md5string.str().c_str());
|
||||
}
|
||||
|
||||
Napi::Object Init(Napi::Env env, Napi::Object exports) {
|
||||
exports.Set(Napi::String::New(env, "md5sum"),
|
||||
Napi::Function::New(env, md5sum));
|
||||
return exports;
|
||||
}
|
||||
|
||||
NODE_API_MODULE(addon, Init)
|
||||
|
|
@ -0,0 +1 @@
|
|||
node-gyp build
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
const addon = require('../build/Release/md5sum-native');
|
||||
|
||||
module.exports = addon.md5sum;
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
const md5sum = require('../lib/binding.js');
|
||||
console.log(md5sum('hello'));
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
import { createRequire } from 'module';
|
||||
const require = createRequire(import.meta.url);
|
||||
const addon = require('../build/Release/md5sum-native');
|
||||
|
||||
export default addon.md5sum;
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
import md5sum from '../lib/binding.js';
|
||||
|
||||
console.log(md5sum('hello'));
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
p = ccall(:strdup, Ptr{Cuchar}, (Ptr{Cuchar},), "Hello world")
|
||||
@show unsafe_string(p) # "Hello world"
|
||||
ccall(:free, Void, (Ptr{Cuchar},), p)
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
using PyCall
|
||||
@pyimport math
|
||||
@show math.cos(1) # 0.5403023058681398
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
// Kotlin Native v0.2
|
||||
|
||||
import kotlinx.cinterop.*
|
||||
import string.*
|
||||
|
||||
fun main(args: Array<String>) {
|
||||
val hw = strdup ("Hello World!")!!.toKString()
|
||||
println(hw)
|
||||
}
|
||||
|
|
@ -0,0 +1,24 @@
|
|||
Section Header
|
||||
|
||||
+ name := TEST_C_INTERFACE;
|
||||
|
||||
// this will be inserted in front of the program
|
||||
- external := `#include <string.h>`;
|
||||
|
||||
Section Public
|
||||
|
||||
- main <- (
|
||||
+ s : STRING_CONSTANT;
|
||||
+ p : NATIVE_ARRAY[CHARACTER];
|
||||
|
||||
s := "Hello World!";
|
||||
p := s.to_external;
|
||||
// this will be inserted in-place
|
||||
// use `expr`:type to tell Lisaac what's the type of the external expression
|
||||
p := `strdup(@p)` : NATIVE_ARRAY[CHARACTER];
|
||||
s.print;
|
||||
'='.print;
|
||||
p.println;
|
||||
// this will also be inserted in-place, expression type disregarded
|
||||
`free(@p)`;
|
||||
);
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
org &1000
|
||||
ld a,'A'
|
||||
call &bb5a
|
||||
ret
|
||||
|
|
@ -0,0 +1,14 @@
|
|||
local ffi = require("ffi")
|
||||
ffi.cdef[[
|
||||
char * strndup(const char * s, size_t n);
|
||||
int strlen(const char *s);
|
||||
]]
|
||||
|
||||
local s1 = "Hello, world!"
|
||||
print("Original: " .. s1)
|
||||
local s_s1 = ffi.C.strlen(s1)
|
||||
print("strlen: " .. s_s1)
|
||||
|
||||
local s2 = ffi.string(ffi.C.strndup(s1, s_s1), s_s1)
|
||||
print("Copy: " .. s2)
|
||||
print("strlen: " .. ffi.C.strlen(s2))
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
import "stdio.h";;
|
||||
import "string.h";;
|
||||
|
||||
let s1:string = "Hello World!";;
|
||||
let s2:char* = strdup(cstring(s1));;
|
||||
puts(s2);;
|
||||
free(s2 as void*)
|
||||
|
|
@ -0,0 +1,21 @@
|
|||
Module CheckCCall {
|
||||
mybuf$=string$(chr$(0), 1000)
|
||||
a$="Hello There 12345"+Chr$(0)
|
||||
Print Len(a$)
|
||||
Buffer Clear Mem as Byte*Len(a$)
|
||||
\\ copy to Mem the converted a$ (from Utf-16Le to ANSI)
|
||||
Return Mem, 0:=str$(a$)
|
||||
|
||||
Declare MyStrDup Lib C "msvcrt._strdup" { Long Ptr}
|
||||
Declare MyFree Lib C "msvcrt.free" { Long Ptr}
|
||||
\\ see & means by reference
|
||||
\\ ... means any number of arguments
|
||||
Declare MyPrintStr Lib C "msvcrt.swprintf" { &sBuf$, sFmt$, long Z }
|
||||
|
||||
\\ Now we use address Mem(0) as pointer (passing by value)
|
||||
Long Z=MyStrDup(Mem(0))
|
||||
a=MyPrintStr(&myBuf$, "%s", Z)
|
||||
Print MyFree(Z), a
|
||||
Print LeftPart$(chr$(mybuf$), chr$(0))
|
||||
}
|
||||
CheckCCall
|
||||
|
|
@ -0,0 +1,43 @@
|
|||
Module Checkit {
|
||||
Global a()
|
||||
mm=10
|
||||
Module CallFromVb {
|
||||
\\ Number get first parameter is numeric else error
|
||||
Print Number
|
||||
}
|
||||
Module Global CallFromVbGlobal {
|
||||
Read X()
|
||||
X(0)++
|
||||
a()=X()
|
||||
Print "ok"
|
||||
}
|
||||
Declare Global vs "MSScriptControl.ScriptControl"
|
||||
Declare Alfa Module
|
||||
Print Type$(Alfa) \\ name is CallBack2
|
||||
With vs, "Language","Vbscript", "AllowUI", true, "SitehWnd", hwnd
|
||||
Method vs, "Reset"
|
||||
Method vs, "AddObject", "__global__", Alfa, true
|
||||
Method vs, "AddCode", {
|
||||
' This is VBScript code
|
||||
dim M(9), k ' 0 to 9, so 10 items
|
||||
Sub main()
|
||||
CallModule "CallFromVb", 1000
|
||||
M(0)=1000
|
||||
CallGlobal "CallFromVbGlobal", M
|
||||
ExecuteStatement "Print a(0)"
|
||||
k=me.Eval("a(0)")
|
||||
CallModule "CallFromVb", k
|
||||
' use Let to assign a number to variable
|
||||
ExecuteStatement "let mm=12345"
|
||||
k=me.Eval("mm")
|
||||
CallModule "CallFromVb", k
|
||||
CallModule "CallFromVb", M(0)
|
||||
End Sub
|
||||
}
|
||||
Method vs, "run", "main"
|
||||
Declare vs nothing
|
||||
If error then print error$
|
||||
Print Len(a())
|
||||
Print a()
|
||||
}
|
||||
CheckIt
|
||||
|
|
@ -0,0 +1,53 @@
|
|||
Module CheckJavaScript {
|
||||
Clear
|
||||
Module ok {
|
||||
if match("S") then {
|
||||
read m$
|
||||
print "ok", m$
|
||||
} else {
|
||||
read m
|
||||
print "ok", m
|
||||
}
|
||||
}
|
||||
Declare vs "MSScriptControl.ScriptControl"
|
||||
Declare Alfa Module
|
||||
Print Type$(Alfa)
|
||||
With vs, "Language","Jscript", "AllowUI", true
|
||||
Method vs, "Reset"
|
||||
Print Type$(Alfa)
|
||||
Method vs, "AddObject", "M2000", Alfa
|
||||
Inventory alfa1=1,2,3,4:="Ok"
|
||||
If exist(alfa1,4) then print "Ok..."
|
||||
Print type$(alfa1)
|
||||
Method vs, "AddObject", "Inventory", alfa1
|
||||
A=(1,2,3,4,"Hello")
|
||||
Method vs, "AddObject", "Arr", A
|
||||
Method vs, "ExecuteStatement", {
|
||||
M2000.AddExecCode("Function BB {=1234 **number} : k=2");
|
||||
M=M2000.ExecuteStatement("Print 1234, BB(k)");
|
||||
// wait a key
|
||||
M2000.AddExecCode("aa$=key$");
|
||||
var m=[10,10+5,20];
|
||||
M2000.CallModule("ok" , Inventory.count) ;
|
||||
n=Inventory.Find("4");
|
||||
Inventory.Value="Not Ok"
|
||||
M2000.CallModule("ok" ,Inventory.Value) ;
|
||||
M2000.CallModule("ok" ,Arr.Count)
|
||||
Arr.item(4)="George"
|
||||
Arr.item(1)++;
|
||||
M2000.CallModule("ok" ,Arr.item(4))
|
||||
}
|
||||
Print Alfa1$(4) '' Not Ok.
|
||||
Print Array$(A, 1) ' 3
|
||||
Print Array$(A, 4) ' George
|
||||
Modules ?
|
||||
\\ BB() and K created from javascript
|
||||
Print BB(k)
|
||||
Method vs, "eval", {"hello there"} as X$
|
||||
Print X$
|
||||
Method vs, "eval", {"hello there too"} as X$
|
||||
Print X$
|
||||
List ' print all variables
|
||||
Declare vs Nothing
|
||||
}
|
||||
CheckJavaScript
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
Declare MessageBox Lib "user32.MessageBoxW" {long alfa, lptext$, lpcaption$, long type}
|
||||
Print MessageBox(Hwnd, "HELLO THERE", "GEORGE", 2)
|
||||
Remove "user32"
|
||||
|
|
@ -0,0 +1,124 @@
|
|||
Module checkit {
|
||||
Static DisplayOnce=0
|
||||
N=100000
|
||||
Read ? N
|
||||
Form 60
|
||||
Pen 14
|
||||
Background { Cls 5}
|
||||
Cls 5
|
||||
\\ use f1 do unload lib - because only New statemend unload it
|
||||
FKEY 1,"save ctst1:new:load ctst1"
|
||||
\\ We use a function as string container, because c code can easy color decorated in M2000.
|
||||
Function ccode {
|
||||
long primes(long a[], long b)
|
||||
{
|
||||
long k=2;
|
||||
long k2,d=2, l, i;
|
||||
k2=k*k;
|
||||
if (b>2)
|
||||
{
|
||||
if (k2<b)
|
||||
{
|
||||
do {
|
||||
for (l=k2; l<=b; l+=k)
|
||||
a[l]--;
|
||||
k++;
|
||||
while (a[k])
|
||||
k++;
|
||||
k2=k*k;
|
||||
} while (k2<=b);
|
||||
}
|
||||
for (i=2;i<=b;i++)
|
||||
{
|
||||
if (a[i]==0)
|
||||
{
|
||||
a[d]=i ; d++ ;
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
if (b>1)
|
||||
{
|
||||
if (b>2)
|
||||
{
|
||||
d=2; a[0]=2; a[1]=3 ;
|
||||
}
|
||||
else {
|
||||
d=1; a[0]=2;
|
||||
}
|
||||
}
|
||||
}
|
||||
a[b+1]=d;
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
\\ extract code. &functionname() is a string with the code inside "{ }"
|
||||
\\ a reference to function actual is code of function in m2000
|
||||
\\ using Document object we have an easy way to drop paragraphs
|
||||
document code$=Mid$(&ccode(), 2, len(&ccode())-2)
|
||||
\\ remove 1st line two times \\ one line for an edit information from interpreter
|
||||
\\ paragraph$(code$, 1) export paragraph 1st,using third parameter -1 means delete after export.
|
||||
drop$=paragraph$(code$,1,-1)+paragraph$(code$,1,-1)
|
||||
If DisplayOnce Else {
|
||||
Report 2, "c code for primes"
|
||||
Report code$ \\ report stop after 3/4 of screen lines use. Press spacebar or mouse button to continue
|
||||
DisplayOnce++
|
||||
}
|
||||
|
||||
\\ dos "del c:\MyName.*", 200;
|
||||
|
||||
If not exist("c:\MyName.dll") then {
|
||||
Report 2, "Now we have to make a dll"
|
||||
Rem : Load Make \\ we can use a Make.gsb in current folder - this is the user folder for now
|
||||
Module MAKE ( fname$, code$, timeout ) {
|
||||
if timeout<1000 then timeout=1000
|
||||
If left$(fname$,2)="My" Else Error "Not proper name - use 'My' as first two letters"
|
||||
Print "Delete old files"
|
||||
try { remove "c:\MyName" }
|
||||
Dos "del c:\"+fname$+".*", timeout;
|
||||
Print "Save c file"
|
||||
Open "c:\"+fname$+".c" for output as F \\ use of non unicode output
|
||||
Print #F, code$
|
||||
Close #F
|
||||
\\ use these two lines for opening dos console and return to M2000 command line
|
||||
rem : Dos "cd c:\ && gcc -c -DBUILD_DLL "+fname$+".c"
|
||||
rem : Error "Check for errors"
|
||||
\\ by default we give a time to process dos command and then continue
|
||||
Print "make object file"
|
||||
dos "cd c:\ && gcc -c -DBUILD_DLL "+fname$+".c" , timeout;
|
||||
if exist("c:\"+fname$+".o") then {
|
||||
Print "make dll"
|
||||
dos "cd c:\ && gcc -shared -o "+fname$+".dll "+fname$+".o -Wl,--out-implib,libmessage.a", timeout;
|
||||
} else Error "No object file - Error"
|
||||
if not exist("c:\"+fname$+".dll") then Error "No dll - Error"
|
||||
}
|
||||
Make "MyName", code$, 1000
|
||||
}
|
||||
Declare primes lib c "c:\MyName.primes" {long c, long d} \\ c after lib mean CDecl call
|
||||
\\ So now we can check error
|
||||
\\ make a Buffer (add two more longs for any purpose)
|
||||
Buffer Clear A as Long*(N+2) \\ so A(0) is base address, of an array of 100002 long (unsign for M2000).
|
||||
\\ profiler enable a timecount
|
||||
profiler
|
||||
Call primes(A(0), N)
|
||||
m=timecount
|
||||
total=Eval(A,N+1)-2
|
||||
Clear Yes, No
|
||||
Print "Press Y or N to display or not the primes"
|
||||
Repeat {
|
||||
Yes=keypress(89) : No=Keypress(78)
|
||||
wait 10
|
||||
} Until Yes or No
|
||||
If Yes then {
|
||||
Form 80,50
|
||||
Refresh
|
||||
For i=2 to total+1
|
||||
Print Eval(A,i),
|
||||
next i
|
||||
Print
|
||||
}
|
||||
Print format$("Compute {0} primes in range 1 to {1}, in msec:{2:3}", total, N, m)
|
||||
\\ unload dll, we have to use exactly the same name, as we use it in declare except for last chars ".dll"
|
||||
remove "c:\MyName"
|
||||
}
|
||||
checkit
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
> strdup := define_external( strdup, s::string, RETURN::string, LIB = "/lib/libc.so.6" ):
|
||||
> strdup( "foo" );
|
||||
"foo"
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
> csin := define_external( sin, s::float[8], RETURN::float[8], LIB = "libm.so" );
|
||||
csin := proc(s::numeric)
|
||||
option call_external, define_external(sin, s::float[8],
|
||||
RETURN::float[8], LIB = "libm.so");
|
||||
call_external(
|
||||
Array(1..8, [...], datatype = integer[4], readonly), false,
|
||||
args)
|
||||
end proc
|
||||
|
||||
> csin( evalf( Pi / 2 ) );
|
||||
1.
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
Needs["NETLink`"];
|
||||
externalstrdup = DefineDLLFunction["_strdup", "msvcrt.dll", "string", {"string"}];
|
||||
Print["Duplicate: ", externalstrdup["Hello world!"]]
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
/* Maxima is written in Lisp and can call Lisp functions.
|
||||
Use load("funcs.lisp"), or inside Maxima: */
|
||||
|
||||
to_lisp();
|
||||
> (defun $f (a b) (+ a b))
|
||||
> (to-maxima)
|
||||
|
||||
f(5, 6);
|
||||
11
|
||||
|
|
@ -0,0 +1,23 @@
|
|||
:- module test_ffi.
|
||||
|
||||
:- interface.
|
||||
|
||||
:- import_module io.
|
||||
|
||||
:- pred main(io::di, io::uo) is det.
|
||||
|
||||
:- implementation.
|
||||
|
||||
% The actual FFI code begins here.
|
||||
:- pragma foreign_decl("C", "#include <string.h>").
|
||||
|
||||
:- func strdup(string::in) = (string::out) is det.
|
||||
:- pragma foreign_proc("C", strdup(S::in) = (SD::out),
|
||||
[will_not_call_mercury, not_thread_safe, promise_pure],
|
||||
"SD = strdup(S);").
|
||||
% The actual FFI code ends here.
|
||||
|
||||
main(!IO) :-
|
||||
io.write_string(strdup("Hello, worlds!\n"), !IO).
|
||||
|
||||
:- end_module test_ffi.
|
||||
|
|
@ -0,0 +1 @@
|
|||
:- func strdup(string) = string.
|
||||
|
|
@ -0,0 +1,68 @@
|
|||
#include <vga.h>
|
||||
|
||||
int Initialize (void)
|
||||
{
|
||||
if ( vga_init () == 0 )
|
||||
return 1;
|
||||
else
|
||||
return 0;
|
||||
}
|
||||
|
||||
void SetMode (int newmode)
|
||||
{
|
||||
vga_setmode (newmode);
|
||||
}
|
||||
|
||||
int GetMode (void)
|
||||
{
|
||||
return vga_getcurrentmode ();
|
||||
}
|
||||
|
||||
int MaxWidth (void)
|
||||
{
|
||||
return vga_getxdim ();
|
||||
}
|
||||
|
||||
int MaxHeight (void)
|
||||
{
|
||||
return vga_getydim ();
|
||||
}
|
||||
|
||||
void Clear (void)
|
||||
{
|
||||
vga_clear ();
|
||||
}
|
||||
void SetColour (int colour)
|
||||
{
|
||||
vga_setcolor (colour);
|
||||
}
|
||||
|
||||
void SetEGAcolour (int colour)
|
||||
{
|
||||
vga_setegacolor (colour);
|
||||
}
|
||||
|
||||
void SetRGB (int red, int green, int blue)
|
||||
{
|
||||
vga_setrgbcolor (red, green, blue);
|
||||
}
|
||||
|
||||
void DrawLine (int x0, int y0, int dx, int dy)
|
||||
{
|
||||
vga_drawline (x0, y0, x0 + dx, y0 + dy);
|
||||
}
|
||||
|
||||
void Plot (int x, int y)
|
||||
{
|
||||
vga_drawpixel (x, y);
|
||||
}
|
||||
|
||||
int ThisColour (int x, int y)
|
||||
{
|
||||
return vga_getpixel (x, y);
|
||||
}
|
||||
|
||||
void GetKey (char *ch)
|
||||
{
|
||||
*ch = vga_getkey ();
|
||||
}
|
||||
|
|
@ -0,0 +1,32 @@
|
|||
FOREIGN MODULE Vga;
|
||||
|
||||
TYPE EGAcolour = (black, blue, green, cyan, red, pink, brown, white,
|
||||
GREY, BLUE, GREEN, CYAN, RED, MAGENTA, YELLOW, WHITE);
|
||||
|
||||
PROCEDURE Initialize () : BOOLEAN;
|
||||
|
||||
PROCEDURE MaxWidth () : CARDINAL;
|
||||
|
||||
PROCEDURE MaxHeight () : CARDINAL;
|
||||
|
||||
PROCEDURE Clear;
|
||||
|
||||
PROCEDURE SetColour (colour : CARDINAL);
|
||||
|
||||
PROCEDURE SetEGAcolour (colour : CARDINAL);
|
||||
|
||||
PROCEDURE SetRGB (red, green, blue : CARDINAL);
|
||||
|
||||
PROCEDURE DrawLine (x0, y0, dx, dy : CARDINAL);
|
||||
|
||||
PROCEDURE Plot (x, y : CARDINAL);
|
||||
|
||||
PROCEDURE ThisColour (x, y : CARDINAL) : CARDINAL;
|
||||
|
||||
PROCEDURE SetMode (newmode : CARDINAL);
|
||||
|
||||
PROCEDURE GetMode () : CARDINAL;
|
||||
|
||||
PROCEDURE GetKey (VAR ch : CHAR);
|
||||
|
||||
END Vga.
|
||||
|
|
@ -0,0 +1,33 @@
|
|||
MODULE svg01;
|
||||
|
||||
FROM InOut IMPORT Read, Write, WriteBf, WriteString;
|
||||
|
||||
IMPORT Vga;
|
||||
|
||||
VAR OldMode, x, y : CARDINAL;
|
||||
ch : CHAR;
|
||||
|
||||
BEGIN
|
||||
IF Vga.Initialize () = FALSE THEN
|
||||
WriteString ('Could not start SVGAlib libraries. Aborting...');
|
||||
WriteBf;
|
||||
HALT
|
||||
END;
|
||||
OldMode := Vga.GetMode ();
|
||||
Vga.SetMode (4);
|
||||
Vga.SetColour (14);
|
||||
Vga.Clear ();
|
||||
Vga.SetColour (10);
|
||||
FOR y := 125 TO 175 DO
|
||||
FOR x := 100 TO 500 DO
|
||||
Vga.Plot (x, y)
|
||||
END
|
||||
END;
|
||||
LOOP
|
||||
Read (ch);
|
||||
IF ch = 'X' THEN EXIT END
|
||||
END;
|
||||
Vga.SetMode (OldMode);
|
||||
Write (ch);
|
||||
WriteBf;
|
||||
END svg01.
|
||||
|
|
@ -0,0 +1,17 @@
|
|||
UNSAFE MODULE Foreign EXPORTS Main;
|
||||
|
||||
IMPORT IO, Ctypes, Cstring, M3toC;
|
||||
|
||||
VAR string1, string2: Ctypes.const_char_star;
|
||||
|
||||
BEGIN
|
||||
string1 := M3toC.CopyTtoS("Foobar");
|
||||
string2 := M3toC.CopyTtoS("Foobar2");
|
||||
IF Cstring.strcmp(string1, string2) = 0 THEN
|
||||
IO.Put("string1 = string2\n");
|
||||
ELSE
|
||||
IO.Put("string1 # string2\n");
|
||||
END;
|
||||
M3toC.FreeCopiedS(string1);
|
||||
M3toC.FreeCopiedS(string2);
|
||||
END Foreign.
|
||||
|
|
@ -0,0 +1,12 @@
|
|||
import clib
|
||||
|
||||
importdll msvcrt =
|
||||
clang function "_strdup" (ref char)ref char
|
||||
end
|
||||
|
||||
proc start=
|
||||
[]char str:=z"hello strdup"
|
||||
ref char str2
|
||||
str2:=_strdup(&.str)
|
||||
println str2
|
||||
end
|
||||
|
|
@ -0,0 +1,20 @@
|
|||
extern "libm.so.6" func sinhf(x : float) -> float
|
||||
extern "libm.so.6" func coshf(x : float) -> float
|
||||
extern "libm.so.6" func powf(base : float, exp : float) -> float
|
||||
extern "libm.so.6" func atanf(x : float) -> float
|
||||
|
||||
func main() -> int
|
||||
{
|
||||
var v1 = sinhf(1.0);
|
||||
var v2 = coshf(1.0);
|
||||
var v3 = powf(10.0, 2.0);
|
||||
var pi = 4.0 * atanf(1.0);
|
||||
|
||||
printf(v1);
|
||||
printf(v2);
|
||||
printf(v3);
|
||||
printf(pi);
|
||||
printf(sinhf(1.0));
|
||||
|
||||
0
|
||||
}
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
; simple FFI interface on Mac OSX
|
||||
(import "libc.dylib" "strdup")
|
||||
(println (get-string (strdup "hello world")))
|
||||
|
||||
; or extended FFI interface on Mac OSX
|
||||
(import "libc.dylib" "strdup" "char*" "char*")
|
||||
(println (strdup "hello world"))
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
proc strcmp(a, b: cstring): cint {.importc: "strcmp", nodecl.}
|
||||
echo strcmp("abc", "def")
|
||||
echo strcmp("hello", "hello")
|
||||
|
||||
proc printf(formatstr: cstring) {.header: "<stdio.h>", varargs.}
|
||||
|
||||
var x = "foo"
|
||||
printf("Hello %d %s!\n", 12, x)
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
void myfunc_a();
|
||||
float myfunc_b(int, float);
|
||||
char *myfunc_c(int *, int);
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
external myfunc_a: unit -> unit = "caml_myfunc_a"
|
||||
external myfunc_b: int -> float -> float = "caml_myfunc_b"
|
||||
external myfunc_c: int array -> string = "caml_myfunc_c"
|
||||
|
|
@ -0,0 +1,30 @@
|
|||
#include <caml/mlvalues.h>
|
||||
#include <caml/alloc.h>
|
||||
#include <mylib.h>
|
||||
|
||||
CAMLprim value
|
||||
caml_myfunc_a(value unit) {
|
||||
myfunc_a();
|
||||
return Val_unit;
|
||||
}
|
||||
|
||||
CAMLprim value
|
||||
caml_myfunc_b(value a, value b) {
|
||||
float c = myfunc_b(Int_val(a), Double_val(b));
|
||||
return caml_copy_double(c);
|
||||
}
|
||||
|
||||
CAMLprim value
|
||||
caml_myfunc_c(value ml_array) {
|
||||
int i, len;
|
||||
int *arr;
|
||||
char *s;
|
||||
len = Wosize_val(ml_array);
|
||||
arr = malloc(len * sizeof(int));
|
||||
for (i=0; i < len; i++) {
|
||||
arr[i] = Int_val(Field(ml_array, i));
|
||||
}
|
||||
s = myfunc_c(arr, len);
|
||||
free(arr);
|
||||
return caml_copy_string(s);
|
||||
}
|
||||
|
|
@ -0,0 +1,26 @@
|
|||
wrap_mylib.o: wrap_mylib.c
|
||||
ocamlc -c -ccopt -I/usr/include/mylib $<
|
||||
|
||||
dllmylib_stubs.so: wrap_mylib.o
|
||||
ocamlmklib -o mylib_stubs $< -lmylib
|
||||
|
||||
mylib.mli: mylib.ml
|
||||
ocamlc -i $< > $@
|
||||
|
||||
mylib.cmi: mylib.mli
|
||||
ocamlc -c $<
|
||||
|
||||
mylib.cmo: mylib.ml mylib.cmi
|
||||
ocamlc -c $<
|
||||
|
||||
mylib.cma: mylib.cmo dllmylib_stubs.so
|
||||
ocamlc -a -o $@ $< -dllib -lmylib_stubs -cclib -lmylib
|
||||
|
||||
mylib.cmx: mylib.ml mylib.cmi
|
||||
ocamlopt -c $<
|
||||
|
||||
mylib.cmxa: mylib.cmx dllmylib_stubs.so
|
||||
ocamlopt -a -o $@ $< -cclib -lmylib_stubs -cclib -lmylib
|
||||
|
||||
clean:
|
||||
rm -f *.[oa] *.so *.cm[ixoa] *.cmxa
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
open Ctypes
|
||||
open Foreign
|
||||
|
||||
let myfunc_a = foreign "myfunc_a" (void @-> returning void)
|
||||
let myfunc_b = foreign "myfunc_b" (int @-> float @-> returning float)
|
||||
let myfunc_c = foreign "myfunc_c" (ptr void @-> int @-> returning string)
|
||||
|
||||
let myfunc_c lst =
|
||||
let arr = CArray.of_list int lst in
|
||||
myfunc_c (to_voidp (CArray.start arr)) (CArray.length arr)
|
||||
;;
|
||||
|
|
@ -0,0 +1,17 @@
|
|||
package main
|
||||
|
||||
import "core:fmt"
|
||||
|
||||
foreign import libc "system:c"
|
||||
|
||||
@(default_calling_convention="c")
|
||||
foreign libc {
|
||||
@(link_name="strdup") cstrdup :: proc(_: cstring) -> cstring ---
|
||||
@(link_name="free") cfree :: proc(_: rawptr) ---
|
||||
}
|
||||
|
||||
main :: proc() {
|
||||
s1 : cstring = "hello"
|
||||
s2 := cstrdup(s1)
|
||||
fmt.printf("{}\n", s2)
|
||||
cfree(rawptr(s2))
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
(import (otus ffi))
|
||||
|
||||
(define self (load-dynamic-library #f))
|
||||
(define strdup (self type-string "strdup" type-string))
|
||||
|
||||
(print (strdup "Hello World!"))
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
(import (otus ffi))
|
||||
|
||||
(if (not (has? *features* 'Windows))
|
||||
(print "The host platform is not a Windows!"))
|
||||
|
||||
(define self (load-dynamic-library "shlwapi.dll"))
|
||||
(define strdup (self type-string "StrDupA" type-string))
|
||||
|
||||
(print (strdup "Hello World!"))
|
||||
|
|
@ -0,0 +1,34 @@
|
|||
; The sample usage of GTK3+ library
|
||||
(import (otus ffi)
|
||||
(lib glib-2)
|
||||
(lib gtk-3))
|
||||
|
||||
(define print_hello (vm:pin (cons
|
||||
(list GtkWidget* gpointer)
|
||||
(lambda (widget userdata)
|
||||
(print "hello")
|
||||
TRUE
|
||||
))))
|
||||
|
||||
(define activate (vm:pin (cons
|
||||
(list GtkApplication* gpointer)
|
||||
(lambda (app userdata)
|
||||
(define window (gtk_application_window_new app))
|
||||
(print "window: " window)
|
||||
(gtk_window_set_title window "Window")
|
||||
(gtk_window_set_default_size window 200 200)
|
||||
|
||||
(define button_box (gtk_button_box_new GTK_ORIENTATION_HORIZONTAL))
|
||||
(gtk_container_add window button_box)
|
||||
|
||||
(define button (gtk_button_new_with_label "Hello World"))
|
||||
(g_signal_connect button "clicked" (G_CALLBACK print_hello) NULL)
|
||||
(gtk_container_add button_box button)
|
||||
|
||||
(gtk_widget_show_all window)
|
||||
))))
|
||||
|
||||
(define app (gtk_application_new (c-string "org.gtk.example") G_APPLICATION_FLAGS_NONE))
|
||||
(g_signal_connect app (c-string "activate") (G_CALLBACK activate) NULL)
|
||||
|
||||
(g_application_run app 0 #false)
|
||||
|
|
@ -0,0 +1,21 @@
|
|||
#include "mozart.h"
|
||||
#include <string.h>
|
||||
|
||||
OZ_BI_define(c_strdup,1,1)
|
||||
{
|
||||
OZ_declareVirtualString(0, s1);
|
||||
char* s2 = strdup(s1);
|
||||
OZ_Term s3 = OZ_string(s2);
|
||||
free( s2 );
|
||||
OZ_RETURN( s3 );
|
||||
}
|
||||
OZ_BI_end
|
||||
|
||||
OZ_C_proc_interface * oz_init_module(void)
|
||||
{
|
||||
static OZ_C_proc_interface table[] = {
|
||||
{"strdup",1,1,c_strdup},
|
||||
{0,0,0,0}
|
||||
};
|
||||
return table;
|
||||
}
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
makefile(
|
||||
lib : [
|
||||
'strdup.o' 'strdup.so'
|
||||
]
|
||||
rules:o('strdup.so':ld('strdup.o'))
|
||||
)
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
declare
|
||||
[Strdup] = {Module.link ['strdup.so{native}']}
|
||||
in
|
||||
{System.showInfo {Strdup.strdup "hello"}}
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
$ffi = FFI::cdef("char *_strdup(const char *strSource);", "msvcrt.dll");
|
||||
|
||||
$cstr = $ffi->_strdup("success");
|
||||
$str = FFI::string($cstr);
|
||||
echo $str;
|
||||
FFI::free($cstr);
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
declare strdup entry (character (30) varyingz) options (fastcall16);
|
||||
|
||||
put (strdup('hello world') );
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
use Inline C => q{
|
||||
char *copy;
|
||||
char * c_dup(char *orig) {
|
||||
return copy = strdup(orig);
|
||||
}
|
||||
void c_free() {
|
||||
free(copy);
|
||||
}
|
||||
};
|
||||
print c_dup('Hello'), "\n";
|
||||
c_free();
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
use Inline C => q{
|
||||
void c_hello (char *text) {
|
||||
char *copy = strdup(text);
|
||||
printf("Hello, %s!\n", copy);
|
||||
free(copy);
|
||||
}
|
||||
};
|
||||
c_hello 'world';
|
||||
|
|
@ -0,0 +1,12 @@
|
|||
(notonline)-->
|
||||
<span style="color: #008080;">without</span> <span style="color: #008080;">js</span> <span style="color: #000080;font-style:italic;">-- not from a browser, mate!</span>
|
||||
<span style="color: #008080;">constant</span> <span style="color: #000000;">shlwapi</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">open_dll</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"shlwapi.dll"</span><span style="color: #0000FF;">),</span>
|
||||
<span style="color: #000000;">kernel32</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">open_dll</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"kernel32.dll"</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">constant</span> <span style="color: #000000;">xStrDup</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">define_c_func</span><span style="color: #0000FF;">(</span><span style="color: #000000;">shlwapi</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"StrDupA"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">C_PTR</span><span style="color: #0000FF;">},</span><span style="color: #000000;">C_PTR</span><span style="color: #0000FF;">),</span>
|
||||
<span style="color: #000000;">xLocalFree</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">define_c_func</span><span style="color: #0000FF;">(</span><span style="color: #000000;">kernel32</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"LocalFree"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">C_PTR</span><span style="color: #0000FF;">},</span><span style="color: #000000;">C_PTR</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">constant</span> <span style="color: #000000;">HelloWorld</span> <span style="color: #0000FF;">=</span> <span style="color: #008000;">"Hello World!"</span>
|
||||
|
||||
<span style="color: #004080;">atom</span> <span style="color: #000000;">pMem</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">c_func</span><span style="color: #0000FF;">(</span><span style="color: #000000;">xStrDup</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">HelloWorld</span><span style="color: #0000FF;">})</span>
|
||||
<span style="color: #0000FF;">?</span><span style="color: #7060A8;">peek_string</span><span style="color: #0000FF;">(</span><span style="color: #000000;">pMem</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #7060A8;">assert</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">c_func</span><span style="color: #0000FF;">(</span><span style="color: #000000;">xLocalFree</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">pMem</span><span style="color: #0000FF;">})==</span><span style="color: #004600;">NULL</span><span style="color: #0000FF;">)</span>
|
||||
<!--
|
||||
|
|
@ -0,0 +1,19 @@
|
|||
(load "@lib/gcc.l")
|
||||
|
||||
(gcc "str" NIL # The 'gcc' function passes all text
|
||||
'duptest ) # until /**/ to the C compiler
|
||||
|
||||
any duptest(any ex) {
|
||||
any x = evSym(cdr(ex)); // Accept a symbol (string)
|
||||
char str[bufSize(x)]; // Create a buffer to unpack the name
|
||||
char *s;
|
||||
|
||||
bufString(x, str); // Upack the string
|
||||
s = strdup(str); // Make a duplicate
|
||||
x = mkStr(s); // Build a new Lisp string
|
||||
free(s); // Dispose the duplicate
|
||||
return x;
|
||||
}
|
||||
/**/
|
||||
|
||||
(println 'Duplicate (duptest "Hello world!"))
|
||||
|
|
@ -0,0 +1,20 @@
|
|||
/*
|
||||
How to create the shared lib/so file:
|
||||
gcc -c -Wall -Werror -fPIC duptest.c
|
||||
gcc -shared -o duptest.so duptest.o -Wno-undef
|
||||
*/
|
||||
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
|
||||
extern char * duptest(char * str);
|
||||
|
||||
char * duptest(char * str) {
|
||||
static char * s;
|
||||
|
||||
free(s); // We simply dispose the result of the last call
|
||||
return s = strdup(str);
|
||||
}
|
||||
|
||||
int main() {
|
||||
}
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
(prinl "Calling custom so/dll library...")
|
||||
(set 'A NIL)
|
||||
(set 'A (native "./duptest.so" "duptest" 'S "abc"))
|
||||
(prinl "A=" A)
|
||||
(when (not (= A NIL)) (prinl "Success!"))
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
:- module(plffi, [strdup/2]).
|
||||
:- use_foreign_library(plffi).
|
||||
|
|
@ -0,0 +1,20 @@
|
|||
#include <string.h>
|
||||
#include <stdio.h>
|
||||
#include <SWI-Prolog.h>
|
||||
|
||||
static foreign_t pl_strdup(term_t string0, term_t string1)
|
||||
{
|
||||
char *input_string, *output_string;
|
||||
|
||||
if (PL_get_atom_chars(string0, &input_string))
|
||||
{
|
||||
output_string = strdup(input_string);
|
||||
return PL_unify_atom_chars(string1, output_string);
|
||||
}
|
||||
PL_fail;
|
||||
}
|
||||
|
||||
install_t install_plffi()
|
||||
{
|
||||
PL_register_foreign("strdup", 2, pl_strdup, 0);
|
||||
}
|
||||
|
|
@ -0,0 +1 @@
|
|||
$ swipl-ld -o plffi -shared plffi.c
|
||||
Some files were not shown because too many files have changed in this diff Show more
Loading…
Add table
Add a link
Reference in a new issue