bootpack.pas

   1 unit bootpack;
   2
   3 interface
   4
   5 uses
   6   System.Classes, System.Generics.Collections, System.SysUtils, System.Types,
   7   graphic;
   8
   9 type
  10   TBOOTINFO = record
  11     cyls, legs, vmode, reserve: Int8;
  12     scrnx, scrny: Int16;
  13     vram: TBytes;
  14   end;
  15
  16   TFIFO32 = record
  17     buf: array of UInt32;
  18     p, q, size, free, flags: integer;
  19   end;
  20
  21   TFifo = class
  22   private
  23     fifo: TFIFO32;
  24   public
  25     constructor Create(size: integer);
  26     destructor Destroy; override;
  27     function Put(data: integer): integer;
  28     function Get: SmallInt;
  29     function Status: integer;
  30   end;
  31
  32   TDevice = class
  33   const
  34     PORT_KEYDAT = $0060;
  35     PORT_KEYSTA = $0064;
  36     PORT_KEYCMD = $0064;
  37     KEYSTA_SEND_NOTREADY = $02;
  38     KEYCMD_WRITE_MODE = $60;
  39     KBC_MODE = $47;
  40   private
  41     fifo: TFifo;
  42     buf: array [0 .. 255] of Byte;
  43     procedure wait_KBC_sendready;
  44   public
  45     procedure inthandler21(var esp: integer); virtual; abstract;
  46   end;
  47
  48   TKeyboard = class(TDevice)
  49   const
  50     cursor_c = COL8_FFFFFF;
  51   private
  52     keydata: integer;
  53     procedure make_table(const keys1, keys2: array of const);
  54   public
  55     keytable0, keytable1: array [$00 .. $80] of Byte;
  56     cursor_x: integer;
  57     constructor Create(fifo: TFifo; data0: integer);
  58     procedure inthandler21(var esp: integer); override;
  59   end;
  60
  61   TMOUSE_DEC = record
  62     buf: array [0 .. 2] of Byte;
  63     phase: Byte;
  64     x, y, btn: integer;
  65   end;
  66
  67   TMouse = class(TDevice)
  68   const
  69     KEYCMD_SENDTO_MOUSE = $D4;
  70     MOUSECMD_ENABLE = $F4;
  71   private
  72     mousedata: integer;
  73   public
  74     dec: TMOUSE_DEC;
  75     constructor Create(fifo: TFifo; data0: integer);
  76     function decode(dat: UInt8): integer;
  77     procedure inthandler21(var esp: integer); override;
  78   end;
  79
  80   TMemtest = class
  81   private
  82     function memtest_sub(start, endpos: Cardinal): Cardinal;
  83   public
  84     function memtest(start, endpos: Cardinal): Cardinal;
  85   end;
  86
  87   TFREEINFO = record
  88     addr, size: Cardinal;
  89   end;
  90
  91   TMEMMAN = class
  92   public
  93     frees, maxfrees, lostsize, losts: integer;
  94     free: TList<TFREEINFO>;
  95     constructor Create;
  96     destructor Destroy; override;
  97   end;
  98
  99   TMem = class
 100   public
 101     procedure Init(mem: TMEMMAN);
 102     function total(mem: TMEMMAN): Cardinal;
 103     function alloc(mem: TMEMMAN; size: Cardinal): Cardinal;
 104     function memfree(mem: TMEMMAN; addr, size: Cardinal): integer;
 105   end;
 106
 107 const
 108   FLAGSOVERRUN = $0001;
 109
 110   PIC0_ICW1 = $0020;
 111   PIC0_OCW2 = $0020;
 112   PIC0_IMR = $0021;
 113   PIC0_ICW2 = $0021;
 114   PIC0_ICW3 = $0021;
 115   PIC0_ICW4 = $0021;
 116   PIC1_ICW1 = $00A0;
 117   PIC1_OCW2 = $00A0;
 118   PIC1_IMR = $00A1;
 119   PIC1_ICW2 = $00A1;
 120   PIC1_ICW3 = $00A1;
 121   PIC1_ICW4 = $00A1;
 122
 123   ADR_BOOTINFO = $00000FF0;
 124
 125 implementation
 126
 127 { TFIFO8 }
 128
 129 uses asmhead;
 130
 131 destructor TFifo.Destroy;
 132 begin
 133   Finalize(fifo.buf);
 134   inherited;
 135 end;
 136
 137 function TFifo.Get: SmallInt;
 138 begin
 139   if fifo.free = fifo.size then
 140   begin
 141     result := -1;
 142     Exit;
 143   end;
 144   result := fifo.buf[fifo.q];
 145   inc(fifo.q);
 146   if fifo.q = fifo.size then
 147     fifo.q := 0;
 148   inc(fifo.free);
 149 end;
 150
 151 constructor TFifo.Create(size: integer);
 152 begin
 153   inherited Create;
 154   SetLength(fifo.buf, size);
 155   fifo.size := size;
 156   fifo.free := size;
 157   fifo.flags := 0;
 158   fifo.p := 0;
 159   fifo.q := 0;
 160 end;
 161
 162 function TFifo.Put(data: integer): integer;
 163 begin
 164   if fifo.free = 0 then
 165   begin
 166     fifo.flags := FLAGSOVERRUN;
 167     result := -1;
 168     Exit;
 169   end;
 170   fifo.buf[fifo.p] := data;
 171   inc(fifo.p);
 172   if fifo.p = fifo.size then
 173     fifo.p := 0;
 174   dec(fifo.free);
 175   result := 0;
 176 end;
 177
 178 function TFifo.Status: integer;
 179 begin
 180   result := fifo.size - fifo.free;
 181 end;
 182
 183 { TMemtest }
 184
 185 function TMemtest.memtest(start, endpos: Cardinal): Cardinal;
 186 const
 187   EFLAGS_AC_BIT = $00040000;
 188   CR0_CASH_DISABLE = $60000000;
 189 var
 190   flag486: UInt8;
 191   eflg, cr0: UInt32;
 192 begin
 193   flag486 := 0;
 194   eflg := io_load_eflags;
 195   eflg := eflg or EFLAGS_AC_BIT;
 196   io_store_eflags(eflg);
 197   eflg := io_load_eflags();
 198   if (eflg and EFLAGS_AC_BIT) <> 0 then
 199     flag486 := 1;
 200   eflg := eflg and EFLAGS_AC_BIT;
 201   io_store_eflags(eflg);
 202   if flag486 <> 0 then
 203   begin
 204     cr0 := load_cr0();
 205     cr0 := cr0 or CR0_CASH_DISABLE;
 206     store_cr0(cr0);
 207   end;
 208   result := memtest_sub(start, endpos);
 209   if flag486 <> 0 then
 210   begin
 211     cr0 := load_cr0();
 212     cr0 := cr0 and CR0_CASH_DISABLE;
 213     store_cr0(cr0);
 214   end;
 215 end;
 216
 217 function TMemtest.memtest_sub(start, endpos: Cardinal): Cardinal;
 218 const
 219   pat0 = $AA55AA55;
 220   pat1 = $55AA55AA;
 221 var
 222   i, old: UInt32;
 223   p: ^UInt32;
 224 begin
 225   i := start;
 226   while i <= endpos do
 227   begin
 228     p := Pointer(i + $FFC);
 229     old := p^;
 230     p^ := pat0;
 231     p^ := p^ XOR $FFFFFFFF;
 232     if p^ <> pat1 then
 233     begin
 234       p^ := old;
 235       break;
 236     end;
 237     p^ := p^ XOR $FFFFFFFF;
 238     if p^ <> pat0 then
 239     begin
 240       p^ := old;
 241       break;
 242     end;
 243     p^ := old;
 244     inc(i, $1000);
 245   end;
 246   result := i;
 247 end;
 248
 249 { TMem }
 250
 251 function TMem.alloc(mem: TMEMMAN; size: Cardinal): Cardinal;
 252 var
 253   i: integer;
 254   s: TFREEINFO;
 255 begin
 256   result := 0;
 257   for i := 0 to mem.free.Count - 1 do
 258     if mem.free[i].size >= size then
 259     begin
 260       s := mem.free[i];
 261       result := s.addr;
 262       inc(s.addr, size);
 263       dec(s.size, size);
 264       if s.size = 0 then
 265         mem.free.delete(i)
 266       else
 267         mem.free[i] := s;
 268       break;
 269     end;
 270 end;
 271
 272 procedure TMem.Init(mem: TMEMMAN);
 273 begin
 274   mem.free.Clear;
 275   mem.maxfrees := 0;
 276   mem.lostsize := 0;
 277   mem.losts := 0;
 278 end;
 279
 280 function TMem.memfree(mem: TMEMMAN; addr, size: Cardinal): integer;
 281 var
 282   i, j: integer;
 283   s: TFREEINFO;
 284 begin
 285   j := 0;
 286   for i := 0 to mem.free.Count - 1 do
 287     if mem.free[i].addr > addr then
 288     begin
 289       j := i;
 290       break;
 291     end;
 292   if i > 0 then
 293     if mem.free[i - 1].addr + mem.free[i - 1].size = addr then
 294     begin
 295       s := mem.free[i - 1];
 296       inc(s.size, size);
 297       if addr + size = s.addr then
 298       begin
 299         inc(s.size, mem.free[i].size);
 300         mem.free.delete(i);
 301       end;
 302       mem.free[i - 1] := s;
 303       result := 0;
 304       Exit;
 305     end;
 306   if addr + size = mem.free[i].addr then
 307   begin
 308     s := mem.free[i];
 309     s.addr := addr;
 310     inc(s.size, size);
 311     mem.free[i] := s;
 312   end
 313   else
 314   begin
 315     s.addr := addr;
 316     s.size := size;
 317     mem.maxfrees := mem.free.Count;
 318     mem.free.Insert(i, s);
 319   end;
 320 end;
 321
 322 function TMem.total(mem: TMEMMAN): Cardinal;
 323 var
 324   i: integer;
 325 begin
 326   result := 0;
 327   for i := 0 to mem.free.Count - 1 do
 328     inc(result, mem.free[i].size);
 329 end;
 330
 331 { TMEMMAN }
 332
 333 constructor TMEMMAN.Create;
 334 begin
 335   inherited;
 336   free := TList<TFREEINFO>.Create;
 337 end;
 338
 339 destructor TMEMMAN.Destroy;
 340 begin
 341   free.free;
 342   inherited;
 343 end;
 344
 345 { TMouse }
 346
 347 constructor TMouse.Create(fifo: TFifo; data0: integer);
 348 begin
 349   inherited Create;
 350   mousedata := data0;
 351   Self.fifo := fifo;
 352   wait_KBC_sendready();
 353   io_out8(PORT_KEYCMD, KEYCMD_SENDTO_MOUSE);
 354   wait_KBC_sendready();
 355   io_out8(PORT_KEYDAT, MOUSECMD_ENABLE);
 356   dec.phase := 0;
 357 end;
 358
 359 function TMouse.decode(dat: UInt8): integer;
 360 begin
 361   result := 0;
 362   case dec.phase of
 363     0:
 364       if dat = $FA then
 365         with dec do
 366           phase := 1;
 367     1:
 368       if (dat and $CB) = $08 then
 369         with dec do
 370         begin
 371           buf[0] := dat;
 372           phase := 2;
 373         end;
 374     2:
 375       with dec do
 376       begin
 377         buf[1] := dat;
 378         phase := 3;
 379       end;
 380     3:
 381       begin
 382         with dec do
 383         begin
 384           buf[2] := dat;
 385           phase := 1;
 386           btn := dec.buf[0] and $07;
 387           x := dec.buf[1];
 388           y := dec.buf[2];
 389           if (buf[0] and $10) <> 0 then
 390             x := x or $FFFFFF00;
 391           if (buf[0] and $20) <> 0 then
 392             y := y or $FFFFFF00;
 393           y := -y;
 394         end;
 395         result := 1;
 396       end;
 397   else
 398     result := -1;
 399   end;
 400 end;
 401
 402 procedure TMouse.inthandler21(var esp: integer);
 403 var
 404   i: integer;
 405 begin
 406   io_out8(PIC1_OCW2, $64);
 407   io_out8(PIC0_OCW2, $62);
 408   i := io_in8(PORT_KEYDAT);
 409   fifo.Put(i + mousedata);
 410 end;
 411
 412 { TDevice }
 413
 414 procedure TDevice.wait_KBC_sendready;
 415 begin
 416   while True do
 417     if io_in8(PORT_KEYSTA) and KEYSTA_SEND_NOTREADY = 0 then
 418       break;
 419 end;
 420
 421 { TKeyboard }
 422
 423 constructor TKeyboard.Create(fifo: TFifo; data0: integer);
 424 begin
 425   inherited Create;
 426   Self.fifo := fifo;
 427   keydata := data0;
 428   wait_KBC_sendready;
 429   io_out8(PORT_KEYCMD, KEYCMD_WRITE_MODE);
 430   wait_KBC_sendready;
 431   io_out8(PORT_KEYDAT, KBC_MODE);
 432   make_table([0, 0, '1', '2', '3', '4', '5', '6', '7', '8', '9', '0', '-', '^',
 433     $08, 0, 'Q', 'W', 'E', 'R', 'T', 'Y', 'U', 'I', 'O', 'P', '@', '[', $0A, 0,
 434     'A', 'S', 'D', 'F', 'G', 'H', 'J', 'K', 'L', ';', ':', 0, 0, ']', 'Z', 'X',
 435     'C', 'V', 'B', 'N', 'M', ',', '.', '/', 0, '*', 0, ' ', 0, 0, 0, 0, 0, 0, 0,
 436     0, 0, 0, 0, 0, 0, '7', '8', '9', '-', '4', '5', '6', '+', '1', '2', '3',
 437     '0', '.', 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
 438     0, 0, 0, 0, 0, 0, 0, 0, 0, $5C, 0, 0, 0, 0, 0, 0, 0, 0, 0, $5C, 0, 0],
 439     [0, 0, '!', $22, '#', '$', '%', '&', $27, '(', ')', '~', '=', '~', $08, 0,
 440     'Q', 'W', 'E', 'R', 'T', 'Y', 'U', 'I', 'O', 'P', '`', '{', $0A, 0, 'A',
 441     'S', 'D', 'F', 'G', 'H', 'J', 'K', 'L', '+', '*', 0, 0, '}', 'Z', 'X', 'C',
 442     'V', 'B', 'N', 'M', '<', '>', '?', 0, '*', 0, ' ', 0, 0, 0, 0, 0, 0, 0, 0,
 443     0, 0, 0, 0, 0, '7', '8', '9', '-', '4', '5', '6', '+', '1', '2', '3', '0',
 444     '.', 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
 445     0, 0, 0, 0, 0, 0, 0, '_', 0, 0, 0, 0, 0, 0, 0, 0, 0, '|', 0, 0]);
 446 end;
 447
 448 procedure TKeyboard.inthandler21(var esp: integer);
 449 var
 450   i: UInt8;
 451 begin
 452   io_out8(PIC0_OCW2, $61);
 453   i := io_in8(PORT_KEYDAT);
 454   fifo.Put(i + keydata);
 455 end;
 456
 457 procedure TKeyboard.make_table(const keys1, keys2: array of const);
 458 var
 459   i: integer;
 460 begin
 461   for i := 0 to High(keys1) do
 462     keytable0[i] := keys1[i].VType;
 463   for i := 0 to High(keys2) do
 464     keytable1[i] := keys2[i].VType;
 465 end;
 466
 467 end.