Merge branch 'master' into crypt

Author: Oldes

src/boot/actions.reb

@@ -208,7 +208,7 @@ find: action [
 	series [series! gob! port! bitset! typeset! object! map! none!]
 	value [any-type!]
 	/part {Limits the search to a given length or position}
-	length [number! series! pair!]
+	range [number! series! pair!]
 	/only {Treats a series value as only a single value}
 	/case {Characters are case-sensitive}
 	/same {Use "same?" as comparator}
@@ -228,7 +228,7 @@ select: action [
 	series [series! port! map! object! module! none!]
 	value [any-type!]
 	/part {Limits the search to a given length or position}
-	length [number! series! pair!]
+	range [number! series! pair!]
 	/only {Treats a series value as only a single value}
 	/case {Characters are case-sensitive}
 	/same {Use "same?" as comparator}
@@ -266,8 +266,8 @@ to: action [
 copy: action [
 	{Copies a series, object, or other value.}
 	value [series! port! map! object! bitset! any-function! error!] {At position}
-	/part {Limits to a given length or position}
-	length [number! series! pair!]
+	/part {Limits to a given length or end position}
+	range [number! series! pair!]
 	/deep {Also copies series values within the block}
 	/types {What datatypes to copy}
 	kinds [typeset! datatype!]
@@ -277,7 +277,7 @@ take: action [
 	{Removes and returns one or more elements.}
 	series [series! port! gob! none!] {At position (modified)}
 	/part {Specifies a length or end position}
-	length [number! series! pair!]
+	range [number! series! pair!]
 	/deep {Also copies series values within the block}
 	/last {Take it from the tail end}
 ]
@@ -295,7 +295,7 @@ insert: action [
 	series [series! port! map! gob! object! bitset!] {At position (modified)}
 	value [any-type!] {The value to insert}
 	/part {Limits to a given length or position}
-	length [number! series! pair!]
+	range [number! series! pair!]
 	/only {Only insert a block as a single value (not the contents of the block)}
 	/dup {Duplicates the insert a specified number of times}
 	count [number! pair!]
@@ -306,7 +306,7 @@ append: action [
 	series [series! port! map! gob! object! bitset!] {Any position (modified)}
 	value [any-type!] {The value to insert}
 	/part {Limits to a given length or position}
-	length [number! series! pair!]
+	range [number! series! pair!]
 	/only {Only insert a block as a single value (not the contents of the block)}
 	/dup {Duplicates the insert a specified number of times}
 	count [number! pair!]
@@ -316,7 +316,7 @@ remove: action [
 	{Removes element(s); returns same position.}
 	series [series! gob! port! bitset! none! map!] {At position (modified)}
 	/part {Removes multiple elements or to a given position}
-	length [number! series! pair! char!]
+	range [number! series! pair! char!]
 	/key {Removes a key from map.}
 	key-arg [any-type!]
 ]
@@ -326,7 +326,7 @@ change: action [
 	series [series! gob! port! struct!]{At position (modified)}
 	value [any-type!] {The new value}
 	/part {Limits the amount to change to a given length or position}
-	length [number! series! pair!]
+	range [number! series! pair!]
 	/only {Only change a block as a single value (not the contents of the block)}
 	/dup {Duplicates the change a specified number of times}
 	count [number! pair!]
@@ -365,7 +365,7 @@ reverse: action [
 	{Reverses the order of elements; returns at same position.}
 	series [series! gob! tuple! pair!] {At position (modified)}
 	/part {Limits to a given length or position}
-	length [number! series!]
+	range [number! series!]
 ]
 
 sort: action [
@@ -376,8 +376,8 @@ sort: action [
 	size [integer!] {Size of each record}
 	/compare  {Comparator offset, block or function}
 	comparator [integer! block! any-function!]
-	/part {Sort only part of a series}
-	length [number! series!] {Length of series to sort}
+	/part {Limits the sorting to a given length or position}
+	range [number! series!]
 	/all {Compare all fields}
 	/reverse {Reverse sort order}
 ]

src/core/l-types.c

@@ -303,10 +303,9 @@ bad_hex:	Trap0(RE_INVALID_CHARS);
 	if (!dig) return 0;
 	if (*cp == 'E' || *cp == 'e') {
 			*ep++ = *cp++;
-			dig = 0;
+			dig = 1;
 			if (*cp == '-' || *cp == '+') *ep++ = *cp++;
-			while (IS_LEX_NUMBER(*cp)) *ep++ = *cp++, dig=1;
-			if (!dig) return 0;
+			while (IS_LEX_NUMBER(*cp)) *ep++ = *cp++;
 	}
 	if (*cp == '%') {
 		if (dec_only) return 0;
@@ -372,7 +371,9 @@ bad_hex:	Trap0(RE_INVALID_CHARS);
 	if (len > 19) return 0;
 
 	// Convert, check, and return:
+	errno = 0;
 	n = CHR_TO_INT(buf);
+	if (errno != 0) return 0; //overflow
 	if ((n > 0 && neg) || (n < 0 && !neg)) return 0;
 	SET_INTEGER(value, n);
 	return cp;

src/core/t-bitset.c

@@ -700,9 +700,18 @@
 		Trap_Arg(arg);
 
 	case A_REMOVE:	// #"a" "abc"  remove/key bs "abcd"
-		if (D_REF(ARG_REMOVE_PART)) Trap0(RE_BAD_REFINES);
-		if (!D_REF(ARG_REMOVE_KEY)) Trap0(RE_MISSING_ARG); // /key required
-		if (Set_Bits(VAL_SERIES(value), D_ARG(ARG_REMOVE_KEY_ARG), FALSE)) break;
+		if (D_REF(ARG_REMOVE_KEY)) {
+			if (D_REF(ARG_REMOVE_PART))
+				Trap0(RE_BAD_REFINES);
+			arg = D_ARG(ARG_REMOVE_KEY_ARG);
+		} else if (D_REF(ARG_REMOVE_PART)) {
+			arg = D_ARG(ARG_REMOVE_RANGE);
+			// remove/part is allowed only with block, string, binary and char
+			if (!(IS_BLOCK(arg) || IS_STRING(arg) || IS_BINARY(arg) || IS_CHAR(arg)))
+				Trap_Arg(arg);
+		}
+		else Trap0(RE_MISSING_ARG); // /key or /part is required
+		if (Set_Bits(VAL_SERIES(value), arg, FALSE)) break;
 		Trap_Arg(D_ARG(3));
 
 	case A_COPY:

src/core/t-block.c

@@ -686,7 +686,7 @@ static struct {
 	case A_TAKE:
 		// take/part:
 		if (D_REF(ARG_TAKE_PART)) {
-			len = Partial1(value, D_ARG(ARG_TAKE_LENGTH));
+			len = Partial1(value, D_ARG(ARG_TAKE_RANGE));
 			if (len == 0) {
 zero_blk:
 				Set_Block(D_RET, Make_Block(0));
@@ -749,7 +749,7 @@ static struct {
 		args = Find_Refines(ds, ALL_FIND_REFS);
 //		if (ANY_BLOCK(arg) || args) {
 			len = ANY_BLOCK(arg) ? VAL_BLK_LEN(arg) : 1;
-			if (args & AM_FIND_PART) tail = index + Partial1(value, D_ARG(ARG_FIND_LENGTH));
+			if (args & AM_FIND_PART) tail = index + Partial1(value, D_ARG(ARG_FIND_RANGE));
 			ret = 1;
 			if (args & AM_FIND_SKIP) ret = Int32s(D_ARG(ARG_FIND_SIZE), 1);
 			ret = Find_Block(ser, index, tail, arg, len, args, ret);
@@ -801,7 +801,7 @@ static struct {
 	case A_COPY: // /PART len /DEEP /TYPES kinds
 #if 0
 		args = D_REF(ARG_COPY_DEEP) ? COPY_ALL : 0;
-		len = Partial1(value, D_ARG(ARG_COPY_LENGTH));
+		len = Partial1(value, D_ARG(ARG_COPY_RANGE));
 		index = (REBINT)VAL_INDEX(value);
 //		VAL_SERIES(value) = (len > 0) ? Copy_Block_Deep(ser, index, len, args) : Make_Block(0);
 		VAL_INDEX(value) = 0;
@@ -816,7 +816,7 @@ static struct {
 			if (IS_DATATYPE(arg)) types |= TYPESET(VAL_DATATYPE(arg));
 			else types |= VAL_TYPESET(arg);
 		}
-		len = Partial1(value, D_ARG(ARG_COPY_LENGTH));
+		len = Partial1(value, D_ARG(ARG_COPY_RANGE));
 		VAL_SERIES(value) = Copy_Block_Values(ser, VAL_INDEX(value), VAL_INDEX(value)+len, types);
 		VAL_INDEX(value) = 0;
 	}

src/core/t-event.c

@@ -379,10 +379,8 @@
 	value = D_ARG(1);
 	arg = D_ARG(2);
 
-	if (action == A_MAKE) {
-		// Clone an existing event?
-		if (IS_EVENT(value)) return R_ARG1;
-		else if (IS_DATATYPE(value)) {
+	if (action == A_MAKE || action == A_TO) {
+		if (IS_EVENT(value) || IS_DATATYPE(value)) {
 			if (IS_EVENT(arg)) return R_ARG2;
 			//Trap_Make(REB_EVENT, value);
 			VAL_SET(D_RET, REB_EVENT);
@@ -392,7 +390,7 @@
 is_arg_error:
 			Trap_Types(RE_EXPECT_VAL, REB_EVENT, VAL_TYPE(arg));
 
-		// Initialize GOB from block:
+		// Initialize event from block:
 		if (IS_BLOCK(arg)) Set_Event_Vars(D_RET, VAL_BLK_DATA(arg));
 		else goto is_arg_error;
 	}

src/core/t-object.c

@@ -396,6 +396,11 @@ static REBSER *Trim_Object(REBSER *obj)
 				break; // returns obj
 			}
 		}
+		else if (IS_ERROR(value)) {
+			Make_Error_Object(arg, value); // arg is block/string, returns value
+			type = 0;
+			break; // returns value
+		}
 		Trap_Make(VAL_TYPE(value), value);
 
 	case A_TO:

src/core/t-string.c

@@ -633,7 +633,7 @@ static struct {
 
 		if (ANY_BINSTR(arg)) len = VAL_LEN(arg);
 
-		if (args & AM_FIND_PART) tail = index + Partial(value, 0, D_ARG(ARG_FIND_LENGTH), 0);
+		if (args & AM_FIND_PART) tail = index + Partial(value, 0, D_ARG(ARG_FIND_RANGE), 0);
 		ret = 1; // skip size
 		if (args & AM_FIND_SKIP) {
 			ret = Partial(value, 0, D_ARG(ARG_FIND_SIZE), 0);

src/include/reb-c.h

@@ -213,7 +213,7 @@ enum {
 **
 ***********************************************************************/
 
-#define MAX_INT_LEN     21
+#define MAX_INT_LEN     25
 #define MAX_HEX_LEN     16
 
 #ifdef ITOA64           // Integer to ascii conversion

src/mezz/mezz-debug.reb

@@ -3,6 +3,7 @@ REBOL [
 	Title: "REBOL 3 Mezzanine: Debug"
 	Rights: {
 		Copyright 2012 REBOL Technologies
+		Copyright 2012-2022 Rebol Open Source Contributors
 		REBOL is a trademark of REBOL Technologies
 	}
 	License: {
@@ -15,6 +16,7 @@ dt: delta-time: function [
 	{Delta-time - returns the time it takes to evaluate the block.}
 	block [block!]
 ][
+	recycle ; force GC, so there is less chance that it is fired in `do block`
 	start: stats/timer
 	do block
 	stats/timer - start
@@ -99,3 +101,138 @@ speed?: function [
 	]
 	result
 ]
+
+;@@ time formating and print table are probably originally made by https://github.com/toomasv
+
+format-time: function [
+	"Convert a time value to a human readable string"
+	time [time!]
+] [
+	if time >= 0:00:01 [
+		return form round/to time 0:0.001
+	]
+	units: ["ms" "μs" "ns"]
+	foreach u units [
+		time: time * 1000
+		if time >= 0:00:01 [
+			time: to integer! round time
+			return append form time u
+		]
+	]
+	"1ns" ; the lowest time in Rebol
+]
+
+print-table: function [
+	"Print a block of blocks as an ASCII table"
+	headers [block!]
+	block [block!]
+] [
+	format: clear []
+	header: clear []
+	sep:    []
+	i:      1
+	unless parse headers [
+		some [
+			(text: width: fmt-func: none)
+			set text string! any [set width integer! | set fmt-func word! | set fmt-func path!]
+			(
+				append header sep
+				append header as-yellow either width [pad text width] [text]
+				either width [
+					either fmt-func [
+						append format compose [(sep) pad (fmt-func) pick block (i) (width)]
+					] [
+						append format compose [(sep) pad pick block (i) (width)]
+					]
+				] [
+					either fmt-func [
+						append format compose [(sep) (fmt-func) pick block (i)]
+					] [
+						append format compose [(sep) pick block (i)]
+					]
+				]
+				sep: "|"
+				i:   i + 1
+			)
+		]
+	] [
+		cause-error "Invalid headers spec"
+	]
+	print header
+	format: func [block] reduce ['print format]
+	foreach row block [format row]
+]
+
+print-horizontal-line: does [
+	loop -1 + any [query/mode system/ports/output 'window-cols 76][ prin #"-" ] prin lf
+]
+
+;@@ profile idea is based on code from https://gist.github.com/giesse/1232d7f71a15a3a8417ec6f091398811
+
+profile: function [
+	"Profile code"
+	blocks [block!]   "Block of code values (block, word, or function) to profile"
+	/times            "Running the test code multiple times, results are average"
+	 count [integer!] "Default value is 10, minimum is 2 and maximum 1000"
+	/quiet "Don't print results, return [time evaluations series-made series-expanded memory source] results instead"
+][
+	; limit the number of code runs. There is GC forced between each run, which may be time consuming!
+	; As the output is counted as an average of each run result, it does not make sense to have too many of them.
+	count: min max any [count 10] 2 1000
+	unless quiet [
+		print ["^/Running" as-green length? blocks "code blocks" as-green count "times."]
+		print-horizontal-line
+	]
+	res: collect [
+		foreach blk blocks [
+			case [
+				block? :blk [code: :blk]
+				all [word? :blk block? code: get/any :blk][]
+				code: to block! :blk
+			]
+			; to get the most precise results, make a deep copy for each test!
+			; GC is done in `delta-profile` call.
+			test: copy/deep :code
+			data: try [delta-profile :test]
+			if error? data [
+				keep/only reduce [0:0:0 0 0 0 0 :blk]
+				continue
+			]
+			loop count - 1 [
+				test: copy/deep :code
+				temp: delta-profile :test
+				foreach [k v] data [ data/(k): v + temp/:k ]
+			]
+			keep/only reduce [
+				data/timer / count
+				to integer! data/evals / count
+				to integer! round/ceiling data/series-made / count
+				to integer! round/ceiling data/series-expanded / count
+				to integer! data/series-bytes / count
+				:blk
+			]
+		]
+	]
+	sort res                ; sort by time
+	either quiet [
+		new-line/all res on ; return formatted results
+	][
+		unless empty? res [
+			reference: res/1/1
+		]
+		fmt-time: function [time] [
+			if time < 0:00:00.000000001 [return "error"]
+			rel: time / (max reference 0:00:00.000000001)
+			ajoin [round/to rel 0.01 "x (" format-time time ")"]
+		]
+		print-table [
+			"Time"   18 fmt-time
+			"Evals"   6
+			"S.made"  6
+			"S.expa"  6
+			"Memory" 11
+			"Code" mold/flat
+		] res
+		print-horizontal-line
+	]
+]

src/mezz/mezz-save.reb

@@ -113,7 +113,8 @@ save: function [
 		file? where [write where data] ; WRITE converts to UTF-8, saves overhead
 		url? where [write where data]  ; But some schemes don't support it
 		none? where [data] ; just return the UTF-8 binary
-		'else [append where data] ; string! or binary!, insert data
+		binary? where [append where data]
+		'else [append where mold data] ; Using mold when appending data to string!
 	]
 ]