voc code generation for __SETOF macro.

[norayr]

this is BIT.Mod from Oberon S3:

(* ETH Oberon, Copyright 1990-2003 Computer Systems Institute, ETH Zurich, CH-8092 Zurich.
Refer to the license.txt file provided with this distribution. *)

MODULE BIT;  (** portable *)  (* tk 12.2.96 *)
(** AUTHOR "tk"; PURPOSE "Bit manipulation"; *)

  IMPORT S := SYSTEM;

  TYPE
    SHORTCARD* = SHORTINT;
    CARDINAL* = INTEGER;
    LONGCARD* = LONGINT;

  CONST
    rbo = FALSE;  (* reverse bit ordering, e.g. PowerPC*)
    risc = FALSE;  (* risc architecture - no support for 8 and 16-bit rotations *)

  (** bitwise exclusive or: x XOR y *)
  PROCEDURE CXOR*(x, y: CHAR): CHAR;
  BEGIN RETURN CHR(S.VAL(LONGINT, S.VAL(SET, LONG(ORD(x))) / S.VAL(SET, LONG(ORD(y)))))
  END CXOR;

  PROCEDURE SXOR*(x, y: SHORTINT): SHORTINT;
  BEGIN RETURN SHORT(SHORT(S.VAL(LONGINT, S.VAL(SET, LONG(LONG(x))) / S.VAL(SET, LONG(LONG(y))))))
  END SXOR;

  PROCEDURE IXOR*(x, y: INTEGER): INTEGER;
  BEGIN RETURN SHORT(S.VAL(LONGINT, S.VAL(SET, LONG(x)) / S.VAL(SET, LONG(y))))
  END IXOR;

  PROCEDURE LXOR*(x, y: LONGINT): LONGINT;
  BEGIN RETURN S.VAL(LONGINT, S.VAL(SET, x) / S.VAL(SET, y))
  END LXOR;


  (** bitwise or: x OR y *)
  PROCEDURE COR*(x, y: CHAR): CHAR;
  BEGIN RETURN CHR(S.VAL(LONGINT, S.VAL(SET, LONG(ORD(x))) + S.VAL(SET, LONG(ORD(y)))))
  END COR;

  PROCEDURE SOR*(x, y: SHORTINT): SHORTINT;
  BEGIN RETURN SHORT(SHORT(S.VAL(LONGINT, S.VAL(SET, LONG(LONG(x))) + S.VAL(SET, LONG(LONG(y))))))
  END SOR;

  PROCEDURE IOR*(x, y: INTEGER): INTEGER;
  BEGIN RETURN SHORT(S.VAL(LONGINT, S.VAL(SET, LONG(x)) + S.VAL(SET, LONG(y))))
  END IOR;

  PROCEDURE LOR*(x, y: LONGINT): LONGINT;
  BEGIN RETURN S.VAL(LONGINT, S.VAL(SET, x) + S.VAL(SET, y))
  END LOR;


  (** bitwise and: x AND y *)
  PROCEDURE CAND*(x, y: CHAR): CHAR;
  BEGIN RETURN CHR(S.VAL(LONGINT, S.VAL(SET, LONG(ORD(x))) * S.VAL(SET, LONG(ORD(y)))))
  END CAND;

  PROCEDURE SAND*(x, y: SHORTINT): SHORTINT;
  BEGIN RETURN SHORT(SHORT(S.VAL(LONGINT, S.VAL(SET, LONG(LONG(x))) * S.VAL(SET, LONG(LONG(y))))))
  END SAND;

  PROCEDURE IAND*(x, y: INTEGER): INTEGER;
  BEGIN RETURN SHORT(S.VAL(LONGINT, S.VAL(SET, LONG(x)) * S.VAL(SET, LONG(y))))
  END IAND;

  PROCEDURE LAND*(x, y: LONGINT): LONGINT;
  BEGIN RETURN S.VAL(LONGINT, S.VAL(SET, x) * S.VAL(SET, y))
  END LAND;


  (** bitwise logical left-shift: x shifted n *)
  PROCEDURE CLSH*(x: CHAR; n: SHORTINT): CHAR;
  BEGIN
    IF risc THEN RETURN CHR(S.LSH(S.VAL(LONGINT, S.VAL(SET, ORD(x)) * S.VAL(SET, 0FFH)), n))
    ELSE RETURN S.LSH(x, n) END
  END CLSH;

  PROCEDURE SLSH*(x: SHORTINT; n: SHORTINT): SHORTINT;
  BEGIN
    IF risc THEN RETURN SHORT(SHORT(S.LSH(S.VAL(LONGINT, S.VAL(SET, LONG(LONG(x))) * S.VAL(SET, 0FFH)), n)))
    ELSE RETURN S.LSH(x, n) END
  END SLSH;

  PROCEDURE ILSH*(x: INTEGER; n: SHORTINT): INTEGER;
  BEGIN
    IF risc THEN RETURN SHORT(S.LSH(S.VAL(LONGINT, S.VAL(SET, LONG(x)) * S.VAL(SET, 0FFFFH)), n))
    ELSE RETURN S.LSH(x, n) END
  END ILSH;

  PROCEDURE LLSH*(x: LONGINT; n: SHORTINT): LONGINT;
  BEGIN RETURN S.LSH(x, n)
  END LLSH;


  (** bitwise rotation: x rotatated by n bits *)
  PROCEDURE CROT*(x: CHAR; n: SHORTINT): CHAR;
    VAR s0, s1: SET; i: INTEGER;
  BEGIN
    IF risc THEN
      s0 := S.VAL(SET, ORD(x)); s1 := {};
      IF rbo THEN
        i := 0; WHILE i < 8 DO
          IF 31-i IN s0 THEN INCL(s1, 31 - ((i+n) MOD 8)) END;
          INC(i)
        END;
      ELSE
        i := 0; WHILE i < 8 DO
          IF i IN s0 THEN INCL(s1, (i+n) MOD 8) END;
          INC(i)
        END;
      END;
      RETURN CHR(S.VAL(LONGINT, s1))
    ELSE RETURN S.ROT(x, n) END;
  END CROT;

  PROCEDURE SROT*(x: SHORTINT; n: SHORTINT): SHORTINT;
    VAR s0, s1: SET; i: INTEGER;
  BEGIN
    IF risc THEN
      s0 := S.VAL(SET, LONG(LONG(x))); s1 := {};
      IF rbo THEN
        i := 0; WHILE i < 8 DO
          IF 31-i IN s0 THEN INCL(s1, 31 - ((i+n) MOD 8)) END;
          INC(i)
        END;
      ELSE
        i := 0; WHILE i < 8 DO
          IF i IN s0 THEN INCL(s1, (i+n) MOD 8) END;
          INC(i)
        END;
      END;
      RETURN SHORT(SHORT(S.VAL(LONGINT, s1)))
    ELSE RETURN S.ROT(x, n) END;
  END SROT;

  PROCEDURE IROT*(x: INTEGER; n: SHORTINT): INTEGER;
    VAR s0, s1: SET; i: INTEGER;
  BEGIN
    IF risc THEN
      s0 := S.VAL(SET, LONG(x)); s1 := {};
      IF rbo THEN
        i := 0; WHILE i < 16 DO
          IF 31-i IN s0 THEN INCL(s1, 31 - ((i+n) MOD 16)) END;
          INC(i)
        END;
      ELSE
        i := 0; WHILE i < 16 DO
          IF i IN s0 THEN INCL(s1, (i+n) MOD 16) END;
          INC(i)
        END;
      END;
      RETURN SHORT(S.VAL(LONGINT, s1))
    ELSE RETURN S.ROT(x, n) END;
  END IROT;

  PROCEDURE LROT*(x: LONGINT; n: SHORTINT): LONGINT;
  BEGIN RETURN S.ROT(x, n)
  END LROT;


  (** swap bytes to change byteordering *)
  PROCEDURE ISWAP*(x: INTEGER): INTEGER;
    TYPE integer = ARRAY 2 OF CHAR; VAR a, b: integer;
  BEGIN a := S.VAL(integer, x); b[0] := a[1]; b[1] := a[0]; RETURN S.VAL(INTEGER, b)
  END ISWAP;

  PROCEDURE LSWAP*(x: LONGINT): LONGINT;
    TYPE longint = ARRAY 4 OF CHAR; VAR a, b: longint;
  BEGIN a := S.VAL(longint, x); b[0] := a[3]; b[1] := a[2]; b[2] := a[1]; b[3] := a[0]; RETURN S.VAL(LONGINT, b)
  END LSWAP;


  (** test bit n in x*)
  PROCEDURE CBIT*(x: CHAR; n: SHORTINT): BOOLEAN;
  BEGIN ASSERT((n >= 0) & (n <= 7));
    IF rbo THEN RETURN (31-n) IN S.VAL(SET, ORD(x)) ELSE RETURN n IN S.VAL(SET, LONG(ORD(x))) END
  END CBIT;

  PROCEDURE BIT*(x: LONGINT; n: SHORTINT): BOOLEAN;
  BEGIN ASSERT((n >= 0) & (n <= 31));
    IF rbo THEN RETURN (31-n) IN S.VAL(SET, x) ELSE RETURN n IN S.VAL(SET, x) END
  END BIT;


  (** set bit n in x*)
  PROCEDURE CSETBIT*(VAR x: CHAR; n: SHORTINT);
    VAR i: LONGINT;
  BEGIN ASSERT((n >= 0) & (n <= 7));
    i := ORD(x); IF rbo THEN INCL(S.VAL(SET, i), 31-n) ELSE INCL(S.VAL(SET, i), n) END; x := CHR(i)
  END CSETBIT;

  PROCEDURE SSETBIT*(VAR x: SHORTINT; n: SHORTINT);
    VAR i: LONGINT;
  BEGIN ASSERT((n >= 0) & (n <= 7));
    i := LONG(LONG(x)); IF rbo THEN INCL(S.VAL(SET, i), 31-n) ELSE INCL(S.VAL(SET, i), n) END; x := SHORT(SHORT(i))
  END SSETBIT;

  PROCEDURE ISETBIT*(VAR x: INTEGER; n: SHORTINT);
    VAR i: LONGINT;
  BEGIN ASSERT((n >= 0) & (n <= 15));
    i := LONG(x); IF rbo THEN INCL(S.VAL(SET, i), 31-n) ELSE INCL(S.VAL(SET, i), n) END; x := SHORT(i)
  END ISETBIT;

  PROCEDURE LSETBIT*(VAR x: LONGINT; n: SHORTINT);
  BEGIN ASSERT((n >= 0) & (n <= 31));
    IF rbo THEN INCL(S.VAL(SET, x), 31-n) ELSE INCL(S.VAL(SET, x), n) END
  END LSETBIT;


  (** clear bit n in x*)
  PROCEDURE CCLRBIT*(VAR x: CHAR; n: SHORTINT);
    VAR i: LONGINT;
  BEGIN ASSERT(ABS(n) < 8);
    i := ORD(x); IF rbo THEN EXCL(S.VAL(SET, i), 31-n) ELSE EXCL(S.VAL(SET, i), n) END; x := CHR(i)
  END CCLRBIT;

  PROCEDURE SCLRBIT*(VAR x: SHORTINT; n: SHORTINT);
    VAR i: LONGINT;
  BEGIN ASSERT(ABS(n) < 8);
    i := LONG(LONG(x)); IF rbo THEN EXCL(S.VAL(SET, i), 31-n) ELSE EXCL(S.VAL(SET, i), n) END; x := SHORT(SHORT(i))
  END SCLRBIT;

  PROCEDURE ICLRBIT*(VAR x: INTEGER; n: SHORTINT);
    VAR i: LONGINT;
  BEGIN ASSERT(ABS(n) < 16);
    i := LONG(x); IF rbo THEN EXCL(S.VAL(SET, i), 31-n) ELSE EXCL(S.VAL(SET, i), n) END; x := SHORT(i)
  END ICLRBIT;

  PROCEDURE LCLRBIT*(VAR x: LONGINT; n: SHORTINT);
  BEGIN IF rbo THEN EXCL(S.VAL(SET, x), 31-n) ELSE EXCL(S.VAL(SET, x), n) END
  END LCLRBIT;


  (** unsigned comparison: x < y *)
  PROCEDURE SLESS*(x, y: SHORTCARD): BOOLEAN;
  BEGIN
    RETURN
      S.VAL(LONGINT, S.VAL(SET, LONG(LONG(x))) * S.VAL(SET, 0FFH))
       <
     S.VAL(LONGINT, S.VAL(SET, LONG(LONG(y))) * S.VAL(SET, 0FFH));
  END SLESS;

  PROCEDURE ILESS*(x, y: CARDINAL): BOOLEAN;
  BEGIN
    RETURN
      S.VAL(LONGINT, S.VAL(SET,LONG(x)) * S.VAL(SET, 0FFFFH))
    <
      S.VAL(LONGINT, S.VAL(SET, LONG(y)) * S.VAL(SET, 0FFFFH))
  END ILESS;

  PROCEDURE LLESS*(x, y: LONGCARD): BOOLEAN;
    VAR x0, y0: LONGINT;
  BEGIN x0 := S.LSH(x, -1); y0 := S.LSH(y, -1);
    IF x0 - y0 = 0 THEN RETURN x0 MOD 2 < y0 MOD 2 ELSE RETURN x0 < y0 END
  END LLESS;


  (** unsigned comparison: x <= y *)
  PROCEDURE SLESSEQ*(x, y: SHORTCARD): BOOLEAN;
  BEGIN
    RETURN
      S.VAL(LONGINT, S.VAL(SET, LONG(LONG(x))) * S.VAL(SET, 0FFH))
    <=
      S.VAL(LONGINT, S.VAL(SET, LONG(LONG(y))) * S.VAL(SET, 0FFH))
  END SLESSEQ;

  PROCEDURE ILESSEQ*(x, y: CARDINAL): BOOLEAN;
  BEGIN
    RETURN
      S.VAL(LONGINT, S.VAL(SET,LONG(x)) * S.VAL(SET, 0FFFFH))
    <=
      S.VAL(LONGINT, S.VAL(SET, LONG(y)) * S.VAL(SET, 0FFFFH))
  END ILESSEQ;

  PROCEDURE LLESSEQ*(x, y: LONGCARD): BOOLEAN;
    VAR x0, y0: LONGINT;
  BEGIN x0 := S.LSH(x, -1); y0 := S.LSH(y, -1);
    IF x0 - y0 = 0 THEN RETURN x0 MOD 2 <= y0 MOD 2 ELSE RETURN x0 <= y0 END
  END LLESSEQ;


  (** unsigned division: x DIV y *)
  PROCEDURE SDIV*(x, y: SHORTCARD): SHORTCARD;
  BEGIN RETURN SHORT(SHORT(S.VAL(LONGINT, S.VAL(SET, LONG(LONG(x))) * S.VAL(SET, 0FFH)) DIV y))
  END SDIV;

  PROCEDURE IDIV*(x, y: CARDINAL): CARDINAL;
  BEGIN RETURN SHORT(S.VAL(LONGINT, S.VAL(SET, LONG(x)) * S.VAL(SET, 0FFFFH))) DIV y;
  END IDIV;

  PROCEDURE LDIV*(x, y: LONGCARD): LONGCARD;
    CONST m = 4.294967296D9;
    VAR x0, y0: LONGREAL;
  BEGIN IF x < 0 THEN x0 := m - x ELSE x0 := x END;
    IF y < 0 THEN y0 := m - y ELSE y0 := y END;
    RETURN ENTIER(x0 / y0)
  END LDIV;

