Skip to content

Commit 0406fd3

Browse files
OldesOldes
authored
Merge pull request #33 from Siskin-framework/master
Sync repositories
2 parents bf118b1 + a03a3b5 commit 0406fd3

34 files changed

+2412
-93
lines changed

‎.github/workflows/main.yml

+17
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,12 @@ jobs:
2727
- name: Prepare 64bit Rebol/Bulk for upload
2828
run: MOVE ./msvc/Release-x64/rebol3-bulk-x64-vs.exe ./rebol3-bulk-x64.exe
2929

30+
- name: Build 64bit test extension using MSVC
31+
run: ./siskin.exe make/rebol3.nest [msvc %test-x64.rebx]
32+
33+
- name: Prepare 64bit test extension
34+
run: MOVE ./msvc/Release-x64/test-x64.rebx.dll ./test-x64.rebx
35+
3036
- name: Test 64bit Rebol/Bulk
3137
run: ./rebol3-bulk-x64.exe -s ./src/tests/run-tests.r3
3238

@@ -56,6 +62,12 @@ jobs:
5662
- name: Build 64bit Rebol/Bulk using gcc
5763
run: ./siskin make/rebol3.nest %rebol3-bulk-x64-libc-gcc
5864

65+
- name: Build 64bit test extension using gcc
66+
run: |
67+
./siskin make/rebol3.nest %test-x64.rebx
68+
cp ./build/test-x64.rebx ./src/tests/
69+
export LD_LIBRARY_PATH=$LD_LIBRARY_PATH:/$PWD/src/tests/
70+
5971
- name: Test 64bit Rebol/Bulk
6072
run: ./build/rebol3-bulk-x64-libc-gcc -s ./src/tests/run-tests.r3
6173

@@ -87,6 +99,11 @@ jobs:
8799
- name: Build 64bit Rebol/Bulk using clang
88100
run: ./siskin make/rebol3.nest %rebol3-bulk-x64-osx
89101

102+
- name: Build 64bit test extension
103+
run: |
104+
./siskin make/rebol3.nest %test-x64.rebx
105+
cp ./build/test-x64.rebx ./src/tests/
106+
90107
- name: Test 64bit Rebol/Bulk
91108
run: ./build/rebol3-bulk-x64-osx -s ./src/tests/run-tests.r3
92109

‎make/rebol3.nest

+17
Original file line numberDiff line numberDiff line change
@@ -886,4 +886,21 @@ eggs: [
886886
shared: %lib-rebol3-core-x64-osx
887887
]
888888
]
889+
"Test extension 32bit" [
890+
name: %test-x86.rebx
891+
files: only %tests/extension/test.c
892+
:arch-x86
893+
compiler: gcc
894+
flags: [-O2 shared]
895+
#if Linux? [ flag: -fPIC ]
896+
#either macOS? [compiler: clang][compiler: gcc]
897+
]
898+
"Test extension 64bit" [
899+
name: %test-x64.rebx
900+
files: only %tests/extension/test.c
901+
:arch-x64
902+
flags: [-O2 shared]
903+
#if Linux? [ flag: -fPIC ]
904+
#either macOS? [compiler: clang][compiler: gcc]
905+
]
889906
]

‎src/boot/ops.reb

