OberonCore

PROCEDURE Proc (a, b: INTEGER): INTEGER;
IN
  ASSERT(a > 0);
  ASSERT(b # 0);
OUT
  ASSERT(res > 0);
VAR res: INTEGER;
BEGIN
  чотатам
  RETURN res;
END Proc;

PROCEDURE Proc (a, b: INTEGER): INTEGER;
IN
  ASSERT(a > 0);
  ASSERT(b # 0);
OUT
  ASSERT(RETURN > 0);
BEGIN
  чотатам
END Proc;

PROCEDURE IntrinsicDStrUnique* (VAR ss: STRING; allocEmpty: BOOLEAN);
VAR
  str, newstr: DynStringPtr;
  tvar, sadr: S.ADDRESS;
  newcap: INTEGER;
BEGIN
  tvar := S.ADR(ss);
  sadr := S.GET(S.ADDRESS, tvar);
  IF sadr # NIL THEN
    str := S.CAST(DynStringPtr, sadr);
    IF str.refc # 1 THEN
      newcap := CalcStrCapacity(str.length);

      sadr := AllocMem(S.CAST(S.USIZE, SIZE(DynString)));
      ASSERT(sadr # NIL, "out of memory for string");
      newstr := S.CAST(DynStringPtr, sadr);

      newstr.data := AllocMemRaw(S.CAST(S.USIZE, newcap));
      IF newstr.data = NIL THEN
        FreeMem(sadr);
        ASSERT(newstr.data # NIL, "out of memory for string data");
      END IF
      DEC[unchecked](str.refc);
      S.PUT(sadr, tvar);

      newstr.refc := 1;
      newstr.length := str.length;
      newstr.capacity := newcap;

      (* copy with final zero byte *)
      S.MOVE(str.data, newstr.data, str.length + 1);
    END IF
  ELSIF allocEmpty THEN
    sadr := AllocMem(S.CAST(S.USIZE, SIZE(DynString)));
    ASSERT(sadr # NIL, "out of memory for string");
    str := S.CAST(DynStringPtr, sadr);

    newcap := CalcStrCapacity(0);
    str.data := AllocMemRaw(S.CAST(S.USIZE, newcap));
    IF str.data = NIL THEN
      FreeMem(sadr);
      ASSERT(str.data # NIL, "out of memory for string data");
    END IF
    S.PUT(sadr, tvar);

    str.refc := 1;
    str.length := 0;
    str.capacity := newcap;

    S.PUT(0X, str.data);
  END IF
END IntrinsicDStrUnique;

TYPE
  TypeIdRecPtr = POINTER TO RECORD [untagged, align1]
    inhLevelAndFlags: INTEGER; (* low word is inhlevel, high word is flags *)
    vmtSize: INTEGER; (* in bytes *)
    byteSize: INTEGER;
    recNameOfs: INTEGER;
      (* yes, memory waste; but it is easier this way; also, align data to 8 bytes) *)
    inhTable: ARRAY MaxInhLevel OF ADDR;
    fieldList: ADDR;
    methodList: ADDR;
    strmapptr: ADDR;
    ptrmapptr: ADDR;
    finalizeProcAddr: ADDR;
    (* VMT table follows *)
    vmt: ADDR;
  END;

  TypeIdArrPtr = POINTER TO RECORD [untagged, align1]
    baseTypeId: ADDR;
    dimCount: INTEGER;
    flags: SET;
    flatSize: INTEGER; (* `-1` means dynamic array *)
    dims: ARRAY MaxDims + 1 OF INTEGER;
  END;

PROCEDURE IntrinsicArrayDecRef* [nonilchecks] (typid: ADDR; flatSize: INTEGER; aptr: ADDR);
VAR
  btyid: TypeIdRecPtr;
  barr: TypeIdArrPtr;
  base, map, mapOrig: ADDR;
  ofs, aflat: INTEGER;
  bsz: USIZE;
BEGIN ASSERT(flatSize >= 0);
  IF flatSize = 0 THEN RETURN; END IF (* just in case *)

  IF typid = ktypeIdString THEN
    (* just a string *)
    REPEAT
      IntrinsicDStrDecRef(aptr);
      INC(aptr, PtrSize);
      DEC[unchecked](flatSize);
    UNTIL flatSize = 0;
    RETURN;
  END IF

  (* it should not be a pointer *)
  IF (typid < 4096) OR ODD(typid) THEN RETURN; END IF

  IF typid MOD 4 = 0 THEN
    btyid := S.CAST(TypeIdRecPtr, typid);
    (* record *)
    bsz := S.CAST(USIZE, btyid.byteSize);
    IF bsz = 0 THEN RETURN; END IF
    mapOrig := btyid.strmapptr;
    IF mapOrig = NIL THEN RETURN; END IF (* just in case *)
    ofs := S.GET(INTEGER, mapOrig);
    IF ofs = -1 THEN RETURN; END IF (* just in case *)
    REPEAT
      map := mapOrig;
      ofs := S.GET(INTEGER, map);
      REPEAT
        INC(map, SIZE(INTEGER));
        IntrinsicDStrDecRef(aptr + S.CAST(S.PTRDIFF, ofs));
        ofs := S.GET(INTEGER, map);
      UNTIL ofs = -1;
      INC(aptr, bsz);
      DEC[unchecked](flatSize);
    UNTIL flatSize = 0;
  ELSE
    (* array *)
    barr := S.CAST(TypeIdArrPtr, typid - 2);
    aflat := barr.flatSize;
    ASSERT(aflat >= 0);
    IF aflat = 0 THEN RETURN; END IF
    (* get base type *)
    base := barr.baseTypeId;
    (* check if we have something to do at all *)
    IF base # ktypeIdString THEN
      (* it should not be a pointer or an array *)
      IF (base < 4096) OR ODD(base) THEN RETURN; END IF
      (* actually, array should not end up here *)
      ASSERT(base MOD 4 = 0);
      (* check if our record has `strmap` at all *)
      btyid := S.CAST(TypeIdRecPtr, base);
      map := btyid.strmapptr;
      IF map = NIL THEN RETURN; END IF
      ofs := S.GET(INTEGER, map);
      IF ofs = -1 THEN RETURN; END IF (* just in case *)
      bsz := S.CAST(USIZE, btyid.byteSize);
      ASSERT(bsz # 0);
    ELSE
      bsz := PtrSize;
    END IF
    (* ok, we need to finalize something *)
    bsz := bsz * S.CAST(USIZE, aflat);
    REPEAT
      IntrinsicArrayDecRef(base, aflat, aptr);
      INC(aptr, bsz);
      DEC[unchecked](flatSize);
    UNTIL flatSize = 0;
  END IF
END IntrinsicArrayDecRef;

CONST
  twistAndTurn = TRUE;
  standStill = FALSE;

PROCEDURE Dance (…; assMovement: BOOLEAN);

Dance(…, standStill);

PROCEDURE Dance (…; assMovement: BOOLEAN);

Dance(…, assMovement:FALSE);