FEAT: new Bincode dialect CROP command for shrinking buffers from the left side at the read buffer index position

Author: Oldes

src/core/u-bincode.c

@@ -3,7 +3,7 @@
 **  REBOL [R3] Language Interpreter and Run-time Environment
 **
 **  Copyright 2012 REBOL Technologies
-**  Copyright 2012-2018 Rebol Open Source Developers
+**  Copyright 2012-2022 Rebol Open Source Developers
 **  REBOL is a trademark of REBOL Technologies
 **
 **  Licensed under the Apache License, Version 2.0 (the "License");
@@ -1639,6 +1639,14 @@ static REBCNT EncodedU32_Size(u32 value) {
 							                         + mst->time.minute * 60
 							                         + mst->time.hour * 3600);
 							break;
+						case SYM_CROP:
+							n = 0;
+							if (IS_PROTECT_SERIES(bin)) Trap0(RE_PROTECTED);
+							Remove_Series(VAL_SERIES(buffer_read), 0, VAL_INDEX(buffer_read));
+							cp = VAL_BIN_HEAD(buffer_read);
+							VAL_INDEX(buffer_write) = MAX(0, (REBI64)VAL_INDEX(buffer_write) - VAL_INDEX(buffer_read));
+							VAL_INDEX(buffer_read) = 0;
+							continue;
 						default:
 							Trap1(RE_INVALID_SPEC, value);
 					}

src/tests/units/bincode-test.r3

@@ -484,6 +484,35 @@ is-protected-error?: func[code][
 
 ===end-group===
 
+===start-group=== "BinCode special read/write functions"
 
+	--test-- "BinCode - CROP"
+	;; CROP shrinks buffers from the left side at the position of the read buffer
+		b: binary #{010203}
+		--assert [1] = binary/read b [UI8 CROP]
+		--assert all [
+			#{0203} = b/buffer
+			#{0203} = b/buffer-write
+		]
+		--assert b = binary/write b [UI8 4]
+		--assert all [
+			#{0403} = b/buffer
+			  #{03} = b/buffer-write
+		]
+		--assert [4] = binary/read b [UI8 CROP]
+		--assert all [
+			  #{03} = b/buffer
+			  #{03} = b/buffer-write
+		]
+		--assert b = binary/write b [AT 2 UI8 5]
+		--assert all [
+			#{0305} = b/buffer
+			    #{} = b/buffer-write
+		]
+		--assert [3 5] = binary/read b [UI8 UI8 CROP]
+		--assert all [
+			empty? head b/buffer
+			empty? head b/buffer-write
+		]
 
 ~~~end-file~~~