END BIT.

voc compiles it to BIT.c:

/* voc 2.1.0 [2024/08/23] for gcc LP64 on gentoo xtspa */

#define SHORTINT INT8
#define INTEGER  INT16
#define LONGINT  INT32
#define SET      UINT32

#include "SYSTEM.h"




export BOOLEAN BIT_BIT (INT32 x, INT8 n);
export CHAR BIT_CAND (CHAR x, CHAR y);
export BOOLEAN BIT_CBIT (CHAR x, INT8 n);
export void BIT_CCLRBIT (CHAR *x, INT8 n);
export CHAR BIT_CLSH (CHAR x, INT8 n);
export CHAR BIT_COR (CHAR x, CHAR y);
export CHAR BIT_CROT (CHAR x, INT8 n);
export void BIT_CSETBIT (CHAR *x, INT8 n);
export CHAR BIT_CXOR (CHAR x, CHAR y);
export INT16 BIT_IAND (INT16 x, INT16 y);
export void BIT_ICLRBIT (INT16 *x, INT8 n);
export INT16 BIT_IDIV (INT16 x, INT16 y);
export BOOLEAN BIT_ILESS (INT16 x, INT16 y);
export BOOLEAN BIT_ILESSEQ (INT16 x, INT16 y);
export INT16 BIT_ILSH (INT16 x, INT8 n);
export INT16 BIT_IOR (INT16 x, INT16 y);
export INT16 BIT_IROT (INT16 x, INT8 n);
export void BIT_ISETBIT (INT16 *x, INT8 n);
export INT16 BIT_ISWAP (INT16 x);
export INT16 BIT_IXOR (INT16 x, INT16 y);
export INT32 BIT_LAND (INT32 x, INT32 y);
export void BIT_LCLRBIT (INT32 *x, INT8 n);
export INT32 BIT_LDIV (INT32 x, INT32 y);
export BOOLEAN BIT_LLESS (INT32 x, INT32 y);
export BOOLEAN BIT_LLESSEQ (INT32 x, INT32 y);
export INT32 BIT_LLSH (INT32 x, INT8 n);
export INT32 BIT_LOR (INT32 x, INT32 y);
export INT32 BIT_LROT (INT32 x, INT8 n);
export void BIT_LSETBIT (INT32 *x, INT8 n);
export INT32 BIT_LSWAP (INT32 x);
export INT32 BIT_LXOR (INT32 x, INT32 y);
export INT8 BIT_SAND (INT8 x, INT8 y);
export void BIT_SCLRBIT (INT8 *x, INT8 n);
export INT8 BIT_SDIV (INT8 x, INT8 y);
export BOOLEAN BIT_SLESS (INT8 x, INT8 y);
export BOOLEAN BIT_SLESSEQ (INT8 x, INT8 y);
export INT8 BIT_SLSH (INT8 x, INT8 n);
export INT8 BIT_SOR (INT8 x, INT8 y);
export INT8 BIT_SROT (INT8 x, INT8 n);
export void BIT_SSETBIT (INT8 *x, INT8 n);
export INT8 BIT_SXOR (INT8 x, INT8 y);


