Rev 9646 | Only display areas with differences | Regard whitespace | Details | Blame | Last modification | View Log | RSS feed
Rev 9646 | Rev 9873 | ||
---|---|---|---|
1 | (* |
1 | (* |
2 | BSD 2-Clause License |
2 | BSD 2-Clause License |
3 | 3 | ||
4 | Copyright (c) 2018-2021, Anton Krotov |
4 | Copyright (c) 2018-2022, Anton Krotov |
5 | All rights reserved. |
5 | All rights reserved. |
6 | *) |
6 | *) |
7 | 7 | ||
8 | MODULE HOST; |
8 | MODULE HOST; |
9 | 9 | ||
10 | IMPORT SYSTEM, K := KOSAPI, API; |
10 | IMPORT SYSTEM, K := KOSAPI, API; |
11 | 11 | ||
12 | 12 | ||
13 | CONST |
13 | CONST |
14 | 14 | ||
15 | slash* = "/"; |
15 | slash* = "/"; |
16 | eol* = 0DX + 0AX; |
16 | eol* = 0DX + 0AX; |
17 | 17 | ||
18 | bit_depth* = API.BIT_DEPTH; |
18 | bit_depth* = API.BIT_DEPTH; |
19 | maxint* = ROR(-2, 1); |
19 | maxint* = ROR(-2, 1); |
20 | minint* = ROR(1, 1); |
20 | minint* = ROR(1, 1); |
21 | 21 | ||
22 | MAX_PARAM = 1024; |
22 | MAX_PARAM = 1024; |
23 | 23 | ||
24 | 24 | ||
25 | TYPE |
25 | TYPE |
26 | 26 | ||
27 | DAYS = ARRAY 12, 31, 2 OF INTEGER; |
27 | DAYS = ARRAY 12, 31, 2 OF INTEGER; |
28 | 28 | ||
29 | FNAME = ARRAY 520 OF CHAR; |
29 | FNAME = ARRAY 520 OF CHAR; |
30 | 30 | ||
31 | FS = POINTER TO rFS; |
31 | FS = POINTER TO rFS; |
32 | 32 | ||
33 | rFS = RECORD |
33 | rFS = RECORD |
34 | subfunc, pos, hpos, bytes, buffer: INTEGER; |
34 | subfunc, pos, hpos, bytes, buffer: INTEGER; |
35 | name: FNAME |
35 | name: FNAME |
36 | END; |
36 | END; |
37 | 37 | ||
38 | FD = POINTER TO rFD; |
38 | FD = POINTER TO rFD; |
39 | 39 | ||
40 | rFD = RECORD |
40 | rFD = RECORD |
41 | attr: INTEGER; |
41 | attr: INTEGER; |
42 | ntyp: CHAR; |
42 | ntyp: CHAR; |
43 | reserved: ARRAY 3 OF CHAR; |
43 | reserved: ARRAY 3 OF CHAR; |
44 | time_create, date_create, |
44 | time_create, date_create, |
45 | time_access, date_access, |
45 | time_access, date_access, |
46 | time_modif, date_modif, |
46 | time_modif, date_modif, |
47 | size, hsize: INTEGER; |
47 | size, hsize: INTEGER; |
48 | name: FNAME |
48 | name: FNAME |
49 | END; |
49 | END; |
50 | 50 | ||
51 | 51 | ||
52 | VAR |
52 | VAR |
53 | 53 | ||
54 | 54 | ||
55 | Console: BOOLEAN; |
55 | Console: BOOLEAN; |
56 | 56 | ||
57 | days: DAYS; |
57 | days: DAYS; |
58 | 58 | ||
59 | Params: ARRAY MAX_PARAM, 2 OF INTEGER; |
59 | Params: ARRAY MAX_PARAM, 2 OF INTEGER; |
60 | argc*: INTEGER; |
60 | argc*: INTEGER; |
61 | 61 | ||
62 | maxreal*: REAL; |
62 | maxreal*, inf*: REAL; |
63 | 63 | ||
64 | 64 | ||
65 | PROCEDURE [stdcall, "Console.obj", "con_init"] con_init (wnd_width, wnd_height, scr_width, scr_height, title: INTEGER); |
65 | PROCEDURE [stdcall, "Console.obj", "con_init"] con_init (wnd_width, wnd_height, scr_width, scr_height, title: INTEGER); |
66 | 66 | ||
67 | PROCEDURE [stdcall, "Console.obj", "con_exit"] con_exit (bCloseWindow: BOOLEAN); |
67 | PROCEDURE [stdcall, "Console.obj", "con_exit"] con_exit (bCloseWindow: BOOLEAN); |
68 | 68 | ||
69 | PROCEDURE [stdcall, "Console.obj", "con_write_string"] con_write_string (string, length: INTEGER); |
69 | PROCEDURE [stdcall, "Console.obj", "con_write_string"] con_write_string (string, length: INTEGER); |
70 | 70 | ||
71 | 71 | ||
72 | PROCEDURE ExitProcess* (p1: INTEGER); |
72 | PROCEDURE ExitProcess* (p1: INTEGER); |
73 | BEGIN |
73 | BEGIN |
74 | IF Console THEN |
74 | IF Console THEN |
75 | con_exit(FALSE) |
75 | con_exit(FALSE) |
76 | END; |
76 | END; |
77 | K.sysfunc1(-1) |
77 | K.sysfunc1(-1) |
78 | END ExitProcess; |
78 | END ExitProcess; |
79 | 79 | ||
80 | 80 | ||
81 | PROCEDURE OutChar* (c: CHAR); |
81 | PROCEDURE OutChar* (c: CHAR); |
82 | BEGIN |
82 | BEGIN |
83 | IF Console THEN |
83 | IF Console THEN |
84 | con_write_string(SYSTEM.ADR(c), 1) |
84 | con_write_string(SYSTEM.ADR(c), 1) |
85 | ELSE |
85 | ELSE |
86 | K.sysfunc3(63, 1, ORD(c)) |
86 | K.sysfunc3(63, 1, ORD(c)) |
87 | END |
87 | END |
88 | END OutChar; |
88 | END OutChar; |
89 | 89 | ||
90 | 90 | ||
91 | PROCEDURE GetFileInfo (FName: ARRAY OF CHAR; VAR Info: rFD): BOOLEAN; |
91 | PROCEDURE GetFileInfo (FName: ARRAY OF CHAR; VAR Info: rFD): BOOLEAN; |
92 | VAR |
92 | VAR |
93 | res2: INTEGER; |
93 | res2: INTEGER; |
94 | fs: rFS; |
94 | fs: rFS; |
95 | 95 | ||
96 | BEGIN |
96 | BEGIN |
97 | fs.subfunc := 5; |
97 | fs.subfunc := 5; |
98 | fs.pos := 0; |
98 | fs.pos := 0; |
99 | fs.hpos := 0; |
99 | fs.hpos := 0; |
100 | fs.bytes := 0; |
100 | fs.bytes := 0; |
101 | fs.buffer := SYSTEM.ADR(Info); |
101 | fs.buffer := SYSTEM.ADR(Info); |
102 | COPY(FName, fs.name) |
102 | COPY(FName, fs.name) |
103 | RETURN K.sysfunc22(70, SYSTEM.ADR(fs), res2) = 0 |
103 | RETURN K.sysfunc22(70, SYSTEM.ADR(fs), res2) = 0 |
104 | END GetFileInfo; |
104 | END GetFileInfo; |
105 | 105 | ||
106 | 106 | ||
107 | PROCEDURE Exists (FName: ARRAY OF CHAR): BOOLEAN; |
107 | PROCEDURE Exists (FName: ARRAY OF CHAR): BOOLEAN; |
108 | VAR |
108 | VAR |
109 | fd: rFD; |
109 | fd: rFD; |
110 | 110 | ||
111 | BEGIN |
111 | BEGIN |
112 | RETURN GetFileInfo(FName, fd) & ~(4 IN BITS(fd.attr)) |
112 | RETURN GetFileInfo(FName, fd) & ~(4 IN BITS(fd.attr)) |
113 | END Exists; |
113 | END Exists; |
114 | 114 | ||
115 | 115 | ||
116 | PROCEDURE Close (VAR F: FS); |
116 | PROCEDURE Close (VAR F: FS); |
117 | BEGIN |
117 | BEGIN |
118 | IF F # NIL THEN |
118 | IF F # NIL THEN |
119 | DISPOSE(F) |
119 | DISPOSE(F) |
120 | END |
120 | END |
121 | END Close; |
121 | END Close; |
122 | 122 | ||
123 | 123 | ||
124 | PROCEDURE Open (FName: ARRAY OF CHAR): FS; |
124 | PROCEDURE Open (FName: ARRAY OF CHAR): FS; |
125 | VAR |
125 | VAR |
126 | F: FS; |
126 | F: FS; |
127 | 127 | ||
128 | BEGIN |
128 | BEGIN |
129 | IF Exists(FName) THEN |
129 | IF Exists(FName) THEN |
130 | NEW(F); |
130 | NEW(F); |
131 | IF F # NIL THEN |
131 | IF F # NIL THEN |
132 | F.subfunc := 0; |
132 | F.subfunc := 0; |
133 | F.pos := 0; |
133 | F.pos := 0; |
134 | F.hpos := 0; |
134 | F.hpos := 0; |
135 | F.bytes := 0; |
135 | F.bytes := 0; |
136 | F.buffer := 0; |
136 | F.buffer := 0; |
137 | COPY(FName, F.name) |
137 | COPY(FName, F.name) |
138 | END |
138 | END |
139 | ELSE |
139 | ELSE |
140 | F := NIL |
140 | F := NIL |
141 | END |
141 | END |
142 | 142 | ||
143 | RETURN F |
143 | RETURN F |
144 | END Open; |
144 | END Open; |
145 | 145 | ||
146 | 146 | ||
147 | PROCEDURE Read (F: FS; Buffer, Count: INTEGER): INTEGER; |
147 | PROCEDURE Read (F: FS; Buffer, Count: INTEGER): INTEGER; |
148 | VAR |
148 | VAR |
149 | res, res2: INTEGER; |
149 | res, res2: INTEGER; |
150 | 150 | ||
151 | BEGIN |
151 | BEGIN |
152 | IF F # NIL THEN |
152 | IF F # NIL THEN |
153 | F.subfunc := 0; |
153 | F.subfunc := 0; |
154 | F.bytes := Count; |
154 | F.bytes := Count; |
155 | F.buffer := Buffer; |
155 | F.buffer := Buffer; |
156 | res := K.sysfunc22(70, SYSTEM.ADR(F^), res2); |
156 | res := K.sysfunc22(70, SYSTEM.ADR(F^), res2); |
157 | IF res2 > 0 THEN |
157 | IF res2 > 0 THEN |
158 | F.pos := F.pos + res2 |
158 | F.pos := F.pos + res2 |
159 | END |
159 | END |
160 | ELSE |
160 | ELSE |
161 | res2 := 0 |
161 | res2 := 0 |
162 | END |
162 | END |
163 | 163 | ||
164 | RETURN res2 |
164 | RETURN res2 |
165 | END Read; |
165 | END Read; |
166 | 166 | ||
167 | 167 | ||
168 | PROCEDURE Write (F: FS; Buffer, Count: INTEGER): INTEGER; |
168 | PROCEDURE Write (F: FS; Buffer, Count: INTEGER): INTEGER; |
169 | VAR |
169 | VAR |
170 | res, res2: INTEGER; |
170 | res, res2: INTEGER; |
171 | 171 | ||
172 | BEGIN |
172 | BEGIN |
173 | IF F # NIL THEN |
173 | IF F # NIL THEN |
174 | F.subfunc := 3; |
174 | F.subfunc := 3; |
175 | F.bytes := Count; |
175 | F.bytes := Count; |
176 | F.buffer := Buffer; |
176 | F.buffer := Buffer; |
177 | res := K.sysfunc22(70, SYSTEM.ADR(F^), res2); |
177 | res := K.sysfunc22(70, SYSTEM.ADR(F^), res2); |
178 | IF res2 > 0 THEN |
178 | IF res2 > 0 THEN |
179 | F.pos := F.pos + res2 |
179 | F.pos := F.pos + res2 |
180 | END |
180 | END |
181 | ELSE |
181 | ELSE |
182 | res2 := 0 |
182 | res2 := 0 |
183 | END |
183 | END |
184 | 184 | ||
185 | RETURN res2 |
185 | RETURN res2 |
186 | END Write; |
186 | END Write; |
187 | 187 | ||
188 | 188 | ||
189 | PROCEDURE Create (FName: ARRAY OF CHAR): FS; |
189 | PROCEDURE Create (FName: ARRAY OF CHAR): FS; |
190 | VAR |
190 | VAR |
191 | F: FS; |
191 | F: FS; |
192 | res2: INTEGER; |
192 | res2: INTEGER; |
193 | 193 | ||
194 | BEGIN |
194 | BEGIN |
195 | NEW(F); |
195 | NEW(F); |
196 | IF F # NIL THEN |
196 | IF F # NIL THEN |
197 | F.subfunc := 2; |
197 | F.subfunc := 2; |
198 | F.pos := 0; |
198 | F.pos := 0; |
199 | F.hpos := 0; |
199 | F.hpos := 0; |
200 | F.bytes := 0; |
200 | F.bytes := 0; |
201 | F.buffer := 0; |
201 | F.buffer := 0; |
202 | COPY(FName, F.name); |
202 | COPY(FName, F.name); |
203 | IF K.sysfunc22(70, SYSTEM.ADR(F^), res2) # 0 THEN |
203 | IF K.sysfunc22(70, SYSTEM.ADR(F^), res2) # 0 THEN |
204 | DISPOSE(F) |
204 | DISPOSE(F) |
205 | END |
205 | END |
206 | END |
206 | END |
207 | 207 | ||
208 | RETURN F |
208 | RETURN F |
209 | END Create; |
209 | END Create; |
210 | 210 | ||
211 | 211 | ||
212 | PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF CHAR; bytes: INTEGER): INTEGER; |
212 | PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF CHAR; bytes: INTEGER): INTEGER; |
213 | VAR |
213 | VAR |
214 | n: INTEGER; |
214 | n: INTEGER; |
215 | fs: FS; |
215 | fs: FS; |
216 | 216 | ||
217 | BEGIN |
217 | BEGIN |
218 | SYSTEM.GET(SYSTEM.ADR(F), fs); |
218 | SYSTEM.GET(SYSTEM.ADR(F), fs); |
219 | n := Read(fs, SYSTEM.ADR(Buffer[0]), bytes); |
219 | n := Read(fs, SYSTEM.ADR(Buffer[0]), bytes); |
220 | IF n = 0 THEN |
220 | IF n = 0 THEN |
221 | n := -1 |
221 | n := -1 |
222 | END |
222 | END |
223 | 223 | ||
224 | RETURN n |
224 | RETURN n |
225 | END FileRead; |
225 | END FileRead; |
226 | 226 | ||
227 | 227 | ||
228 | PROCEDURE FileWrite* (F: INTEGER; Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER; |
228 | PROCEDURE FileWrite* (F: INTEGER; Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER; |
229 | VAR |
229 | VAR |
230 | n: INTEGER; |
230 | n: INTEGER; |
231 | fs: FS; |
231 | fs: FS; |
232 | 232 | ||
233 | BEGIN |
233 | BEGIN |
234 | SYSTEM.GET(SYSTEM.ADR(F), fs); |
234 | SYSTEM.GET(SYSTEM.ADR(F), fs); |
235 | n := Write(fs, SYSTEM.ADR(Buffer[0]), bytes); |
235 | n := Write(fs, SYSTEM.ADR(Buffer[0]), bytes); |
236 | IF n = 0 THEN |
236 | IF n = 0 THEN |
237 | n := -1 |
237 | n := -1 |
238 | END |
238 | END |
239 | 239 | ||
240 | RETURN n |
240 | RETURN n |
241 | END FileWrite; |
241 | END FileWrite; |
242 | 242 | ||
243 | 243 | ||
244 | PROCEDURE FileCreate* (FName: ARRAY OF CHAR): INTEGER; |
244 | PROCEDURE FileCreate* (FName: ARRAY OF CHAR): INTEGER; |
245 | VAR |
245 | VAR |
246 | fs: FS; |
246 | fs: FS; |
247 | res: INTEGER; |
247 | res: INTEGER; |
248 | 248 | ||
249 | BEGIN |
249 | BEGIN |
250 | fs := Create(FName); |
250 | fs := Create(FName); |
251 | SYSTEM.GET(SYSTEM.ADR(fs), res) |
251 | SYSTEM.GET(SYSTEM.ADR(fs), res) |
252 | RETURN res |
252 | RETURN res |
253 | END FileCreate; |
253 | END FileCreate; |
254 | 254 | ||
255 | 255 | ||
256 | PROCEDURE FileClose* (F: INTEGER); |
256 | PROCEDURE FileClose* (F: INTEGER); |
257 | VAR |
257 | VAR |
258 | fs: FS; |
258 | fs: FS; |
259 | 259 | ||
260 | BEGIN |
260 | BEGIN |
261 | SYSTEM.GET(SYSTEM.ADR(F), fs); |
261 | SYSTEM.GET(SYSTEM.ADR(F), fs); |
262 | Close(fs) |
262 | Close(fs) |
263 | END FileClose; |
263 | END FileClose; |
264 | 264 | ||
265 | 265 | ||
266 | PROCEDURE FileOpen* (FName: ARRAY OF CHAR): INTEGER; |
266 | PROCEDURE FileOpen* (FName: ARRAY OF CHAR): INTEGER; |
267 | VAR |
267 | VAR |
268 | fs: FS; |
268 | fs: FS; |
269 | res: INTEGER; |
269 | res: INTEGER; |
270 | 270 | ||
271 | BEGIN |
271 | BEGIN |
272 | fs := Open(FName); |
272 | fs := Open(FName); |
273 | SYSTEM.GET(SYSTEM.ADR(fs), res) |
273 | SYSTEM.GET(SYSTEM.ADR(fs), res) |
274 | RETURN res |
274 | RETURN res |
275 | END FileOpen; |
275 | END FileOpen; |
276 | 276 | ||
277 | 277 | ||
278 | PROCEDURE chmod* (FName: ARRAY OF CHAR); |
278 | PROCEDURE chmod* (FName: ARRAY OF CHAR); |
279 | END chmod; |
279 | END chmod; |
280 | 280 | ||
281 | 281 | ||
282 | PROCEDURE GetTickCount* (): INTEGER; |
282 | PROCEDURE GetTickCount* (): INTEGER; |
283 | RETURN K.sysfunc2(26, 9) |
283 | RETURN K.sysfunc2(26, 9) |
284 | END GetTickCount; |
284 | END GetTickCount; |
285 | 285 | ||
286 | 286 | ||
287 | PROCEDURE AppAdr (): INTEGER; |
287 | PROCEDURE AppAdr (): INTEGER; |
288 | VAR |
288 | VAR |
289 | buf: ARRAY 1024 OF CHAR; |
289 | buf: ARRAY 1024 OF CHAR; |
290 | a: INTEGER; |
290 | a: INTEGER; |
291 | 291 | ||
292 | BEGIN |
292 | BEGIN |
293 | a := K.sysfunc3(9, SYSTEM.ADR(buf), -1); |
293 | a := K.sysfunc3(9, SYSTEM.ADR(buf), -1); |
294 | SYSTEM.GET(SYSTEM.ADR(buf) + 22, a) |
294 | SYSTEM.GET(SYSTEM.ADR(buf) + 22, a) |
295 | RETURN a |
295 | RETURN a |
296 | END AppAdr; |
296 | END AppAdr; |
297 | 297 | ||
298 | 298 | ||
299 | PROCEDURE GetCommandLine (): INTEGER; |
299 | PROCEDURE GetCommandLine (): INTEGER; |
300 | VAR |
300 | VAR |
301 | param: INTEGER; |
301 | param: INTEGER; |
302 | 302 | ||
303 | BEGIN |
303 | BEGIN |
304 | SYSTEM.GET(28 + AppAdr(), param) |
304 | SYSTEM.GET(28 + AppAdr(), param) |
305 | RETURN param |
305 | RETURN param |
306 | END GetCommandLine; |
306 | END GetCommandLine; |
307 | 307 | ||
308 | 308 | ||
309 | PROCEDURE GetName (): INTEGER; |
309 | PROCEDURE GetName (): INTEGER; |
310 | VAR |
310 | VAR |
311 | name: INTEGER; |
311 | name: INTEGER; |
312 | 312 | ||
313 | BEGIN |
313 | BEGIN |
314 | SYSTEM.GET(32 + AppAdr(), name) |
314 | SYSTEM.GET(32 + AppAdr(), name) |
315 | RETURN name |
315 | RETURN name |
316 | END GetName; |
316 | END GetName; |
317 | 317 | ||
318 | 318 | ||
319 | PROCEDURE GetChar (adr: INTEGER): CHAR; |
319 | PROCEDURE GetChar (adr: INTEGER): CHAR; |
320 | VAR |
320 | VAR |
321 | res: CHAR; |
321 | res: CHAR; |
322 | 322 | ||
323 | BEGIN |
323 | BEGIN |
324 | SYSTEM.GET(adr, res) |
324 | SYSTEM.GET(adr, res) |
325 | RETURN res |
325 | RETURN res |
326 | END GetChar; |
326 | END GetChar; |
327 | 327 | ||
328 | 328 | ||
329 | PROCEDURE ParamParse; |
329 | PROCEDURE ParamParse; |
330 | VAR |
330 | VAR |
331 | p, count, name, cond: INTEGER; |
331 | p, count, name, cond: INTEGER; |
332 | c: CHAR; |
332 | c: CHAR; |
333 | 333 | ||
334 | 334 | ||
335 | PROCEDURE ChangeCond (A, B, C: INTEGER; c: CHAR; VAR cond: INTEGER); |
335 | PROCEDURE ChangeCond (A, B, C: INTEGER; c: CHAR; VAR cond: INTEGER); |
336 | BEGIN |
336 | BEGIN |
337 | IF (c <= 20X) & (c # 0X) THEN |
337 | IF (c <= 20X) & (c # 0X) THEN |
338 | cond := A |
338 | cond := A |
339 | ELSIF c = 22X THEN |
339 | ELSIF c = 22X THEN |
340 | cond := B |
340 | cond := B |
341 | ELSIF c = 0X THEN |
341 | ELSIF c = 0X THEN |
342 | cond := 6 |
342 | cond := 6 |
343 | ELSE |
343 | ELSE |
344 | cond := C |
344 | cond := C |
345 | END |
345 | END |
346 | END ChangeCond; |
346 | END ChangeCond; |
347 | 347 | ||
348 | 348 | ||
349 | BEGIN |
349 | BEGIN |
350 | p := GetCommandLine(); |
350 | p := GetCommandLine(); |
351 | name := GetName(); |
351 | name := GetName(); |
352 | Params[0, 0] := name; |
352 | Params[0, 0] := name; |
353 | WHILE GetChar(name) # 0X DO |
353 | WHILE GetChar(name) # 0X DO |
354 | INC(name) |
354 | INC(name) |
355 | END; |
355 | END; |
356 | Params[0, 1] := name - 1; |
356 | Params[0, 1] := name - 1; |
357 | cond := 0; |
357 | cond := 0; |
358 | count := 1; |
358 | count := 1; |
359 | WHILE (argc < MAX_PARAM) & (cond # 6) DO |
359 | WHILE (argc < MAX_PARAM) & (cond # 6) DO |
360 | c := GetChar(p); |
360 | c := GetChar(p); |
361 | CASE cond OF |
361 | CASE cond OF |
362 | |0: ChangeCond(0, 4, 1, c, cond); IF cond = 1 THEN Params[count, 0] := p END |
362 | |0: ChangeCond(0, 4, 1, c, cond); IF cond = 1 THEN Params[count, 0] := p END |
363 | |1: ChangeCond(0, 3, 1, c, cond); IF cond IN {0, 6} THEN Params[count, 1] := p - 1; INC(count) END |
363 | |1: ChangeCond(0, 3, 1, c, cond); IF cond IN {0, 6} THEN Params[count, 1] := p - 1; INC(count) END |
364 | |3: ChangeCond(3, 1, 3, c, cond); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END |
364 | |3: ChangeCond(3, 1, 3, c, cond); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END |
365 | |4: ChangeCond(5, 0, 5, c, cond); IF cond = 5 THEN Params[count, 0] := p END |
365 | |4: ChangeCond(5, 0, 5, c, cond); IF cond = 5 THEN Params[count, 0] := p END |
366 | |5: ChangeCond(5, 1, 5, c, cond); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END |
366 | |5: ChangeCond(5, 1, 5, c, cond); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END |
367 | |6: |
367 | |6: |
368 | END; |
368 | END; |
369 | INC(p) |
369 | INC(p) |
370 | END; |
370 | END; |
371 | argc := count |
371 | argc := count |
372 | END ParamParse; |
372 | END ParamParse; |
373 | 373 | ||
374 | 374 | ||
375 | PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR); |
375 | PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR); |
376 | VAR |
376 | VAR |
377 | i, j, len: INTEGER; |
377 | i, j, len: INTEGER; |
378 | c: CHAR; |
378 | c: CHAR; |
379 | 379 | ||
380 | BEGIN |
380 | BEGIN |
381 | j := 0; |
381 | j := 0; |
382 | IF n < argc THEN |
382 | IF n < argc THEN |
383 | len := LEN(s) - 1; |
383 | len := LEN(s) - 1; |
384 | i := Params[n, 0]; |
384 | i := Params[n, 0]; |
385 | WHILE (j < len) & (i <= Params[n, 1]) DO |
385 | WHILE (j < len) & (i <= Params[n, 1]) DO |
386 | c := GetChar(i); |
386 | c := GetChar(i); |
387 | IF c # 22X THEN |
387 | IF c # 22X THEN |
388 | s[j] := c; |
388 | s[j] := c; |
389 | INC(j) |
389 | INC(j) |
390 | END; |
390 | END; |
391 | INC(i) |
391 | INC(i) |
392 | END |
392 | END |
393 | END; |
393 | END; |
394 | s[j] := 0X |
394 | s[j] := 0X |
395 | END GetArg; |
395 | END GetArg; |
396 | 396 | ||
397 | 397 | ||
398 | PROCEDURE GetCurrentDirectory* (VAR path: ARRAY OF CHAR); |
398 | PROCEDURE GetCurrentDirectory* (VAR path: ARRAY OF CHAR); |
399 | VAR |
399 | VAR |
400 | n: INTEGER; |
400 | n: INTEGER; |
401 | 401 | ||
402 | BEGIN |
402 | BEGIN |
403 | n := K.sysfunc4(30, 2, SYSTEM.ADR(path[0]), LEN(path) - 2); |
403 | n := K.sysfunc4(30, 2, SYSTEM.ADR(path[0]), LEN(path) - 2); |
404 | path[n - 1] := slash; |
404 | path[n - 1] := slash; |
405 | path[n] := 0X |
405 | path[n] := 0X |
406 | END GetCurrentDirectory; |
406 | END GetCurrentDirectory; |
407 | 407 | ||
408 | 408 | ||
409 | PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN; |
409 | PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN; |
410 | RETURN path[0] # slash |
410 | RETURN path[0] # slash |
411 | END isRelative; |
411 | END isRelative; |
412 | 412 | ||
413 | 413 | ||
414 | PROCEDURE UnixTime* (): INTEGER; |
414 | PROCEDURE UnixTime* (): INTEGER; |
415 | VAR |
415 | VAR |
416 | date, time, year, month, day, hour, min, sec: INTEGER; |
416 | date, time, year, month, day, hour, min, sec: INTEGER; |
417 | 417 | ||
418 | BEGIN |
418 | BEGIN |
419 | date := K.sysfunc1(29); |
419 | date := K.sysfunc1(29); |
420 | time := K.sysfunc1(3); |
420 | time := K.sysfunc1(3); |
421 | 421 | ||
422 | year := date MOD 16; |
422 | year := date MOD 16; |
423 | date := date DIV 16; |
423 | date := date DIV 16; |
424 | year := (date MOD 16) * 10 + year; |
424 | year := (date MOD 16) * 10 + year; |
425 | date := date DIV 16; |
425 | date := date DIV 16; |
426 | 426 | ||
427 | month := date MOD 16; |
427 | month := date MOD 16; |
428 | date := date DIV 16; |
428 | date := date DIV 16; |
429 | month := (date MOD 16) * 10 + month; |
429 | month := (date MOD 16) * 10 + month; |
430 | date := date DIV 16; |
430 | date := date DIV 16; |
431 | 431 | ||
432 | day := date MOD 16; |
432 | day := date MOD 16; |
433 | date := date DIV 16; |
433 | date := date DIV 16; |
434 | day := (date MOD 16) * 10 + day; |
434 | day := (date MOD 16) * 10 + day; |
435 | date := date DIV 16; |
435 | date := date DIV 16; |
436 | 436 | ||
437 | hour := time MOD 16; |
437 | hour := time MOD 16; |
438 | time := time DIV 16; |
438 | time := time DIV 16; |
439 | hour := (time MOD 16) * 10 + hour; |
439 | hour := (time MOD 16) * 10 + hour; |
440 | time := time DIV 16; |
440 | time := time DIV 16; |
441 | 441 | ||
442 | min := time MOD 16; |
442 | min := time MOD 16; |
443 | time := time DIV 16; |
443 | time := time DIV 16; |
444 | min := (time MOD 16) * 10 + min; |
444 | min := (time MOD 16) * 10 + min; |
445 | time := time DIV 16; |
445 | time := time DIV 16; |
446 | 446 | ||
447 | sec := time MOD 16; |
447 | sec := time MOD 16; |
448 | time := time DIV 16; |
448 | time := time DIV 16; |
449 | sec := (time MOD 16) * 10 + sec; |
449 | sec := (time MOD 16) * 10 + sec; |
450 | time := time DIV 16; |
450 | time := time DIV 16; |
451 | 451 | ||
452 | INC(year, 2000) |
452 | INC(year, 2000) |
453 | 453 | ||
454 | RETURN ((year - 1970) * 365 + days[month - 1, day - 1, ORD(year DIV 4 = 0)] + (year - 1969) DIV 4) * 86400 + hour * 3600 + min * 60 + sec |
454 | RETURN ((year - 1970) * 365 + days[month - 1, day - 1, ORD(year DIV 4 = 0)] + (year - 1969) DIV 4) * 86400 + hour * 3600 + min * 60 + sec |
455 | END UnixTime; |
455 | END UnixTime; |
456 | 456 | ||
457 | 457 | ||
458 | PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER; |
458 | PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER; |
459 | BEGIN |
459 | BEGIN |
460 | SYSTEM.GET32(SYSTEM.ADR(x), a); |
460 | SYSTEM.GET32(SYSTEM.ADR(x), a); |
461 | SYSTEM.GET32(SYSTEM.ADR(x) + 4, b) |
461 | SYSTEM.GET32(SYSTEM.ADR(x) + 4, b) |
462 | RETURN a |
462 | RETURN a |
463 | END splitf; |
463 | END splitf; |
464 | 464 | ||
465 | 465 | ||
466 | PROCEDURE d2s* (x: REAL): INTEGER; |
466 | PROCEDURE d2s* (x: REAL): INTEGER; |
467 | VAR |
467 | VAR |
468 | h, l, s, e: INTEGER; |
468 | h, l, s, e: INTEGER; |
469 | 469 | ||
470 | BEGIN |
470 | BEGIN |
471 | e := splitf(x, l, h); |
471 | e := splitf(x, l, h); |
472 | 472 | ||
473 | s := ASR(h, 31) MOD 2; |
473 | s := ASR(h, 31) MOD 2; |
474 | e := (h DIV 100000H) MOD 2048; |
474 | e := (h DIV 100000H) MOD 2048; |
475 | IF e <= 896 THEN |
475 | IF e <= 896 THEN |
476 | h := (h MOD 100000H) * 8 + (l DIV 20000000H) MOD 8 + 800000H; |
476 | h := (h MOD 100000H) * 8 + (l DIV 20000000H) MOD 8 + 800000H; |
477 | REPEAT |
477 | REPEAT |
478 | h := h DIV 2; |
478 | h := h DIV 2; |
479 | INC(e) |
479 | INC(e) |
480 | UNTIL e = 897; |
480 | UNTIL e = 897; |
481 | e := 896; |
481 | e := 896; |
482 | l := (h MOD 8) * 20000000H; |
482 | l := (h MOD 8) * 20000000H; |
483 | h := h DIV 8 |
483 | h := h DIV 8 |
484 | ELSIF (1151 <= e) & (e < 2047) THEN |
484 | ELSIF (1151 <= e) & (e < 2047) THEN |
485 | e := 1151; |
485 | e := 1151; |
486 | h := 0; |
486 | h := 0; |
487 | l := 0 |
487 | l := 0 |
488 | ELSIF e = 2047 THEN |
488 | ELSIF e = 2047 THEN |
489 | e := 1151; |
489 | e := 1151; |
490 | IF (h MOD 100000H # 0) OR (BITS(l) * {0..31} # {}) THEN |
490 | IF (h MOD 100000H # 0) OR (BITS(l) * {0..31} # {}) THEN |
491 | h := 80000H; |
491 | h := 80000H; |
492 | l := 0 |
492 | l := 0 |
493 | END |
493 | END |
494 | END; |
494 | END; |
495 | DEC(e, 896) |
495 | DEC(e, 896) |
496 | 496 | ||
497 | RETURN LSL(s, 31) + LSL(e, 23) + (h MOD 100000H) * 8 + (l DIV 20000000H) MOD 8 |
497 | RETURN LSL(s, 31) + LSL(e, 23) + (h MOD 100000H) * 8 + (l DIV 20000000H) MOD 8 |
498 | END d2s; |
498 | END d2s; |
499 | 499 | ||
500 | 500 | ||
501 | PROCEDURE init (VAR days: DAYS); |
501 | PROCEDURE init (VAR days: DAYS); |
502 | VAR |
502 | VAR |
503 | i, j, n0, n1: INTEGER; |
503 | i, j, n0, n1: INTEGER; |
504 | 504 | ||
505 | BEGIN |
505 | BEGIN |
506 | 506 | ||
507 | FOR i := 0 TO 11 DO |
507 | FOR i := 0 TO 11 DO |
508 | FOR j := 0 TO 30 DO |
508 | FOR j := 0 TO 30 DO |
509 | days[i, j, 0] := 0; |
509 | days[i, j, 0] := 0; |
510 | days[i, j, 1] := 0; |
510 | days[i, j, 1] := 0; |
511 | END |
511 | END |
512 | END; |
512 | END; |
513 | 513 | ||
514 | days[ 1, 28, 0] := -1; |
514 | days[ 1, 28, 0] := -1; |
515 | 515 | ||
516 | FOR i := 0 TO 1 DO |
516 | FOR i := 0 TO 1 DO |
517 | days[ 1, 29, i] := -1; |
517 | days[ 1, 29, i] := -1; |
518 | days[ 1, 30, i] := -1; |
518 | days[ 1, 30, i] := -1; |
519 | days[ 3, 30, i] := -1; |
519 | days[ 3, 30, i] := -1; |
520 | days[ 5, 30, i] := -1; |
520 | days[ 5, 30, i] := -1; |
521 | days[ 8, 30, i] := -1; |
521 | days[ 8, 30, i] := -1; |
522 | days[10, 30, i] := -1; |
522 | days[10, 30, i] := -1; |
523 | END; |
523 | END; |
524 | 524 | ||
525 | n0 := 0; |
525 | n0 := 0; |
526 | n1 := 0; |
526 | n1 := 0; |
527 | FOR i := 0 TO 11 DO |
527 | FOR i := 0 TO 11 DO |
528 | FOR j := 0 TO 30 DO |
528 | FOR j := 0 TO 30 DO |
529 | IF days[i, j, 0] = 0 THEN |
529 | IF days[i, j, 0] = 0 THEN |
530 | days[i, j, 0] := n0; |
530 | days[i, j, 0] := n0; |
531 | INC(n0) |
531 | INC(n0) |
532 | END; |
532 | END; |
533 | IF days[i, j, 1] = 0 THEN |
533 | IF days[i, j, 1] = 0 THEN |
534 | days[i, j, 1] := n1; |
534 | days[i, j, 1] := n1; |
535 | INC(n1) |
535 | INC(n1) |
536 | END |
536 | END |
537 | END |
537 | END |
538 | END; |
538 | END; |
- | 539 | ||
539 | 540 | inf := SYSTEM.INF(); |
|
540 | maxreal := 1.9; |
541 | maxreal := 1.9; |
541 | PACK(maxreal, 1023); |
542 | PACK(maxreal, 1023); |
542 | Console := TRUE; |
543 | Console := TRUE; |
543 | IF Console THEN |
544 | IF Console THEN |
544 | con_init(-1, -1, -1, -1, SYSTEM.SADR("Oberon-07 for KolibriOS")) |
545 | con_init(-1, -1, -1, -1, SYSTEM.SADR("Oberon-07 for KolibriOS")) |
545 | END; |
546 | END; |
546 | ParamParse |
547 | ParamParse |
547 | END init; |
548 | END init; |
548 | 549 | ||
549 | 550 | ||
550 | BEGIN |
551 | BEGIN |
551 | init(days) |
552 | init(days) |
552 | END HOST.>=>=>=>>>>=> |
553 | END HOST.>=>=>=>>>>=> |