Oberon-07:

base address 0x10000 for applications (parameter "kem" instead "kos") git-svn-id: svn://kolibrios.org@7209 a494cfbc-eb01-0410-851d-a64ba20cac60
2018-03-23 22:01:12 +00:00 · 2018-03-23 22:01:12 +00:00 · bddfb2f439
commit bddfb2f439
parent 2644460def
8 changed files with 92 additions and 40 deletions
--- a/programs/develop/oberon07/Compiler.kex
+++ b/programs/develop/oberon07/Compiler.kex
--- a/programs/develop/oberon07/Docs/About1251.txt
+++ b/programs/develop/oberon07/Docs/About1251.txt
@ -17,6 +17,8 @@
 		"elf" - Linux
 		"kos" - KolibriOS
 		"obj" - KolibriOS DLL
+		"kem" - KolibriOS с адресом загрузки 0x10000 для возможного
+			исполнения в эмуляторе
 	3) размер стэка в мегабайтах, необязательный параметр, по умолчанию -
 	1 Мб, для ELF игнорируется. Если 2-й параметр = "obj" (KolibriOS DLL),
 	то 3-й параметр задается шестнадцатиричным числом
--- a/programs/develop/oberon07/Docs/About866.txt
+++ b/programs/develop/oberon07/Docs/About866.txt
@ -17,6 +17,8 @@
 		"elf" - Linux
 		"kos" - KolibriOS
 		"obj" - KolibriOS DLL
+		"kem" - KolibriOS á  ¤à¥á®¬ § £àã§ª¨ 0x10000 ¤«ï ¢®§¬®¦®£®
+			¨á¯®«¥¨ï ¢ í¬ã«ïâ®à¥
 	3) à §¬¥à áâíª  ¢ ¬¥£ ¡ ©â å, ¥®¡ï§ â¥«ìë© ¯ à ¬¥âà, ¯® ã¬®«ç ¨î -
 	1 Œ¡, ¤«ï ELF ¨£®à¨àã¥âáï. …á«¨ 2-© ¯ à ¬¥âà = "obj" (KolibriOS DLL),
 	â® 3-© ¯ à ¬¥âà § ¤ ¥âáï è¥áâ ¤æ â¨à¨çë¬ ç¨á«®¬