CHAR BIT_CXOR (CHAR x, CHAR y)
{
	return (CHAR)((INT32)((UINT32)(x) ^ (UINT32)(y)));
}

INT8 BIT_SXOR (INT8 x, INT8 y)
{
	return (INT8)((INT16)((INT32)((UINT32)(((INT16)x)) ^ (UINT32)(((INT16)y)))));
}

INT16 BIT_IXOR (INT16 x, INT16 y)
{
	return (INT16)((INT32)((UINT32)(x) ^ (UINT32)(y)));
}

INT32 BIT_LXOR (INT32 x, INT32 y)
{
	return (INT32)((UINT32)x ^ (UINT32)y);
}

CHAR BIT_COR (CHAR x, CHAR y)
{
	return (CHAR)((INT32)((UINT32)(x) | (UINT32)(y)));
}

INT8 BIT_SOR (INT8 x, INT8 y)
{
	return (INT8)((INT16)((INT32)((UINT32)(((INT16)x)) | (UINT32)(((INT16)y)))));
}

INT16 BIT_IOR (INT16 x, INT16 y)
{
	return (INT16)((INT32)((UINT32)(x) | (UINT32)(y)));
}

INT32 BIT_LOR (INT32 x, INT32 y)
{
	return (INT32)((UINT32)x | (UINT32)y);
}

