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