WebSVN – Kolibri OS – Diff – /programs/develop/oberon07/Lib/KolibriOS/HOST.ob07


﻿(*
    BSD 2-Clause License
 
    Copyright (c) 2018-2020, Anton Krotov
    All rights reserved.
*)
 
MODULE HOST;
 
IMPORT SYSTEM, K := KOSAPI, API, RTL;
 
 
CONST
 
    slash* = "/";
    eol* = 0DX + 0AX;
 
    bit_depth* = RTL.bit_depth;
    maxint* = RTL.maxint;
    minint* = RTL.minint;
 
    MAX_PARAM = 1024;
 
 
TYPE
 
    DAYS = ARRAY 12, 31, 2 OF INTEGER;
 
    FNAME = ARRAY 520 OF CHAR;
 
    FS = POINTER TO rFS;
 
    rFS = RECORD
        subfunc, pos, hpos, bytes, buffer: INTEGER;
        name: FNAME
    END;
 
    FD = POINTER TO rFD;
 
    rFD = RECORD
        attr: INTEGER;
        ntyp: CHAR;
        reserved: ARRAY 3 OF CHAR;
        time_create, date_create,
        time_access, date_access,
        time_modif,  date_modif,
        size, hsize: INTEGER;
        name: FNAME
    END;
 
 
VAR
 
 
    Console: BOOLEAN;
 
    days: DAYS;
 
    Params: ARRAY MAX_PARAM, 2 OF INTEGER;
    argc*: INTEGER;
 
 
 
    maxreal*: REAL;
 
 
PROCEDURE [stdcall, "Console.obj", "con_init"] con_init (wnd_width, wnd_height, scr_width, scr_height, title: INTEGER);
 
PROCEDURE [stdcall, "Console.obj", "con_exit"] con_exit (bCloseWindow: BOOLEAN);
 
PROCEDURE [stdcall, "Console.obj", "con_write_string"] con_write_string (string, length: INTEGER);
 
 
PROCEDURE ExitProcess* (p1: INTEGER);
BEGIN
    IF Console THEN
        con_exit(FALSE)
    END;
    K.sysfunc1(-1)
END ExitProcess;
 
 
PROCEDURE OutChar* (c: CHAR);
BEGIN
    IF Console THEN
        con_write_string(SYSTEM.ADR(c), 1)
    ELSE
        K.sysfunc3(63, 1, ORD(c))
    END
END OutChar;
 
 
PROCEDURE GetFileInfo (FName: ARRAY OF CHAR; VAR Info: rFD): BOOLEAN;
VAR
    res2: INTEGER;
    fs:   rFS;
 
BEGIN
    fs.subfunc := 5;
    fs.pos := 0;
    fs.hpos := 0;
    fs.bytes := 0;
    fs.buffer := SYSTEM.ADR(Info);
    COPY(FName, fs.name)
    RETURN K.sysfunc22(70, SYSTEM.ADR(fs), res2) = 0
END GetFileInfo;
 
 
PROCEDURE Exists (FName: ARRAY OF CHAR): BOOLEAN;
VAR
    fd: rFD;
 
BEGIN
    RETURN GetFileInfo(FName, fd) & ~(4 IN BITS(fd.attr))
END Exists;
 
 
PROCEDURE Close (VAR F: FS);
BEGIN
    IF F # NIL THEN
        DISPOSE(F)
    END
END Close;
 
 
PROCEDURE Open (FName: ARRAY OF CHAR): FS;
VAR
    F: FS;
 
BEGIN
    IF Exists(FName) THEN
        NEW(F);
        IF F # NIL THEN
            F.subfunc := 0;
            F.pos := 0;
            F.hpos := 0;
            F.bytes := 0;
            F.buffer := 0;
            COPY(FName, F.name)
        END
    ELSE
        F := NIL
    END
 
    RETURN F
END Open;
 
 
PROCEDURE Read (F: FS; Buffer, Count: INTEGER): INTEGER;
VAR
    res, res2: INTEGER;
 
BEGIN
    IF F # NIL THEN
        F.subfunc := 0;
        F.bytes := Count;
        F.buffer := Buffer;
        res := K.sysfunc22(70, SYSTEM.ADR(F^), res2);
        IF res2 > 0 THEN
            F.pos := F.pos + res2
        END
    ELSE
        res2 := 0
    END
 
    RETURN res2
END Read;
 
 
PROCEDURE Write (F: FS; Buffer, Count: INTEGER): INTEGER;
VAR
    res, res2: INTEGER;
 
BEGIN
    IF F # NIL THEN
        F.subfunc := 3;
        F.bytes := Count;
        F.buffer := Buffer;
        res := K.sysfunc22(70, SYSTEM.ADR(F^), res2);
        IF res2 > 0 THEN
            F.pos := F.pos + res2
        END
    ELSE
        res2 := 0
    END
 
    RETURN res2
END Write;
 
 
PROCEDURE Create (FName: ARRAY OF CHAR): FS;
VAR
    F:    FS;
    res2: INTEGER;
 
