| 0,0 → 1,390 |
|---|
| (* |
| BSD 2-Clause License |
| |
| Copyright (c) 2019-2020, Anton Krotov |
| All rights reserved. |
| *) |
| |
| MODULE RTL; |
| |
| IMPORT SYSTEM, F := FPU, Trap; |
| |
| |
| CONST |
| |
| bit_depth = 32; |
| maxint = 7FFFFFFFH; |
| minint = 80000000H; |
| |
| WORD = bit_depth DIV 8; |
| MAX_SET = bit_depth - 1; |
| |
| |
| VAR |
| |
| Heap, Types, TypesCount: INTEGER; |
| |
| |
| PROCEDURE _error* (modnum, _module, err, line: INTEGER); |
| BEGIN |
| Trap.trap(modnum, _module, err, line) |
| END _error; |
| |
| |
| PROCEDURE _fmul* (b, a: INTEGER): INTEGER; |
| RETURN F.mul(b, a) |
| END _fmul; |
| |
| |
| PROCEDURE _fdiv* (b, a: INTEGER): INTEGER; |
| RETURN F._div(b, a) |
| END _fdiv; |
| |
| |
| PROCEDURE _fdivi* (b, a: INTEGER): INTEGER; |
| RETURN F._div(a, b) |
| END _fdivi; |
| |
| |
| PROCEDURE _fadd* (b, a: INTEGER): INTEGER; |
| RETURN F.add(b, a) |
| END _fadd; |
| |
| |
| PROCEDURE _fsub* (b, a: INTEGER): INTEGER; |
| RETURN F.sub(b, a) |
| END _fsub; |
| |
| |
| PROCEDURE _fsubi* (b, a: INTEGER): INTEGER; |
| RETURN F.sub(a, b) |
| END _fsubi; |
| |
| |
| PROCEDURE _fcmp* (op, b, a: INTEGER): BOOLEAN; |
| RETURN F.cmp(op, b, a) |
| END _fcmp; |
| |
| |
| PROCEDURE _floor* (x: INTEGER): INTEGER; |
| RETURN F.floor(x) |
| END _floor; |
| |
| |
| PROCEDURE _flt* (x: INTEGER): INTEGER; |
| RETURN F.flt(x) |
| END _flt; |
| |
| |
| PROCEDURE _pack* (n: INTEGER; VAR x: SET); |
| BEGIN |
| n := LSL((LSR(ORD(x), 23) MOD 256 + n) MOD 256, 23); |
| x := x - {23..30} + BITS(n) |
| END _pack; |
| |
| |
| PROCEDURE _unpk* (VAR n: INTEGER; VAR x: SET); |
| BEGIN |
| n := LSR(ORD(x), 23) MOD 256 - 127; |
| x := x - {30} + {23..29} |
| END _unpk; |
| |
| |
| PROCEDURE _rot* (VAR A: ARRAY OF INTEGER); |
| VAR |
| i, n, k: INTEGER; |
| |
| BEGIN |
| k := LEN(A) - 1; |
| n := A[0]; |
| i := 0; |
| WHILE i < k DO |
| A[i] := A[i + 1]; |
| INC(i) |
| END; |
| A[k] := n |
| END _rot; |
| |
| |
| PROCEDURE _set* (b, a: INTEGER): INTEGER; |
| BEGIN |
| IF (a <= b) & (a <= MAX_SET) & (b >= 0) THEN |
| IF b > MAX_SET THEN |
| b := MAX_SET |
| END; |
| IF a < 0 THEN |
| a := 0 |
| END; |
| a := LSR(ASR(minint, b - a), MAX_SET - b) |
| ELSE |
| a := 0 |
| END |
| |
| RETURN a |
| END _set; |
| |
| |
| PROCEDURE _set1* (a: INTEGER): INTEGER; |
| BEGIN |
| IF ASR(a, 5) = 0 THEN |
| a := LSL(1, a) |
| ELSE |
| a := 0 |
| END |
| RETURN a |
| END _set1; |
| |
| |
| PROCEDURE _length* (len, str: INTEGER): INTEGER; |
| VAR |
| c: CHAR; |
| res: INTEGER; |
| |
| BEGIN |
| res := 0; |
| REPEAT |
| SYSTEM.GET(str, c); |
| INC(str); |
| DEC(len); |
| INC(res) |
| UNTIL (len = 0) OR (c = 0X); |
| |
| RETURN res - ORD(c = 0X) |
| END _length; |
| |
| |
| PROCEDURE _move* (bytes, dest, source: INTEGER); |
| VAR |
| b: BYTE; |
| i: INTEGER; |
| |
| BEGIN |
| WHILE ((source MOD WORD # 0) OR (dest MOD WORD # 0)) & (bytes > 0) DO |
| SYSTEM.GET(source, b); |
| SYSTEM.PUT8(dest, b); |
| INC(source); |
| INC(dest); |
| DEC(bytes) |
| END; |
| |
| WHILE bytes >= WORD DO |
| SYSTEM.GET(source, i); |
| SYSTEM.PUT(dest, i); |
| INC(source, WORD); |
| INC(dest, WORD); |
| DEC(bytes, WORD) |
| END; |
| |
| WHILE bytes > 0 DO |
| SYSTEM.GET(source, b); |
| SYSTEM.PUT8(dest, b); |
| INC(source); |
| INC(dest); |
| DEC(bytes) |
| END |
| END _move; |
| |
| |
| PROCEDURE _lengthw* (len, str: INTEGER): INTEGER; |
| VAR |
| c: WCHAR; |
| res: INTEGER; |
| |
| BEGIN |
| res := 0; |
| REPEAT |
| SYSTEM.GET(str, c); |
| INC(str, 2); |
| DEC(len); |
| INC(res) |
| UNTIL (len = 0) OR (c = 0X); |
| |
| RETURN res - ORD(c = 0X) |
| END _lengthw; |
| |
| |
| PROCEDURE strncmp (a, b, n: INTEGER): INTEGER; |
| VAR |
| A, B: CHAR; |
| res: INTEGER; |
| |
| BEGIN |
| res := 0; |
| WHILE n > 0 DO |
| SYSTEM.GET(a, A); INC(a); |
| SYSTEM.GET(b, B); INC(b); |
| DEC(n); |
| IF A # B THEN |
| res := ORD(A) - ORD(B); |
| n := 0 |
| ELSIF A = 0X THEN |
| n := 0 |
| END |
| END |
| RETURN res |
| END strncmp; |
| |
| |
| PROCEDURE _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN; |
| VAR |
| res: INTEGER; |
| bRes: BOOLEAN; |
| |
| BEGIN |
| res := strncmp(str1, str2, MIN(len1, len2)); |
| IF res = 0 THEN |
| res := _length(len1, str1) - _length(len2, str2) |
| END; |
| |
| CASE op OF |
| |0: bRes := res = 0 |
| |1: bRes := res # 0 |
| |2: bRes := res < 0 |
| |3: bRes := res <= 0 |
| |4: bRes := res > 0 |
| |5: bRes := res >= 0 |
| END |
| |
| RETURN bRes |
| END _strcmp; |
| |
| |
| PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER; |
| VAR |
| A, B: WCHAR; |
| res: INTEGER; |
| |
| BEGIN |
| res := 0; |
| WHILE n > 0 DO |
| SYSTEM.GET(a, A); INC(a, 2); |
| SYSTEM.GET(b, B); INC(b, 2); |
| DEC(n); |
| IF A # B THEN |
| res := ORD(A) - ORD(B); |
| n := 0 |
| ELSIF A = WCHR(0) THEN |
| n := 0 |
| END |
| END |
| RETURN res |
| END strncmpw; |
| |
| |
| PROCEDURE _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN; |
| VAR |
| res: INTEGER; |
| bRes: BOOLEAN; |
| |
| BEGIN |
| res := strncmpw(str1, str2, MIN(len1, len2)); |
| IF res = 0 THEN |
| res := _lengthw(len1, str1) - _lengthw(len2, str2) |
| END; |
| |
| CASE op OF |
| |0: bRes := res = 0 |
| |1: bRes := res # 0 |
| |2: bRes := res < 0 |
| |3: bRes := res <= 0 |
| |4: bRes := res > 0 |
| |5: bRes := res >= 0 |
| END |
| |
| RETURN bRes |
| END _strcmpw; |
| |
| |
| PROCEDURE _arrcpy* (base_size, len_dst, dst, len_src, src: INTEGER): BOOLEAN; |
| VAR |
| res: BOOLEAN; |
| |
| BEGIN |
| IF len_src > len_dst THEN |
| res := FALSE |
| ELSE |
| _move(len_src * base_size, dst, src); |
| res := TRUE |
| END |
| |
| RETURN res |
| END _arrcpy; |
| |
| |
| PROCEDURE _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER); |
| BEGIN |
| _move(MIN(len_dst, len_src) * chr_size, dst, src) |
| END _strcpy; |
| |
| |
| PROCEDURE _new* (t, size: INTEGER; VAR p: INTEGER); |
| BEGIN |
| IF Heap + size < Trap.sp() - 64 THEN |
| p := Heap + WORD; |
| REPEAT |
| SYSTEM.PUT(Heap, t); |
| INC(Heap, WORD); |
| DEC(size, WORD); |
| t := 0 |
| UNTIL size = 0 |
| ELSE |
| p := 0 |
| END |
| END _new; |
| |
| |
| PROCEDURE _guard* (t, p: INTEGER): BOOLEAN; |
| VAR |
| _type: INTEGER; |
| |
| BEGIN |
| SYSTEM.GET(p, p); |
| IF p # 0 THEN |
| SYSTEM.GET(p - WORD, _type); |
| WHILE (_type # t) & (_type # 0) DO |
| SYSTEM.GET(Types + _type * WORD, _type) |
| END |
| ELSE |
| _type := t |
| END |
| |
| RETURN _type = t |
| END _guard; |
| |
| |
| PROCEDURE _is* (t, p: INTEGER): BOOLEAN; |
| VAR |
| _type: INTEGER; |
| |
| BEGIN |
| _type := 0; |
| IF p # 0 THEN |
| SYSTEM.GET(p - WORD, _type); |
| WHILE (_type # t) & (_type # 0) DO |
| SYSTEM.GET(Types + _type * WORD, _type) |
| END |
| END |
| |
| RETURN _type = t |
| END _is; |
| |
| |
| PROCEDURE _guardrec* (t0, t1: INTEGER): BOOLEAN; |
| BEGIN |
| WHILE (t1 # t0) & (t1 # 0) DO |
| SYSTEM.GET(Types + t1 * WORD, t1) |
| END |
| |
| RETURN t1 = t0 |
| END _guardrec; |
| |
| |
| PROCEDURE _init* (tcount, heap, types: INTEGER); |
| BEGIN |
| Heap := heap; |
| TypesCount := tcount; |
| Types := types |
| END _init; |
| |
| |
| END RTL. |