+2-1
Original file line numberDiff line numberDiff line change
@@ -18,7 +18,8 @@ REBOL [
1818
- subtract
1919
* multiply
2020
/ divide
21-
// remainder
21+
// modulo
22+
% remainder
2223
** power
2324
= equal?
2425
=? same?

‎src/core/c-function.c

+24-20
Original file line numberDiff line numberDiff line change
@@ -193,38 +193,42 @@
193193
REBVAL *body;
194194
REBCNT len;
195195

196-
if (
197-
!IS_BLOCK(def)
198-
|| (len = VAL_LEN(def)) < 2
199-
|| !IS_BLOCK(spec = VAL_BLK(def))
200-
|| type == REB_ACTION //@@ https://github.com/rebol/rebol-issues/issues/1051
201-
|| type == REB_NATIVE
202-
) return FALSE;
203-
204-
body = VAL_BLK_SKIP(def, 1);
205-
206-
VAL_FUNC_SPEC(value) = VAL_SERIES(spec);
207-
VAL_FUNC_ARGS(value) = Check_Func_Spec(VAL_SERIES(spec));
208-
209-
if (type != REB_COMMAND) {
210-
if (len != 2 || !IS_BLOCK(body)) return FALSE;
211-
VAL_FUNC_BODY(value) = VAL_SERIES(body);
196+
if (type == REB_ACTION || type == REB_NATIVE) //@@ https://github.com/rebol/rebol-issues/issues/1051
197+
return FALSE;
198+
199+
if (IS_BLOCK(def)) {
200+
if ((len = VAL_LEN(def)) < 2 || !IS_BLOCK(spec = VAL_BLK(def)))
201+
return FALSE;
202+
body = VAL_BLK_SKIP(def, 1);
203+
VAL_FUNC_SPEC(value) = VAL_SERIES(spec);
204+
VAL_FUNC_ARGS(value) = Check_Func_Spec(VAL_SERIES(spec));
205+
206+
if (type != REB_COMMAND) {
207+
if (len != 2 || !IS_BLOCK(body)) return FALSE;
208+
VAL_FUNC_BODY(value) = VAL_SERIES(body);
209+
}
210+
else
211+
Make_Command(value, def);
212+
}
213+
else if (type == REB_OP && IS_FUNCTION(def)) {
214+
VAL_FUNC_SPEC(value) = VAL_FUNC_SPEC(def);
215+
VAL_FUNC_BODY(value) = VAL_FUNC_BODY(def);
216+
VAL_FUNC_ARGS(value) = VAL_FUNC_ARGS(def);
212217
}
213-
else
214-
Make_Command(value, def);
218+
else return FALSE;
215219

216220
VAL_SET(value, type);
217221

218222
if (type == REB_OP) {
219-
// make sure that there are at least 2 args
223+
// make sure that there are exactly 2 args
220224
REBVAL *args = BLK_HEAD(VAL_FUNC_ARGS(value))+1;
221225
REBCNT w = 0;
222226
for (; NOT_END(args); args++) {
223227
if(IS_REFINEMENT(args) && VAL_WORD_CANON(args) == SYM_LOCAL) break;
224228
else if(IS_WORD(args))
225229
w++;
226230
}
227-
if (w < 2) return FALSE;
231+
if (w != 2) return FALSE;
228232
VAL_SET_EXT(value, REB_FUNCTION);
229233
}
230234

‎src/core/f-extension.c

+6-3
Original file line numberDiff line numberDiff line change
@@ -312,7 +312,7 @@ x*/ int Do_Callback(REBSER *obj, u32 name, RXIARG *args, RXIARG *result)
312312
**
313313
***********************************************************************/
314314
{
315-
REBCHR *name;
315+
REBSER* path;
316316
void *dll;
317317
REBCNT error;
318318
REBYTE *code;
@@ -329,10 +329,10 @@ x*/ int Do_Callback(REBSER *obj, u32 name, RXIARG *args, RXIARG *result)
329329

330330
if (!IS_FILE(val)) Trap_Arg(val);
331331

332-
name = Val_Str_To_OS(val);
332+
path = Value_To_OS_Path(val, FALSE);
333333

334334
// Try to load the DLL file:
335-
if (!(dll = OS_OPEN_LIBRARY(name, &error))) {
335+
if (!(dll = OS_OPEN_LIBRARY(SERIES_DATA(path), &error))) {
336336
//printf("error: %i\n", error);
337337
Trap1(RE_NO_EXTENSION, val);
338338
}
@@ -449,6 +449,8 @@ x*/ int Do_Callback(REBSER *obj, u32 name, RXIARG *args, RXIARG *result)
449449
REBCNT n;
450450
RXIFRM frm; // args stored here
451451

452+
CLEARS(&frm);
453+
452454
// All of these were checked above on definition:
453455
val = BLK_HEAD(VAL_FUNC_BODY(value));
454456
cmd = (int)VAL_INT64(val+1);
@@ -485,6 +487,7 @@ x*/ int Do_Callback(REBSER *obj, u32 name, RXIARG *args, RXIARG *result)
485487
case RXR_FALSE:
486488
SET_FALSE(val);
487489
break;
490+
case RXR_BAD_ARGS:
488491
case RXR_ERROR:
489492
{
490493
const char* errmsg = frm.args[1].series;

‎src/core/l-scan.c

+27-2
Original file line numberDiff line numberDiff line change
@@ -882,10 +882,11 @@
882882
return -TOKEN_STRING;
883883

884884
case LEX_DELIMIT_SLASH: /* probably / or / * */
885-
while (*cp && *cp == '/') cp++;
885+
while (*cp == '/') cp++;
886886
if (IS_LEX_AT_LEAST_WORD(*cp) || *cp=='+' || *cp=='-' || *cp=='.') {
887-
// ///refine not allowed
887+
/* ///refine not allowed */
888888
if (scan_state->begin + 1 != cp) {
889+
while (!IS_LEX_DELIMIT(*cp)) cp++;
889890
scan_state->end = cp;
890891
return -TOKEN_REFINE;
891892
}
@@ -901,6 +902,10 @@
901902
type = TOKEN_REFINE;
902903
goto scan_arrow_word;
903904
}
905+
if (*cp == ':' && IS_LEX_DELIMIT(cp[1])) {
906+
scan_state->end = cp+1;
907+
return TOKEN_SET;
908+
}
904909
scan_state->end = cp;
905910
return TOKEN_WORD;
906911

@@ -962,6 +967,15 @@
962967
}
963968
return TOKEN_GET; // allowed :%
964969
}
970+
if (cp[1] == '/') { // allow :///
971+
cp++;
972+
while (*cp == '/') cp++;
973+
if (IS_LEX_DELIMIT(*cp)) {
974+
scan_state->end = cp;
975+
return TOKEN_GET;
976+
}
977+
else cp = scan_state->begin;
978+
}
965979
type = TOKEN_GET;
966980
cp++; /* skip ':' */
967981
goto scanword;
@@ -986,6 +1000,17 @@
9861000
}
9871001
}
9881002
if (*cp == '\'') return -TOKEN_LIT; // no ''foo
1003+
if (*cp == '/') { // allow '///
1004+
cp++;
1005+
while (*cp == '/') cp++;
1006+
if (IS_LEX_DELIMIT(*cp)) {
1007+
scan_state->end = cp;
1008+
return TOKEN_LIT;
1009+
}
1010+
while (!IS_LEX_DELIMIT(*cp)) cp++;
1011+
scan_state->end = cp;
1012+
return -TOKEN_LIT;
1013+
}
9891014
type = TOKEN_LIT;
9901015
goto scanword;
9911016

‎src/core/n-math.c

+92
Original file line numberDiff line numberDiff line change
@@ -34,6 +34,8 @@
3434
#include <math.h>
3535
#include <float.h>
3636

37+
REBOOL almost_equal(REBDEC a, REBDEC b, REBCNT max_diff); // in t-decimal.c
38+
3739
#define LOG2 0.6931471805599453
3840
#define EPS 2.718281828459045235360287471
3941

@@ -359,6 +361,77 @@ enum {SINE, COSINE, TANGENT};
359361
}
360362