--- a/programs/develop/oberon07/Lib/KolibriOS/API.ob07
+++ b/programs/develop/oberon07/Lib/KolibriOS/API.ob07
@ -1,5 +1,5 @@
 (*
-    Copyright 2016, 2017 Anton Krotov
+    Copyright 2016, 2017, 2018 Anton Krotov

    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
@ -24,11 +24,11 @@ CONST

    MAX_SIZE  = 16 * 400H;
    HEAP_SIZE =  1 * 100000H;
-    
+
    _new = 1;
    _dispose = 2;

-    
+
 TYPE

    CRITICAL_SECTION = ARRAY 2 OF INTEGER;
@ -45,7 +45,7 @@ VAR
 PROCEDURE [stdcall] zeromem* (size, adr: INTEGER);
 BEGIN
    sys.CODE("578B7D0C8B4D0833C09CFCF3AB9D5F")
-END zeromem; 
+END zeromem;


 PROCEDURE mem_commit* (adr, size: INTEGER);
@ -55,7 +55,7 @@ BEGIN
    FOR tmp := adr TO adr + size - 1 BY 4096 DO
        sys.PUT(tmp, 0)
    END
-END mem_commit;  
+END mem_commit;


 PROCEDURE strncmp* (a, b, n: INTEGER): INTEGER;
@ -76,7 +76,7 @@ BEGIN
        END
    END
    RETURN Res
-END strncmp;    
+END strncmp;


 PROCEDURE [stdcall] sysfunc1* (arg1: INTEGER): INTEGER;
@ -86,7 +86,7 @@ BEGIN
    sys.CODE("C9");               (* leave                    *)
    sys.CODE("C20400");           (* ret     04h              *)
    RETURN 0
-END sysfunc1; 
+END sysfunc1;


 PROCEDURE [stdcall] sysfunc2* (arg1, arg2: INTEGER): INTEGER;
@ -99,7 +99,7 @@ BEGIN
    sys.CODE("C9");               (* leave                    *)
    sys.CODE("C20800");           (* ret     08h              *)
    RETURN 0
-END sysfunc2;    
+END sysfunc2;


 PROCEDURE [stdcall] sysfunc3* (arg1, arg2, arg3: INTEGER): INTEGER;
@ -128,7 +128,7 @@ BEGIN
    sys.CODE("C9");               (* leave                    *)
    sys.CODE("C21000");           (* ret     10h              *)
    RETURN 0
-END sysfunc4;    
+END sysfunc4;


 PROCEDURE [stdcall] sysfunc5* (arg1, arg2, arg3, arg4, arg5: INTEGER): INTEGER;
@ -247,7 +247,7 @@ BEGIN
            res := 0
        END
    END;
-    IF res # 0 THEN
+    IF (res # 0) & (size <= MAX_SIZE) THEN
        zeromem(ASR(size, 2) - 1, res)
    END
    RETURN res
@ -274,24 +274,24 @@ END __DISPOSE;
 PROCEDURE NEW_DISPOSE (func, arg: INTEGER): INTEGER;
 VAR
    res: INTEGER;
-BEGIN    
-    EnterCriticalSection(CriticalSection); 
+BEGIN
+    EnterCriticalSection(CriticalSection);

    IF func = _new THEN
        res := __NEW(arg)
    ELSIF func = _dispose THEN
        res := __DISPOSE(arg)
-    END;                 
+    END;

    LeaveCriticalSection(CriticalSection)
    RETURN res
-END NEW_DISPOSE;  
+END NEW_DISPOSE;


 PROCEDURE _NEW* (size: INTEGER): INTEGER;
    RETURN NEW_DISPOSE(_new, size)
 END _NEW;
-                     
+

 PROCEDURE _DISPOSE* (ptr: INTEGER): INTEGER;
    RETURN NEW_DISPOSE(_dispose, ptr)
@ -300,14 +300,14 @@ END _DISPOSE;

 PROCEDURE ExitProcess* (p1: INTEGER);
 BEGIN
-  p1 := sysfunc1(-1)
-END ExitProcess;  
+    p1 := sysfunc1(-1)
+END ExitProcess;


 PROCEDURE ExitThread* (p1: INTEGER);
 BEGIN
    p1 := sysfunc1(-1)
-END ExitThread;  
+END ExitThread;


 PROCEDURE OutChar (c: CHAR);
@ -315,7 +315,7 @@ VAR
    res: INTEGER;
 BEGIN
    res := sysfunc3(63, 1, ORD(c))
-END OutChar; 
+END OutChar;


 PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER);
@ -347,14 +347,14 @@ BEGIN
        OutChar(0DX);
        OutChar(0AX)
    END
-END DebugMsg;  
+END DebugMsg;


 PROCEDURE init* (p1: INTEGER);
 BEGIN
    p1 := sysfunc2(68, 11);
    InitializeCriticalSection(CriticalSection)
-END init; 
+END init;


 END API.
--- a/programs/develop/oberon07/Lib/KolibriOS/HOST.ob07
+++ b/programs/develop/oberon07/Lib/KolibriOS/HOST.ob07
@ -35,9 +35,9 @@ TYPE

 VAR

-  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);
+  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);

  fsize, sec*, dsec*: INTEGER;

@ -107,8 +107,8 @@ BEGIN
  Time(sec, dsec);
  Lib := API.sysfunc3(68, 19, sys.ADR("/rd/1/lib/console.obj"));
  IF Lib # 0 THEN
-    GetProc(sys.ADR(con_init),         "con_init");
-    GetProc(sys.ADR(con_exit),         "con_exit");
+    GetProc(sys.ADR(con_init),	       "con_init");
+    GetProc(sys.ADR(con_exit),	       "con_exit");
    GetProc(sys.ADR(con_write_asciiz), "con_write_asciiz");
    IF con_init # NIL THEN
      con_init(-1, -1, -1, -1, sys.ADR("Oberon-07/11 for KolibriOS"))
