Subversion Repositories Kolibri OS

Rev

Rev 6755 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
6613 leency 1
(*
7107 akron1 2
    Copyright 2016, 2017 Anton Krotov
6613 leency 3
 
4
    This program is free software: you can redistribute it and/or modify
5
    it under the terms of the GNU Lesser General Public License as published by
6
    the Free Software Foundation, either version 3 of the License, or
7
    (at your option) any later version.
8
 
9
    This program is distributed in the hope that it will be useful,
10
    but WITHOUT ANY WARRANTY; without even the implied warranty of
11
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12
    GNU Lesser General Public License for more details.
13
 
14
    You should have received a copy of the GNU Lesser General Public License
15
    along with this program.  If not, see .
16
*)
17
 
18
MODULE API;
19
 
20
IMPORT sys := SYSTEM;
21
 
22
CONST
23
 
24
  MAX_SIZE  = 16 * 400H;
25
  HEAP_SIZE =  1 * 100000H;
26
 
27
VAR
28
 
29
  heap, endheap: INTEGER;
30
  pockets: ARRAY MAX_SIZE DIV 32 + 1 OF INTEGER;
31
 
32
PROCEDURE [stdcall] zeromem*(size, adr: INTEGER);
33
BEGIN
34
  sys.CODE("578B7D0C8B4D0833C09CFCF3AB9D5F")
35
END zeromem;
36
 
6647 akron1 37
PROCEDURE mem_commit*(adr, size: INTEGER);
38
VAR tmp: INTEGER;
39
BEGIN
40
  FOR tmp := adr TO adr + size - 1 BY 4096 DO
41
    sys.PUT(tmp, 0)
42
  END
43
END mem_commit;
44
 
6613 leency 45
PROCEDURE strncmp*(a, b, n: INTEGER): INTEGER;
46
VAR A, B: CHAR; Res: INTEGER;
47
BEGIN
48
  Res := 0;
49
  WHILE n > 0 DO
50
    sys.GET(a, A); INC(a);
51
    sys.GET(b, B); INC(b);
52
    DEC(n);
53
    IF A # B THEN
54
      Res := ORD(A) - ORD(B);
55
      n := 0
56
    ELSIF A = 0X THEN
57
      n := 0
58
    END
59
  END
60
  RETURN Res
61
END strncmp;
62
 
6755 akron1 63
PROCEDURE [stdcall] sysfunc1*(arg1: INTEGER): INTEGER;
6613 leency 64
BEGIN
65
  sys.CODE("8B4508");           (* mov     eax, [ebp + 08h] *)
66
  sys.CODE("CD40");             (* int     40h              *)
67
  sys.CODE("C9");               (* leave                    *)
68
  sys.CODE("C20400");           (* ret     04h              *)
69
  RETURN 0
70
END sysfunc1;
71
 
6755 akron1 72
PROCEDURE [stdcall] sysfunc2*(arg1, arg2: INTEGER): INTEGER;
6613 leency 73
BEGIN
74
  sys.CODE("53");               (* push    ebx              *)
75
  sys.CODE("8B4508");           (* mov     eax, [ebp + 08h] *)
76
  sys.CODE("8B5D0C");           (* mov     ebx, [ebp + 0Ch] *)
77
  sys.CODE("CD40");             (* int     40h              *)
78
  sys.CODE("5B");               (* pop     ebx              *)
79
  sys.CODE("C9");               (* leave                    *)
80
  sys.CODE("C20800");           (* ret     08h              *)
81
  RETURN 0
82
END sysfunc2;
83
 
6755 akron1 84
PROCEDURE [stdcall] sysfunc3*(arg1, arg2, arg3: INTEGER): INTEGER;
6613 leency 85
BEGIN
86
  sys.CODE("53");               (* push    ebx              *)
87
  sys.CODE("8B4508");           (* mov     eax, [ebp + 08h] *)
88
  sys.CODE("8B5D0C");           (* mov     ebx, [ebp + 0Ch] *)
89
  sys.CODE("8B4D10");           (* mov     ecx, [ebp + 10h] *)
90
  sys.CODE("CD40");             (* int     40h              *)
91
  sys.CODE("5B");               (* pop     ebx              *)
92
  sys.CODE("C9");               (* leave                    *)
93
  sys.CODE("C20C00");           (* ret     0Ch              *)
