Rev 8097 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed
Rev | Author | Line No. | Line |
---|---|---|---|
7983 | leency | 1 | (* |
7597 | akron1 | 2 | BSD 2-Clause License |
6613 | leency | 3 | |
8859 | leency | 4 | Copyright (c) 2018, 2020-2021, Anton Krotov |
7597 | akron1 | 5 | All rights reserved. |
6613 | leency | 6 | *) |
7 | |||
8 | MODULE API; |
||
9 | |||
7597 | akron1 | 10 | IMPORT SYSTEM, K := KOSAPI; |
6613 | leency | 11 | |
7110 | akron1 | 12 | |
6613 | leency | 13 | CONST |
14 | |||
8097 | maxcodehac | 15 | eol* = 0DX + 0AX; |
8859 | leency | 16 | BIT_DEPTH* = 32; |
8097 | maxcodehac | 17 | |
7110 | akron1 | 18 | MAX_SIZE = 16 * 400H; |
19 | HEAP_SIZE = 1 * 100000H; |
||
7209 | akron1 | 20 | |
7110 | akron1 | 21 | _new = 1; |
22 | _dispose = 2; |
||
6613 | leency | 23 | |
7696 | akron1 | 24 | SizeOfHeader = 36; |
7209 | akron1 | 25 | |
7696 | akron1 | 26 | |
7110 | akron1 | 27 | TYPE |
28 | |||
29 | CRITICAL_SECTION = ARRAY 2 OF INTEGER; |
||
30 | |||
31 | |||
6613 | leency | 32 | VAR |
33 | |||
7110 | akron1 | 34 | heap, endheap: INTEGER; |
35 | pockets: ARRAY MAX_SIZE DIV 32 + 1 OF INTEGER; |
||
6613 | leency | 36 | |
7110 | akron1 | 37 | CriticalSection: CRITICAL_SECTION; |
38 | |||
8097 | maxcodehac | 39 | _import*, multi: BOOLEAN; |
7110 | akron1 | 40 | |
7597 | akron1 | 41 | base*: INTEGER; |
42 | |||
43 | |||
44 | PROCEDURE [stdcall] zeromem* (dwords: INTEGER; adr: INTEGER); |
||
6613 | leency | 45 | BEGIN |
7597 | akron1 | 46 | SYSTEM.CODE( |
47 | 0FCH, (* cld *) |
||
48 | 031H, 0C0H, (* xor eax, eax *) |
||
49 | 057H, (* push edi *) |
||
50 | 08BH, 07DH, 00CH, (* mov edi, dword [ebp + 12] *) |
||
51 | 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 8] *) |
||
52 | 0F3H, 0ABH, (* rep stosd *) |
||
53 | 05FH (* pop edi *) |
||
54 | ) |
||
7209 | akron1 | 55 | END zeromem; |
6613 | leency | 56 | |
7110 | akron1 | 57 | |
58 | PROCEDURE mem_commit* (adr, size: INTEGER); |
||
59 | VAR |
||
60 | tmp: INTEGER; |
||
6647 | akron1 | 61 | BEGIN |
7110 | akron1 | 62 | FOR tmp := adr TO adr + size - 1 BY 4096 DO |
7597 | akron1 | 63 | SYSTEM.PUT(tmp, 0) |
7110 | akron1 | 64 | END |
7209 | akron1 | 65 | END mem_commit; |
6647 | akron1 | 66 | |
7110 | akron1 | 67 | |
68 | PROCEDURE switch_task; |
||
69 | BEGIN |
||
7597 | akron1 | 70 | K.sysfunc2(68, 1) |
7110 | akron1 | 71 | END switch_task; |
72 | |||
73 | |||
74 | PROCEDURE futex_create (ptr: INTEGER): INTEGER; |
||
7597 | akron1 | 75 | RETURN K.sysfunc3(77, 0, ptr) |
7110 | akron1 | 76 | END futex_create; |
77 | |||
78 | |||
79 | PROCEDURE futex_wait (futex, value, timeout: INTEGER); |
||
80 | BEGIN |
||
7597 | akron1 | 81 | K.sysfunc5(77, 2, futex, value, timeout) |
7110 | akron1 | 82 | END futex_wait; |
83 | |||
84 | |||
85 | PROCEDURE futex_wake (futex, number: INTEGER); |
||
86 | BEGIN |
||
7597 | akron1 | 87 | K.sysfunc4(77, 3, futex, number) |
7110 | akron1 | 88 | END futex_wake; |
89 | |||
90 | |||
91 | PROCEDURE EnterCriticalSection* (VAR CriticalSection: CRITICAL_SECTION); |
||
92 | BEGIN |
||
93 | switch_task; |
||
94 | futex_wait(CriticalSection[0], 1, 10000); |
||
95 | CriticalSection[1] := 1 |
||
96 | END EnterCriticalSection; |
||
97 | |||
98 | |||
99 | PROCEDURE LeaveCriticalSection* (VAR CriticalSection: CRITICAL_SECTION); |
||
100 | BEGIN |
||
101 | CriticalSection[1] := 0; |
||
102 | futex_wake(CriticalSection[0], 1) |
||
103 | END LeaveCriticalSection; |
||
104 | |||
105 | |||
106 | PROCEDURE InitializeCriticalSection* (VAR CriticalSection: CRITICAL_SECTION); |
||
107 | BEGIN |
||
7597 | akron1 | 108 | CriticalSection[0] := futex_create(SYSTEM.ADR(CriticalSection[1])); |
7110 | akron1 | 109 | CriticalSection[1] := 0 |
110 | END InitializeCriticalSection; |
||
111 | |||
112 | |||
113 | PROCEDURE __NEW (size: INTEGER): INTEGER; |
||
114 | VAR |
||
115 | res, idx, temp: INTEGER; |
||
116 | BEGIN |
||
117 | IF size <= MAX_SIZE THEN |
||
118 | idx := ASR(size, 5); |
||
119 | res := pockets[idx]; |
||
120 | IF res # 0 THEN |
||
7597 | akron1 | 121 | SYSTEM.GET(res, pockets[idx]); |
122 | SYSTEM.PUT(res, size); |
||
7110 | akron1 | 123 | INC(res, 4) |
124 | ELSE |
||
125 | temp := 0; |
||
126 | IF heap + size >= endheap THEN |
||
7597 | akron1 | 127 | IF K.sysfunc2(18, 16) > ASR(HEAP_SIZE, 10) THEN |
128 | temp := K.sysfunc3(68, 12, HEAP_SIZE) |
||
7110 | akron1 | 129 | ELSE |
130 | temp := 0 |
||
131 | END; |
||
132 | IF temp # 0 THEN |
||
133 | mem_commit(temp, HEAP_SIZE); |
||
134 | heap := temp; |
||
135 | endheap := heap + HEAP_SIZE |
||
136 | ELSE |
||
137 | temp := -1 |
||
138 | END |
||
139 | END; |
||
140 | IF (heap # 0) & (temp # -1) THEN |
||
7597 | akron1 | 141 | SYSTEM.PUT(heap, size); |
7110 | akron1 | 142 | res := heap + 4; |
143 | heap := heap + size |
||
144 | ELSE |
||
145 | res := 0 |
||
146 | END |
||
147 | END |
||
6613 | leency | 148 | ELSE |
7597 | akron1 | 149 | IF K.sysfunc2(18, 16) > ASR(size, 10) THEN |
150 | res := K.sysfunc3(68, 12, size); |
||
7110 | akron1 | 151 | IF res # 0 THEN |
152 | mem_commit(res, size); |
||
7597 | akron1 | 153 | SYSTEM.PUT(res, size); |
7110 | akron1 | 154 | INC(res, 4) |
155 | END |
||
7107 | akron1 | 156 | ELSE |
7110 | akron1 | 157 | res := 0 |
7107 | akron1 | 158 | END |
7110 | akron1 | 159 | END; |
7209 | akron1 | 160 | IF (res # 0) & (size <= MAX_SIZE) THEN |
7110 | akron1 | 161 | zeromem(ASR(size, 2) - 1, res) |
6613 | leency | 162 | END |
7110 | akron1 | 163 | RETURN res |
164 | END __NEW; |
||
165 | |||
166 | |||
167 | PROCEDURE __DISPOSE (ptr: INTEGER): INTEGER; |
||
168 | VAR |
||
169 | size, idx: INTEGER; |
||
170 | BEGIN |
||
171 | DEC(ptr, 4); |
||
7597 | akron1 | 172 | SYSTEM.GET(ptr, size); |
7110 | akron1 | 173 | IF size <= MAX_SIZE THEN |
174 | idx := ASR(size, 5); |
||
7597 | akron1 | 175 | SYSTEM.PUT(ptr, pockets[idx]); |
7110 | akron1 | 176 | pockets[idx] := ptr |
6613 | leency | 177 | ELSE |
7597 | akron1 | 178 | size := K.sysfunc3(68, 13, ptr) |
6613 | leency | 179 | END |
7110 | akron1 | 180 | RETURN 0 |
181 | END __DISPOSE; |
||
182 | |||
183 | |||
184 | PROCEDURE NEW_DISPOSE (func, arg: INTEGER): INTEGER; |
||
185 | VAR |
||
186 | res: INTEGER; |
||
7597 | akron1 | 187 | |
7209 | akron1 | 188 | BEGIN |
7597 | akron1 | 189 | IF multi THEN |
190 | EnterCriticalSection(CriticalSection) |
||
191 | END; |
||
7110 | akron1 | 192 | |
193 | IF func = _new THEN |
||
194 | res := __NEW(arg) |
||
195 | ELSIF func = _dispose THEN |
||
196 | res := __DISPOSE(arg) |
||
7209 | akron1 | 197 | END; |
7110 | akron1 | 198 | |
7597 | akron1 | 199 | IF multi THEN |
200 | LeaveCriticalSection(CriticalSection) |
||
201 | END |
||
202 | |||
7110 | akron1 | 203 | RETURN res |
7209 | akron1 | 204 | END NEW_DISPOSE; |
7110 | akron1 | 205 | |
206 | |||
207 | PROCEDURE _NEW* (size: INTEGER): INTEGER; |
||
208 | RETURN NEW_DISPOSE(_new, size) |
||
6613 | leency | 209 | END _NEW; |
210 | |||
7209 | akron1 | 211 | |
7110 | akron1 | 212 | PROCEDURE _DISPOSE* (ptr: INTEGER): INTEGER; |
213 | RETURN NEW_DISPOSE(_dispose, ptr) |
||
6613 | leency | 214 | END _DISPOSE; |
215 | |||
7110 | akron1 | 216 | |
7597 | akron1 | 217 | PROCEDURE exit* (p1: INTEGER); |
6613 | leency | 218 | BEGIN |
7597 | akron1 | 219 | K.sysfunc1(-1) |
220 | END exit; |
||
6613 | leency | 221 | |
7110 | akron1 | 222 | |
7597 | akron1 | 223 | PROCEDURE exit_thread* (p1: INTEGER); |
7107 | akron1 | 224 | BEGIN |
7597 | akron1 | 225 | K.sysfunc1(-1) |
226 | END exit_thread; |
||
7107 | akron1 | 227 | |
7110 | akron1 | 228 | |
229 | PROCEDURE OutChar (c: CHAR); |
||
6613 | leency | 230 | BEGIN |
7597 | akron1 | 231 | K.sysfunc3(63, 1, ORD(c)) |
7209 | akron1 | 232 | END OutChar; |
6613 | leency | 233 | |
7110 | akron1 | 234 | |
7597 | akron1 | 235 | PROCEDURE OutLn; |
236 | BEGIN |
||
237 | OutChar(0DX); |
||
238 | OutChar(0AX) |
||
239 | END OutLn; |
||
240 | |||
241 | |||
242 | PROCEDURE OutStr (pchar: INTEGER); |
||
7110 | akron1 | 243 | VAR |
244 | c: CHAR; |
||
6613 | leency | 245 | BEGIN |
7597 | akron1 | 246 | IF pchar # 0 THEN |
7110 | akron1 | 247 | REPEAT |
7597 | akron1 | 248 | SYSTEM.GET(pchar, c); |
7110 | akron1 | 249 | IF c # 0X THEN |
250 | OutChar(c) |
||
251 | END; |
||
7597 | akron1 | 252 | INC(pchar) |
253 | UNTIL c = 0X |
||
254 | END |
||
255 | END OutStr; |
||
256 | |||
257 | |||
258 | PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER); |
||
259 | BEGIN |
||
260 | IF lpCaption # 0 THEN |
||
261 | OutLn; |
||
262 | OutStr(lpCaption); |
||
7110 | akron1 | 263 | OutChar(":"); |
7597 | akron1 | 264 | OutLn |
7110 | akron1 | 265 | END; |
7597 | akron1 | 266 | OutStr(lpText); |
7110 | akron1 | 267 | IF lpCaption # 0 THEN |
7597 | akron1 | 268 | OutLn |
7110 | akron1 | 269 | END |
7209 | akron1 | 270 | END DebugMsg; |
6613 | leency | 271 | |
7110 | akron1 | 272 | |
7597 | akron1 | 273 | PROCEDURE OutString (s: ARRAY OF CHAR); |
274 | VAR |
||
275 | i: INTEGER; |
||
6613 | leency | 276 | BEGIN |
7597 | akron1 | 277 | i := 0; |
278 | WHILE (i < LEN(s)) & (s[i] # 0X) DO |
||
279 | OutChar(s[i]); |
||
280 | INC(i) |
||
281 | END |
||
282 | END OutString; |
||
283 | |||
284 | |||
285 | PROCEDURE imp_error; |
||
286 | BEGIN |
||
287 | OutString("import error: "); |
||
288 | IF K.imp_error.error = 1 THEN |
||
8097 | maxcodehac | 289 | OutString("can't load '"); OutString(K.imp_error.lib) |
7597 | akron1 | 290 | ELSIF K.imp_error.error = 2 THEN |
8097 | maxcodehac | 291 | OutString("not found '"); OutString(K.imp_error.proc); OutString("' in '"); OutString(K.imp_error.lib) |
7597 | akron1 | 292 | END; |
8097 | maxcodehac | 293 | OutString("'"); |
7597 | akron1 | 294 | OutLn |
295 | END imp_error; |
||
296 | |||
297 | |||
8097 | maxcodehac | 298 | PROCEDURE init* (import_, code: INTEGER); |
7597 | akron1 | 299 | BEGIN |
300 | multi := FALSE; |
||
7696 | akron1 | 301 | base := code - SizeOfHeader; |
7597 | akron1 | 302 | K.sysfunc2(68, 11); |
303 | InitializeCriticalSection(CriticalSection); |
||
304 | K._init; |
||
8097 | maxcodehac | 305 | _import := (K.dll_Load(import_) = 0) & (K.imp_error.error = 0); |
306 | IF ~_import THEN |
||
7597 | akron1 | 307 | imp_error |
308 | END |
||
7209 | akron1 | 309 | END init; |
6613 | leency | 310 | |
7110 | akron1 | 311 | |
7597 | akron1 | 312 | PROCEDURE SetMultiThr* (value: BOOLEAN); |
313 | BEGIN |
||
314 | multi := value |
||
315 | END SetMultiThr; |
||
316 | |||
317 | |||
318 | PROCEDURE GetTickCount* (): INTEGER; |
||
319 | RETURN K.sysfunc2(26, 9) * 10 |
||
320 | END GetTickCount; |
||
321 | |||
322 | |||
7983 | leency | 323 | PROCEDURE dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER; |
324 | RETURN 0 |
||
325 | END dllentry; |
||
326 | |||
327 | |||
328 | PROCEDURE sofinit*; |
||
329 | END sofinit; |
||
330 | |||
331 | |||
332 | END API.>=>=>=> |