Subversion Repositories Kolibri OS

Rev

Rev 6613 | Go to most recent revision | Blame | Last modification | View Log | Download | RSS feed

  1. (*
  2.     Copyright 2016, 2017 Anton Krotov
  3.  
  4.     This file is part of Compiler.
  5.  
  6.     Compiler is free software: you can redistribute it and/or modify
  7.     it under the terms of the GNU General Public License as published by
  8.     the Free Software Foundation, either version 3 of the License, or
  9.     (at your option) any later version.
  10.  
  11.     Compiler is distributed in the hope that it will be useful,
  12.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  13.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14.     GNU General Public License for more details.
  15.  
  16.     You should have received a copy of the GNU General Public License
  17.     along with Compiler. If not, see <http://www.gnu.org/licenses/>.
  18. *)
  19.  
  20. MODULE UTILS;
  21.  
  22. IMPORT sys := SYSTEM, H := HOST, ERRORS;
  23.  
  24. CONST
  25.  
  26.   OS* = H.OS;
  27.   Slash* = H.Slash;
  28.   Ext* = ".ob07";
  29.   MAX_PATH = 1024;
  30.   MAX_PARAM = 1024;
  31.   Date* = 1509580800;  (* 2017-11-02 *)
  32.  
  33. TYPE
  34.  
  35.   STRING* = ARRAY MAX_PATH OF CHAR;
  36.  
  37.   ITEM* = POINTER TO rITEM;
  38.  
  39.   rITEM* = RECORD
  40.     Next*, Prev*: ITEM
  41.   END;
  42.  
  43.   LIST* = POINTER TO RECORD
  44.     First*, Last*: ITEM;
  45.     Count*: INTEGER
  46.   END;
  47.  
  48.   STRCONST* = POINTER TO RECORD (rITEM)
  49.     Str*: STRING;
  50.     Len*, Number*: INTEGER
  51.   END;
  52.  
  53. VAR
  54.  
  55.   Params: ARRAY MAX_PARAM, 2 OF INTEGER;
  56.   ParamCount*, Line*, Unit*: INTEGER;
  57.   FileName: STRING;
  58.  
  59. PROCEDURE SetFile*(F: STRING);
  60. BEGIN
  61.   FileName := F
  62. END SetFile;
  63.  
  64. PROCEDURE IsInf*(x: LONGREAL): BOOLEAN;
  65.   RETURN ABS(x) = sys.INF(LONGREAL)
  66. END IsInf;
  67.  
  68. PROCEDURE GetChar(adr: INTEGER): CHAR;
  69. VAR res: CHAR;
  70. BEGIN
  71.   sys.GET(adr, res)
  72.   RETURN res
  73. END GetChar;
  74.  
  75. PROCEDURE ParamParse(count: INTEGER);
  76. VAR c: CHAR; cond, p: INTEGER;
  77.  
  78.   PROCEDURE ChangeCond(A, B, C: INTEGER);
  79.   BEGIN
  80.     cond := C;
  81.     CASE c OF
  82.     |0X: cond := 6
  83.     |1X..20X: cond := A
  84.     |22X: cond := B
  85.     ELSE
  86.     END
  87.   END ChangeCond;
  88.  
  89. BEGIN
  90.   p := H.GetCommandLine();
  91.   cond := 0;
  92.   WHILE (count < MAX_PARAM) & (cond # 6) DO
  93.     c := GetChar(p);
  94.     CASE cond OF
  95.     |0: ChangeCond(0, 4, 1); IF cond = 1 THEN Params[count, 0] := p END
  96.     |4: ChangeCond(5, 0, 5); IF cond = 5 THEN Params[count, 0] := p END
  97.     |1: ChangeCond(0, 3, 1); IF cond IN {0, 6} THEN Params[count, 1] := p - 1; INC(count) END
  98.     |3, 5: ChangeCond(cond, 1, cond); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END
  99.     ELSE
  100.     END;
  101.     INC(p)
  102.   END;
  103.   ParamCount := count - 1
  104. END ParamParse;
  105.  
  106. PROCEDURE ParamStr*(VAR str: ARRAY OF CHAR; n: INTEGER);
  107. VAR i, j, len: INTEGER; c: CHAR;
  108. BEGIN
  109.   j := 0;
  110.   IF n <= ParamCount THEN
  111.     len := LEN(str) - 1;
  112.     i := Params[n, 0];
  113.     WHILE (j < len) & (i <= Params[n, 1]) DO
  114.       c := GetChar(i);
  115.       IF c # 22X THEN
  116.         str[j] := c;
  117.         INC(j)
  118.       END;
  119.       INC(i)
  120.     END
  121.   END;
  122.   str[j] := 0X
  123. END ParamStr;
  124.  
  125. PROCEDURE GetMem*(n: INTEGER): INTEGER;
  126.   RETURN H.malloc(n)
  127. END GetMem;
  128.  
  129. PROCEDURE CloseF*(F: INTEGER);
  130. BEGIN
  131.   H.CloseFile(F)
  132. END CloseF;
  133.  
  134. PROCEDURE Read*(F, Buffer, Count: INTEGER): INTEGER;
  135.   RETURN H.FileRW(F, Buffer, Count, FALSE)
  136. END Read;
  137.  
  138. PROCEDURE Write*(F, Buffer, Count: INTEGER): INTEGER;
  139.   RETURN H.FileRW(F, Buffer, Count, TRUE)
  140. END Write;
  141.  
  142. PROCEDURE FileSize*(F: INTEGER): INTEGER;
  143.   RETURN H.FileSize(F)
  144. END FileSize;
  145.  
  146. PROCEDURE CharC*(x: CHAR);
  147. VAR str: ARRAY 2 OF CHAR;
  148. BEGIN
  149.   str[0] := x;
  150.   str[1] := 0X;
  151.   H.OutString(str)
  152. END CharC;
  153.  
  154. PROCEDURE Int*(x: INTEGER);
  155. VAR i: INTEGER; buf: ARRAY 11 OF INTEGER;
  156. BEGIN
  157.   i := 0;
  158.   REPEAT
  159.     buf[i] := x MOD 10;
  160.     x := x DIV 10;
  161.     INC(i)
  162.   UNTIL x = 0;
  163.   REPEAT
  164.     DEC(i);
  165.     CharC(CHR(buf[i] + ORD("0")))
  166.   UNTIL i = 0
  167. END Int;
  168.  
  169. PROCEDURE Ln*;
  170. BEGIN
  171.   CharC(0DX);
  172.   CharC(0AX)
  173. END Ln;
  174.  
  175. PROCEDURE OutString*(str: ARRAY OF CHAR);
  176. BEGIN
  177.   H.OutString(str)
  178. END OutString;
  179.  
  180. PROCEDURE ErrMsg*(code: INTEGER);
  181. VAR str: ARRAY 1024 OF CHAR;
  182. BEGIN
  183.   ERRORS.ErrorMsg(code, str);
  184.   OutString("error: ("); Int(code); OutString(") "); OutString(str); Ln
  185. END ErrMsg;
  186.  
  187. PROCEDURE ErrMsgPos*(line, col, code: INTEGER);
  188. VAR s: STRING;
  189. BEGIN
  190.   ErrMsg(code);
  191.   OutString("file:  "); OutString(FileName); Ln;
  192.   OutString("line:  "); Int(line); Ln;
  193.   OutString("pos:   "); Int(col); Ln;
  194. END ErrMsgPos;
  195.  
  196. PROCEDURE UnitLine*(newUnit, newLine: INTEGER);
  197. BEGIN
  198.   Unit := newUnit;
  199.   Line := newLine
  200. END UnitLine;
  201.  
  202. PROCEDURE Align*(n: INTEGER): INTEGER;
  203.   RETURN (4 - n MOD 4) MOD 4
  204. END Align;
  205.  
  206. PROCEDURE CAP(x: CHAR): CHAR;
  207. BEGIN
  208.   IF (x >= "a") & (x <= "z") THEN
  209.     x := CHR(ORD(x) - 32)
  210.   END
  211.   RETURN x
  212. END CAP;
  213.  
  214. PROCEDURE streq*(a, b: ARRAY OF CHAR): BOOLEAN;
  215. VAR i: INTEGER;
  216. BEGIN
  217.   i := -1;
  218.   REPEAT
  219.     INC(i)
  220.   UNTIL (CAP(a[i]) # CAP(b[i])) OR (a[i] = 0X) OR (b[i] = 0X)
  221.   RETURN a[i] = b[i]
  222. END streq;
  223.  
  224. PROCEDURE concat*(VAR L: STRING; R: STRING);
  225. VAR i, n, pos: INTEGER;
  226. BEGIN
  227.   n := LENGTH(R);
  228.   i := 0;
  229.   pos := LENGTH(L);
  230.   WHILE (i <= n) & (pos < LEN(L)) DO
  231.     L[pos] := R[i];
  232.     INC(pos);
  233.     INC(i)
  234.   END
  235. END concat;
  236.  
  237. PROCEDURE GetStr*(this: LIST; str: STRING): STRCONST;
  238. VAR res: STRCONST;
  239. BEGIN
  240.   res := this.First(STRCONST);
  241.   WHILE (res # NIL) & (res.Str # str) DO
  242.     res := res.Next(STRCONST)
  243.   END
  244.   RETURN res
  245. END GetStr;
  246.  
  247. PROCEDURE Push*(this: LIST; item: ITEM);
  248. BEGIN
  249.   IF this.Count = 0 THEN
  250.     this.First := item;
  251.     item.Prev := NIL
  252.   ELSE
  253.     this.Last.Next := item;
  254.     item.Prev := this.Last
  255.   END;
  256.   INC(this.Count);
  257.   this.Last := item;
  258.   item.Next := NIL
  259. END Push;
  260.  
  261. PROCEDURE Insert*(this: LIST; item, prev: ITEM);
  262. BEGIN
  263.   IF prev # this.Last THEN
  264.     item.Next := prev.Next;
  265.     item.Prev := prev;
  266.     prev.Next := item;
  267.     item.Next.Prev := item;
  268.     INC(this.Count)
  269.   ELSE
  270.     Push(this, item)
  271.   END
  272. END Insert;
  273.  
  274. PROCEDURE Clear*(this: LIST);
  275. BEGIN
  276.   this.First := NIL;
  277.   this.Last := NIL;
  278.   this.Count := 0
  279. END Clear;
  280.  
  281. PROCEDURE Revers(VAR str: STRING);
  282. VAR a, b: INTEGER; c: CHAR;
  283. BEGIN
  284.   a := 0;
  285.   b := LENGTH(str) - 1;
  286.   WHILE a < b DO
  287.     c := str[a];
  288.     str[a] := str[b];
  289.     str[b] := c;
  290.     INC(a);
  291.     DEC(b)
  292.   END
  293. END Revers;
  294.  
  295. PROCEDURE Split*(FName: STRING; VAR Path, Name, Ext: STRING);
  296. VAR i, j, k: INTEGER;
  297. BEGIN
  298.   i := LENGTH(FName) - 1;
  299.   j := 0;
  300.   WHILE (i >= 0) & (FName[i] # Slash) DO
  301.     Name[j] := FName[i];
  302.     DEC(i);
  303.     INC(j)
  304.   END;
  305.   Name[j] := 0X;
  306.   Revers(Name);
  307.   j := 0;
  308.   k := LENGTH(Name) - 1;
  309.   WHILE (k >= 0) & (Name[k] # ".") DO
  310.     Ext[j] := Name[k];
  311.     DEC(k);
  312.     INC(j)
  313.   END;
  314.   IF k >= 0 THEN
  315.     Name[k] := 0X;
  316.     Ext[j] := ".";
  317.     INC(j)
  318.   ELSE
  319.     j := 0
  320.   END;
  321.   Ext[j] := 0X;
  322.   Revers(Ext);
  323.   FOR j := 0 TO i DO
  324.     Path[j] := FName[j]
  325.   END;
  326.   Path[i + 1] := 0X
  327. END Split;
  328.  
  329. PROCEDURE LinuxParam;
  330. VAR p, i, str: INTEGER; c: CHAR;
  331. BEGIN
  332.   p := H.GetCommandLine();
  333.   sys.GET(p, ParamCount);
  334.   sys.GET(p + 4, p);
  335.   FOR i := 0 TO ParamCount - 1 DO
  336.     sys.GET(p + i * 4, str);
  337.     Params[i, 0] := str;
  338.     REPEAT
  339.       sys.GET(str, c);
  340.       INC(str)
  341.     UNTIL c = 0X;
  342.     Params[i, 1] := str - 1
  343.   END;
  344.   DEC(ParamCount)
  345. END LinuxParam;
  346.  
  347. PROCEDURE Time*;
  348. VAR sec, dsec: INTEGER;
  349. BEGIN
  350.   OutString("elapsed time ");
  351.   H.Time(sec, dsec);
  352.   sec := sec - H.sec;
  353.   dsec := dsec - H.dsec;
  354.   dsec := dsec + sec * 100;
  355.   Int(dsec DIV 100); CharC(".");
  356.   dsec := dsec MOD 100;
  357.   IF dsec < 10 THEN
  358.     Int(0)
  359.   END;
  360.   Int(dsec); OutString(" sec"); Ln
  361. END Time;
  362.  
  363. PROCEDURE HALT*(n: INTEGER);
  364. BEGIN
  365.   Time;
  366.   H.ExitProcess(n)
  367. END HALT;
  368.  
  369. PROCEDURE MemErr*(err: BOOLEAN);
  370. BEGIN
  371.   IF err THEN
  372.     ErrMsg(72);
  373.     HALT(1)
  374.   END
  375. END MemErr;
  376.  
  377. PROCEDURE CreateList*(): LIST;
  378. VAR nov: LIST;
  379. BEGIN
  380.   NEW(nov);
  381.   MemErr(nov = NIL)
  382.   RETURN nov
  383. END CreateList;
  384.  
  385. PROCEDURE CreateF*(FName: ARRAY OF CHAR): INTEGER;
  386.   RETURN H.CreateFile(FName)
  387. END CreateF;
  388.  
  389. PROCEDURE OpenF*(FName: ARRAY OF CHAR(*; Mode: INTEGER*)): INTEGER;
  390.   RETURN H.OpenFile(FName)
  391. END OpenF;
  392.  
  393. PROCEDURE Init;
  394. VAR p: INTEGER;
  395.  
  396.   PROCEDURE last(VAR p: INTEGER);
  397.   BEGIN
  398.     WHILE GetChar(p) # 0X DO INC(p) END;
  399.     DEC(p)
  400.   END last;
  401.  
  402. BEGIN
  403.   H.init;
  404.   IF OS = "WIN" THEN
  405.     ParamParse(0)
  406.   ELSIF OS = "KOS" THEN
  407.     ParamParse(1);
  408.     Params[0, 0] := H.GetName();
  409.     Params[0, 1] := Params[0, 0];
  410.     last(Params[0, 1])
  411.   ELSIF OS = "LNX" THEN
  412.     LinuxParam
  413.   END
  414. END Init;
  415.  
  416. BEGIN
  417.   Init
  418. END UTILS.