CHAR BIT_CAND (CHAR x, CHAR y)
{
	return (CHAR)((INT32)(((UINT32)(x) & (UINT32)(y))));
}

INT8 BIT_SAND (INT8 x, INT8 y)
{
	return (INT8)((INT16)((INT32)(((UINT32)(((INT16)x)) & (UINT32)(((INT16)y))))));
}

INT16 BIT_IAND (INT16 x, INT16 y)
{
	return (INT16)((INT32)(((UINT32)(x) & (UINT32)(y))));
}

INT32 BIT_LAND (INT32 x, INT32 y)
{
	return (INT32)(((UINT32)x & (UINT32)y));
}

CHAR BIT_CLSH (CHAR x, INT8 n)
{
	return __LSH(x, n, 8);
}

INT8 BIT_SLSH (INT8 x, INT8 n)
{
	return __LSH(x, n, 8);
}

INT16 BIT_ILSH (INT16 x, INT8 n)
{
	return __LSH(x, n, 16);
}

INT32 BIT_LLSH (INT32 x, INT8 n)
{
	return __LSH(x, n, 32);
}

CHAR BIT_CROT (CHAR x, INT8 n)
{
	UINT32 s0, s1;
	INT16 i;
	return __ROT(x, n, 8);
}

INT8 BIT_SROT (INT8 x, INT8 n)
{
	UINT32 s0, s1;
	INT16 i;
	return __ROT(x, n, 8);
}

