LINUX386.Kernel.Mod.txt

MODULE Kernel;  (*NW/PR  11.4.86 / 27.12.95 / 4.2.2014*)
  IMPORT SYSTEM;
  CONST SectorLength* = 1024;

  TYPE Sector* = ARRAY SectorLength OF BYTE;

  VAR allocated*, NofSectors*: INTEGER;
    heapOrg*, heapLim*: INTEGER; 
    stackOrg* ,  stackSize*, MemLim*: INTEGER;
    clock, time, time0, org: INTEGER;
    list0, list1, list2, list3: INTEGER;  (*lists of free blocks of size n*256, 128, 64, 32 bytes*)
    InitFPU: PROCEDURE;
    syscall1: PROCEDURE (eax: INTEGER): INTEGER;
    syscall2: PROCEDURE (eax, ebx: INTEGER): INTEGER;
    syscall3: PROCEDURE (eax, ebx, ecx: INTEGER): INTEGER;
    syscall4: PROCEDURE (eax, ebx, ecx, edx: INTEGER): INTEGER;
    
(* ---------- New: heap allocation ----------*)

  PROCEDURE NewBlock(VAR p: LONGINT; len: LONGINT);
    CONST N = 262144;
    VAR adr, lim, size, q: LONGINT;
  BEGIN p := 0; lim := (heapLim + len + 256 + N - 1) DIV N * N;
    IF lim > heapOrg THEN
      adr := syscall2(45, lim);
      IF adr >= lim THEN
        p := heapLim; q := p + len; size := adr - heapLim;
        SYSTEM.PUT(p, len); SYSTEM.PUT(p+4, -1);
        SYSTEM.PUT(q, size-len); SYSTEM.PUT(q+4, -1); SYSTEM.PUT(q+8, list0); list0 := q;
        heapLim := adr
      END
    END
  END NewBlock;
  
  PROCEDURE GetBlock(VAR p: LONGINT; len: LONGINT);
    (*len is multiple of 256*)
    VAR q0, q1, q2, size: LONGINT; done: BOOLEAN;
  BEGIN q0 := 0; q1 := list0; done := FALSE;
    WHILE ~done & (q1 # 0) DO
      SYSTEM.GET(q1, size); SYSTEM.GET(q1+8, q2);
      IF size < len THEN (*no fit*) q0 := q1; q1 := q2
      ELSIF size = len THEN (*extract -> p*)
        done := TRUE; p := q1;
        IF q0 # 0 THEN SYSTEM.PUT(q0+8, q2) ELSE list0 := q2 END
      ELSE (*reduce size*)
        done := TRUE; p := q1; q1 := q1 + len;
        SYSTEM.PUT(q1, size-len); SYSTEM.PUT(q1+4, -1); SYSTEM.PUT(q1+8, q2);
        IF q0 # 0 THEN SYSTEM.PUT(q0+8, q1) ELSE list0 := q1 END
      END
    END ;
    IF ~done THEN NewBlock(p, len) END
  END GetBlock;

  PROCEDURE GetBlock128(VAR p: LONGINT);
    VAR q: LONGINT;
  BEGIN
    IF list1 # 0 THEN p := list1; SYSTEM.GET(list1+8, list1)
    ELSE GetBlock(q, 256); SYSTEM.PUT(q+128, 128); SYSTEM.PUT(q+132, -1); SYSTEM.PUT(q+136, list1);
      list1 := q + 128; p := q
    END
  END GetBlock128;

  PROCEDURE GetBlock64(VAR p: LONGINT);
    VAR q: LONGINT;
  BEGIN
    IF list2 # 0 THEN p := list2; SYSTEM.GET(list2+8, list2)
    ELSE GetBlock128(q); SYSTEM.PUT(q+64, 64); SYSTEM.PUT(q+68, -1); SYSTEM.PUT(q+72, list2);
      list2 := q + 64; p := q
    END
  END GetBlock64;

  PROCEDURE GetBlock32(VAR p: LONGINT);
    VAR q: LONGINT;
  BEGIN
    IF list3 # 0 THEN p := list3; SYSTEM.GET(list3+8, list3)
    ELSE GetBlock64(q); SYSTEM.PUT(q+32, 32); SYSTEM.PUT(q+36, -1); SYSTEM.PUT(q+40, list3);
      list3 := q + 32; p := q
    END
  END GetBlock32;

   PROCEDURE New*(VAR ptr: LONGINT; tag: LONGINT);
    (*called by NEW via MT[0]; ptr and tag are pointers*)
    VAR p, size, lim: LONGINT;
  BEGIN SYSTEM.GET(tag, size);
    IF size = 32 THEN GetBlock32(p)
    ELSIF size = 64 THEN GetBlock64(p)
    ELSIF size = 128 THEN GetBlock128(p)
    ELSE GetBlock(p, (size+255) DIV 256 * 256)
    END ;
    IF p = 0 THEN ptr := 0
    ELSE ptr := p+8; SYSTEM.PUT(p, tag); lim := p + size; INC(p, 4); INC(allocated, size);
      WHILE p < lim DO SYSTEM.PUT(p, 0); INC(p, 4) END
    END
  END New;

(* ---------- Garbage collector ----------*)

  PROCEDURE Mark*(pref: LONGINT);
    VAR pvadr, offadr, offset, tag, p, q, r: LONGINT;
  BEGIN SYSTEM.GET(pref, pvadr); (*pointers < heapOrg considered NIL*)
    WHILE pvadr # 0 DO
      SYSTEM.GET(pvadr, p);
      IF p >= heapOrg THEN SYSTEM.GET(p-4, offadr);
        IF offadr = 0 THEN q := p;   (*mark elements in data structure with root p*)
          REPEAT SYSTEM.GET(p-4, offadr);
            IF offadr = 0 THEN SYSTEM.GET(p-8, tag); offadr := tag + 16 ELSE INC(offadr, 4) END ;
            SYSTEM.PUT(p-4, offadr); SYSTEM.GET(offadr, offset);
            IF offset # -1 THEN (*down*)
              SYSTEM.GET(p+offset, r);
  			IF r >= heapOrg THEN SYSTEM.GET(r-4, offadr);
  	            IF offadr = 0 THEN SYSTEM.PUT(p+offset, q); q := p; p := r END
  	        END
            ELSE (*up*) SYSTEM.GET(q-4, offadr); SYSTEM.GET(offadr, offset);
              IF p # q THEN SYSTEM.GET(q+offset, r); SYSTEM.PUT(q+offset, p); p := q; q := r END
            END
          UNTIL (p = q) & (offset = -1)
        END
      END ;
      INC(pref, 4); SYSTEM.GET(pref, pvadr)
    END
  END Mark;

  PROCEDURE Scan*;
    VAR p, q, mark, tag, size: LONGINT;
  BEGIN p := heapOrg;
    REPEAT SYSTEM.GET(p+4, mark); q := p;
      WHILE mark = 0 DO
        SYSTEM.GET(p, tag); SYSTEM.GET(tag, size); INC(p, size); SYSTEM.GET(p+4, mark)
      END ;
      size := p - q; DEC(allocated, size);  (*size of free block*)
      IF size > 0 THEN
        IF size MOD 64 # 0 THEN
          SYSTEM.PUT(q, 32); SYSTEM.PUT(q+4, -1); SYSTEM.PUT(q+8, list3); list3 := q; INC(q, 32); DEC(size, 32)
        END ;
        IF size MOD 128 # 0 THEN
          SYSTEM.PUT(q, 64); SYSTEM.PUT(q+4, -1); SYSTEM.PUT(q+8, list2); list2 := q; INC(q, 64); DEC(size, 64)
        END ;
        IF size MOD 256 # 0 THEN
          SYSTEM.PUT(q, 128); SYSTEM.PUT(q+4, -1); SYSTEM.PUT(q+8,  list1); list1 := q; INC(q, 128); DEC(size, 128)
        END ;
        IF size > 0 THEN
          SYSTEM.PUT(q, size); SYSTEM.PUT(q+4, -1); SYSTEM.PUT(q+8, list0); list0 := q; INC(q, size)
        END
      END ;
      IF mark > 0 THEN SYSTEM.GET(p, tag); SYSTEM.GET(tag, size); SYSTEM.PUT(p+4, 0); INC(p, size)
      ELSE (*free*) SYSTEM.GET(p, size); INC(p, size)
      END
    UNTIL p >= heapLim
  END Scan;

(* ---------- Disk storage management ----------*)

  PROCEDURE InitSecMap*;
  BEGIN NofSectors := 0
  END InitSecMap;

  PROCEDURE MarkSector*(sec: INTEGER);
  BEGIN ASSERT(FALSE)
  END MarkSector;

  PROCEDURE FreeSector*(sec: INTEGER);
  BEGIN ASSERT(FALSE)
  END FreeSector;

  PROCEDURE AllocSector*(hint: INTEGER; VAR sec: INTEGER);
  BEGIN ASSERT(FALSE)
  END AllocSector;

  PROCEDURE GetSector*(src: INTEGER; VAR dst: Sector);
  BEGIN ASSERT(FALSE)
  END GetSector;
  
  PROCEDURE PutSector*(dst: INTEGER; VAR src: Sector);
  BEGIN ASSERT(FALSE)
  END PutSector;

(*-------- Miscellaneous procedures----------*)

  PROCEDURE UnixToClock(t: INTEGER): INTEGER;
    VAR z, era, y, doe, yoe, doy, mp, second, minute, hour, day, month, year: INTEGER;
  BEGIN
    z := (t DIV 86400) + 719468;
    IF z >= 0 THEN era := z DIV 146097 ELSE era := (z - 146096) DIV 146097 END;
    doe := z - era*146097;
    yoe := (doe - doe DIV 1460 + doe DIV 36524 - doe DIV 146096) DIV 365;
    doy := doe - (365*yoe + yoe DIV 4 - yoe DIV 100);
    mp := (5*doy + 2) DIV 153;
    y := yoe + era*400;
    day := doy - (153*mp + 2) DIV 5 + 1;
    IF mp < 10 THEN month := mp + 3 ELSE month := mp - 9 END;
    IF month <= 2 THEN year := y + 1 ELSE year := y END;
    year := year MOD 100;
    hour := t DIV 3600 MOD 24;
    minute := t DIV 60 MOD 60;
    second := t MOD 60;
    RETURN ((((year*10H + month)*20H + day)*20H + hour)*40H + minute)*40H + second
  END UnixToClock;

  PROCEDURE ClockToUnix(dt: INTEGER): INTEGER;
    VAR y, m, d, era, yoe, doy, doe, days, hour, min, sec: INTEGER;
  BEGIN
    y := dt DIV 4000000H MOD 40H + 2000;
    m := dt DIV 400000H MOD 10H;
    d := dt DIV 20000H MOD 20H;
    hour := dt DIV 1000H MOD 20H;
    min := dt DIV 40H MOD 40H;
    sec := dt  MOD 40H;
    IF m <= 2 THEN DEC(y, 1) END;
    IF y >= 0 THEN era := y DIV 400 ELSE era := (y - 399) DIV 400 END;
    yoe := y - era*400;
    IF m > 2 THEN doy := m - 3 ELSE doy := m + 9 END;
    doy := (153*doy + 2) DIV 5 + d - 1;
    doe := yoe*365 + yoe DIV 4 - yoe DIV 100 + doy;
    days := era*146097 + doe - 719468;
    RETURN ((days*24 + hour)*60 + min)*60 + sec
  END ClockToUnix;

  PROCEDURE Time*(): INTEGER;
    VAR res: INTEGER; tv: ARRAY 2 OF INTEGER;
  BEGIN (*clock_gettime(CLOCK_BOOTTIME, tv)*)
    REPEAT res := syscall3(265, 7, SYSTEM.ADR(tv)) UNTIL res # -4;
    IF res = 0 THEN time := tv[0]*1000 + tv[1] DIV 1000000 - time0 END;
    RETURN time
  END Time;

  PROCEDURE Clock*(): INTEGER;
    VAR res: INTEGER; tv: ARRAY 2 OF INTEGER;
  BEGIN (*clock_gettime(CLOCK_REALTIME, tv)*)
    REPEAT res := syscall3(265, 0, SYSTEM.ADR(tv)) UNTIL res # -4;
    IF res = 0 THEN clock := UnixToClock(tv[0]) END;
    RETURN clock
  END Clock;

  PROCEDURE SetClock*(dt: INTEGER);
    VAR res: INTEGER; tv: ARRAY 2 OF INTEGER;
  BEGIN (*clock_settime(CLOCK_REALTIME, tv)*)
    tv[0] := ClockToUnix(dt); tv[1] := 0;
    REPEAT res := syscall3(264, 0, SYSTEM.ADR(tv)) UNTIL res # -4;
    clock := dt
  END SetClock;

  PROCEDURE Install*(Padr, at: INTEGER);
  BEGIN SYSTEM.PUT(org + at, Padr)
  END Install;

  PROCEDURE Id (): INTEGER;
  BEGIN RETURN 0
  END Id;

  PROCEDURE Trap(VAR a: INTEGER; b, c: INTEGER);
    VAR u, v, w: INTEGER;
  BEGIN w := c MOD 100H; (*trap number*)
    IF w = 0 THEN New(a, b)
    ELSIF w = 255 THEN (*led*)
    ELSIF w = 254 THEN u := Id() (*id*)
    ELSE (*stop*)
      u := syscall3(37, syscall1(20), 6); (*kill(getpid(), SIGABRT)*)
      u := syscall2(1, w); (*exit*)
      REPEAT UNTIL FALSE
    END
  END Trap;

  PROCEDURE Init*;
    VAR i, u, w, argc, argv, envp: INTEGER; ch: CHAR; rlimit: ARRAY 2 OF INTEGER;
  BEGIN org := SYSTEM.REG(3)-20H;
    SYSTEM.PUT(SYSTEM.ADR(InitFPU), SYSTEM.ADR($55 89E5 9BDBE3 68BF070000 D92C24 83C404 5D C3 90$));
    SYSTEM.PUT(SYSTEM.ADR(syscall1), SYSTEM.ADR($8B442404 CD80 C20400 6690 90$));
    SYSTEM.PUT(SYSTEM.ADR(syscall2), SYSTEM.ADR($8B442408 8B5C2404 CD80 C20800 6690 90$));
    SYSTEM.PUT(SYSTEM.ADR(syscall3), SYSTEM.ADR($8B44240C 8B5C2408 8B4C2404 CD80 C20C00 6690 90$));
    SYSTEM.PUT(SYSTEM.ADR(syscall4), SYSTEM.ADR($8B442410 8B5C240C 8B4C2408 8B542404 CD80 C21000 6690 90$));
    InitFPU; Install(SYSTEM.ADR(Trap), 20H);  (*install temporary trap*)
    SYSTEM.GET(org+12, MemLim);
    (*get stack origin via backtrace Kernel->Files->Modules, skip argc->argv->envp->strings->null->origin*)
    SYSTEM.GET(SYSTEM.REG(5), u); SYSTEM.GET(u, u); SYSTEM.GET(u, u);
    SYSTEM.GET(u + 8, argc); argv := u + 12; envp := argv + argc*4 + 4;
    u := envp; REPEAT SYSTEM.GET(u, w); INC(u, 4) UNTIL w = 0;
    SYSTEM.GET(u - 8, u); REPEAT SYSTEM.GET(u, ch); INC(u) UNTIL ch = 0X;
    REPEAT SYSTEM.GET(u, ch); INC(u) UNTIL ch = 0X; u := (u + 4095) DIV 4096 * 4096;
    stackOrg := argv - 8;
    (*get stack size via getrlimit(R_STACK)*)
    IF syscall3(76, 3, SYSTEM.ADR(rlimit)) = 0 THEN stackSize := rlimit[0] - (u - stackOrg)
    ELSE stackSize := 8000H
    END;
    (*get heap origin via brk(0)*)
    heapOrg := syscall2(45, 0); heapLim := syscall2(45, heapOrg + 262144);
    ASSERT(heapOrg >= 0); ASSERT(heapLim >= 0); ASSERT(heapOrg + 16384 <= heapLim);
    list1 := 0; list2 := 0; list3 := 0; list0 := heapOrg;
    SYSTEM.PUT(list0, heapLim - heapOrg); SYSTEM.PUT(list0+4, -1); SYSTEM.PUT(list0+8, 0);
    allocated := 0; clock := 0; time := 0; time0 := 0; time0 := Time(); InitSecMap
  END Init;

END Kernel.