361363

364+
/***********************************************************************
365+
**
366+
*/ void modulus(REBVAL *ret, REBVAL *val1, REBVAL *val2, REBOOL round)
367+
/*
368+
** Based on: https://stackoverflow.com/a/66777048/494472
369+
**
370+
***********************************************************************/
371+
{
372+
double a, aa, b, m;
373+
if (IS_INTEGER(val1) && IS_INTEGER(val2)) {
374+
REBI64 ia = VAL_INT64(val1);
375+
REBI64 ib = VAL_INT64(val2);
376+
if (ib == 0) Trap0(RE_ZERO_DIVIDE);
377+
SET_INTEGER(ret, ((ia % ib) + ib) % ib);
378+
return;
379+
}
380+
381+
a = Number_To_Dec(val1);
382+
b = Number_To_Dec(val2);
383+
384+
if (b == 0.0) Trap0(RE_ZERO_DIVIDE);
385+
386+
if (round && b < 0.0) b = fabs(b);
387+
388+
m = fmod(fmod(a, b) + b, b);
389+
390+
if (round && (almost_equal(a, a - m, 10) || almost_equal(b, b + m, 10))) {
391+
m = 0.0;
392+
}
393+
switch (VAL_TYPE(val1)) {
394+
case REB_DECIMAL:
395+
case REB_PERCENT: SET_DECIMAL(ret, m); break;
396+
case REB_INTEGER: SET_INTEGER(ret, (REBI64)m); break;
397+
case REB_TIME: VAL_TIME(ret) = DEC_TO_SECS(m); break;
398+
case REB_MONEY: VAL_DECI(ret) = decimal_to_deci(m); break;
399+
case REB_CHAR: SET_CHAR(ret, (REBINT)m); break;
400+
}
401+
SET_TYPE(ret, VAL_TYPE(val1));
402+
}
403+
404+
/***********************************************************************
405+
**
406+
*/ REBNATIVE(mod)
407+
/*
408+
// mod: native [
409+
// {Compute a nonnegative remainder of A divided by B.}
410+
// a [number! money! char! time!]
411+
// b [number! money! char! time!] "Must be nonzero."
412+
// ]
413+
***********************************************************************/
414+
{
415+
modulus(D_RET, D_ARG(1), D_ARG(2), FALSE);
416+
return R_RET;
417+
}
418+
419+
/***********************************************************************
420+
**
421+
*/ REBNATIVE(modulo)
422+
/*
423+
// modulo: native [
424+
// {Wrapper for MOD that handles errors like REMAINDER. Negligible values (compared to A and B) are rounded to zero.}
425+
// a [number! money! char! time!]
426+
// b [number! money! char! time!] "Absolute value will be used."
427+
// ]
428+
***********************************************************************/
429+
{
430+
modulus(D_RET, D_ARG(1), D_ARG(2), TRUE);
431+
return R_RET;
432+
}
433+
434+
362435
/***********************************************************************
363436
**
364437
*/ REBNATIVE(log_10)
@@ -578,6 +651,10 @@ enum {SINE, COSINE, TANGENT};
578651
}
579652
else if (tb == REB_INTEGER || tb == REB_CHAR) // special negative?, zero?, ...
580653
goto compare;
654+
else if (tb == REB_TIME) {
655+
SET_INTEGER(b, (REBI64)SECS_IN(VAL_TIME(b)));
656+
goto compare;
657+
}
581658
break;
582659

