Jürgen
In 950 (and going back a few releases) Command.cc has broken )HELP.
At (around) line 150, add
if (!strcmp(command, ")HELP")) return false;
without this, things like ")HELP +" (or whatever) won't work.
Second: )HELP doesn't actually behave well with NATIVE functions. At
(around) line 962,
try
if (ufun) ufun->help(CERR);
instead of
Assert(ufun);
Now, it would be useful to implement a "help" option to NATIVE -- but I
haven't done that.
As a side-note, it would be useful to have a CHANGES.txt file detailing
the changes from a release
to the next.
Find attached a first cut at shared memory support (mem.cc). It allows
mmap() of a region
(get the file handle from fopen), and supports floating, integer,
character, complex vectors
of different sizes transferring from GNU APL to and from the shared
memory region. I am
working with this currently, and when I get some experience will try to
graft into some
of the primitives. But this gives an idea of what I was talking about at
the beginning of the
month.
Fred Weigel
/**********************************************************************
* *
* mem.cc *
* *
* Implement shared memory for GNU APL. Vectors of the same type are *
* stored in memory buffers (mmap and munmap interfaces are provided) *
* The handle to access the file is provided by Quad FIO (fopen), and *
* a pointer to memory is provided. The size in bytes (chars) of each *
* supported type is provided, and is used to compute strides. Vector *
* of each type can be transferred between the buffer and an APL *
* vector. The memory vectors must be of only one type. In future, *
* the APL primitives may be enhanced to support these uni-type *
* vectors directly, as this maximizes cache/memory performance. *
* The current advantage to using mem.cc is that the APL Workspace is *
* not bloated with data, and the data is not even read if it is not *
* used. *
* *
* Copyright (C) 2017 Fred Weigel *
* *
* This program is free software: you can redistribute it and/or *
* modify it under the terms of the GNU General Public License as *
* published by the Free Software Foundation, either version 3 of the *
* License, or (at your option) any later version. *
* *
* This program is distributed in the hope that it will be useful, *
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *
* GNU General Public License for more details. *
* *
* You should have received a copy of the GNU General Public License *
* along with this program. If not, see *
* <http://www.gnu.org/licenses/>. *
* *
**********************************************************************/
#include <stdio.h>
#include <errno.h>
#include <string.h>
#include <sys/mman.h>
#include <complex.h>
#include "../Value.icc"
#include "../Native_interface.hh"
#include "../Quad_FIO.hh"
class NativeFunction;
static Fun_signature get_signature() {
return SIG_Z_A_F2_B;
}
static Token help(ostream &out) {
out <<
" Functions provided by MEM...\n"
"\n"
" Legend: e - error code (integer)\n"
" h - file handle (integer)\n"
" p - pointer (integer)\n"
" i - integer\n"
" s - string\n"
"\n"
" MEM[ 0] '' print this text\n"
" Zp ← MEM[ 1] B1h B2i B3s mmap fd B1h, length B2i, mode B3s,\n"
" B4i offset B4i\n"
" mode: r read\n"
" w write\n"
" s shared (default private)\n"
" h huge pages\n"
" n noreserve\n"
" p populate\n"
" B3s default: rw private\n"
" B1h = -1: anonymous map\n"
" Ze ← MEM[ 2] B1p B2i munmap pointer B1p, length B2i\n"
"\n"
" Zi ← MEM[ 50] '' sizeof (float)\n"
" Zi ← MEM[ 51] '' sizeof (double)\n"
" Zi ← MEM[ 52] '' sizeof (long double)\n"
" Zi ← MEM[ 53] '' sizeof (_Complex float)\n"
" Zi ← MEM[ 54] '' sizeof (_Complex double)\n"
" Zi ← MEM[ 55] '' sizeof (_Complex long double)\n"
" Zi ← MEM[ 56] '' sizeof (char)\n"
" Zi ← MEM[ 57] '' sizeof (short)\n"
" Zi ← MEM[ 58] '' sizeof (int)\n"
" Zi ← MEM[ 59] '' sizeof (long)\n"
" Zi ← MEM[ 60] '' sizeof (long long)\n"
" Zi ← MEM[ 61] '' sizeof (void *)\n"
" Zi ← MEM[ 62] '' sizeof (char32_t)\n"
"\n"
" Z ← Ap MEM[100] Bi vector of Bi float at Ap\n"
" Z ← Ap MEM[101] Bi vector of Bi double at Ap\n"
" Z ← Ap MEM[102] Bi vector of Bi long double at Ap\n"
" Z ← Ap MEM[103] Bi vector of Bi _Complex float at Ap\n"
" Z ← Ap MEM[104] Bi vector of Bi _Complex double at Ap\n"
" Z ← Ap MEM[105] Bi vector of Bi _Complex long double at Ap\n"
" Z ← Ap MEM[106] Bi vector of Bi char int at Ap\n"
" Z ← Ap MEM[107] Bi vector of Bi short from Ap\n"
" Z ← Ap MEM[108] Bi vector of Bi int at Ap\n"
" Z ← Ap MEM[109] Bi vector of Bi long at Ap\n"
" Z ← Ap MEM[110] Bi vector of Bi long long at Ap\n"
" Z ← Ap MEM[111] Bi vector of Bi (void *) at Ap\n"
" Z ← Ap MEM[112] Bi vector of Bi char32_t at Ap\n"
" Z ← Ap MEM[113] Bi vector of Bi char at Ap\n"
"\n"
" Ap MEM[150] B set Ap as float from B\n"
" Ap MEM[151] B set Ap as double from B\n"
" Ap MEM[152] B set Ap as long double from B\n"
" Ap MEM[153] B set Ap as _Complex float from B\n"
" Ap MEM[154] B set Ap as _Complex double from B\n"
" Ap MEM[155] B set Ap as _Complex long double from B\n"
" Ap MEM[156] B set Ap as char int from B\n"
" Ap MEM[157] B set Ap as short from B\n"
" Ap MEM[158] B set Ap as int from B\n"
" Ap MEM[159] B set Ap as long from B\n"
" Ap MEM[160] B set Ap as long long from B\n"
" Ap MEM[161] B set Ap as (void *) from B\n"
" Ap MEM[162] B set Ap as char32_t from B\n"
" Ap MEM[163] B set Ap as char from B\n"
;
/* msync [3] -- possible
*/
return Token(TOK_APL_VALUE1, Str0(LOC));
}
static Token eval_B(Value_P B, const NativeFunction *caller) {
return help(COUT);
}
static Token eval_AB(Value_P A, Value_P B,
const NativeFunction *caller) {
return help(COUT);
}
static Token eval_XB(Value_P X, Value_P B,
const NativeFunction *caller) {
int types[] = { sizeof (float), sizeof (double),
sizeof (long double), sizeof (_Complex float),
sizeof (_Complex double),
sizeof (_Complex long double),
sizeof (char), sizeof (short), sizeof (int),
sizeof (long), sizeof (long long),
sizeof (void *), sizeof (char32_t)
};
if (B->get_rank() > 1)
RANK_ERROR;
if (X->get_rank() > 1)
RANK_ERROR;
int fn = X->get_ravel(0).get_near_int();
switch (fn) {
case 0: return help(CERR);
case 1: { /* mmap B1h B2i B3s */
int fd = B->get_ravel(0).get_near_int();
int l = B->get_ravel(1).get_near_int();
Value_P str = B->get_ravel(2).get_pointer_value();
UCS_string ucs(*str.get());
UTF8_string u(ucs);
const char *s = u.c_str();
int flags = 0;
int prot = 0;
int shared = 0;
int o = 0;
if (fd == -1)
flags = MAP_ANONYMOUS;
else
o = B->get_ravel(3).get_near_int();
for (; *s; ++s)
switch (*s) {
case 'r': prot |= PROT_READ;
break;
case 'w': prot |= PROT_WRITE;
break;
case 's': shared = 1;
break;
case 'h': flags |= MAP_HUGETLB;
break;
case 'n': flags |= MAP_NORESERVE;
break;
case 'p': flags |= MAP_POPULATE;
break;
}
if (prot == 0)
prot = PROT_READ | PROT_WRITE;
flags |= shared ? MAP_SHARED : MAP_PRIVATE;
void *p = mmap(NULL, l, prot, flags, fd, o);
return Token(TOK_APL_VALUE1, IntScalar((long)p, LOC));
}
case 2: { /* munmap B1p B2l */
void *p = (void *)(B->get_ravel(0).get_near_int());
int l = B->get_ravel(1).get_near_int();
int r = munmap(p, l);
return Token(TOK_APL_VALUE1, IntScalar(r, LOC));
}
case 50 ... 62:
return Token(TOK_APL_VALUE1, IntScalar(types[fn-50], LOC));
}
MORE_ERROR() << "bad function number " << fn << " in MEM eval_XB";
CERR << "MEM function number: " << fn << endl;
DOMAIN_ERROR;
return Token(TOK_APL_VALUE1, IntScalar(-1, LOC));
}
static Token eval_AXB(Value_P A, Value_P X, Value_P B,
const NativeFunction *caller) {
if (A->get_rank() > 1)
RANK_ERROR;
if (B->get_rank() > 1)
RANK_ERROR;
if (X->get_rank() > 1)
RANK_ERROR;
int fn = X->get_ravel(0).get_near_int();
switch (fn) {
case 0 ... 99:
return eval_XB(X, B, caller);
case 100: {
float *p = (float *)(A->get_ravel(0).get_near_int());
int n = B->get_ravel(0).get_near_int();
Value_P Z(n, LOC);
loop(i, n) new (Z->next_ravel()) FloatCell(p[i]);
Z->check_value(LOC);
return Token(TOK_APL_VALUE1, Z);
}
case 101: {
double *p = (double *)(A->get_ravel(0).get_near_int());
int n = B->get_ravel(0).get_near_int();
Value_P Z(n, LOC);
loop(i, n) new (Z->next_ravel()) FloatCell(p[i]);
Z->check_value(LOC);
return Token(TOK_APL_VALUE1, Z);
}
case 102: {
long double *p =
(long double *)(A->get_ravel(0).get_near_int());
int n = B->get_ravel(0).get_near_int();
Value_P Z(n, LOC);
loop(i, n) new (Z->next_ravel()) FloatCell(p[i]);
Z->check_value(LOC);
return Token(TOK_APL_VALUE1, Z);
}
case 103: {
_Complex float *p =
(_Complex float *)(A->get_ravel(0).get_near_int());
int n = B->get_ravel(0).get_near_int();
Value_P Z(n, LOC);
loop(i, n)
new (Z->next_ravel()) ComplexCell(creal(p[i]), cimag(p[i]));
Z->check_value(LOC);
return Token(TOK_APL_VALUE1, Z);
}
case 104: {
_Complex double *p =
(_Complex double *)(A->get_ravel(0).get_near_int());
int n = B->get_ravel(0).get_near_int();
Value_P Z(n, LOC);
loop(i, n)
new (Z->next_ravel()) ComplexCell(creal(p[i]), cimag(p[i]));
Z->check_value(LOC);
return Token(TOK_APL_VALUE1, Z);
}
case 105: {
_Complex long double *p =
(_Complex long double *)(A->get_ravel(0).get_near_int());
int n = B->get_ravel(0).get_near_int();
Value_P Z(n, LOC);
loop(i, n)
new (Z->next_ravel()) ComplexCell(creal(p[i]), cimag(p[i]));
Z->check_value(LOC);
return Token(TOK_APL_VALUE1, Z);
}
case 106: {
char *p = (char *)(A->get_ravel(0).get_near_int());
int n = B->get_ravel(0).get_near_int();
Value_P Z(n, LOC);
loop(i, n) new (Z->next_ravel()) IntCell(p[i]);
Z->check_value(LOC);
return Token(TOK_APL_VALUE1, Z);
}
case 107: {
short *p = (short *)(A->get_ravel(0).get_near_int());
int n = B->get_ravel(0).get_near_int();
Value_P Z(n, LOC);
loop(i, n) new (Z->next_ravel()) IntCell(p[i]);
Z->check_value(LOC);
return Token(TOK_APL_VALUE1, Z);
}
case 108: {
int *p = (int *)(A->get_ravel(0).get_near_int());
int n = B->get_ravel(0).get_near_int();
Value_P Z(n, LOC);
loop(i, n) new (Z->next_ravel()) IntCell(p[i]);
Z->check_value(LOC);
return Token(TOK_APL_VALUE1, Z);
}
case 109: {
long *p = (long *)(A->get_ravel(0).get_near_int());
int n = B->get_ravel(0).get_near_int();
Value_P Z(n, LOC);
loop(i, n) new (Z->next_ravel()) IntCell(p[i]);
Z->check_value(LOC);
return Token(TOK_APL_VALUE1, Z);
}
case 110: {
long long *p =
(long long *)(A->get_ravel(0).get_near_int());
int n = B->get_ravel(0).get_near_int();
Value_P Z(n, LOC);
loop(i, n) new (Z->next_ravel()) IntCell(p[i]);
Z->check_value(LOC);
return Token(TOK_APL_VALUE1, Z);
}
case 111: {
void **p = (void **)(A->get_ravel(0).get_near_int());
int n = B->get_ravel(0).get_near_int();
Value_P Z(n, LOC);
loop(i, n) new (Z->next_ravel()) IntCell((long)(p[i]));
Z->check_value(LOC);
return Token(TOK_APL_VALUE1, Z);
}
case 112: {
char32_t *p = (char32_t *)(A->get_ravel(0).get_near_int());
int n = B->get_ravel(0).get_near_int();
Value_P Z(n, LOC);
loop(i, n)
new (Z->next_ravel()) CharCell((Unicode)(p[i] ? p[i] : ' '));
Z->check_value(LOC);
return Token(TOK_APL_VALUE1, Z);
}
case 113: {
char *p = (char *)(A->get_ravel(0).get_near_int());
int n = B->get_ravel(0).get_near_int();
Value_P Z(n, LOC);
loop(i, n)
new (Z->next_ravel()) CharCell((Unicode)(p[i] ? p[i] : ' '));
Z->check_value(LOC);
return Token(TOK_APL_VALUE1, Z);
}
case 150: {
float *p = (float *)(A->get_ravel(0).get_near_int());
int n = B->get_cols();
loop(i, n) p[i] = B->get_ravel(i).get_real_value();
return Token(TOK_APL_VALUE1, Str0(LOC));
}
case 151: {
double *p = (double *)(A->get_ravel(0).get_near_int());
int n = B->get_cols();
loop(i, n) p[i] = B->get_ravel(i).get_real_value();
return Token(TOK_APL_VALUE1, Str0(LOC));
}
case 152: {
long double *p =
(long double *)(A->get_ravel(0).get_near_int());
int n = B->get_cols();
loop(i, n) p[i] = B->get_ravel(i).get_real_value();
return Token(TOK_APL_VALUE1, Str0(LOC));
}
case 153: {
_Complex float *p =
(_Complex float *)(A->get_ravel(0).get_near_int());
int n = B->get_cols();
loop(i, n) p[i] = B->get_ravel(i).get_real_value() +
I * B->get_ravel(i).get_imag_value();
return Token(TOK_APL_VALUE1, Str0(LOC));
}
case 154: {
_Complex double *p =
(_Complex double *)(A->get_ravel(0).get_near_int());
int n = B->get_cols();
loop(i, n) p[i] = B->get_ravel(i).get_real_value() +
I * B->get_ravel(i).get_imag_value();
return Token(TOK_APL_VALUE1, Str0(LOC));
}
case 155: {
_Complex long double *p =
(_Complex long double *)(A->get_ravel(0).get_near_int());
int n = B->get_cols();
loop(i, n) p[i] = B->get_ravel(i).get_real_value() +
I * B->get_ravel(i).get_imag_value();
return Token(TOK_APL_VALUE1, Str0(LOC));
}
case 156: {
char *p = (char *)(A->get_ravel(0).get_near_int());
int n = B->get_cols();
loop(i, n) p[i] = B->get_ravel(i).get_near_int();
return Token(TOK_APL_VALUE1, Str0(LOC));
}
case 157: {
short *p = (short *)(A->get_ravel(0).get_near_int());
int n = B->get_cols();
loop(i, n) p[i] = B->get_ravel(i).get_near_int();
return Token(TOK_APL_VALUE1, Str0(LOC));
}
case 158: {
int *p = (int *)(A->get_ravel(0).get_near_int());
int n = B->get_cols();
loop(i, n) p[i] = B->get_ravel(i).get_near_int();
return Token(TOK_APL_VALUE1, Str0(LOC));
}
case 159: {
long *p = (long *)(A->get_ravel(0).get_near_int());
int n = B->get_cols();
loop(i, n) p[i] = B->get_ravel(i).get_near_int();
return Token(TOK_APL_VALUE1, Str0(LOC));
}
case 160: {
long long *p =
(long long *)(A->get_ravel(0).get_near_int());
int n = B->get_cols();
loop(i, n) p[i] = B->get_ravel(i).get_near_int();
return Token(TOK_APL_VALUE1, Str0(LOC));
}
case 161: {
void **p = (void **)(A->get_ravel(0).get_near_int());
int n = B->get_cols();
loop(i, n) p[i] = (void *)(B->get_ravel(i).get_near_int());
return Token(TOK_APL_VALUE1, Str0(LOC));
}
case 162: {
char32_t *p = (char32_t *)(A->get_ravel(0).get_near_int());
int n = B->get_cols();
loop(i, n)
p[i] = (char32_t)(B->get_ravel(i).get_char_value());
return Token(TOK_APL_VALUE1, Str0(LOC));
}
case 163: {
char *p = (char *)(A->get_ravel(0).get_near_int());
int n = B->get_cols();
loop(i, n) p[i] = (char)(B->get_ravel(i).get_char_value());
return Token(TOK_APL_VALUE1, Str0(LOC));
}
}
MORE_ERROR() << "bad function number " << fn << " in MEM eval_AXB";
CERR << "MEM function number: " << fn << endl;
DOMAIN_ERROR;
return Token(TOK_APL_VALUE1, IntScalar(-1, LOC));
}
extern "C" void *get_function_mux(const char *function_name) {
if (!strcmp(function_name, "get_signature"))
return (void *)&get_signature;
if (!strcmp(function_name, "eval_B"))
return (void *)&eval_B;
if (!strcmp(function_name, "eval_AB"))
return (void *)&eval_AB;
if (!strcmp(function_name, "eval_XB"))
return (void *)&eval_XB;
if (!strcmp(function_name, "eval_AXB"))
return (void *)&eval_AXB;
return 0;
}