INT16 BIT_IROT (INT16 x, INT8 n)
{
	UINT32 s0, s1;
	INT16 i;
	return __ROT(x, n, 16);
}

INT32 BIT_LROT (INT32 x, INT8 n)
{
	return __ROT(x, n, 32);
}

typedef
	CHAR integer__20[2];

INT16 BIT_ISWAP (INT16 x)
{
	integer__20 a, b;
	__MOVE(__VAL(integer__20, x), a, 2);
	b[0] = a[1];
	b[1] = a[0];
	return __VAL(INT16, b);
}

typedef
	CHAR longint__32[4];

INT32 BIT_LSWAP (INT32 x)
{
	longint__32 a, b;
	__MOVE(__VAL(longint__32, x), a, 4);
	b[0] = a[3];
	b[1] = a[2];
	b[2] = a[1];
	b[3] = a[0];
	return __VAL(INT32, b);
}

BOOLEAN BIT_CBIT (CHAR x, INT8 n)
{
	__ASSERT((n >= 0 && n <= 7), 0);
	return __IN(n, (UINT32)(x), 32);
}

BOOLEAN BIT_BIT (INT32 x, INT8 n)
{
	__ASSERT((n >= 0 && n <= 31), 0);
	return __IN(n, (UINT32)x, 32);
}

