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