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

 (*
-    Copyright 2016, 2017 Anton Krotov
+    BSD 2-Clause License
-    This program is free software: you can redistribute it and/or modify
-    it under the terms of the GNU Lesser General Public License as published by
-    the Free Software Foundation, either version 3 of the License, or
+    Copyright (c) 2018, 2019, Anton Krotov
-    (at your option) any later version.
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU Lesser General Public License for more details.
-    You should have received a copy of the GNU Lesser General Public License
-    along with this program.  If not, see .
+    All rights reserved.
 *)
+MODULE HOST;
 MODULE HOST;
+IMPORT SYSTEM, K := KOSAPI, API, RTL;
+CONST
+    slash* = "/";
+    OS* = "KOS";
-IMPORT sys := SYSTEM, API;
+    bit_depth* = RTL.bit_depth;
     maxint* = RTL.maxint;
-CONST
+    minint* = RTL.minint;
+    MAX_PARAM = 1024;
-  OS* = "KOS";
-  Slash* = "/";
+TYPE
+    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;
-TYPE
+        reserved: ARRAY 3 OF CHAR;
-  FILENAME = ARRAY 2048 OF CHAR;
-  OFSTRUCT = RECORD
+        time_create, date_create,
+        time_access, date_access,
+        time_modif,  date_modif,
+        size, hsize: INTEGER;
+        name: FNAME
+    END;
+VAR
-    subfunc, pos, hpos, bytes, buf: INTEGER;
+    Console: BOOLEAN;
+    Params: ARRAY MAX_PARAM, 2 OF INTEGER;
+    argc*: INTEGER;
     name: FILENAME
+    eol*: ARRAY 3 OF CHAR;
-  END;
+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
-VAR
+    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;
-  con_init		 : PROCEDURE [stdcall] (wnd_width, wnd_height, scr_width, scr_height, title: INTEGER);
-  con_exit		 : PROCEDURE [stdcall] (bCloseWindow: BOOLEAN);
-  con_write_asciiz	 : PROCEDURE [stdcall] (string: INTEGER);
+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;
-  fsize, sec*, dsec*: INTEGER;
+    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
-PROCEDURE [stdcall] sysfunc22(arg1, arg2: INTEGER; VAR res2: INTEGER): INTEGER;
+    fd: rFD;
-BEGIN
-  sys.CODE("53");               (* push    ebx              *)
-  sys.CODE("8B4508");           (* mov     eax, [ebp + 08h] *)
+BEGIN
-  sys.CODE("8B5D0C");           (* mov     ebx, [ebp + 0Ch] *)
+    RETURN GetFileInfo(FName, fd) & ~(4 IN BITS(fd.attr))
+END Exists;
   sys.CODE("CD40");             (* int     40h              *)