@ -124,17 +124,27 @@ BEGIN
  API.ExitProcess(0)
 END ExitProcess;

+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, param)
+  sys.GET(28 + AppAdr(), param)
  RETURN param
 END GetCommandLine;

 PROCEDURE GetName*(): INTEGER;
 VAR name: INTEGER;
 BEGIN
-  sys.GET(32, name)
+  sys.GET(32 + AppAdr(), name)
  RETURN name
 END GetName;

--- a/programs/develop/oberon07/Lib/KolibriOS/KOSAPI.ob07
+++ b/programs/develop/oberon07/Lib/KolibriOS/KOSAPI.ob07
@ -1,5 +1,5 @@
 (*
-    Copyright 2016 Anton Krotov
+    Copyright 2016, 2018 Anton Krotov

    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
@ -187,17 +187,27 @@ BEGIN
  RETURN ptr
 END realloc;

+PROCEDURE AppAdr(): INTEGER;
+VAR
+    buf: ARRAY 1024 OF CHAR;
+    a: INTEGER;
+BEGIN
+    a := 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, param)
+  sys.GET(28 + AppAdr(), param)
  RETURN param
 END GetCommandLine;

 PROCEDURE GetName*(): INTEGER;
 VAR name: INTEGER;
 BEGIN
-  sys.GET(32, name)
+  sys.GET(32 + AppAdr(), name)
  RETURN name
 END GetName;