583660
case REB_DECIMAL:
@@ -592,6 +669,10 @@ enum {SINE, COSINE, TANGENT};
592669
}
593670
else if (tb == REB_DECIMAL || tb == REB_PERCENT) // equivalent types
594671
goto compare;
672+
else if (tb == REB_TIME) {
673+
SET_DECIMAL(b, (REBDEC)VAL_TIME(b) * NANO);
674+
goto compare;
675+
}
595676
break;
596677

597678
case REB_MONEY:
@@ -627,6 +708,17 @@ enum {SINE, COSINE, TANGENT};
627708
//o: with not integer numbers (money, decimal, percent)
628709
if (tb == REB_INTEGER)
629710
goto compare;
711+
break;
712+
case REB_TIME:
713+
if (tb == REB_INTEGER) {
714+
SET_INTEGER(a, (REBI64)SECS_IN(VAL_TIME(a)));
715+
goto compare;
716+
}
717+
else if (tb == REB_DECIMAL || tb == REB_PERCENT) {
718+
SET_DECIMAL(a, (REBDEC)VAL_TIME(a) * NANO);
719+
goto compare;
720+
}
721+
break;
630722
}
631723
if (strictness == 0 || strictness == 1) return FALSE;
632724
//if (strictness >= 2)

‎src/core/t-decimal.c

+18
Original file line numberDiff line numberDiff line change
@@ -214,6 +214,24 @@ REBOOL almost_equal(REBDEC a, REBDEC b, REBCNT max_diff) {
214214
VAL_INT64(dec) = n; // aliasing the bits!
215215
}
216216

217+
/***********************************************************************
218+
**
219+
*/ REBDEC Number_To_Dec(REBVAL* val)
220+
/*
221+
***********************************************************************/
222+
{
223+
REBDEC d = NAN;
224+
switch (VAL_TYPE(val)) {
225+
case REB_DECIMAL:
226+
case REB_PERCENT: d = VAL_DECIMAL(val); break;
227+
case REB_INTEGER: d = (REBDEC)VAL_INT64(val); break;
228+
case REB_MONEY: d = deci_to_decimal(VAL_DECI(val)); break;
229+
case REB_CHAR: d = (REBDEC)VAL_CHAR(val); break;
230+
case REB_TIME: d = VAL_TIME(val) * NANO;
231+
}
232+
return d;
233+
}
234+
217235

218236
/***********************************************************************
219237
**

0 commit comments

Comments
 (0)