94
  RETURN 0
95
END sysfunc3;
96
 
97
PROCEDURE _NEW*(size: INTEGER): INTEGER;
98
VAR res, idx, temp: INTEGER;
99
BEGIN
100
  IF size <= MAX_SIZE THEN
101
    idx := ASR(size, 5);
102
    res := pockets[idx];
103
    IF res # 0 THEN
104
      sys.GET(res, pockets[idx]);
105
      sys.PUT(res, size);
106
      INC(res, 4)
107
    ELSE
6647 akron1 108
      temp := 0;
6613 leency 109
      IF heap + size >= endheap THEN
7107 akron1 110
        IF sysfunc2(18, 16) > ASR(HEAP_SIZE, 10) THEN
111
          temp := sysfunc3(68, 12, HEAP_SIZE)
112
        ELSE
113
          temp := 0
114
        END;
115
        IF temp # 0 THEN
116
          mem_commit(temp, HEAP_SIZE);
117
          heap := temp;
118
          endheap := heap + HEAP_SIZE
119
        ELSE
120
          temp := -1
121
        END
6613 leency 122
      END;
6647 akron1 123
      IF (heap # 0) & (temp # -1) THEN
7107 akron1 124
        sys.PUT(heap, size);
125
        res := heap + 4;
126
        heap := heap + size
6613 leency 127
      ELSE
7107 akron1 128
        res := 0
6613 leency 129
      END
130
    END
131
  ELSE
132
    IF sysfunc2(18, 16) > ASR(size, 10) THEN
133
      res := sysfunc3(68, 12, size);
6647 akron1 134
      IF res # 0 THEN
7107 akron1 135
        mem_commit(res, size);
136
        sys.PUT(res, size);
137
        INC(res, 4)
6647 akron1 138
      END
6613 leency 139
    ELSE
140
      res := 0
141
    END
142
  END;
143
  IF res # 0 THEN
144
    zeromem(ASR(size, 2) - 1, res)
145
  END
146
  RETURN res
147
END _NEW;
148
 
149
PROCEDURE _DISPOSE*(ptr: INTEGER): INTEGER;
150
VAR size, idx: INTEGER;
151
BEGIN
152
  DEC(ptr, 4);
153
  sys.GET(ptr, size);
154
  IF size <= MAX_SIZE THEN
155
    idx := ASR(size, 5);
156
    sys.PUT(ptr, pockets[idx]);
157
    pockets[idx] := ptr
158
  ELSE
159
    size := sysfunc3(68, 13, ptr)
160
  END
161
  RETURN 0
162
END _DISPOSE;
163
 
164
PROCEDURE ExitProcess*(p1: INTEGER);
165
BEGIN
166
  p1 := sysfunc1(-1)
167
END ExitProcess;
168
 
7107 akron1 169
PROCEDURE ExitThread*(p1: INTEGER);
170
BEGIN
171
  p1 := sysfunc1(-1)
172
END ExitThread;
173
 
6613 leency 174
PROCEDURE OutChar(c: CHAR);
175
VAR res: INTEGER;
176
BEGIN
177
  res := sysfunc3(63, 1, ORD(c))
178
END OutChar;
179
 
180
PROCEDURE DebugMsg*(lpText, lpCaption: INTEGER);
181
VAR c: CHAR;
182
BEGIN
183
  IF lpCaption # 0 THEN
184
    OutChar(0DX);
185
    OutChar(0AX);
186
    REPEAT
187
      sys.GET(lpCaption, c);
188
      IF c # 0X THEN
7107 akron1 189
        OutChar(c)
6613 leency 190
      END;
191
      INC(lpCaption)
192
    UNTIL c = 0X;
193
    OutChar(":");
194
    OutChar(0DX);
195
    OutChar(0AX)
196
  END;
197
  REPEAT
198
    sys.GET(lpText, c);
199
    IF c # 0X THEN
200
      OutChar(c)
201
    END;
202
    INC(lpText)
203
  UNTIL c = 0X;
204
  IF lpCaption # 0 THEN
205
    OutChar(0DX);
206
    OutChar(0AX)
207
  END
208
END DebugMsg;
209
 
210
PROCEDURE init* (p1: INTEGER);
211
BEGIN
212
  p1 := sysfunc2(68, 11)
213
END init;
214
 
215
END API.