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