void BIT_CSETBIT (CHAR *x, INT8 n)
{
	INT32 i;
	__ASSERT((n >= 0 && n <= 7), 0);
	i = (INT16)*x;
	(UINT32)i |= __SETOF(n,32);
	*x = (CHAR)i;
}

void BIT_SSETBIT (INT8 *x, INT8 n)
{
	INT32 i;
	__ASSERT((n >= 0 && n <= 7), 0);
	i = ((INT16)*x);
	(UINT32)i |= __SETOF(n,32);
	*x = (INT8)((INT16)i);
}

void BIT_ISETBIT (INT16 *x, INT8 n)
{
	INT32 i;
	__ASSERT((n >= 0 && n <= 15), 0);
	i = *x;
	(UINT32)i |= __SETOF(n,32);
	*x = (INT16)i;
}

void BIT_LSETBIT (INT32 *x, INT8 n)
{
	__ASSERT((n >= 0 && n <= 31), 0);
	(UINT32)*x |= __SETOF(n,32);
}

void BIT_CCLRBIT (CHAR *x, INT8 n)
{
	INT32 i;
	__ASSERT(__ABS(n) < 8, 0);
	i = (INT16)*x;
	(UINT32)i &= ~__SETOF(n,32);
	*x = (CHAR)i;
}

void BIT_SCLRBIT (INT8 *x, INT8 n)
{
	INT32 i;
	__ASSERT(__ABS(n) < 8, 0);
	i = ((INT16)*x);
	(UINT32)i &= ~__SETOF(n,32);
	*x = (INT8)((INT16)i);
}