BEGIN
    NEW(F);
    IF F # NIL THEN
        F.subfunc := 2;
        F.pos := 0;
        F.hpos := 0;
        F.bytes := 0;
        F.buffer := 0;
        COPY(FName, F.name);
        IF K.sysfunc22(70, SYSTEM.ADR(F^), res2) # 0 THEN
            DISPOSE(F)
        END
    END
 
    RETURN F
END Create;
 
 
PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF CHAR; bytes: INTEGER): INTEGER;
VAR
    n: INTEGER;
    fs: FS;
 
BEGIN
    SYSTEM.GET(SYSTEM.ADR(F), fs);
    n := Read(fs, SYSTEM.ADR(Buffer[0]), bytes);
    IF n = 0 THEN
        n := -1
    END
 
    RETURN n
END FileRead;
 
 
PROCEDURE FileWrite* (F: INTEGER; Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER;
VAR
    n: INTEGER;
    fs: FS;
 
BEGIN
    SYSTEM.GET(SYSTEM.ADR(F), fs);
    n := Write(fs, SYSTEM.ADR(Buffer[0]), bytes);
    IF n = 0 THEN
        n := -1
    END
 
    RETURN n
END FileWrite;
 
 
PROCEDURE FileCreate* (FName: ARRAY OF CHAR): INTEGER;
VAR
    fs: FS;
    res: INTEGER;
 
BEGIN
    fs := Create(FName);
    SYSTEM.GET(SYSTEM.ADR(fs), res)
    RETURN res
END FileCreate;
 
 
PROCEDURE FileClose* (F: INTEGER);
VAR
    fs: FS;
 
BEGIN
    SYSTEM.GET(SYSTEM.ADR(F), fs);
    Close(fs)
END FileClose;
 
 
PROCEDURE FileOpen* (FName: ARRAY OF CHAR): INTEGER;
VAR
    fs: FS;
    res: INTEGER;
 
BEGIN
    fs := Open(FName);
    SYSTEM.GET(SYSTEM.ADR(fs), res)
    RETURN res
END FileOpen;
 
 
PROCEDURE chmod* (FName: ARRAY OF CHAR);
END chmod;
 
 
PROCEDURE GetTickCount* (): INTEGER;
    RETURN K.sysfunc2(26, 9)
END GetTickCount;
 
 
PROCEDURE AppAdr (): INTEGER;
VAR
    buf: ARRAY 1024 OF CHAR;
    a: INTEGER;
 
BEGIN
    a := K.sysfunc3(9, SYSTEM.ADR(buf), -1);
    SYSTEM.GET(SYSTEM.ADR(buf) + 22, a)
    RETURN a
END AppAdr;
 
 
PROCEDURE GetCommandLine (): INTEGER;
VAR
    param: INTEGER;
 
BEGIN
    SYSTEM.GET(28 + AppAdr(), param)
    RETURN param
END GetCommandLine;
 
 
PROCEDURE GetName (): INTEGER;
VAR
    name: INTEGER;
 
BEGIN
    SYSTEM.GET(32 + AppAdr(), name)
    RETURN name
END GetName;
 
 
PROCEDURE GetChar (adr: INTEGER): CHAR;
VAR
    res: CHAR;
 
BEGIN
    SYSTEM.GET(adr, res)
    RETURN res
END GetChar;
 
 
PROCEDURE ParamParse;
VAR
    p, count, name, cond: INTEGER;
    c: CHAR;
 
 
    PROCEDURE ChangeCond (A, B, C: INTEGER; c: CHAR; VAR cond: INTEGER);
    BEGIN
        IF (c <= 20X) & (c # 0X) THEN
            cond := A
        ELSIF c = 22X THEN
            cond := B
        ELSIF c = 0X THEN
            cond := 6
        ELSE
            cond := C
        END
    END ChangeCond;
 
 
BEGIN
    p := GetCommandLine();
    name := GetName();
    Params[0, 0] := name;
    WHILE GetChar(name) # 0X DO
        INC(name)
    END;
    Params[0, 1] := name - 1;
    cond := 0;
    count := 1;
    WHILE (argc < MAX_PARAM) & (cond # 6) DO
        c := GetChar(p);
        CASE cond OF
        |0: ChangeCond(0, 4, 1, c, cond); IF cond = 1 THEN Params[count, 0] := p END
        |1: ChangeCond(0, 3, 1, c, cond); IF cond IN {0, 6} THEN Params[count, 1] := p - 1; INC(count) END
        |3: ChangeCond(3, 1, 3, c, cond); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END
        |4: ChangeCond(5, 0, 5, c, cond); IF cond = 5 THEN Params[count, 0] := p END
        |5: ChangeCond(5, 1, 5, c, cond); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END
        |6:
        END;
        INC(p)
    END;
    argc := count
END ParamParse;
 
 
PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR);
VAR
    i, j, len: INTEGER;
    c: CHAR;
 
BEGIN
    j := 0;
    IF n < argc THEN
        len := LEN(s) - 1;
        i := Params[n, 0];
        WHILE (j < len) & (i <= Params[n, 1]) DO
            c := GetChar(i);
            IF c # 22X THEN
                s[j] := c;
                INC(j)
            END;
            INC(i)
        END
    END;
    s[j] := 0X
END GetArg;
 
 
PROCEDURE GetCurrentDirectory* (VAR path: ARRAY OF CHAR);
VAR
    n: INTEGER;
 
BEGIN
    GetArg(0, path);
    n := LENGTH(path) - 1;
    WHILE path[n] # slash DO
        DEC(n)
    END;
    path[n + 1] := 0X
END GetCurrentDirectory;
 
 
PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN;
    RETURN path[0] # slash
END isRelative;
 
 
PROCEDURE UnixTime* (): INTEGER;
VAR
    date, time, year, month, day, hour, min, sec: INTEGER;
 
BEGIN
    date  := K.sysfunc1(29);
    time  := K.sysfunc1(3);
 
    year  := date MOD 16;
    date  := date DIV 16;
    year  := (date MOD 16) * 10 + year;
    date  := date DIV 16;
 
    month := date MOD 16;
    date  := date DIV 16;
    month := (date MOD 16) * 10 + month;
    date  := date DIV 16;
 
    day   := date MOD 16;
    date  := date DIV 16;
    day   := (date MOD 16) * 10 + day;
    date  := date DIV 16;
 
    hour  := time MOD 16;
    time  := time DIV 16;
    hour  := (time MOD 16) * 10 + hour;
    time  := time DIV 16;
 
    min   := time MOD 16;
    time  := time DIV 16;
    min   := (time MOD 16) * 10 + min;
    time  := time DIV 16;
 
    sec   := time MOD 16;
    time  := time DIV 16;
    sec   := (time MOD 16) * 10 + sec;
    time  := time DIV 16;
 
 
 
    INC(year, 2000)
 
 
    RETURN ((year - 1970) * 365 + days[month - 1, day - 1, ORD(year DIV 4 = 0)] + (year - 1969) DIV 4) * 86400 + hour * 3600 + min * 60 + sec
END UnixTime;
 
 
PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER;
BEGIN
    SYSTEM.GET32(SYSTEM.ADR(x), a);
    SYSTEM.GET32(SYSTEM.ADR(x) + 4, b)
    RETURN a
END splitf;
 
 
PROCEDURE d2s* (x: REAL): INTEGER;
VAR
    h, l, s, e: INTEGER;
 
BEGIN
 
    e := splitf(x, l, h);
 
    s := ASR(h, 31) MOD 2;
    e := (h DIV 100000H) MOD 2048;
    IF e <= 896 THEN
        h := (h MOD 100000H) * 8 + (l DIV 20000000H) MOD 8 + 800000H;
        REPEAT
            h := h DIV 2;
            INC(e)
        UNTIL e = 897;
        e := 896;
        l := (h MOD 8) * 20000000H;
        h := h DIV 8
    ELSIF (1151 <= e) & (e < 2047) THEN
        e := 1151;
        h := 0;
        l := 0
    ELSIF e = 2047 THEN
        e := 1151;
        IF (h MOD 100000H # 0) OR (BITS(l) * {0..31} # {}) THEN
            h := 80000H;
            l := 0
        END
    END;
    DEC(e, 896)
 
    RETURN LSL(s, 31) + LSL(e, 23) + (h MOD 100000H) * 8 + (l DIV 20000000H) MOD 8
END d2s;
 
 
PROCEDURE init (VAR days: DAYS);
VAR
    i, j, n0, n1: INTEGER;
 
 
 
 
 
BEGIN
 
    FOR i := 0 TO 11 DO
        FOR j := 0 TO 30 DO
            days[i, j, 0] := 0;
            days[i, j, 1] := 0;
        END
    END;
 
    days[ 1, 28, 0] := -1;
 
    FOR i := 0 TO 1 DO
        days[ 1, 29, i] := -1;
        days[ 1, 30, i] := -1;
        days[ 3, 30, i] := -1;
        days[ 5, 30, i] := -1;
        days[ 8, 30, i] := -1;
        days[10, 30, i] := -1;
    END;
 
    n0 := 0;
    n1 := 0;
    FOR i := 0 TO 11 DO
        FOR j := 0 TO 30 DO
            IF days[i, j, 0] = 0 THEN
                days[i, j, 0] := n0;
                INC(n0)
            END;
            IF days[i, j, 1] = 0 THEN
                days[i, j, 1] := n1;
                INC(n1)
            END
 
 
        END
    END;
 
    maxreal := 1.9;
    PACK(maxreal, 1023);
    Console := API._import;
    IF Console THEN
        con_init(-1, -1, -1, -1, SYSTEM.SADR("Oberon-07 for KolibriOS"))
    END;
    ParamParse
END init;
 
 
BEGIN
    init(days)
END HOST.


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;

Subversion Repositories Kolibri OS

(root)/programs/develop/oberon07/Lib/KolibriOS/HOST.ob07 – Rev 7983 → 8097