--- a/programs/develop/oberon07/Source/Compiler.ob07
+++ b/programs/develop/oberon07/Source/Compiler.ob07
@ -1,5 +1,5 @@
 (*
-    Copyright 2016, 2017 Anton Krotov
+    Copyright 2016, 2017, 2018 Anton Krotov

    This file is part of Compiler.

@ -289,6 +289,10 @@ BEGIN
        IntType(e1.T, coord);
        Load(e1);
        IF e.T.Len = 0 THEN
+          IF e1.eType = eCONST THEN
+            idx := FLOOR(e1.Value);
+            Assert(idx >= 0, coord, 159)
+          END;
          BaseT := DECL.OpenBase(e.T);
          X86.PushConst(BaseT.Size);
          X86.OpenIdx(DECL.Dim(e.T))
@ -866,6 +870,9 @@ BEGIN
      X86.DropFpu(param.T.tType = TLONGREAL)
    END;
    IF (e1.T.tType = TSTRING) & (param.T.tType = TARRAY) THEN
+      IF param.T.Len > X86.maxstrlen THEN
+          X86.set_maxstrlen(param.T.Len)
+      END;
      s := DECL.GetString(e1.Value);
      IF s.Len = 1 THEN
        X86.Mono(s.Number)
@ -1885,7 +1892,11 @@ BEGIN
  END;
  UTILS.Split(SelfName, SelfPath, CName, CExt);
  temp := Name;
-  IF UTILS.streq(system, "obj") THEN
+  IF UTILS.streq(system, "kem") THEN
+    X86.setkem;
+    platform := 4;
+    UTILS.concat(temp, ".kex")
+  ELSIF UTILS.streq(system, "obj") THEN
    platform := 6;
    UTILS.concat(temp, ".obj")
  ELSIF UTILS.streq(system, "elf") THEN
@ -1924,6 +1935,7 @@ BEGIN
    UTILS.concat(SelfPath, "Windows32")
  END;
  UTILS.concat(SelfPath, UTILS.Slash);
+  X86.set_maxstrlen(0);
  X86.Init(platform);
  X86.Prolog(temp);
  DECL.Program(SelfPath, Path, Name, Ext, platform IN {1, 2, 3}, OpSeq, Expr, AssComp, sttypes);
--- a/programs/develop/oberon07/Source/X86.ob07
+++ b/programs/develop/oberon07/Source/X86.ob07
@ -1,5 +1,5 @@
 (*
-    Copyright 2016, 2017 Anton Krotov
+    Copyright 2016, 2017, 2018 Anton Krotov

    This file is part of Compiler.

@ -119,7 +119,7 @@ TYPE
    reloc: ARRAY 1024 OF sys.CARD16
  END;

-VAR asmlist: UTILS.LIST; start: ASMLINE; dll, con, gui, kos, elf, obj: BOOLEAN;
+VAR asmlist: UTILS.LIST; start: ASMLINE; dll, con, gui, kos, elf, obj, kem: BOOLEAN;
    Lcount, reccount, topstk: INTEGER; recarray: ARRAY 2048 OF INTEGER; current*: ASMLINE;
    callstk: ARRAY 1024, 2 OF ASMLINE; OutFile: UTILS.STRING;
    Code: ARRAY 4000000 OF CHAR; ccount: INTEGER; Data: ARRAY 1000000 OF CHAR; dcount: INTEGER;
@ -128,6 +128,12 @@ VAR asmlist: UTILS.LIST; start: ASMLINE; dll, con, gui, kos, elf, obj: BOOLEAN;
    RtlProc: ARRAY 20 OF INTEGER; OutFilePos: INTEGER; RelocSection: SECTION;
    fpu*: INTEGER; isfpu: BOOLEAN; maxfpu: INTEGER; fpucmd: ASMLINE;
    kosexp: ARRAY 65536 OF RECORD Name: SCAN.NODE; Adr, NameLabel: INTEGER END; kosexpcount: INTEGER;
+    maxstrlen*: INTEGER;
+
+PROCEDURE set_maxstrlen* (value: INTEGER);
+BEGIN
+    maxstrlen := value
+END set_maxstrlen;

 PROCEDURE AddRtlProc*(idx, proc: INTEGER);
 BEGIN
@ -567,7 +573,7 @@ BEGIN
  NEW(nov);
  UTILS.MemErr(nov = NIL);
  UTILS.Push(asmlist, nov);
-  current := nov;
+  current := nov
 END Init;

 PROCEDURE datastr(str: UTILS.STRING);
@ -1556,10 +1562,10 @@ BEGIN
  IF ~obj THEN
    Header.menuet01 := "MENUET01";
    Header.ver := 1;
-    Header.start := sys.SIZE(KOSHEADER);
+    Header.start := sys.SIZE(KOSHEADER) + ORD(kem) * 65536;
    Header.size := Align(size, 4) + datasize;
    Header.mem := Header.size + stk + gsize + strsize * 2 + 1000H;
-    Header.sp := Header.size + gsize + stk;
+    Header.sp := Header.size + gsize + stk;// + ORD(kem) * 65536;
    Header.param := Header.sp;
    Header.path := Header.param + strsize;

@ -1768,7 +1774,7 @@ BEGIN
  ELSIF con OR gui THEN
    LoadAdr := 400000H
  ELSIF kos OR obj THEN
-    LoadAdr := sys.SIZE(KOSHEADER)
+    LoadAdr := sys.SIZE(KOSHEADER) + ORD(kem & kos) * 65536
  ELSIF elf THEN
    LoadAdr := 134514420 + 1024;
    INC(gsize, 1024)
@ -1926,6 +1932,9 @@ PROCEDURE Epilog*(gsize: INTEGER; FName: ARRAY OF CHAR; stk: INTEGER);
 VAR i, glob: INTEGER;
 BEGIN
  glob := 0;
+  IF gsize < maxstrlen THEN
+      gsize := maxstrlen
+  END;
  gsize := Align(gsize, 4) + 4;
  COPY(FName, OutFile);
  Labels[RTABLE] := -dcount;
@ -1983,6 +1992,13 @@ BEGIN
    END
  END;
  FixLabels(FName, stk, gsize, glob)
-END Epilog;
+END Epilog; 

+PROCEDURE setkem*;
+BEGIN            
+    kem := TRUE
+END setkem;
+
+BEGIN
+    kem := FALSE
 END X86.