void BIT_ICLRBIT (INT16 *x, INT8 n)
{
	INT32 i;
	__ASSERT(__ABS(n) < 16, 0);
	i = *x;
	(UINT32)i &= ~__SETOF(n,32);
	*x = (INT16)i;
}

void BIT_LCLRBIT (INT32 *x, INT8 n)
{
	(UINT32)*x &= ~__SETOF(n,32);
}

BOOLEAN BIT_SLESS (INT8 x, INT8 y)
{
	return (INT32)(((UINT32)(((INT16)x)) & (UINT32)255)) < (INT32)(((UINT32)(((INT16)y)) & (UINT32)255));
}

BOOLEAN BIT_ILESS (INT16 x, INT16 y)
{
	return (INT32)(((UINT32)(x) & (UINT32)65535)) < (INT32)(((UINT32)(y) & (UINT32)65535));
}

BOOLEAN BIT_LLESS (INT32 x, INT32 y)
{
	INT32 x0, y0;
	x0 = __LSHR(x, 1, 32);
	y0 = __LSHR(y, 1, 32);
	if (x0 - y0 == 0) {
		return __MASK(x0, -2) < __MASK(y0, -2);
	} else {
		return x0 < y0;
	}
	__RETCHK;
}

BOOLEAN BIT_SLESSEQ (INT8 x, INT8 y)
{
	return (INT32)(((UINT32)(((INT16)x)) & (UINT32)255)) <= (INT32)(((UINT32)(((INT16)y)) & (UINT32)255));
}

BOOLEAN BIT_ILESSEQ (INT16 x, INT16 y)
{
	return (INT32)(((UINT32)(x) & (UINT32)65535)) <= (INT32)(((UINT32)(y) & (UINT32)65535));
}

BOOLEAN BIT_LLESSEQ (INT32 x, INT32 y)
{
	INT32 x0, y0;
	x0 = __LSHR(x, 1, 32);
	y0 = __LSHR(y, 1, 32);
	if (x0 - y0 == 0) {
		return __MASK(x0, -2) <= __MASK(y0, -2);
	} else {
		return x0 <= y0;
	}
	__RETCHK;
}

INT8 BIT_SDIV (INT8 x, INT8 y)
{
	return (INT8)((INT16)__DIV((INT32)(((UINT32)(((INT16)x)) & (UINT32)255)), y));
}

INT16 BIT_IDIV (INT16 x, INT16 y)
{
	return __DIV((INT16)((INT32)(((UINT32)(x) & (UINT32)65535))), y);
}

INT32 BIT_LDIV (INT32 x, INT32 y)
{
	LONGREAL x0, y0;
	if (x < 0) {
		x0 =   4.29496729600000e+009 - x;
	} else {
		x0 = x;
	}
	if (y < 0) {
		y0 =   4.29496729600000e+009 - y;
	} else {
		y0 = y;
	}
	return (INT32)__ENTIER(x0 / y0);
}


export void *BIT__init(void)
{
	__DEFMOD;
	__REGMOD("BIT", 0);
/* BEGIN */
	__ENDMOD;
}

and when it tries to compile the generated C file:

 $ voc -s BIT.Mod 
BIT.Mod  Compiling BIT.

  75:     IF risc THEN RETURN CHR(S.LSH(S.VAL(LONGINT, S.VAL(SET, ORD(x)) * S.VAL(SET, 0FFH)), n))
                                                                       ^
  pos  2417  warning 308  SYSTEM.VAL result includes memory past end of source variable; use SYSTEM.GET

 101:       s0 := S.VAL(SET, ORD(x)); s1 := {};
                                  ^
  pos  3187  warning 308  SYSTEM.VAL result includes memory past end of source variable; use SYSTEM.GET

 177:     IF rbo THEN RETURN (31-n) IN S.VAL(SET, ORD(x)) ELSE RETURN n IN S.VAL(SET, LONG(ORD(x))) END
                                                       ^
  pos  5331  warning 308  SYSTEM.VAL result includes memory past end of source variable; use SYSTEM.GET  6723 chars.
