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