-  sys.CODE("8B4D10");           (* mov     ecx, [ebp + 10h] *)
+PROCEDURE Close (VAR F: FS);
-  sys.CODE("8919");             (* mov     [ecx], ebx       *)
+BEGIN
-  sys.CODE("5B");               (* pop     ebx              *)
+    IF F # NIL THEN
-  sys.CODE("C9");               (* leave                    *)
+        DISPOSE(F)
+    END
+END Close;
-  sys.CODE("C20C00");           (* ret     0Ch              *)
+PROCEDURE Open (FName: ARRAY OF CHAR): FS;
+VAR
-  RETURN 0
+    F: FS;
+BEGIN
-END sysfunc22;
+    IF Exists(FName) THEN
+        NEW(F);
+        IF F # NIL THEN
+            F.subfunc := 0;
+            F.pos := 0;
+            F.hpos := 0;
+            F.bytes := 0;
-PROCEDURE GetProcAdr(name: ARRAY OF CHAR; lib: INTEGER): INTEGER;
+            F.buffer := 0;
-VAR cur, procname, adr: INTEGER;
+            COPY(FName, F.name)
-  PROCEDURE streq(str1, str2: INTEGER): BOOLEAN;
+        END
-  VAR c1, c2: CHAR;
-  BEGIN
+    ELSE
-    REPEAT
+        F := NIL
-      sys.GET(str1, c1);
+    END
-      sys.GET(str2, c2);
-      INC(str1);
+    RETURN F
-      INC(str2)
+END Open;
-    UNTIL (c1 # c2) OR (c1 = 0X)
+PROCEDURE Read (F: FS; Buffer, Count: INTEGER): INTEGER;
-    RETURN c1 = c2
-  END streq;
+VAR
+    res, res2: INTEGER;
+BEGIN
+    IF F # NIL THEN
+        F.subfunc := 0;
-BEGIN
+        F.bytes := Count;
+        F.buffer := Buffer;
-  adr := 0;
+        res := K.sysfunc22(70, SYSTEM.ADR(F^), res2);
+        IF res2 > 0 THEN
-  IF (lib # 0) & (name # "") THEN
+            F.pos := F.pos + res2
+        END
+    ELSE
+        res2 := 0
+    END
-    cur := lib;
+    RETURN res2
+END Read;
-    REPEAT
+PROCEDURE Write (F: FS; Buffer, Count: INTEGER): INTEGER;
+VAR
-      sys.GET(cur, procname);
+    res, res2: INTEGER;
-      INC(cur, 8)
-    UNTIL (procname = 0) OR streq(procname, sys.ADR(name[0]));
-    IF procname # 0 THEN
+BEGIN
+    IF F # NIL THEN
-      sys.GET(cur - 4, adr)
+        F.subfunc := 3;
+        F.bytes := Count;
-    END
+        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
-  END
+    RETURN res2
+END Write;
+PROCEDURE Create (FName: ARRAY OF CHAR): FS;
-  RETURN adr
+VAR
-END GetProcAdr;
+    F:    FS;
+    res2: INTEGER;
+BEGIN
+    NEW(F);
+    IF F # NIL THEN
+        F.subfunc := 2;
         F.pos := 0;
-PROCEDURE Time*(VAR sec, dsec: INTEGER);
+        F.hpos := 0;
-VAR t: INTEGER;
+        F.bytes := 0;
-BEGIN
+        F.buffer := 0;
-  t := API.sysfunc2(26, 9);
-  sec := t DIV 100;
-  dsec := t MOD 100
-END Time;
+        COPY(FName, F.name);
-PROCEDURE init*;
+        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 BYTE; bytes: INTEGER): INTEGER;
+VAR
+    n: INTEGER;
+    fs: FS;
+BEGIN
+    SYSTEM.GET(SYSTEM.ADR(F), fs);
-VAR Lib: INTEGER;
+    n := Read(fs, SYSTEM.ADR(Buffer[0]), bytes);
+    IF n = 0 THEN
+        n := -1
+    END
-  PROCEDURE GetProc(v: INTEGER; name: ARRAY OF CHAR);
+    RETURN n
+END FileRead;
+PROCEDURE FileWrite* (F: INTEGER; Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER;
-  VAR a: INTEGER;
+VAR
-  BEGIN
+    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;
-    a := GetProcAdr(name, Lib);
+PROCEDURE FileCreate* (FName: ARRAY OF CHAR): INTEGER;
+VAR
+    fs: FS;
+    res: INTEGER;
+BEGIN
+    fs := Create(FName);
-    sys.PUT(v, a)
+    SYSTEM.GET(SYSTEM.ADR(fs), res)
+    RETURN res
+END FileCreate;
-  END GetProc;
+PROCEDURE FileClose* (F: INTEGER);
+VAR
+    fs: FS;
+BEGIN
+    SYSTEM.GET(SYSTEM.ADR(F), fs);
-BEGIN
+    Close(fs)
-  Time(sec, dsec);
+END FileClose;
   Lib := API.sysfunc3(68, 19, sys.ADR("/rd/1/lib/console.obj"));
   IF Lib # 0 THEN
+PROCEDURE FileOpen* (FName: ARRAY OF CHAR): INTEGER;
-    GetProc(sys.ADR(con_init),	       "con_init");
+VAR
-    GetProc(sys.ADR(con_exit),	       "con_exit");
+    fs: FS;
-    GetProc(sys.ADR(con_write_asciiz), "con_write_asciiz");
+    res: INTEGER;
     IF con_init # NIL THEN
-      con_init(-1, -1, -1, -1, sys.ADR("Oberon-07/11 for KolibriOS"))
+BEGIN
+    fs := Open(FName);
-    END
+    SYSTEM.GET(SYSTEM.ADR(fs), res)
+    RETURN res
-  END
+END FileOpen;
 END init;
+PROCEDURE GetTickCount* (): INTEGER;
-PROCEDURE ExitProcess* (n: INTEGER);
+    RETURN K.sysfunc2(26, 9)
-BEGIN
+END GetTickCount;
-  IF con_exit # NIL THEN
+PROCEDURE AppAdr (): INTEGER;
-    con_exit(FALSE)
+VAR
+    buf: ARRAY 1024 OF CHAR;
-  END;
+    a: INTEGER;
-  API.ExitProcess(0)
-END ExitProcess;
+BEGIN
     a := K.sysfunc3(9, SYSTEM.ADR(buf), -1);
-PROCEDURE AppAdr(): INTEGER;
-VAR
-    buf: ARRAY 1024 OF CHAR;
-    a: INTEGER;
-BEGIN
-    a := API.sysfunc3(9, sys.ADR(buf), -1);
-    sys.GET(sys.ADR(buf) + 22, a)
-    RETURN a
-END AppAdr;
-PROCEDURE GetCommandLine*(): INTEGER;
-VAR param: INTEGER;
-BEGIN
-  sys.GET(28 + AppAdr(), param)
-  RETURN param
-END GetCommandLine;
-PROCEDURE GetName*(): INTEGER;
-VAR name: INTEGER;
-BEGIN
-  sys.GET(32 + AppAdr(), name)
-  RETURN name
-END GetName;
-PROCEDURE malloc*(size: INTEGER): INTEGER;
-  RETURN API.sysfunc3(68, 12, size)
-END malloc;
-PROCEDURE CloseFile*(hObject: INTEGER);
+    SYSTEM.GET(SYSTEM.ADR(buf) + 22, a)
+    RETURN a
-VAR pFS: POINTER TO OFSTRUCT;
+END AppAdr;
 BEGIN
-  sys.PUT(sys.ADR(pFS), hObject);
-  DISPOSE(pFS)
-END CloseFile;
-PROCEDURE _OCFile(FileName: ARRAY OF CHAR; VAR FS: OFSTRUCT; mode: INTEGER; VAR fsize: INTEGER): INTEGER;
-VAR buf: ARRAY 40 OF CHAR; res: INTEGER;
-BEGIN
-  FS.subfunc := mode;
+PROCEDURE GetCommandLine (): INTEGER;
-  FS.pos := 0;
+VAR
-  FS.hpos := 0;
+    param: INTEGER;
+BEGIN
+    SYSTEM.GET(28 + AppAdr(), param)
+    RETURN param
+END GetCommandLine;
-  FS.bytes := 0;
+PROCEDURE GetName (): INTEGER;
-  FS.buf := sys.ADR(buf);
-  COPY(FileName, FS.name);
+VAR
-  IF sysfunc22(70, sys.ADR(FS), res) = 0 THEN
+    name: INTEGER;
-    res := sys.ADR(FS);
-    sys.GET(sys.ADR(buf) + 32, fsize)
+BEGIN
-  ELSE
+    SYSTEM.GET(32 + AppAdr(), name)
-    res := 0
-  END
+    RETURN name
-  RETURN res
+END GetName;
-END _OCFile;
-PROCEDURE IOFile(VAR FS: OFSTRUCT; Buffer, bytes, io: INTEGER): INTEGER;
-VAR res1, res: INTEGER;
+PROCEDURE GetChar (adr: INTEGER): CHAR;
-BEGIN
-  FS.subfunc := io;
+VAR
-  FS.bytes := bytes;
-  FS.buf := Buffer;
-  res1 := sysfunc22(70, sys.ADR(FS), res);
-  IF res = -1 THEN
-    res := 0
-  END;
-  FS.pos := FS.pos + res
-  RETURN res
-END IOFile;
-PROCEDURE OCFile(FName: ARRAY OF CHAR; mode: INTEGER): INTEGER;
-VAR FS: OFSTRUCT; pFS: POINTER TO OFSTRUCT; res: INTEGER;
-BEGIN
-  IF _OCFile(FName, FS, mode, fsize) # 0 THEN
-    NEW(pFS);
-    IF pFS = NIL THEN
-      res := 0
-    ELSE
-      sys.GET(sys.ADR(pFS), res);
-      pFS^ := FS
-    END
-  ELSE
-    res := 0
-  END
-  RETURN res
-END OCFile;
+    res: CHAR;
+BEGIN
+    SYSTEM.GET(adr, res)
-PROCEDURE CreateFile* (FName: ARRAY OF CHAR): INTEGER;
+    RETURN res
+END GetChar;
+PROCEDURE ParamParse;
+VAR
-  RETURN OCFile(FName, 2)
+    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
-END CreateFile;
+            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
-PROCEDURE OpenFile* (FName: ARRAY OF CHAR): INTEGER;
+        |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
-  RETURN OCFile(FName, 5)
+        |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 now* (VAR year, month, day, hour, min, sec: INTEGER);
+VAR
+    date, time: 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;
-END OpenFile;
+    sec   := time MOD 16;
     time  := time DIV 16;

Subversion Repositories Kolibri OS

(root)/programs/develop/oberon07/Lib/KolibriOS/HOST.ob07 – Rev 7209 → 7597