BIT.c: In function ‘BIT_CSETBIT’:
BIT.c:205:19: error: lvalue required as left operand of assignment
  205 |         (UINT32)i |= __SETOF(n,32);
      |                   ^~
BIT.c: In function ‘BIT_SSETBIT’:
BIT.c:214:19: error: lvalue required as left operand of assignment
  214 |         (UINT32)i |= __SETOF(n,32);
      |                   ^~
BIT.c: In function ‘BIT_ISETBIT’:
BIT.c:223:19: error: lvalue required as left operand of assignment
  223 |         (UINT32)i |= __SETOF(n,32);
      |                   ^~
BIT.c: In function ‘BIT_LSETBIT’:
BIT.c:230:20: error: lvalue required as left operand of assignment
  230 |         (UINT32)*x |= __SETOF(n,32);
      |                    ^~
BIT.c: In function ‘BIT_CCLRBIT’:
BIT.c:238:19: error: lvalue required as left operand of assignment
  238 |         (UINT32)i &= ~__SETOF(n,32);
      |                   ^~
BIT.c: In function ‘BIT_SCLRBIT’:
BIT.c:247:19: error: lvalue required as left operand of assignment
  247 |         (UINT32)i &= ~__SETOF(n,32);
      |                   ^~
BIT.c: In function ‘BIT_ICLRBIT’:
BIT.c:256:19: error: lvalue required as left operand of assignment
  256 |         (UINT32)i &= ~__SETOF(n,32);
      |                   ^~
BIT.c: In function ‘BIT_LCLRBIT’:
BIT.c:262:20: error: lvalue required as left operand of assignment
  262 |         (UINT32)*x &= ~__SETOF(n,32);
      |                    ^~
C compile: gcc -fPIC -g -I "/opt/voc/2/include"   -c BIT.c
-- failed: status 0, exitcode 1.
Terminated by Halt(1)

[norayr]

so in august 30 i spent several hours trying to fix code generation, and generate maybe even two lines instead of one, to fix this issue. whatever i tried, i failed, that's why i created this issue to remember and come back to this problem.

but came to say that as a temporary solution, i found out that when voc is built with tcc (by exporting CC=tcc) then tcc is able to compile BIT.Mod

[Oleg-N-Cher]

Regarding this (and similar) lines:

S.VAL(LONGINT, S.VAL(SET, ORD(x))...)

Here SET is cast in LONGINT. We remember that SYSTEM.VAL is a memory operation:

#define __VAL(t, x) (*(t*)&(x))

And the contents of the upper 4 bytes will be undefined because it's someone else's memory. So the warning is quite reasonable, because it is a potential source of bugs. So I wouldn't change the compiler, I'd just rewrite the source to get rid of such castings.

[norayr]

thank you, Oleg!

meanwhile i changed DES.Mod a little bit, and was able to compile DES.Mod with BIT.Mod (by using tcc): https://github.com/norayr/des/tree/main

[norayr]

yes, i was driven by a thought that voc should generate proper C code that can be translated by a C compiler.

[norayr]

Oleg, thank you, i have changed BIT.Mod to compile with voc which uses gcc.

[Oleg-N-Cher]

Oops. I'm so used to LONGINT 64-bit in Component Pascal, that it confused me. Of course the warning is caused by casting ORD(x) to SET. As we recall, the default size of integer calculations in Oberon-2 is of a 16-bit INTEGER, so the result of ORD(x) is 16-bit, and is cast to a 32-bit SET. In this case, it will be sufficient to add a LONG, i.e.

IF risc THEN RETURN CHR(S.LSH(S.VAL(LONGINT, S.VAL(SET, LONG(ORD(x))) * S.VAL(SET, 0FFH)), n))

When risc = TRUE it looks like this in C:

return (CHAR)__LSH((INT32)((SET)((INT32)x) & (SET)255), n, INT32);

There could be a distortion of the value of x here if it were a negative number. Then when multiplying the sign by the higher digits (using LONG) they could become 0FFFFH, but in this case it does not happen because the result of ORD cannot be negative. Well, the result of the logical operation x & 0FFH (even within 16-bit digit capacity) will not be negative either.

So I apologize for some possible misunderstanding.