|
@@ -0,0 +1,1072 @@
|
|
|
|
|
+(*
|
|
|
|
|
+ BSD 2-Clause License
|
|
|
|
|
+
|
|
|
|
|
+ Copyright (c) 2018-2021, 2023, Anton Krotov
|
|
|
|
|
+ All rights reserved.
|
|
|
|
|
+*)
|
|
|
|
|
+
|
|
|
|
|
+(*---------------------x86_64---------------------*)
|
|
|
|
|
+
|
|
|
|
|
+$IF (CPU_X8664)
|
|
|
|
|
+MODULE RTL;
|
|
|
|
|
+
|
|
|
|
|
+IMPORT SYSTEM, API;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+CONST
|
|
|
|
|
+
|
|
|
|
|
+ minint = ROR(1, 1);
|
|
|
|
|
+
|
|
|
|
|
+ WORD = API.BIT_DEPTH DIV 8;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+VAR
|
|
|
|
|
+
|
|
|
|
|
+ name: INTEGER;
|
|
|
|
|
+ types: INTEGER;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [oberon] _move* (bytes, dest, source: INTEGER);
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ SYSTEM.CODE(
|
|
|
|
|
+ 048H, 08BH, 045H, 010H, (* mov rax, qword [rbp + 16] *)
|
|
|
|
|
+ 048H, 085H, 0C0H, (* test rax, rax *)
|
|
|
|
|
+ 07EH, 020H, (* jle L *)
|
|
|
|
|
+ 0FCH, (* cld *)
|
|
|
|
|
+ 057H, (* push rdi *)
|
|
|
|
|
+ 056H, (* push rsi *)
|
|
|
|
|
+ 048H, 08BH, 075H, 020H, (* mov rsi, qword [rbp + 32] *)
|
|
|
|
|
+ 048H, 08BH, 07DH, 018H, (* mov rdi, qword [rbp + 24] *)
|
|
|
|
|
+ 048H, 089H, 0C1H, (* mov rcx, rax *)
|
|
|
|
|
+ 048H, 0C1H, 0E9H, 003H, (* shr rcx, 3 *)
|
|
|
|
|
+ 0F3H, 048H, 0A5H, (* rep movsd *)
|
|
|
|
|
+ 048H, 089H, 0C1H, (* mov rcx, rax *)
|
|
|
|
|
+ 048H, 083H, 0E1H, 007H, (* and rcx, 7 *)
|
|
|
|
|
+ 0F3H, 0A4H, (* rep movsb *)
|
|
|
|
|
+ 05EH, (* pop rsi *)
|
|
|
|
|
+ 05FH (* pop rdi *)
|
|
|
|
|
+ (* L: *)
|
|
|
|
|
+ )
|
|
|
|
|
+END _move;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [oberon] _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 [oberon] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER);
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ _move(MIN(len_dst, len_src) * chr_size, dst, src)
|
|
|
|
|
+END _strcpy;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [oberon] _rot* (Len, Ptr: INTEGER);
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ SYSTEM.CODE(
|
|
|
|
|
+ 048H, 08BH, 04DH, 010H, (* mov rcx, qword [rbp + 16] *) (* rcx <- Len *)
|
|
|
|
|
+ 048H, 08BH, 045H, 018H, (* mov rax, qword [rbp + 24] *) (* rax <- Ptr *)
|
|
|
|
|
+ 048H, 0FFH, 0C9H, (* dec rcx *)
|
|
|
|
|
+ 04CH, 08BH, 010H, (* mov r10, qword [rax] *)
|
|
|
|
|
+ (* L: *)
|
|
|
|
|
+ 048H, 08BH, 050H, 008H, (* mov rdx, qword [rax + 8] *)
|
|
|
|
|
+ 048H, 089H, 010H, (* mov qword [rax], rdx *)
|
|
|
|
|
+ 048H, 083H, 0C0H, 008H, (* add rax, 8 *)
|
|
|
|
|
+ 048H, 0FFH, 0C9H, (* dec rcx *)
|
|
|
|
|
+ 075H, 0F0H, (* jnz L *)
|
|
|
|
|
+ 04CH, 089H, 010H, (* mov qword [rax], r10 *)
|
|
|
|
|
+ 05DH, (* pop rbp *)
|
|
|
|
|
+ 0C2H, 010H, 000H (* ret 16 *)
|
|
|
|
|
+ )
|
|
|
|
|
+END _rot;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [oberon] _set* (b, a: INTEGER); (* {a..b} -> rax *)
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ SYSTEM.CODE(
|
|
|
|
|
+ 048H, 08BH, 04DH, 010H, (* mov rcx, qword ptr [rbp + 16] *) (* rcx <- b *)
|
|
|
|
|
+ 048H, 08BH, 045H, 018H, (* mov rax, qword ptr [rbp + 24] *) (* rax <- a *)
|
|
|
|
|
+ 048H, 039H, 0C8H, (* cmp rax, rcx *)
|
|
|
|
|
+ 07FH, 047H, (* jg L1 *)
|
|
|
|
|
+ 048H, 083H, 0F8H, 03FH, (* cmp rax, 63 *)
|
|
|
|
|
+ 07FH, 041H, (* jg L1 *)
|
|
|
|
|
+ 048H, 085H, 0C9H, (* test rcx, rcx *)
|
|
|
|
|
+ 07CH, 03CH, (* jl L1 *)
|
|
|
|
|
+ 048H, 083H, 0F9H, 03FH, (* cmp rcx, 63 *)
|
|
|
|
|
+ 07EH, 007H, (* jle L3 *)
|
|
|
|
|
+ 048H, 0C7H, 0C1H, 03FH, (* mov rcx, 63 *)
|
|
|
|
|
+ 000H, 000H, 000H,
|
|
|
|
|
+ (* L3: *)
|
|
|
|
|
+ 048H, 085H, 0C0H, (* test rax, rax *)
|
|
|
|
|
+ 07DH, 003H, (* jge L2 *)
|
|
|
|
|
+ 048H, 031H, 0C0H, (* xor rax, rax *)
|
|
|
|
|
+ (* L2: *)
|
|
|
|
|
+ 048H, 089H, 0CAH, (* mov rdx, rcx *)
|
|
|
|
|
+ 048H, 029H, 0C2H, (* sub rdx, rax *)
|
|
|
|
|
+ 048H, 0B8H, 000H, 000H, (* movabs rax, minint *)
|
|
|
|
|
+ 000H, 000H, 000H, 000H,
|
|
|
|
|
+ 000H, 080H,
|
|
|
|
|
+
|
|
|
|
|
+ 048H, 087H, 0CAH, (* xchg rdx, rcx *)
|
|
|
|
|
+ 048H, 0D3H, 0F8H, (* sar rax, cl *)
|
|
|
|
|
+ 048H, 087H, 0CAH, (* xchg rdx, rcx *)
|
|
|
|
|
+ 048H, 083H, 0E9H, 03FH, (* sub rcx, 63 *)
|
|
|
|
|
+ 048H, 0F7H, 0D9H, (* neg rcx *)
|
|
|
|
|
+ 048H, 0D3H, 0E8H, (* shr rax, cl *)
|
|
|
|
|
+ 05DH, (* pop rbp *)
|
|
|
|
|
+ 0C2H, 010H, 000H, (* ret 16 *)
|
|
|
|
|
+ (* L1: *)
|
|
|
|
|
+ 048H, 031H, 0C0H, (* xor rax, rax *)
|
|
|
|
|
+ 05DH, (* pop rbp *)
|
|
|
|
|
+ 0C2H, 010H, 000H (* ret 16 *)
|
|
|
|
|
+ )
|
|
|
|
|
+END _set;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [oberon] _set1* (a: INTEGER); (* {a} -> rax *)
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ SYSTEM.CODE(
|
|
|
|
|
+ 048H, 031H, 0C0H, (* xor rax, rax *)
|
|
|
|
|
+ 048H, 08BH, 04DH, 010H, (* mov rcx, qword [rbp + 16] *) (* rcx <- a *)
|
|
|
|
|
+ 048H, 083H, 0F9H, 03FH, (* cmp rcx, 63 *)
|
|
|
|
|
+ 077H, 004H, (* ja L *)
|
|
|
|
|
+ 048H, 00FH, 0ABH, 0C8H (* bts rax, rcx *)
|
|
|
|
|
+ (* L: *)
|
|
|
|
|
+ )
|
|
|
|
|
+END _set1;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [oberon] _divmod* (y, x: INTEGER); (* (x div y) -> rax; (x mod y) -> rdx *)
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ SYSTEM.CODE(
|
|
|
|
|
+ 048H, 08BH, 045H, 018H, (* mov rax, qword [rbp + 24] *) (* rax <- x *)
|
|
|
|
|
+ 048H, 031H, 0D2H, (* xor rdx, rdx *)
|
|
|
|
|
+ 048H, 085H, 0C0H, (* test rax, rax *)
|
|
|
|
|
+ 074H, 022H, (* je L2 *)
|
|
|
|
|
+ 07FH, 003H, (* jg L1 *)
|
|
|
|
|
+ 048H, 0F7H, 0D2H, (* not rdx *)
|
|
|
|
|
+ (* L1: *)
|
|
|
|
|
+ 049H, 089H, 0C0H, (* mov r8, rax *)
|
|
|
|
|
+ 048H, 08BH, 04DH, 010H, (* mov rcx, qword [rbp + 16] *) (* rcx <- y *)
|
|
|
|
|
+ 048H, 0F7H, 0F9H, (* idiv rcx *)
|
|
|
|
|
+ 048H, 085H, 0D2H, (* test rdx, rdx *)
|
|
|
|
|
+ 074H, 00EH, (* je L2 *)
|
|
|
|
|
+ 049H, 031H, 0C8H, (* xor r8, rcx *)
|
|
|
|
|
+ 04DH, 085H, 0C0H, (* test r8, r8 *)
|
|
|
|
|
+ 07DH, 006H, (* jge L2 *)
|
|
|
|
|
+ 048H, 0FFH, 0C8H, (* dec rax *)
|
|
|
|
|
+ 048H, 001H, 0CAH (* add rdx, rcx *)
|
|
|
|
|
+ (* L2: *)
|
|
|
|
|
+ )
|
|
|
|
|
+END _divmod;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [oberon] _new* (t, size: INTEGER; VAR ptr: INTEGER);
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ ptr := API._NEW(size);
|
|
|
|
|
+ IF ptr # 0 THEN
|
|
|
|
|
+ SYSTEM.PUT(ptr + 8, t);
|
|
|
|
|
+ INC(ptr, 16)
|
|
|
|
|
+ END
|
|
|
|
|
+END _new;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [oberon] _dispose* (VAR ptr: INTEGER);
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ IF ptr # 0 THEN
|
|
|
|
|
+ ptr := API._DISPOSE(ptr - 16)
|
|
|
|
|
+ END
|
|
|
|
|
+END _dispose;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [oberon] _length* (len, str: INTEGER);
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ SYSTEM.CODE(
|
|
|
|
|
+ 048H, 08BH, 045H, 018H, (* mov rax, qword [rbp + 24] *)
|
|
|
|
|
+ 048H, 08BH, 04DH, 010H, (* mov rcx, qword [rbp + 16] *)
|
|
|
|
|
+ 048H, 0FFH, 0C8H, (* dec rax *)
|
|
|
|
|
+ (* L1: *)
|
|
|
|
|
+ 048H, 0FFH, 0C0H, (* inc rax *)
|
|
|
|
|
+ 080H, 038H, 000H, (* cmp byte [rax], 0 *)
|
|
|
|
|
+ 074H, 005H, (* jz L2 *)
|
|
|
|
|
+ 0E2H, 0F6H, (* loop L1 *)
|
|
|
|
|
+ 048H, 0FFH, 0C0H, (* inc rax *)
|
|
|
|
|
+ (* L2: *)
|
|
|
|
|
+ 048H, 02BH, 045H, 018H (* sub rax, qword [rbp + 24] *)
|
|
|
|
|
+ )
|
|
|
|
|
+END _length;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [oberon] _lengthw* (len, str: INTEGER);
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ SYSTEM.CODE(
|
|
|
|
|
+ 048H, 08BH, 045H, 018H, (* mov rax, qword [rbp + 24] *)
|
|
|
|
|
+ 048H, 08BH, 04DH, 010H, (* mov rcx, qword [rbp + 16] *)
|
|
|
|
|
+ 048H, 083H, 0E8H, 002H, (* sub rax, 2 *)
|
|
|
|
|
+ (* L1: *)
|
|
|
|
|
+ 048H, 083H, 0C0H, 002H, (* add rax, 2 *)
|
|
|
|
|
+ 066H, 083H, 038H, 000H, (* cmp word [rax], 0 *)
|
|
|
|
|
+ 074H, 006H, (* jz L2 *)
|
|
|
|
|
+ 0E2H, 0F4H, (* loop L1 *)
|
|
|
|
|
+ 048H, 083H, 0C0H, 002H, (* add rax, 2 *)
|
|
|
|
|
+ (* L2: *)
|
|
|
|
|
+ 048H, 02BH, 045H, 018H, (* sub rax, qword [rbp + 24] *)
|
|
|
|
|
+ 048H, 0D1H, 0E8H (* shr rax, 1 *)
|
|
|
|
|
+ )
|
|
|
|
|
+END _lengthw;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [oberon] strncmp (a, b, n: INTEGER): INTEGER;
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ SYSTEM.CODE(
|
|
|
|
|
+ 048H, 08BH, 04DH, 010H, (* mov rcx, qword[rbp + 16]; rcx <- a *)
|
|
|
|
|
+ 048H, 08BH, 055H, 018H, (* mov rdx, qword[rbp + 24]; rdx <- b *)
|
|
|
|
|
+ 04CH, 08BH, 045H, 020H, (* mov r8, qword[rbp + 32]; r8 <- n *)
|
|
|
|
|
+ 04DH, 031H, 0C9H, (* xor r9, r9 *)
|
|
|
|
|
+ 04DH, 031H, 0D2H, (* xor r10, r10 *)
|
|
|
|
|
+ 048H, 0B8H, 000H, 000H, (* movabs rax, minint *)
|
|
|
|
|
+ 000H, 000H, 000H, 000H,
|
|
|
|
|
+ 000H, 080H,
|
|
|
|
|
+ (* L1: *)
|
|
|
|
|
+ 04DH, 085H, 0C0H, (* test r8, r8 *)
|
|
|
|
|
+ 07EH, 024H, (* jle L3 *)
|
|
|
|
|
+ 044H, 08AH, 009H, (* mov r9b, byte[rcx] *)
|
|
|
|
|
+ 044H, 08AH, 012H, (* mov r10b, byte[rdx] *)
|
|
|
|
|
+ 048H, 0FFH, 0C1H, (* inc rcx *)
|
|
|
|
|
+ 048H, 0FFH, 0C2H, (* inc rdx *)
|
|
|
|
|
+ 049H, 0FFH, 0C8H, (* dec r8 *)
|
|
|
|
|
+ 04DH, 039H, 0D1H, (* cmp r9, r10 *)
|
|
|
|
|
+ 074H, 008H, (* je L2 *)
|
|
|
|
|
+ 04CH, 089H, 0C8H, (* mov rax, r9 *)
|
|
|
|
|
+ 04CH, 029H, 0D0H, (* sub rax, r10 *)
|
|
|
|
|
+ 0EBH, 008H, (* jmp L3 *)
|
|
|
|
|
+ (* L2: *)
|
|
|
|
|
+ 04DH, 085H, 0C9H, (* test r9, r9 *)
|
|
|
|
|
+ 075H, 0DAH, (* jne L1 *)
|
|
|
|
|
+ 048H, 031H, 0C0H, (* xor rax, rax *)
|
|
|
|
|
+ (* L3: *)
|
|
|
|
|
+ 05DH, (* pop rbp *)
|
|
|
|
|
+ 0C2H, 018H, 000H (* ret 24 *)
|
|
|
|
|
+ )
|
|
|
|
|
+ RETURN 0
|
|
|
|
|
+END strncmp;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [oberon] strncmpw (a, b, n: INTEGER): INTEGER;
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ SYSTEM.CODE(
|
|
|
|
|
+ 048H, 08BH, 04DH, 010H, (* mov rcx, qword[rbp + 16]; rcx <- a *)
|
|
|
|
|
+ 048H, 08BH, 055H, 018H, (* mov rdx, qword[rbp + 24]; rdx <- b *)
|
|
|
|
|
+ 04CH, 08BH, 045H, 020H, (* mov r8, qword[rbp + 32]; r8 <- n *)
|
|
|
|
|
+ 04DH, 031H, 0C9H, (* xor r9, r9 *)
|
|
|
|
|
+ 04DH, 031H, 0D2H, (* xor r10, r10 *)
|
|
|
|
|
+ 048H, 0B8H, 000H, 000H, (* movabs rax, minint *)
|
|
|
|
|
+ 000H, 000H, 000H, 000H,
|
|
|
|
|
+ 000H, 080H,
|
|
|
|
|
+ (* L1: *)
|
|
|
|
|
+ 04DH, 085H, 0C0H, (* test r8, r8 *)
|
|
|
|
|
+ 07EH, 028H, (* jle L3 *)
|
|
|
|
|
+ 066H, 044H, 08BH, 009H, (* mov r9w, word[rcx] *)
|
|
|
|
|
+ 066H, 044H, 08BH, 012H, (* mov r10w, word[rdx] *)
|
|
|
|
|
+ 048H, 083H, 0C1H, 002H, (* add rcx, 2 *)
|
|
|
|
|
+ 048H, 083H, 0C2H, 002H, (* add rdx, 2 *)
|
|
|
|
|
+ 049H, 0FFH, 0C8H, (* dec r8 *)
|
|
|
|
|
+ 04DH, 039H, 0D1H, (* cmp r9, r10 *)
|
|
|
|
|
+ 074H, 008H, (* je L2 *)
|
|
|
|
|
+ 04CH, 089H, 0C8H, (* mov rax, r9 *)
|
|
|
|
|
+ 04CH, 029H, 0D0H, (* sub rax, r10 *)
|
|
|
|
|
+ 0EBH, 008H, (* jmp L3 *)
|
|
|
|
|
+ (* L2: *)
|
|
|
|
|
+ 04DH, 085H, 0C9H, (* test r9, r9 *)
|
|
|
|
|
+ 075H, 0D6H, (* jne L1 *)
|
|
|
|
|
+ 048H, 031H, 0C0H, (* xor rax, rax *)
|
|
|
|
|
+ (* L3: *)
|
|
|
|
|
+ 05DH, (* pop rbp *)
|
|
|
|
|
+ 0C2H, 018H, 000H (* ret 24 *)
|
|
|
|
|
+ )
|
|
|
|
|
+ RETURN 0
|
|
|
|
|
+END strncmpw;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [oberon] _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
|
|
|
|
|
+VAR
|
|
|
|
|
+ res: INTEGER;
|
|
|
|
|
+ bRes: BOOLEAN;
|
|
|
|
|
+ c: CHAR;
|
|
|
|
|
+
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ res := strncmp(str1, str2, MIN(len1, len2));
|
|
|
|
|
+ IF res = minint THEN
|
|
|
|
|
+ IF len1 > len2 THEN
|
|
|
|
|
+ SYSTEM.GET(str1 + len2, c);
|
|
|
|
|
+ res := ORD(c)
|
|
|
|
|
+ ELSIF len1 < len2 THEN
|
|
|
|
|
+ SYSTEM.GET(str2 + len1, c);
|
|
|
|
|
+ res := -ORD(c)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ res := 0
|
|
|
|
|
+ END
|
|
|
|
|
+ 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 [oberon] _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
|
|
|
|
|
+VAR
|
|
|
|
|
+ res: INTEGER;
|
|
|
|
|
+ bRes: BOOLEAN;
|
|
|
|
|
+ c: WCHAR;
|
|
|
|
|
+
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ res := strncmpw(str1, str2, MIN(len1, len2));
|
|
|
|
|
+ IF res = minint THEN
|
|
|
|
|
+ IF len1 > len2 THEN
|
|
|
|
|
+ SYSTEM.GET(str1 + len2 * 2, c);
|
|
|
|
|
+ res := ORD(c)
|
|
|
|
|
+ ELSIF len1 < len2 THEN
|
|
|
|
|
+ SYSTEM.GET(str2 + len1 * 2, c);
|
|
|
|
|
+ res := -ORD(c)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ res := 0
|
|
|
|
|
+ END
|
|
|
|
|
+ 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 PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR);
|
|
|
|
|
+VAR
|
|
|
|
|
+ c: CHAR;
|
|
|
|
|
+ i: INTEGER;
|
|
|
|
|
+
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ i := 0;
|
|
|
|
|
+ REPEAT
|
|
|
|
|
+ SYSTEM.GET(pchar, c);
|
|
|
|
|
+ s[i] := c;
|
|
|
|
|
+ INC(pchar);
|
|
|
|
|
+ INC(i)
|
|
|
|
|
+ UNTIL c = 0X
|
|
|
|
|
+END PCharToStr;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE IntToStr (x: INTEGER; VAR str: ARRAY OF CHAR);
|
|
|
|
|
+VAR
|
|
|
|
|
+ i, a: INTEGER;
|
|
|
|
|
+
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ i := 0;
|
|
|
|
|
+ a := x;
|
|
|
|
|
+ REPEAT
|
|
|
|
|
+ INC(i);
|
|
|
|
|
+ a := a DIV 10
|
|
|
|
|
+ UNTIL a = 0;
|
|
|
|
|
+
|
|
|
|
|
+ str[i] := 0X;
|
|
|
|
|
+
|
|
|
|
|
+ REPEAT
|
|
|
|
|
+ DEC(i);
|
|
|
|
|
+ str[i] := CHR(x MOD 10 + ORD("0"));
|
|
|
|
|
+ x := x DIV 10
|
|
|
|
|
+ UNTIL x = 0
|
|
|
|
|
+END IntToStr;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR);
|
|
|
|
|
+VAR
|
|
|
|
|
+ n1, n2: INTEGER;
|
|
|
|
|
+
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ n1 := LENGTH(s1);
|
|
|
|
|
+ n2 := LENGTH(s2);
|
|
|
|
|
+
|
|
|
|
|
+ ASSERT(n1 + n2 < LEN(s1));
|
|
|
|
|
+
|
|
|
|
|
+ SYSTEM.MOVE(SYSTEM.ADR(s2[0]), SYSTEM.ADR(s1[n1]), n2);
|
|
|
|
|
+ s1[n1 + n2] := 0X
|
|
|
|
|
+END append;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [oberon] _error* (modnum, _module, err, line: INTEGER);
|
|
|
|
|
+VAR
|
|
|
|
|
+ s, temp: ARRAY 1024 OF CHAR;
|
|
|
|
|
+
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ CASE err OF
|
|
|
|
|
+ | 1: s := "assertion failure"
|
|
|
|
|
+ | 2: s := "NIL dereference"
|
|
|
|
|
+ | 3: s := "bad divisor"
|
|
|
|
|
+ | 4: s := "NIL procedure call"
|
|
|
|
|
+ | 5: s := "type guard error"
|
|
|
|
|
+ | 6: s := "index out of range"
|
|
|
|
|
+ | 7: s := "invalid CASE"
|
|
|
|
|
+ | 8: s := "array assignment error"
|
|
|
|
|
+ | 9: s := "CHR out of range"
|
|
|
|
|
+ |10: s := "WCHR out of range"
|
|
|
|
|
+ |11: s := "BYTE out of range"
|
|
|
|
|
+ END;
|
|
|
|
|
+
|
|
|
|
|
+ append(s, API.eol + "module: "); PCharToStr(_module, temp); append(s, temp);
|
|
|
|
|
+ append(s, API.eol + "line: "); IntToStr(line, temp); append(s, temp);
|
|
|
|
|
+
|
|
|
|
|
+ API.DebugMsg(SYSTEM.ADR(s[0]), name);
|
|
|
|
|
+
|
|
|
|
|
+ API.exit_thread(0)
|
|
|
|
|
+END _error;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [oberon] _isrec* (t0, t1, r: INTEGER): INTEGER;
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ SYSTEM.GET(t0 + t1 + types, t0)
|
|
|
|
|
+ RETURN t0 MOD 2
|
|
|
|
|
+END _isrec;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [oberon] _is* (t0, p: INTEGER): INTEGER;
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ IF p # 0 THEN
|
|
|
|
|
+ SYSTEM.GET(p - WORD, p);
|
|
|
|
|
+ SYSTEM.GET(t0 + p + types, p)
|
|
|
|
|
+ END
|
|
|
|
|
+
|
|
|
|
|
+ RETURN p MOD 2
|
|
|
|
|
+END _is;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [oberon] _guardrec* (t0, t1: INTEGER): INTEGER;
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ SYSTEM.GET(t0 + t1 + types, t0)
|
|
|
|
|
+ RETURN t0 MOD 2
|
|
|
|
|
+END _guardrec;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [oberon] _guard* (t0, p: INTEGER): INTEGER;
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ SYSTEM.GET(p, p);
|
|
|
|
|
+ IF p # 0 THEN
|
|
|
|
|
+ SYSTEM.GET(p - WORD, p);
|
|
|
|
|
+ SYSTEM.GET(t0 + p + types, p)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ p := 1
|
|
|
|
|
+ END
|
|
|
|
|
+
|
|
|
|
|
+ RETURN p MOD 2
|
|
|
|
|
+END _guard;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [oberon] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER;
|
|
|
|
|
+ RETURN API.dllentry(hinstDLL, fdwReason, lpvReserved)
|
|
|
|
|
+END _dllentry;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [oberon] _sofinit*;
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ API.sofinit
|
|
|
|
|
+END _sofinit;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [oberon] _exit* (code: INTEGER);
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ API.exit(code)
|
|
|
|
|
+END _exit;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [oberon] _init* (modname: INTEGER; tcount, _types: INTEGER; code, param: INTEGER);
|
|
|
|
|
+VAR
|
|
|
|
|
+ t0, t1, i, j: INTEGER;
|
|
|
|
|
+
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ API.init(param, code);
|
|
|
|
|
+
|
|
|
|
|
+ types := API._NEW(tcount * tcount + SYSTEM.SIZE(INTEGER));
|
|
|
|
|
+ ASSERT(types # 0);
|
|
|
|
|
+ FOR i := 0 TO tcount - 1 DO
|
|
|
|
|
+ FOR j := 0 TO tcount - 1 DO
|
|
|
|
|
+ t0 := i; t1 := j;
|
|
|
|
|
+
|
|
|
|
|
+ WHILE (t1 # 0) & (t1 # t0) DO
|
|
|
|
|
+ SYSTEM.GET(_types + t1 * WORD, t1)
|
|
|
|
|
+ END;
|
|
|
|
|
+
|
|
|
|
|
+ SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1))
|
|
|
|
|
+ END
|
|
|
|
|
+ END;
|
|
|
|
|
+
|
|
|
|
|
+ name := modname
|
|
|
|
|
+END _init;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+END RTL.
|
|
|
|
|
+$END
|
|
|
|
|
+
|
|
|
|
|
+(*---------------------x86------------------------*)
|
|
|
|
|
+
|
|
|
|
|
+$IF (CPU_X86)
|
|
|
|
|
+MODULE RTL;
|
|
|
|
|
+
|
|
|
|
|
+IMPORT SYSTEM, API;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+CONST
|
|
|
|
|
+
|
|
|
|
|
+ minint = ROR(1, 1);
|
|
|
|
|
+
|
|
|
|
|
+ WORD = API.BIT_DEPTH DIV 8;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+VAR
|
|
|
|
|
+
|
|
|
|
|
+ name: INTEGER;
|
|
|
|
|
+ types: INTEGER;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [stdcall] _move* (bytes, dest, source: INTEGER);
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ SYSTEM.CODE(
|
|
|
|
|
+ 08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *)
|
|
|
|
|
+ 085H, 0C0H, (* test eax, eax *)
|
|
|
|
|
+ 07EH, 019H, (* jle L *)
|
|
|
|
|
+ 0FCH, (* cld *)
|
|
|
|
|
+ 057H, (* push edi *)
|
|
|
|
|
+ 056H, (* push esi *)
|
|
|
|
|
+ 08BH, 075H, 010H, (* mov esi, dword [ebp + 16] *)
|
|
|
|
|
+ 08BH, 07DH, 00CH, (* mov edi, dword [ebp + 12] *)
|
|
|
|
|
+ 089H, 0C1H, (* mov ecx, eax *)
|
|
|
|
|
+ 0C1H, 0E9H, 002H, (* shr ecx, 2 *)
|
|
|
|
|
+ 0F3H, 0A5H, (* rep movsd *)
|
|
|
|
|
+ 089H, 0C1H, (* mov ecx, eax *)
|
|
|
|
|
+ 083H, 0E1H, 003H, (* and ecx, 3 *)
|
|
|
|
|
+ 0F3H, 0A4H, (* rep movsb *)
|
|
|
|
|
+ 05EH, (* pop esi *)
|
|
|
|
|
+ 05FH (* pop edi *)
|
|
|
|
|
+ (* L: *)
|
|
|
|
|
+ )
|
|
|
|
|
+END _move;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [stdcall] _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 [stdcall] _strcpy* (chr_size, len_src, src, len_dst, dst: INTEGER);
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ _move(MIN(len_dst, len_src) * chr_size, dst, src)
|
|
|
|
|
+END _strcpy;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [stdcall] _rot* (Len, Ptr: INTEGER);
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ SYSTEM.CODE(
|
|
|
|
|
+ 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 8] *) (* ecx <- Len *)
|
|
|
|
|
+ 08BH, 045H, 00CH, (* mov eax, dword [ebp + 12] *) (* eax <- Ptr *)
|
|
|
|
|
+ 049H, (* dec ecx *)
|
|
|
|
|
+ 053H, (* push ebx *)
|
|
|
|
|
+ 08BH, 018H, (* mov ebx, dword [eax] *)
|
|
|
|
|
+ (* L: *)
|
|
|
|
|
+ 08BH, 050H, 004H, (* mov edx, dword [eax + 4] *)
|
|
|
|
|
+ 089H, 010H, (* mov dword [eax], edx *)
|
|
|
|
|
+ 083H, 0C0H, 004H, (* add eax, 4 *)
|
|
|
|
|
+ 049H, (* dec ecx *)
|
|
|
|
|
+ 075H, 0F5H, (* jnz L *)
|
|
|
|
|
+ 089H, 018H, (* mov dword [eax], ebx *)
|
|
|
|
|
+ 05BH, (* pop ebx *)
|
|
|
|
|
+ 05DH, (* pop ebp *)
|
|
|
|
|
+ 0C2H, 008H, 000H (* ret 8 *)
|
|
|
|
|
+ )
|
|
|
|
|
+END _rot;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [stdcall] _set* (b, a: INTEGER); (* {a..b} -> eax *)
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ SYSTEM.CODE(
|
|
|
|
|
+ 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 8] *) (* ecx <- b *)
|
|
|
|
|
+ 08BH, 045H, 00CH, (* mov eax, dword [ebp + 12] *) (* eax <- a *)
|
|
|
|
|
+ 039H, 0C8H, (* cmp eax, ecx *)
|
|
|
|
|
+ 07FH, 033H, (* jg L1 *)
|
|
|
|
|
+ 083H, 0F8H, 01FH, (* cmp eax, 31 *)
|
|
|
|
|
+ 07FH, 02EH, (* jg L1 *)
|
|
|
|
|
+ 085H, 0C9H, (* test ecx, ecx *)
|
|
|
|
|
+ 07CH, 02AH, (* jl L1 *)
|
|
|
|
|
+ 083H, 0F9H, 01FH, (* cmp ecx, 31 *)
|
|
|
|
|
+ 07EH, 005H, (* jle L3 *)
|
|
|
|
|
+ 0B9H, 01FH, 000H, 000H, 000H, (* mov ecx, 31 *)
|
|
|
|
|
+ (* L3: *)
|
|
|
|
|
+ 085H, 0C0H, (* test eax, eax *)
|
|
|
|
|
+ 07DH, 002H, (* jge L2 *)
|
|
|
|
|
+ 031H, 0C0H, (* xor eax, eax *)
|
|
|
|
|
+ (* L2: *)
|
|
|
|
|
+ 089H, 0CAH, (* mov edx, ecx *)
|
|
|
|
|
+ 029H, 0C2H, (* sub edx, eax *)
|
|
|
|
|
+ 0B8H, 000H, 000H, 000H, 080H, (* mov eax, 0x80000000 *)
|
|
|
|
|
+ 087H, 0CAH, (* xchg edx, ecx *)
|
|
|
|
|
+ 0D3H, 0F8H, (* sar eax, cl *)
|
|
|
|
|
+ 087H, 0CAH, (* xchg edx, ecx *)
|
|
|
|
|
+ 083H, 0E9H, 01FH, (* sub ecx, 31 *)
|
|
|
|
|
+ 0F7H, 0D9H, (* neg ecx *)
|
|
|
|
|
+ 0D3H, 0E8H, (* shr eax, cl *)
|
|
|
|
|
+ 05DH, (* pop ebp *)
|
|
|
|
|
+ 0C2H, 008H, 000H, (* ret 8 *)
|
|
|
|
|
+ (* L1: *)
|
|
|
|
|
+ 031H, 0C0H, (* xor eax, eax *)
|
|
|
|
|
+ 05DH, (* pop ebp *)
|
|
|
|
|
+ 0C2H, 008H, 000H (* ret 8 *)
|
|
|
|
|
+ )
|
|
|
|
|
+END _set;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [stdcall] _set1* (a: INTEGER); (* {a} -> eax *)
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ SYSTEM.CODE(
|
|
|
|
|
+ 031H, 0C0H, (* xor eax, eax *)
|
|
|
|
|
+ 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 8] *) (* ecx <- a *)
|
|
|
|
|
+ 083H, 0F9H, 01FH, (* cmp ecx, 31 *)
|
|
|
|
|
+ 077H, 003H, (* ja L *)
|
|
|
|
|
+ 00FH, 0ABH, 0C8H (* bts eax, ecx *)
|
|
|
|
|
+ (* L: *)
|
|
|
|
|
+ )
|
|
|
|
|
+END _set1;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [stdcall] _divmod* (y, x: INTEGER); (* (x div y) -> eax; (x mod y) -> edx *)
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ SYSTEM.CODE(
|
|
|
|
|
+ 053H, (* push ebx *)
|
|
|
|
|
+ 08BH, 045H, 00CH, (* mov eax, dword [ebp + 12] *) (* eax <- x *)
|
|
|
|
|
+ 031H, 0D2H, (* xor edx, edx *)
|
|
|
|
|
+ 085H, 0C0H, (* test eax, eax *)
|
|
|
|
|
+ 074H, 018H, (* je L2 *)
|
|
|
|
|
+ 07FH, 002H, (* jg L1 *)
|
|
|
|
|
+ 0F7H, 0D2H, (* not edx *)
|
|
|
|
|
+ (* L1: *)
|
|
|
|
|
+ 089H, 0C3H, (* mov ebx, eax *)
|
|
|
|
|
+ 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 8] *) (* ecx <- y *)
|
|
|
|
|
+ 0F7H, 0F9H, (* idiv ecx *)
|
|
|
|
|
+ 085H, 0D2H, (* test edx, edx *)
|
|
|
|
|
+ 074H, 009H, (* je L2 *)
|
|
|
|
|
+ 031H, 0CBH, (* xor ebx, ecx *)
|
|
|
|
|
+ 085H, 0DBH, (* test ebx, ebx *)
|
|
|
|
|
+ 07DH, 003H, (* jge L2 *)
|
|
|
|
|
+ 048H, (* dec eax *)
|
|
|
|
|
+ 001H, 0CAH, (* add edx, ecx *)
|
|
|
|
|
+ (* L2: *)
|
|
|
|
|
+ 05BH (* pop ebx *)
|
|
|
|
|
+ )
|
|
|
|
|
+END _divmod;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER);
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ ptr := API._NEW(size);
|
|
|
|
|
+ IF ptr # 0 THEN
|
|
|
|
|
+ SYSTEM.PUT(ptr + ORD(API.OS = "LINUX")*12, t);
|
|
|
|
|
+ INC(ptr, 4 + ORD(API.OS = "LINUX")*12)
|
|
|
|
|
+ END
|
|
|
|
|
+END _new;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [stdcall] _dispose* (VAR ptr: INTEGER);
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ IF ptr # 0 THEN
|
|
|
|
|
+ ptr := API._DISPOSE(ptr - (4 + ORD(API.OS = "LINUX")*12))
|
|
|
|
|
+ END
|
|
|
|
|
+END _dispose;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [stdcall] _length* (len, str: INTEGER);
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ SYSTEM.CODE(
|
|
|
|
|
+ 08BH, 045H, 00CH, (* mov eax, dword [ebp + 0Ch] *)
|
|
|
|
|
+ 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 08h] *)
|
|
|
|
|
+ 048H, (* dec eax *)
|
|
|
|
|
+ (* L1: *)
|
|
|
|
|
+ 040H, (* inc eax *)
|
|
|
|
|
+ 080H, 038H, 000H, (* cmp byte [eax], 0 *)
|
|
|
|
|
+ 074H, 003H, (* jz L2 *)
|
|
|
|
|
+ 0E2H, 0F8H, (* loop L1 *)
|
|
|
|
|
+ 040H, (* inc eax *)
|
|
|
|
|
+ (* L2: *)
|
|
|
|
|
+ 02BH, 045H, 00CH (* sub eax, dword [ebp + 0Ch] *)
|
|
|
|
|
+ )
|
|
|
|
|
+END _length;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [stdcall] _lengthw* (len, str: INTEGER);
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ SYSTEM.CODE(
|
|
|
|
|
+ 08BH, 045H, 00CH, (* mov eax, dword [ebp + 0Ch] *)
|
|
|
|
|
+ 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 08h] *)
|
|
|
|
|
+ 048H, (* dec eax *)
|
|
|
|
|
+ 048H, (* dec eax *)
|
|
|
|
|
+ (* L1: *)
|
|
|
|
|
+ 040H, (* inc eax *)
|
|
|
|
|
+ 040H, (* inc eax *)
|
|
|
|
|
+ 066H, 083H, 038H, 000H, (* cmp word [eax], 0 *)
|
|
|
|
|
+ 074H, 004H, (* jz L2 *)
|
|
|
|
|
+ 0E2H, 0F6H, (* loop L1 *)
|
|
|
|
|
+ 040H, (* inc eax *)
|
|
|
|
|
+ 040H, (* inc eax *)
|
|
|
|
|
+ (* L2: *)
|
|
|
|
|
+ 02BH, 045H, 00CH, (* sub eax, dword [ebp + 0Ch] *)
|
|
|
|
|
+ 0D1H, 0E8H (* shr eax, 1 *)
|
|
|
|
|
+ )
|
|
|
|
|
+END _lengthw;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [stdcall] strncmp (a, b, n: INTEGER): INTEGER;
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ SYSTEM.CODE(
|
|
|
|
|
+ 056H, (* push esi *)
|
|
|
|
|
+ 057H, (* push edi *)
|
|
|
|
|
+ 053H, (* push ebx *)
|
|
|
|
|
+ 08BH, 075H, 008H, (* mov esi, dword[ebp + 8]; esi <- a *)
|
|
|
|
|
+ 08BH, 07DH, 00CH, (* mov edi, dword[ebp + 12]; edi <- b *)
|
|
|
|
|
+ 08BH, 05DH, 010H, (* mov ebx, dword[ebp + 16]; ebx <- n *)
|
|
|
|
|
+ 031H, 0C9H, (* xor ecx, ecx *)
|
|
|
|
|
+ 031H, 0D2H, (* xor edx, edx *)
|
|
|
|
|
+ 0B8H,
|
|
|
|
|
+ 000H, 000H, 000H, 080H, (* mov eax, minint *)
|
|
|
|
|
+ (* L1: *)
|
|
|
|
|
+ 085H, 0DBH, (* test ebx, ebx *)
|
|
|
|
|
+ 07EH, 017H, (* jle L3 *)
|
|
|
|
|
+ 08AH, 00EH, (* mov cl, byte[esi] *)
|
|
|
|
|
+ 08AH, 017H, (* mov dl, byte[edi] *)
|
|
|
|
|
+ 046H, (* inc esi *)
|
|
|
|
|
+ 047H, (* inc edi *)
|
|
|
|
|
+ 04BH, (* dec ebx *)
|
|
|
|
|
+ 039H, 0D1H, (* cmp ecx, edx *)
|
|
|
|
|
+ 074H, 006H, (* je L2 *)
|
|
|
|
|
+ 089H, 0C8H, (* mov eax, ecx *)
|
|
|
|
|
+ 029H, 0D0H, (* sub eax, edx *)
|
|
|
|
|
+ 0EBH, 006H, (* jmp L3 *)
|
|
|
|
|
+ (* L2: *)
|
|
|
|
|
+ 085H, 0C9H, (* test ecx, ecx *)
|
|
|
|
|
+ 075H, 0E7H, (* jne L1 *)
|
|
|
|
|
+ 031H, 0C0H, (* xor eax, eax *)
|
|
|
|
|
+ (* L3: *)
|
|
|
|
|
+ 05BH, (* pop ebx *)
|
|
|
|
|
+ 05FH, (* pop edi *)
|
|
|
|
|
+ 05EH, (* pop esi *)
|
|
|
|
|
+ 05DH, (* pop ebp *)
|
|
|
|
|
+ 0C2H, 00CH, 000H (* ret 12 *)
|
|
|
|
|
+ )
|
|
|
|
|
+ RETURN 0
|
|
|
|
|
+END strncmp;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [stdcall] strncmpw (a, b, n: INTEGER): INTEGER;
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ SYSTEM.CODE(
|
|
|
|
|
+ 056H, (* push esi *)
|
|
|
|
|
+ 057H, (* push edi *)
|
|
|
|
|
+ 053H, (* push ebx *)
|
|
|
|
|
+ 08BH, 075H, 008H, (* mov esi, dword[ebp + 8]; esi <- a *)
|
|
|
|
|
+ 08BH, 07DH, 00CH, (* mov edi, dword[ebp + 12]; edi <- b *)
|
|
|
|
|
+ 08BH, 05DH, 010H, (* mov ebx, dword[ebp + 16]; ebx <- n *)
|
|
|
|
|
+ 031H, 0C9H, (* xor ecx, ecx *)
|
|
|
|
|
+ 031H, 0D2H, (* xor edx, edx *)
|
|
|
|
|
+ 0B8H,
|
|
|
|
|
+ 000H, 000H, 000H, 080H, (* mov eax, minint *)
|
|
|
|
|
+ (* L1: *)
|
|
|
|
|
+ 085H, 0DBH, (* test ebx, ebx *)
|
|
|
|
|
+ 07EH, 01BH, (* jle L3 *)
|
|
|
|
|
+ 066H, 08BH, 00EH, (* mov cx, word[esi] *)
|
|
|
|
|
+ 066H, 08BH, 017H, (* mov dx, word[edi] *)
|
|
|
|
|
+ 046H, (* inc esi *)
|
|
|
|
|
+ 046H, (* inc esi *)
|
|
|
|
|
+ 047H, (* inc edi *)
|
|
|
|
|
+ 047H, (* inc edi *)
|
|
|
|
|
+ 04BH, (* dec ebx *)
|
|
|
|
|
+ 039H, 0D1H, (* cmp ecx, edx *)
|
|
|
|
|
+ 074H, 006H, (* je L2 *)
|
|
|
|
|
+ 089H, 0C8H, (* mov eax, ecx *)
|
|
|
|
|
+ 029H, 0D0H, (* sub eax, edx *)
|
|
|
|
|
+ 0EBH, 006H, (* jmp L3 *)
|
|
|
|
|
+ (* L2: *)
|
|
|
|
|
+ 085H, 0C9H, (* test ecx, ecx *)
|
|
|
|
|
+ 075H, 0E3H, (* jne L1 *)
|
|
|
|
|
+ 031H, 0C0H, (* xor eax, eax *)
|
|
|
|
|
+ (* L3: *)
|
|
|
|
|
+ 05BH, (* pop ebx *)
|
|
|
|
|
+ 05FH, (* pop edi *)
|
|
|
|
|
+ 05EH, (* pop esi *)
|
|
|
|
|
+ 05DH, (* pop ebp *)
|
|
|
|
|
+ 0C2H, 00CH, 000H (* ret 12 *)
|
|
|
|
|
+ )
|
|
|
|
|
+ RETURN 0
|
|
|
|
|
+END strncmpw;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [stdcall] _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
|
|
|
|
|
+VAR
|
|
|
|
|
+ res: INTEGER;
|
|
|
|
|
+ bRes: BOOLEAN;
|
|
|
|
|
+ c: CHAR;
|
|
|
|
|
+
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ res := strncmp(str1, str2, MIN(len1, len2));
|
|
|
|
|
+ IF res = minint THEN
|
|
|
|
|
+ IF len1 > len2 THEN
|
|
|
|
|
+ SYSTEM.GET(str1 + len2, c);
|
|
|
|
|
+ res := ORD(c)
|
|
|
|
|
+ ELSIF len1 < len2 THEN
|
|
|
|
|
+ SYSTEM.GET(str2 + len1, c);
|
|
|
|
|
+ res := -ORD(c)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ res := 0
|
|
|
|
|
+ END
|
|
|
|
|
+ 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 [stdcall] _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN;
|
|
|
|
|
+VAR
|
|
|
|
|
+ res: INTEGER;
|
|
|
|
|
+ bRes: BOOLEAN;
|
|
|
|
|
+ c: WCHAR;
|
|
|
|
|
+
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ res := strncmpw(str1, str2, MIN(len1, len2));
|
|
|
|
|
+ IF res = minint THEN
|
|
|
|
|
+ IF len1 > len2 THEN
|
|
|
|
|
+ SYSTEM.GET(str1 + len2 * 2, c);
|
|
|
|
|
+ res := ORD(c)
|
|
|
|
|
+ ELSIF len1 < len2 THEN
|
|
|
|
|
+ SYSTEM.GET(str2 + len1 * 2, c);
|
|
|
|
|
+ res := -ORD(c)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ res := 0
|
|
|
|
|
+ END
|
|
|
|
|
+ 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 PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR);
|
|
|
|
|
+VAR
|
|
|
|
|
+ c: CHAR;
|
|
|
|
|
+ i: INTEGER;
|
|
|
|
|
+
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ i := 0;
|
|
|
|
|
+ REPEAT
|
|
|
|
|
+ SYSTEM.GET(pchar, c);
|
|
|
|
|
+ s[i] := c;
|
|
|
|
|
+ INC(pchar);
|
|
|
|
|
+ INC(i)
|
|
|
|
|
+ UNTIL c = 0X
|
|
|
|
|
+END PCharToStr;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE IntToStr (x: INTEGER; VAR str: ARRAY OF CHAR);
|
|
|
|
|
+VAR
|
|
|
|
|
+ i, a: INTEGER;
|
|
|
|
|
+
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ i := 0;
|
|
|
|
|
+ a := x;
|
|
|
|
|
+ REPEAT
|
|
|
|
|
+ INC(i);
|
|
|
|
|
+ a := a DIV 10
|
|
|
|
|
+ UNTIL a = 0;
|
|
|
|
|
+
|
|
|
|
|
+ str[i] := 0X;
|
|
|
|
|
+
|
|
|
|
|
+ REPEAT
|
|
|
|
|
+ DEC(i);
|
|
|
|
|
+ str[i] := CHR(x MOD 10 + ORD("0"));
|
|
|
|
|
+ x := x DIV 10
|
|
|
|
|
+ UNTIL x = 0
|
|
|
|
|
+END IntToStr;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR);
|
|
|
|
|
+VAR
|
|
|
|
|
+ n1, n2: INTEGER;
|
|
|
|
|
+
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ n1 := LENGTH(s1);
|
|
|
|
|
+ n2 := LENGTH(s2);
|
|
|
|
|
+
|
|
|
|
|
+ ASSERT(n1 + n2 < LEN(s1));
|
|
|
|
|
+
|
|
|
|
|
+ SYSTEM.MOVE(SYSTEM.ADR(s2[0]), SYSTEM.ADR(s1[n1]), n2);
|
|
|
|
|
+ s1[n1 + n2] := 0X
|
|
|
|
|
+END append;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [stdcall] _error* (modnum, _module, err, line: INTEGER);
|
|
|
|
|
+VAR
|
|
|
|
|
+ s, temp: ARRAY 1024 OF CHAR;
|
|
|
|
|
+
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ CASE err OF
|
|
|
|
|
+ | 1: s := "assertion failure"
|
|
|
|
|
+ | 2: s := "NIL dereference"
|
|
|
|
|
+ | 3: s := "bad divisor"
|
|
|
|
|
+ | 4: s := "NIL procedure call"
|
|
|
|
|
+ | 5: s := "type guard error"
|
|
|
|
|
+ | 6: s := "index out of range"
|
|
|
|
|
+ | 7: s := "invalid CASE"
|
|
|
|
|
+ | 8: s := "array assignment error"
|
|
|
|
|
+ | 9: s := "CHR out of range"
|
|
|
|
|
+ |10: s := "WCHR out of range"
|
|
|
|
|
+ |11: s := "BYTE out of range"
|
|
|
|
|
+ END;
|
|
|
|
|
+
|
|
|
|
|
+ append(s, API.eol + "module: "); PCharToStr(_module, temp); append(s, temp);
|
|
|
|
|
+ append(s, API.eol + "line: "); IntToStr(line, temp); append(s, temp);
|
|
|
|
|
+
|
|
|
|
|
+ API.DebugMsg(SYSTEM.ADR(s[0]), name);
|
|
|
|
|
+
|
|
|
|
|
+ API.exit_thread(0)
|
|
|
|
|
+END _error;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): INTEGER;
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ SYSTEM.GET(t0 + t1 + types, t0)
|
|
|
|
|
+ RETURN t0 MOD 2
|
|
|
|
|
+END _isrec;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [stdcall] _is* (t0, p: INTEGER): INTEGER;
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ IF p # 0 THEN
|
|
|
|
|
+ SYSTEM.GET(p - WORD, p);
|
|
|
|
|
+ SYSTEM.GET(t0 + p + types, p)
|
|
|
|
|
+ END
|
|
|
|
|
+
|
|
|
|
|
+ RETURN p MOD 2
|
|
|
|
|
+END _is;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): INTEGER;
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ SYSTEM.GET(t0 + t1 + types, t0)
|
|
|
|
|
+ RETURN t0 MOD 2
|
|
|
|
|
+END _guardrec;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [stdcall] _guard* (t0, p: INTEGER): INTEGER;
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ SYSTEM.GET(p, p);
|
|
|
|
|
+ IF p # 0 THEN
|
|
|
|
|
+ SYSTEM.GET(p - WORD, p);
|
|
|
|
|
+ SYSTEM.GET(t0 + p + types, p)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ p := 1
|
|
|
|
|
+ END
|
|
|
|
|
+
|
|
|
|
|
+ RETURN p MOD 2
|
|
|
|
|
+END _guard;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [stdcall] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER;
|
|
|
|
|
+ RETURN API.dllentry(hinstDLL, fdwReason, lpvReserved)
|
|
|
|
|
+END _dllentry;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [stdcall] _sofinit*;
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ API.sofinit
|
|
|
|
|
+END _sofinit;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [stdcall] _exit* (code: INTEGER);
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ API.exit(code)
|
|
|
|
|
+END _exit;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE [stdcall] _init* (modname: INTEGER; tcount, _types: INTEGER; code, param: INTEGER);
|
|
|
|
|
+VAR
|
|
|
|
|
+ t0, t1, i, j: INTEGER;
|
|
|
|
|
+
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ SYSTEM.CODE(09BH, 0DBH, 0E3H); (* finit *)
|
|
|
|
|
+ API.init(param, code);
|
|
|
|
|
+
|
|
|
|
|
+ types := API._NEW(tcount * tcount + SYSTEM.SIZE(INTEGER));
|
|
|
|
|
+ ASSERT(types # 0);
|
|
|
|
|
+ FOR i := 0 TO tcount - 1 DO
|
|
|
|
|
+ FOR j := 0 TO tcount - 1 DO
|
|
|
|
|
+ t0 := i; t1 := j;
|
|
|
|
|
+
|
|
|
|
|
+ WHILE (t1 # 0) & (t1 # t0) DO
|
|
|
|
|
+ SYSTEM.GET(_types + t1 * WORD, t1)
|
|
|
|
|
+ END;
|
|
|
|
|
+
|
|
|
|
|
+ SYSTEM.PUT8(i * tcount + j + types, ORD(t0 = t1))
|
|
|
|
|
+ END
|
|
|
|
|
+ END;
|
|
|
|
|
+
|
|
|
|
|
+ name := modname
|
|
|
|
|
+END _init;
|
|
|
|
|
+
|
|
|
|
|
+
|
|
|
|
|
+END RTL.
|
|
|
|
|
+$END
|