bootpack.pas

   1 unit bootpack;
   2
   3 interface
   4
   5 uses
   6   System.Classes, System.Generics.Collections, System.SysUtils, System.Types,
   7   files;
   8
   9 const
  10   COL8_000000 = 0;
  11   COL8_FF0000 = 1;
  12   COL8_00FF00 = 2;
  13   COL8_FFFF00 = 3;
  14   COL8_0000FF = 4;
  15   COL8_FF00FF = 5;
  16   COL8_00FFFF = 6;
  17   COL8_FFFFFF = 7;
  18   COL8_C6C6C6 = 8;
  19   COL8_840000 = 9;
  20   COL8_008400 = 10;
  21   COL8_848400 = 11;
  22   COL8_000084 = 12;
  23   COL8_840084 = 13;
  24   COL8_008484 = 14;
  25   COL8_848484 = 15;
  26
  27 type
  28   TBOOTINFO = record
  29     cyls, leds, vmode, reserve: Int8;
  30     scrnx, scrny: Int16;
  31     vram: TBytes;
  32   end;
  33
  34   TTimer = class
  35   private
  36     timeout: integer;
  37     data: integer;
  38     procedure settime(priority: integer);
  39   public
  40     constructor Create(data0: integer);
  41   end;
  42
  43   TSS32 = record
  44     backlink, esp0, ss0, esp1, ss1, esp2, ss2, cr3: integer;
  45     eip, esp: Pointer;
  46     eflags, eax, ecx, edx, ebx, ebp, esi, edi: integer;
  47     es, cs, ss, ds, fs, gs: integer;
  48     ldtr, iomap: integer;
  49   end;
  50
  51   TTask = class
  52   private
  53     sel, flags: integer;
  54     priority, level: integer;
  55     tss: TSS32;
  56     lv_change: Boolean;
  57   public
  58     constructor Create;
  59     procedure run(level, priority: integer);
  60   end;
  61
  62   TIdle = class(TTask)
  63   public
  64     constructor Create;
  65   end;
  66
  67   TFifo = class
  68   private
  69     buf: array of UInt32;
  70     p, q, size, space, flags: integer;
  71     task: TTask;
  72   public
  73     constructor Create(size: integer);
  74     destructor Destroy; override;
  75     function Put(data: integer): Boolean;
  76     function Get: SmallInt;
  77     function Status: integer;
  78   end;
  79
  80   TDevice = class
  81   const
  82     PORT_KEYDAT = $0060;
  83     PORT_KEYSTA = $0064;
  84     PORT_KEYCMD = $0064;
  85     KEYSTA_SEND_NOTREADY = $02;
  86     KEYCMD_WRITE_MODE = $60;
  87     KBC_MODE = $47;
  88   private
  89     fifo: TFifo;
  90   public
  91     procedure wait_KBC_sendready;
  92     procedure inthandler21(var esp: integer); virtual; abstract;
  93   end;
  94
  95   TKeyboard = class(TDevice)
  96   private
  97     keydata: integer;
  98     procedure make_table(const keys1, keys2: array of const);
  99   public
 100     keytable0, keytable1: array [$00 .. $80] of Byte;
 101     constructor Create(fifo: TFifo; data0: integer);
 102     procedure inthandler21(var esp: integer); override;
 103   end;
 104
 105   TMOUSE_DEC = record
 106     buf: array [0 .. 2] of Byte;
 107     phase: Byte;
 108     x, y, btn: UInt32;
 109   end;
 110
 111   TMouse = class(TDevice)
 112   const
 113     KEYCMD_SENDTO_MOUSE = $D4;
 114     MOUSECMD_ENABLE = $F4;
 115   private
 116     mousedata: integer;
 117   public
 118     dec: TMOUSE_DEC;
 119     constructor Create(fifo: TFifo; data0: integer);
 120     function decode(dat: UInt8): integer;
 121     procedure inthandler21(var esp: integer); override;
 122   end;
 123
 124   TTaskCtl = class(TList)
 125     now: integer;
 126   end;
 127
 128   TCtl = class
 129   private const
 130     MAX_TASKLEVELS = 10;
 131     MAX_TIMER = 500;
 132     procedure taskswitchsub;
 133
 134   var
 135     list: TList;
 136     buf: array [0 .. MAX_TASKLEVELS - 1] of TTask;
 137     task: array [0 .. MAX_TASKLEVELS] of TTaskCtl;
 138     count: integer;
 139     next: integer;
 140     top: integer;
 141     now_lv: integer;
 142     ts: integer;
 143     mt_timer: TTimer;
 144     procedure inthandler20(var esp: integer);
 145   public
 146     fifo: TFifo;
 147     constructor Create(fifo: TFifo);
 148     destructor Destroy; override;
 149     function run(level, priority: integer): TTask;
 150     procedure remove(task: TTask);
 151     procedure sleep(task: TTask);
 152     function now: TTask;
 153     procedure taskswitch;
 154     function settime(data: integer; timeout: integer): TTimer;
 155   end;
 156
 157   TMemtest = class
 158   private
 159     function memtest_sub(start, endpos: Cardinal): Cardinal;
 160   public
 161     function memtest(start, endpos: Cardinal): Cardinal;
 162   end;
 163
 164   TFREEINFO = record
 165     addr, size: UInt32;
 166   end;
 167
 168   TMEMMAN = class
 169   public
 170     frees, maxfrees, lostsize, losts: integer;
 171     free: TList<TFREEINFO>;
 172     constructor Create;
 173     destructor Destroy; override;
 174   end;
 175
 176   TMem = class
 177   public
 178     procedure Init(mem: TMEMMAN);
 179     function total(mem: TMEMMAN): UInt32;
 180     function alloc(mem: TMEMMAN; size: UInt32): UInt32;
 181     function memfree(mem: TMEMMAN; addr, size: Cardinal): integer;
 182   end;
 183
 184   TDesk = class
 185   public
 186     constructor Create;
 187   end;
 188
 189   TPic = class
 190   public
 191     constructor Create;
 192     procedure inthandler27(var esp: integer);
 193   end;
 194
 195   TRefresh = procedure(Sender: TObject) of object;
 196
 197   TSheet = class
 198   private const
 199     table: array [0 .. 14, 0 .. 2] of Byte = (($00, $00, $00), ($FF, $00, $00),
 200       ($00, $FF, $00), ($FF, $FF, $00), ($00, $00, $FF), ($FF, $00, $FF),
 201       ($00, $FF, $FF), ($C6, $C6, $C6), ($84, $00, $00), ($00, $84, $00),
 202       ($84, $84, $00), ($00, $00, $84), ($84, $00, $84), ($00, $84, $84),
 203       ($84, $84, $84));
 204
 205   var
 206     vram: TBytes;
 207     procedure putfont8(x, y: integer; c: Int8; font: PChar);
 208     procedure putfonts8_asc(x, y: integer; c: Int8; s: string);
 209   public
 210     cursor_c: integer;
 211     cursor_x: integer;
 212     bxsize, bysize, vx0, vy0, col_inv, flags: integer;
 213     visible: Boolean;
 214     hankaku: TResourceStream;
 215     clip: TRect;
 216     OnRefresh: TRefresh;
 217     constructor Create(x, y, act: integer);
 218     destructor Destroy; override;
 219     procedure boxfill8(c: UInt8; x0, y0, x1, y1: integer); overload;
 220     procedure boxfill8(c: UInt8; rect: TRect); overload;
 221     procedure setp(start, endpos: integer; rgb: TBytes);
 222     procedure putfonts8_asc_sht(x, y: integer; font: string;
 223       const back: integer = COL8_000000; const color: integer = COL8_FFFFFF);
 224   end;
 225
 226   TCursor = class(TSheet)
 227   public
 228     constructor Create(x, y, act: integer);
 229   end;
 230
 231   TScreen = class(TSheet)
 232   public
 233     constructor Create(x, y, act: integer);
 234   end;
 235
 236   TWindow = class(TScreen)
 237   private
 238     procedure wintitl(title: string; act: integer);
 239   public
 240     constructor Create(xsize, ysize: integer; title: string; act: integer);
 241   end;
 242
 243   TConsole = class(TWindow)
 244   private
 245     ctl: TCtl;
 246     info: array of TFileInfo;
 247     procedure newline;
 248     procedure putchar(ch: Char; move: integer);
 249     procedure putstr0(str: string);
 250     procedure putstrl(str: string; length: integer);
 251   public
 252     fifo: TFifo;
 253     cursor_y: integer;
 254     files: TFiles;
 255     constructor Create(xsize, ysize: integer; title: string; act: integer);
 256     destructor Destroy; override;
 257     procedure cmd_ls;
 258     procedure cmd_type(param: string);
 259     procedure cmd_mem;
 260     procedure cmd_cls;
 261   end;
 262
 263   TShtCtl = class
 264   private const
 265     SHEET_USE = 1;
 266     procedure refreshmap(arect: TRect);
 267     procedure refreshsub(arect: TRect);
 268   public
 269     vram, map: TBytes;
 270     col_inv: integer;
 271     xsize, ysize: integer;
 272     top: integer;
 273     sheets: TList;
 274     screen: TScreen;
 275     constructor Create(x, y: integer);
 276     destructor Destroy; override;
 277     procedure updown(sheet: TSheet; height: integer);
 278     procedure refresh(bx0, by0, bx1, by1: integer); overload;
 279     procedure refresh(Sender: TObject); overload;
 280     procedure slide(sheet: TSheet; x, y: integer);
 281     procedure delete(index: integer);
 282     procedure add(sheet: TSheet);
 283   end;
 284
 285 const
 286   FLAGSOVERRUN = $0001;
 287
 288   PIC0_ICW1 = $0020;
 289   PIC0_OCW2 = $0020;
 290   PIC0_IMR = $0021;
 291   PIC0_ICW2 = $0021;
 292   PIC0_ICW3 = $0021;
 293   PIC0_ICW4 = $0021;
 294   PIC1_ICW1 = $00A0;
 295   PIC1_OCW2 = $00A0;
 296   PIC1_IMR = $00A1;
 297   PIC1_ICW2 = $00A1;
 298   PIC1_ICW3 = $00A1;
 299   PIC1_ICW4 = $00A1;
 300
 301   ADR_BOOTINFO = $00000FF0;
 302   ADR_IDT = $0026F800;
 303   LIMIT_IDT = $000007FF;
 304   ADR_GDT = $00270000;
 305   LIMIT_GDT = $0000FFFF;
 306   ADR_BOTPAK = $00280000;
 307   LIMIT_BOTPAK = $0007FFFF;
 308   AR_DATA32_RW = $4092;
 309   AR_CODE32_ER = $409A;
 310   AR_TSS32 = $0089;
 311   AR_INTGATE32 = $008E;
 312   ADR_DISKIMG = 0;
 313
 314 implementation
 315
 316 uses asmhead, func;
 317
 318 const
 319   PIT_CTRL = $0043;
 320   PIT_CNT0 = $0040;
 321
 322   { TTimer }
 323
 324 constructor TTimer.Create(data0: integer);
 325 begin
 326   inherited Create;
 327   io_out8(PIT_CTRL, $34);
 328   io_out8(PIT_CNT0, $9C);
 329   io_out8(PIT_CNT0, $2E);
 330   data := data0;
 331   timeout := 0;
 332 end;
 333
 334 procedure TTimer.settime(priority: integer);
 335 begin
 336   Self.timeout := priority;
 337 end;
 338
 339 { TTask }
 340
 341 constructor TTask.Create;
 342 begin
 343   inherited;
 344   priority := 2;
 345   flags := 1;
 346   with tss do
 347   begin
 348     ldtr := 0;
 349     iomap := $40000000;
 350     eflags := $00000202;
 351     eax := 0;
 352     ecx := 0;
 353     edx := 0;
 354     ebx := 0;
 355     ebp := 0;
 356     esi := 0;
 357     edi := 0;
 358     es := 0;
 359     cs := 0;
 360     ss := 0;
 361     ds := 0;
 362     fs := 0;
 363     gs := 0;
 364   end;
 365 end;
 366
 367 procedure TTask.run(level, priority: integer);
 368 begin
 369   if level < 0 then
 370     level := Self.level;
 371   if priority > 0 then
 372     Self.priority := priority;
 373   if (flags = 2) and (Self.level <> level) then
 374     flags := 1;
 375   if flags <> 2 then
 376   begin
 377     Self.level := level;
 378     lv_change := true;
 379   end
 380   else
 381     lv_change := false;
 382 end;
 383
 384 { TFifo }
 385
 386 destructor TFifo.Destroy;
 387 begin
 388   Finalize(buf);
 389   inherited;
 390 end;
 391
 392 function TFifo.Get: SmallInt;
 393 begin
 394   if space = size then
 395   begin
 396     result := -1;
 397     Exit;
 398   end;
 399   result := buf[q];
 400   inc(q);
 401   if q = size then
 402     q := 0;
 403   inc(space);
 404 end;
 405
 406 constructor TFifo.Create(size: integer);
 407 begin
 408   inherited Create;
 409   SetLength(buf, size);
 410   size := size;
 411   space := size;
 412   flags := 0;
 413   p := 0;
 414   q := 0;
 415 end;
 416
 417 function TFifo.Put(data: integer): Boolean;
 418 begin
 419   if space = 0 then
 420   begin
 421     flags := FLAGSOVERRUN;
 422     result := false;
 423     Exit;
 424   end;
 425   buf[p] := data;
 426   inc(p);
 427   if p = size then
 428     p := 0;
 429   dec(space);
 430   if (task <> nil) and (task.flags <> 2) then
 431     task.run(-1, 0);
 432   result := true;
 433 end;
 434
 435 function TFifo.Status: integer;
 436 begin
 437   result := size - space;
 438 end;
 439
 440 { TMemtest }
 441
 442 function TMemtest.memtest(start, endpos: Cardinal): Cardinal;
 443 const
 444   EFLAGS_AC_BIT = $00040000;
 445   CR0_CASH_DISABLE = $60000000;
 446 var
 447   flag486: UInt8;
 448   eflg, cr0: UInt32;
 449 begin
 450   flag486 := 0;
 451   eflg := io_load_eflags;
 452   eflg := eflg or EFLAGS_AC_BIT;
 453   io_store_eflags(eflg);
 454   eflg := io_load_eflags();
 455   if (eflg and EFLAGS_AC_BIT) <> 0 then
 456     flag486 := 1;
 457   eflg := eflg and EFLAGS_AC_BIT;
 458   io_store_eflags(eflg);
 459   if flag486 <> 0 then
 460   begin
 461     cr0 := load_cr0();
 462     cr0 := cr0 or CR0_CASH_DISABLE;
 463     store_cr0(cr0);
 464   end;
 465   result := memtest_sub(start, endpos);
 466   if flag486 <> 0 then
 467   begin
 468     cr0 := load_cr0();
 469     cr0 := cr0 and CR0_CASH_DISABLE;
 470     store_cr0(cr0);
 471   end;
 472 end;
 473
 474 function TMemtest.memtest_sub(start, endpos: Cardinal): Cardinal;
 475 const
 476   pat0 = $AA55AA55;
 477   pat1 = $55AA55AA;
 478 var
 479   i, old: UInt32;
 480   p: ^UInt32;
 481 begin
 482   i := start;
 483   while i <= endpos do
 484   begin
 485     p := Pointer(i + $FFC);
 486     old := p^;
 487     p^ := pat0;
 488     p^ := p^ XOR $FFFFFFFF;
 489     if p^ <> pat1 then
 490     begin
 491       p^ := old;
 492       break;
 493     end;
 494     p^ := p^ XOR $FFFFFFFF;
 495     if p^ <> pat0 then
 496     begin
 497       p^ := old;
 498       break;
 499     end;
 500     p^ := old;
 501     inc(i, $1000);
 502   end;
 503   result := i;
 504 end;
 505
 506 { TMem }
 507
 508 function TMem.alloc(mem: TMEMMAN; size: UInt32): UInt32;
 509 var
 510   i: integer;
 511   s: TFREEINFO;
 512 begin
 513   result := 0;
 514   for i := 0 to mem.free.count - 1 do
 515     if mem.free[i].size >= size then
 516     begin
 517       s := mem.free[i];
 518       result := s.addr;
 519       inc(s.addr, size);
 520       dec(s.size, size);
 521       if s.size = 0 then
 522         mem.free.delete(i)
 523       else
 524         mem.free[i] := s;
 525       break;
 526     end;
 527 end;
 528
 529 procedure TMem.Init(mem: TMEMMAN);
 530 begin
 531   mem.free.Clear;
 532   mem.maxfrees := 0;
 533   mem.lostsize := 0;
 534   mem.losts := 0;
 535 end;
 536
 537 function TMem.memfree(mem: TMEMMAN; addr, size: Cardinal): integer;
 538 var
 539   i, j: integer;
 540   s: TFREEINFO;
 541 begin
 542   j := 0;
 543   for i := 0 to mem.free.count - 1 do
 544     if mem.free[i].addr > addr then
 545     begin
 546       j := i;
 547       break;
 548     end;
 549   if i > 0 then
 550     if mem.free[i - 1].addr + mem.free[i - 1].size = addr then
 551     begin
 552       s := mem.free[i - 1];
 553       inc(s.size, size);
 554       if addr + size = s.addr then
 555       begin
 556         inc(s.size, mem.free[i].size);
 557         mem.free.delete(i);
 558       end;
 559       mem.free[i - 1] := s;
 560       result := 0;
 561       Exit;
 562     end;
 563   if addr + size = mem.free[i].addr then
 564   begin
 565     s := mem.free[i];
 566     s.addr := addr;
 567     inc(s.size, size);
 568     mem.free[i] := s;
 569   end
 570   else
 571   begin
 572     s.addr := addr;
 573     s.size := size;
 574     mem.maxfrees := mem.free.count;
 575     mem.free.Insert(i, s);
 576   end;
 577 end;
 578
 579 function TMem.total(mem: TMEMMAN): UInt32;
 580 var
 581   i: integer;
 582 begin
 583   result := 0;
 584   for i := 0 to mem.free.count - 1 do
 585     inc(result, mem.free[i].size);
 586 end;
 587
 588 { TMEMMAN }
 589
 590 constructor TMEMMAN.Create;
 591 begin
 592   inherited;
 593   free := TList<TFREEINFO>.Create;
 594 end;
 595
 596 destructor TMEMMAN.Destroy;
 597 begin
 598   free.free;
 599   inherited;
 600 end;
 601
 602 { TMouse }
 603
 604 constructor TMouse.Create(fifo: TFifo; data0: integer);
 605 begin
 606   inherited Create;
 607   mousedata := data0;
 608   Self.fifo := fifo;
 609   wait_KBC_sendready();
 610   io_out8(PORT_KEYCMD, KEYCMD_SENDTO_MOUSE);
 611   wait_KBC_sendready();
 612   io_out8(PORT_KEYDAT, MOUSECMD_ENABLE);
 613   dec.phase := 0;
 614 end;
 615
 616 function TMouse.decode(dat: UInt8): integer;
 617 begin
 618   result := 0;
 619   case dec.phase of
 620     0:
 621       if dat = $FA then
 622         with dec do
 623           phase := 1;
 624     1:
 625       if (dat and $CB) = $08 then
 626         with dec do
 627         begin
 628           buf[0] := dat;
 629           phase := 2;
 630         end;
 631     2:
 632       with dec do
 633       begin
 634         buf[1] := dat;
 635         phase := 3;
 636       end;
 637     3:
 638       begin
 639         with dec do
 640         begin
 641           buf[2] := dat;
 642           phase := 1;
 643           btn := dec.buf[0] and $07;
 644           x := dec.buf[1];
 645           y := dec.buf[2];
 646           if (buf[0] and $10) <> 0 then
 647             x := x or $FFFFFF00;
 648           if (buf[0] and $20) <> 0 then
 649             y := y or $FFFFFF00;
 650           y := -y;
 651         end;
 652         result := 1;
 653       end;
 654   else
 655     result := -1;
 656   end;
 657 end;
 658
 659 procedure TMouse.inthandler21(var esp: integer);
 660 var
 661   i: integer;
 662 begin
 663   io_out8(PIC1_OCW2, $64);
 664   io_out8(PIC0_OCW2, $62);
 665   i := io_in8(PORT_KEYDAT);
 666   fifo.Put(i + mousedata);
 667 end;
 668
 669 { TDevice }
 670
 671 procedure TDevice.wait_KBC_sendready;
 672 begin
 673   while true do
 674     if io_in8(PORT_KEYSTA) and KEYSTA_SEND_NOTREADY = 0 then
 675       break;
 676 end;
 677
 678 { TKeyboard }
 679
 680 constructor TKeyboard.Create(fifo: TFifo; data0: integer);
 681 begin
 682   inherited Create;
 683   Self.fifo := fifo;
 684   keydata := data0;
 685   wait_KBC_sendready;
 686   io_out8(PORT_KEYCMD, KEYCMD_WRITE_MODE);
 687   wait_KBC_sendready;
 688   io_out8(PORT_KEYDAT, KBC_MODE);
 689   make_table([0, 0, '1', '2', '3', '4', '5', '6', '7', '8', '9', '0', '-', '^',
 690     $08, 0, 'Q', 'W', 'E', 'R', 'T', 'Y', 'U', 'I', 'O', 'P', '@', '[', $0A, 0,
 691     'A', 'S', 'D', 'F', 'G', 'H', 'J', 'K', 'L', ';', ':', 0, 0, ']', 'Z', 'X',
 692     'C', 'V', 'B', 'N', 'M', ',', '.', '/', 0, '*', 0, ' ', 0, 0, 0, 0, 0, 0, 0,
 693     0, 0, 0, 0, 0, 0, '7', '8', '9', '-', '4', '5', '6', '+', '1', '2', '3',
 694     '0', '.', 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
 695     0, 0, 0, 0, 0, 0, 0, 0, 0, $5C, 0, 0, 0, 0, 0, 0, 0, 0, 0, $5C, 0, 0],
 696     [0, 0, '!', $22, '#', '$', '%', '&', $27, '(', ')', '~', '=', '~', $08, 0,
 697     'Q', 'W', 'E', 'R', 'T', 'Y', 'U', 'I', 'O', 'P', '`', '{', $0A, 0, 'A',
 698     'S', 'D', 'F', 'G', 'H', 'J', 'K', 'L', '+', '*', 0, 0, '}', 'Z', 'X', 'C',
 699     'V', 'B', 'N', 'M', '<', '>', '?', 0, '*', 0, ' ', 0, 0, 0, 0, 0, 0, 0, 0,
 700     0, 0, 0, 0, 0, '7', '8', '9', '-', '4', '5', '6', '+', '1', '2', '3', '0',
 701     '.', 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
 702     0, 0, 0, 0, 0, 0, 0, '_', 0, 0, 0, 0, 0, 0, 0, 0, 0, '|', 0, 0]);
 703 end;
 704
 705 procedure TKeyboard.inthandler21(var esp: integer);
 706 var
 707   i: UInt8;
 708 begin
 709   io_out8(PIC0_OCW2, $61);
 710   i := io_in8(PORT_KEYDAT);
 711   fifo.Put(i + keydata);
 712 end;
 713
 714 procedure TKeyboard.make_table(const keys1, keys2: array of const);
 715 var
 716   i: integer;
 717 begin
 718   for i := 0 to High(keys1) do
 719     keytable0[i] := keys1[i].VType;
 720   for i := 0 to High(keys2) do
 721     keytable1[i] := keys2[i].VType;
 722 end;
 723
 724 procedure init_pit(timerctl: TCtl);
 725 begin
 726
 727 end;
 728
 729 { TCtl }
 730
 731 procedure TCtl.inthandler20(var esp: integer);
 732 var
 733   i: integer;
 734   s: TTimer;
 735 begin
 736   io_out8(PIC0_OCW2, $60);
 737   inc(count);
 738   ts := 0;
 739   if next > count then
 740     Exit;
 741   for i := 0 to list.count - 1 do
 742   begin
 743     s := list[i];
 744     if s.timeout > count then
 745     begin
 746       s.free;
 747       list.delete(i);
 748       break;
 749     end;
 750     if s <> mt_timer then
 751       fifo.Put(s.data)
 752     else
 753       ts := 1;
 754   end;
 755   next := TTimer(list[0]).timeout;
 756   if ts <> 0 then
 757     taskswitch;
 758 end;
 759
 760 function TCtl.now: TTask;
 761 begin
 762   result := task[now_lv].Items[top];
 763 end;
 764
 765 procedure TCtl.remove(task: TTask);
 766 var
 767   i: integer;
 768   j: integer;
 769   s: TTaskCtl;
 770 begin
 771   for i := 0 to High(Self.task) do
 772   begin
 773     s := Self.task[i];
 774     for j := 0 to Self.task[i].count - 1 do
 775       if s[j] = task then
 776         s.delete(j);
 777   end;
 778   if s.now >= s.count then
 779     s.now := 0;
 780   task.flags := 1;
 781 end;
 782
 783 function TCtl.run(level, priority: integer): TTask;
 784 var
 785   i: integer;
 786 begin
 787   result := nil;
 788   for i := 0 to High(buf) do
 789     if buf[i].flags = 1 then
 790     begin
 791       result := buf[i];
 792       break;
 793     end;
 794   if level >= 0 then
 795     result.level := level;
 796   if priority > 0 then
 797     result.priority := priority;
 798   result.flags := 2;
 799   task[result.level].add(result);
 800 end;
 801
 802 constructor TCtl.Create(fifo: TFifo);
 803 var
 804   i, j: integer;
 805   s, s0: TTask;
 806 begin
 807   inherited Create;
 808   j := High(buf);
 809   for i := 0 to j - 1 do
 810     buf[i] := TTask.Create;
 811   buf[j] := TIdle.Create;
 812   s0 := buf[j];
 813   list := TList.Create;
 814   for i := 0 to High(task) do
 815     task[i] := TTaskCtl.Create;
 816   s := buf[0];
 817   s.flags := 2;
 818   s.priority := 2;
 819   s.level := 0;
 820   Self.fifo := fifo;
 821   fifo.task := s;
 822   task[s.level].add(s);
 823   s.tss.eip := s;
 824   taskswitchsub;
 825   load_tr(s.sel);
 826   mt_timer := settime(0, s.priority);
 827   s0.run(MAX_TASKLEVELS - 1, 1);
 828   task[s.level].add(s0);
 829 end;
 830
 831 destructor TCtl.Destroy;
 832 var
 833   i: integer;
 834   s: TObject;
 835 begin
 836   for i := 0 to High(buf) do
 837     buf[i].free;
 838   for i := 0 to list.count - 1 do
 839   begin
 840     s := list[i];
 841     s.free;
 842   end;
 843   for i := 0 to High(task) do
 844     task[i].free;
 845   list.free;
 846   inherited;
 847 end;
 848
 849 function TCtl.settime(data: integer; timeout: integer): TTimer;
 850 var
 851   eflags: integer;
 852   s, timer: TTimer;
 853   i: integer;
 854 begin
 855   if list.count < MAX_TIMER then
 856   begin
 857     eflags := io_load_eflags;
 858     io_cli;
 859     timer := TTimer.Create(data);
 860     timer.settime(timeout + count);
 861     result := timer;
 862     for i := 0 to list.count - 1 do
 863     begin
 864       s := TTimer(list[i]);
 865       if s.timeout >= timer.timeout then
 866       begin
 867         list.Insert(i, timer);
 868         next := s.timeout;
 869         io_store_eflags(eflags);
 870         Exit;
 871       end;
 872     end;
 873     list.add(timer);
 874     io_store_eflags(eflags);
 875   end
 876   else
 877     result := nil;
 878 end;
 879
 880 procedure TCtl.sleep(task: TTask);
 881 var
 882   s: TTask;
 883 begin
 884   if task.flags = 2 then
 885   begin
 886     s := now;
 887     remove(task);
 888     if s = task then
 889     begin
 890       taskswitchsub;
 891       s := now;
 892       farjump(0, s.sel);
 893     end;
 894   end;
 895 end;
 896
 897 procedure TCtl.taskswitch;
 898 var
 899   i: integer;
 900   s: TTaskCtl;
 901   t1, t2: TTask;
 902   x: Boolean;
 903   j: integer;
 904 begin
 905   x := false;
 906   for i := 0 to High(task) do
 907   begin
 908     s := task[i];
 909     for j := 0 to s.count - 1 do
 910     begin
 911       t1 := s[j];
 912       if t1.lv_change = true then
 913       begin
 914         t1.lv_change := false;
 915         t1.run(-1, 0);
 916         x := true;
 917       end;
 918     end;
 919   end;
 920   s := task[now_lv];
 921   t1 := s[s.now];
 922   s.now := s.now + 1;
 923   if s.now = s.count then
 924     s.now := 0;
 925   if x = true then
 926   begin
 927     taskswitchsub;
 928     s := task[now_lv];
 929   end;
 930   t2 := s[s.now];
 931   mt_timer.settime(t2.priority);
 932   if t1 <> t2 then
 933     farjump(0, TTask(task[top]).sel);
 934 end;
 935
 936 procedure TCtl.taskswitchsub;
 937 var
 938   i: integer;
 939 begin
 940   for i := 0 to High(task) do
 941     if task[i].count > 0 then
 942       now_lv := i;
 943 end;
 944
 945 { TShtCtl }
 946
 947 constructor TShtCtl.Create(x, y: integer);
 948 begin
 949   sheets := TList.Create;
 950   SetLength(vram, x * y);
 951   SetLength(map, x * y);
 952   add(TScreen.Create(x, y, -1));
 953 end;
 954
 955 procedure TShtCtl.delete(index: integer);
 956 var
 957   s: TSheet;
 958 begin
 959   s := sheets[index];
 960   s.free;
 961   sheets.delete(index);
 962 end;
 963
 964 destructor TShtCtl.Destroy;
 965 begin
 966   screen.free;
 967   sheets.free;
 968   Finalize(vram);
 969   Finalize(map);
 970   inherited;
 971 end;
 972
 973 procedure TShtCtl.add(sheet: TSheet);
 974 begin
 975   sheets.add(sheet);
 976   sheet.OnRefresh := refresh;
 977   sheet.flags := SHEET_USE;
 978 end;
 979
 980 procedure TShtCtl.refresh(bx0, by0, bx1, by1: integer);
 981 var
 982   i: integer;
 983   arect: TRect;
 984   s: TSheet;
 985 begin
 986   arect := rect(bx0, by0, bx1, by1);
 987   if arect.Left < 0 then
 988     arect.Left := 0;
 989   if arect.Right >= xsize then
 990     arect.Right := xsize;
 991   if arect.top < 0 then
 992     arect.top := 0;
 993   if arect.Bottom >= ysize then
 994     arect.Bottom := ysize;
 995   for i := 0 to sheets.count - 1 do
 996   begin
 997     s := TSheet(sheets[i]);
 998     arect.Left := arect.Left - s.vx0;
 999     arect.Right := arect.Right - s.vx0;
1000     arect.top := arect.top - s.vy0;
1001     arect.Bottom := arect.Bottom - s.vy0;
1002     if arect.Left < 0 then
1003       arect.Left := 0;
1004     if arect.Right > xsize then
1005       arect.Right := xsize;
1006     if arect.top < 0 then
1007       arect.top := 0;
1008     if arect.Bottom > ysize then
1009       arect.Bottom := ysize;
1010     refreshmap(arect);
1011     refreshsub(arect);
1012   end;
1013 end;
1014
1015 procedure TShtCtl.refresh(Sender: TObject);
1016 var
1017   arect: TRect;
1018   obj: TSheet;
1019 begin
1020   obj := Sender as TSheet;
1021   if Assigned(obj.OnRefresh) = false then
1022     Exit;
1023   arect := obj.clip;
1024   refresh(arect.Left + obj.vx0, arect.top + obj.vy0, arect.Right + obj.vx0,
1025     arect.Bottom + obj.vy0);
1026 end;
1027
1028 procedure TShtCtl.refreshmap(arect: TRect);
1029 var
1030   i: integer;
1031   s: TSheet;
1032   x: integer;
1033   y: integer;
1034   bx0, by0, bx1, by1, vx, vy: integer;
1035 begin
1036   if arect.Left < 0 then
1037     arect.Left := 0;
1038   if arect.Right > xsize then
1039     arect.Right := xsize;
1040   if arect.top < 0 then
1041     arect.top := 0;
1042   if arect.Bottom > ysize then
1043     arect.Bottom := ysize;
1044   for i := top to sheets.count - 1 do
1045   begin
1046     s := TSheet(sheets[i]);
1047     if arect.Left < s.vx0 then
1048       bx0 := 0
1049     else
1050       bx0 := arect.Left;
1051     if arect.Right > s.vx0 + s.bxsize then
1052       bx1 := s.bxsize
1053     else
1054       bx1 := arect.Right;
1055     if arect.top < s.vy0 then
1056       by0 := 0
1057     else
1058       by0 := arect.top;
1059     if arect.Bottom > s.bysize then
1060       by1 := s.bysize
1061     else
1062       by1 := arect.Bottom;
1063     for y := by0 to by1 do
1064     begin
1065       vy := s.vy0 + y;
1066       for x := bx0 to bx1 do
1067       begin
1068         vx := s.vx0 + x;
1069         if s.vram[y * s.bxsize + x] <> s.col_inv then
1070           vram[vy * xsize + vx] := s.col_inv;
1071       end;
1072     end;
1073   end;
1074 end;
1075
1076 procedure TShtCtl.refreshsub(arect: TRect);
1077 var
1078   x, y, vx, vy: integer;
1079   c: integer;
1080   s: TSheet;
1081 begin
1082   c := -1;
1083   s := nil;
1084   for y := arect.top to arect.Bottom do
1085     for x := arect.Left to arect.Right do
1086     begin
1087       if c <> map[y * xsize + y] then
1088       begin
1089         c := map[y * xsize + x];
1090         s := sheets[c];
1091       end;
1092       vx := x - s.vx0;
1093       vy := y - s.vy0;
1094       vram[y * xsize + x] := s.vram[vy * s.bxsize + vx];
1095     end;
1096 end;
1097
1098 procedure TShtCtl.slide(sheet: TSheet; x, y: integer);
1099 var
1100   i, j: integer;
1101 begin
1102   i := sheet.vx0;
1103   j := sheet.vy0;
1104   sheet.vx0 := x;
1105   sheet.vy0 := y;
1106   if sheet.flags = SHEET_USE then
1107   begin
1108     refresh(i, j, i + sheet.bxsize, j + sheet.bysize);
1109     refresh(x, y, x + sheet.bxsize, y + sheet.bysize);
1110   end;
1111 end;
1112
1113 procedure TShtCtl.updown(sheet: TSheet; height: integer);
1114 var
1115   i, j: integer;
1116 begin
1117   j := -1;
1118   for i := 0 to sheets.count - 1 do
1119     if sheet = sheets[i] then
1120       j := i;
1121   if height >= sheets.count then
1122     height := sheets.count - 1;
1123   if height < -1 then
1124     height := -1;
1125   if (height >= 0) and (sheet.flags = SHEET_USE) then
1126     sheets.move(j, height);
1127 end;
1128
1129 { TPallet }
1130
1131 procedure TSheet.boxfill8(c: UInt8; x0, y0, x1, y1: integer);
1132 begin
1133   clip := rect(x0, y0, x1, y1);
1134   boxfill8(c, clip);
1135 end;
1136
1137 procedure TSheet.boxfill8(c: UInt8; rect: TRect);
1138 var
1139   x: integer;
1140   y: integer;
1141 begin
1142   for y := rect.top to rect.Bottom do
1143     for x := rect.Left to rect.Right do
1144       vram[y * bxsize + x] := c;
1145 end;
1146
1147 constructor TSheet.Create(x, y, act: integer);
1148 begin
1149   inherited Create;
1150   bxsize := x;
1151   SetLength(vram, x * y);
1152   setp(0, 15, TBytes(@table));
1153   hankaku := TResourceStream.Create(HInstance, 'hankaku', RT_RCDATA);
1154 end;
1155
1156 destructor TSheet.Destroy;
1157 begin
1158   hankaku.free;
1159   Finalize(vram);
1160   inherited;
1161 end;
1162
1163 procedure TSheet.putfont8(x, y: integer; c: Int8; font: PChar);
1164 var
1165   i: integer;
1166   p: TBytes;
1167   d: Byte;
1168 begin
1169   for i := 0 to 16 do
1170   begin
1171     p := TBytes(@vram[(y + i) * bxsize + x]);
1172     d := Byte(font[i]);
1173     if d and $80 <> 0 then
1174       p[0] := c;
1175     if d and $40 <> 0 then
1176       p[1] := c;
1177     if d and $20 <> 0 then
1178       p[2] := c;
1179     if d and $10 <> 0 then
1180       p[3] := c;
1181     if d and $08 <> 0 then
1182       p[4] := c;
1183     if d and $04 <> 0 then
1184       p[5] := c;
1185     if d and $02 <> 0 then
1186       p[6] := c;
1187     if d and $01 <> 0 then
1188       p[7] := c;
1189   end;
1190 end;
1191
1192 procedure TSheet.putfonts8_asc(x, y: integer; c: Int8; s: string);
1193 var
1194   i: integer;
1195   buf: array [0 .. 15] of Byte;
1196 begin
1197   s := LowerCase(s);
1198   for i := 1 to length(s) do
1199   begin
1200     hankaku.Write(TBytes(@buf), Ord(s[i]), 16);
1201     putfont8(x, y, c, PChar(@buf));
1202     inc(x, 8);
1203   end;
1204 end;
1205
1206 procedure TSheet.putfonts8_asc_sht(x, y: integer; font: string;
1207   const back: integer = COL8_000000; const color: integer = COL8_FFFFFF);
1208 begin
1209   clip := rect(x, y, x + bxsize * 8 - 1, y + 15);
1210   boxfill8(back, clip);
1211   putfonts8_asc(x, y, color, font);
1212   OnRefresh(Self);
1213 end;
1214
1215 procedure TSheet.setp(start, endpos: integer; rgb: TBytes);
1216 var
1217   eflags: integer;
1218   i, j: integer;
1219 begin
1220   eflags := io_load_eflags;
1221   io_cli;
1222   io_out8($03C8, start);
1223   j := 0;
1224   for i := start to endpos - 1 do
1225   begin
1226     io_out8($03C9, rgb[j + 0] div 4);
1227     io_out8($03C9, rgb[j + 1] div 4);
1228     io_out8($03C9, rgb[j + 2] div 4);
1229     inc(j, 3);
1230   end;
1231   io_store_eflags(eflags);
1232 end;
1233
1234 { TScreen }
1235
1236 constructor TScreen.Create(x, y, act: integer);
1237 begin
1238   inherited;
1239   boxfill8(COL8_008484, 0, 0, x - 1, y - 29);
1240   boxfill8(COL8_C6C6C6, 0, y - 28, x - 1, y - 28);
1241   boxfill8(COL8_FFFFFF, 0, y - 27, x - 1, y - 27);
1242   boxfill8(COL8_C6C6C6, 0, y - 26, x - 1, y - 1);
1243
1244   boxfill8(COL8_FFFFFF, 3, y - 24, 59, y - 24);
1245   boxfill8(COL8_FFFFFF, 2, y - 24, 2, y - 4);
1246   boxfill8(COL8_848484, 3, y - 4, 59, y - 4);
1247   boxfill8(COL8_848484, 59, y - 23, 59, y - 5);
1248   boxfill8(COL8_000000, 2, y - 3, 59, y - 3);
1249   boxfill8(COL8_000000, 60, y - 24, 60, y - 3);
1250
1251   boxfill8(COL8_848484, x - 47, y - 24, x - 4, y - 24);
1252   boxfill8(COL8_848484, x - 47, y - 23, x - 47, y - 4);
1253   boxfill8(COL8_FFFFFF, x - 47, y - 3, x - 4, y - 3);
1254   boxfill8(COL8_FFFFFF, x - 3, y - 24, x - 3, y - 3);
1255 end;
1256
1257 { TWindow }
1258
1259 constructor TWindow.Create(xsize, ysize: integer; title: string; act: integer);
1260 begin
1261   inherited Create(xsize, ysize, act);
1262   putfonts8_asc(24, 4, COL8_FFFFFF, title);
1263   boxfill8(COL8_C6C6C6, 0, 0, xsize - 1, 0);
1264   boxfill8(COL8_FFFFFF, 1, 1, xsize - 2, 1);
1265   boxfill8(COL8_C6C6C6, 0, 0, 0, ysize - 1);
1266   boxfill8(COL8_FFFFFF, 1, 1, 1, ysize - 2);
1267   boxfill8(COL8_848484, xsize - 2, 1, xsize - 2, ysize - 2);
1268   boxfill8(COL8_000000, xsize - 1, 0, xsize - 1, ysize - 1);
1269   boxfill8(COL8_C6C6C6, 2, 2, xsize - 3, ysize - 3);
1270   boxfill8(COL8_000084, 3, 3, xsize - 4, 20);
1271   boxfill8(COL8_848484, 1, ysize - 2, xsize - 2, ysize - 2);
1272   boxfill8(COL8_000000, 0, ysize - 1, xsize - 1, ysize - 1);
1273   wintitl(title, act);
1274 end;
1275
1276 procedure TWindow.wintitl(title: string; act: integer);
1277 const
1278   closebtn: array [0 .. 14] of string[16] = ( //
1279     ('000000000000000@'), //
1280     ('0QQQQQQQQQQQQQ$@'), //
1281     ('0QQQQQQQQQQQQQ$@'), //
1282     ('0QQQQQQQQQQQQQ$@'), //
1283     ('0QQQ@@QQQQ@@QQ$@'), //
1284     ('0QQQQ@@QQ@@QQQ$@'), //
1285     ('0QQQQQ@@@@QQQQ$@'), //
1286     ('0QQQQQQ@@QQQQQ$@'), //
1287     ('0QQQQQ@@@@QQQQ$@'), //
1288     ('00QQQ@@QQ@@QQQ$@'), //
1289     ('0QQQ@@QQQQ@@QQ$@'), //
1290     ('0QQQQQQQQQQQQQ$@'), //
1291     ('0QQQQQQQQQQQQQ$@'), //
1292     ('0$$$$$$$$$$$$$$@'), //
1293     ('@@@@@@@@@@@@@@@@') //
1294     );
1295 var
1296   y: integer;
1297   x: integer;
1298   c: AnsiChar;
1299   tc, tbc: UInt8;
1300   i: Byte;
1301 begin
1302   if act <> 0 then
1303   begin
1304     tc := COL8_FFFFFF;
1305     tbc := COL8_000084;
1306   end
1307   else
1308   begin
1309     tc := COL8_C6C6C6;
1310     tbc := COL8_848484;
1311   end;
1312   boxfill8(tbc, 3, 3, bxsize - 4, 20);
1313   putfonts8_asc(24, 4, tc, title);
1314   for y := 0 to 14 do
1315     for x := 1 to 16 do
1316     begin
1317       c := closebtn[y][x];
1318       case c of
1319         '@':
1320           i := COL8_000000;
1321         '$':
1322           i := COL8_848484;
1323         '0':
1324           i := COL8_C6C6C6;
1325       else
1326         i := COL8_FFFFFF;
1327       end;
1328       vram[(5 + y) * bxsize + (bxsize - 21 + x)] := i;
1329     end;
1330 end;
1331
1332 { TCursor }
1333
1334 constructor TCursor.Create(x, y, act: integer);
1335 const
1336   cursor: array [0 .. 15] of string[16] = ( //
1337     ('**************..'), //
1338     ('*00000000000*...'), //
1339     ('*0000000000*....'), //
1340     ('*000000000*.....'), //
1341     ('*00000000*......'), //
1342     ('*0000000*.......'), //
1343     ('*0000000*.......'), //
1344     ('*00000000*......'), //
1345     ('*0000**000*.....'), //
1346     ('*000*..*000*....'), //
1347     ('*00*....*000*...'), //
1348     ('*0*......*000*..'), //
1349     ('**........*000*.'), //
1350     ('*..........*000*'), //
1351     ('............*00*'), //
1352     ('.............***') //
1353     );
1354 var
1355   i: integer;
1356   j: integer;
1357 begin
1358   inherited;
1359   for j := 0 to y do
1360     for i := 0 to x do
1361       case cursor[j, i] of // x , y ?
1362         '*':
1363           vram[j * 16 + i] := COL8_000000;
1364         '0':
1365           vram[j * 16 + i] := COL8_FFFFFF;
1366         '.':
1367           vram[j * 16 + i] := act;
1368       end;
1369 end;
1370
1371 { TConsole }
1372
1373 procedure TConsole.cmd_type(param: string);
1374 var
1375   buf: TBytes;
1376   i: integer;
1377 begin
1378   i := files.search(Copy(param, 1, 5), info, 224);
1379   if i > -1 then
1380   begin
1381     GetMem(Pointer(buf), info[i].size);
1382     files.loadfile(info[i].clustno, info[i].size, buf,
1383       Pointer(ADR_DISKIMG + $003E00));
1384     putstrl(PChar(buf), info[i].size);
1385     FreeMem(Pointer(buf));
1386   end
1387   else
1388     putstr0('file not found.');
1389 end;
1390
1391 procedure TConsole.cmd_cls;
1392 begin
1393
1394 end;
1395
1396 constructor TConsole.Create(xsize, ysize: integer; title: string; act: integer);
1397 var
1398   i: integer;
1399   s: TTask;
1400   cmd: string;
1401   str: AnsiString;
1402   j: integer;
1403 begin
1404   inherited;
1405   s := ctl.now;
1406   fifo := TFifo.Create(128);
1407   fifo.task := s;
1408   files := TFiles.Create;
1409   cursor_x := 16;
1410   cursor_y := 28;
1411   cursor_c := COL8_000000;
1412   ctl.run(ctl.MAX_TASKLEVELS - 1, 1);
1413   s.tss.esp := vram;
1414   ctl := TCtl.Create(fifo);
1415   ctl.settime(0, 50);
1416   info := Pointer(ADR_DISKIMG + $002600);
1417   while true do
1418   begin
1419     io_cli;
1420     if fifo.Status = 0 then
1421     begin
1422       s := ctl.now;
1423       ctl.sleep(s);
1424       io_sti;
1425     end
1426     else
1427     begin
1428       i := fifo.Get;
1429       io_sti;
1430       if i <= 1 then
1431       begin
1432         if i <> 0 then
1433         begin
1434           ctl.settime(0, 50);
1435           cursor_c := COL8_FFFFFF;
1436         end
1437         else
1438         begin
1439           ctl.settime(1, 50);
1440           cursor_c := COL8_000000;
1441         end;
1442         boxfill8(cursor_c, cursor_x, 28, cursor_x + 7, 43);
1443         clip := rect(cursor_x, 28, cursor_x + 8, 44);
1444         OnRefresh(Self);
1445       end;
1446       case i of
1447         2:
1448           cursor_c := COL8_FFFFFF;
1449         3:
1450           begin
1451             boxfill8(COL8_000000, cursor_x, 28, cursor_x + 7, 43);
1452             cursor_c := -1;
1453           end;
1454       end;
1455       if (i >= 256) and (i <= 511) then
1456         if i = 8 + 256 then
1457         begin
1458           if cursor_x > 16 then
1459           begin
1460             putfonts8_asc(cursor_x, 28, 1, ' ');
1461             dec(cursor_x, 8);
1462           end;
1463         end
1464         else if i = 10 + 256 then
1465         begin
1466           putfonts8_asc_sht(cursor_x, cursor_y, ' ');
1467           newline;
1468           cmd := LowerCase(str);
1469           if cmd = 'mem' then
1470             cmd_mem
1471           else if cmd = 'cls' then
1472             cmd_cls
1473           else if cmd = 'ls' then
1474             cmd_ls
1475           else if cmd = 'type' then
1476             cmd_type(str)
1477           else if Length(cmd) <> 0 then;
1478         end
1479         else if cursor_x < 240 then
1480         begin
1481           cmd := LowerCase(str);
1482           cmd[1] := Char(i - 256);
1483           cmd[2] := Char(0);
1484           putfonts8_asc(cursor_x, 28, 1, cmd);
1485           inc(cursor_x, 8);
1486         end;
1487       if cursor_c >= 0 then
1488         boxfill8(cursor_c, cursor_x, 28, cursor_x + 7, 43);
1489       boxfill8(cursor_c, cursor_x, 28, cursor_x + 7, 43);
1490       OnRefresh(Self);
1491     end;
1492   end;
1493 end;
1494
1495 destructor TConsole.Destroy;
1496 begin
1497   fifo.free;
1498   files.free;
1499   ctl.free;
1500   inherited;
1501 end;
1502
1503 procedure TConsole.cmd_ls;
1504 var
1505   i: integer;
1506   str: string;
1507 begin
1508   for i := 0 to 223 do
1509   begin
1510     case Byte(info[i].name[1]) of
1511       $00:
1512         break;
1513       $E5:
1514         if Byte(info[i].tpye) and $18 = 0 then
1515         begin
1516           str := info[i].name;
1517           str := str + info[i].ext;
1518           putfonts8_asc_sht(8, cursor_y, str);
1519           newline;
1520         end;
1521     end;
1522   end;
1523   newline;
1524 end;
1525
1526 procedure TConsole.cmd_mem;
1527 begin
1528
1529 end;
1530
1531 procedure TConsole.newline;
1532 var
1533   i: integer;
1534   j: integer;
1535 begin
1536   if cursor_y < 28 + 112 then
1537     inc(cursor_y, 15)
1538   else
1539   begin
1540     for i := 28 + 112 to 28 + 127 do
1541       for j := 8 to 8 + 239 do
1542         vram[j + i * bxsize] := vram[j + (i + 16) * bxsize];
1543     for i := 28 to 28 + 111 do
1544       for j := 8 to 8 + 239 do
1545         vram[j + i * bxsize] := COL8_000000;
1546     clip := rect(8, 28, 8 + 240, 128 + 28);
1547     OnRefresh(Self);
1548   end;
1549 end;
1550
1551 procedure TConsole.putchar(ch: Char; move: integer);
1552 begin
1553   if Byte(ch) = $09 then
1554     while true do
1555     begin
1556       putfonts8_asc(cursor_x, cursor_y, 1, ch);
1557       inc(cursor_x, 8);
1558       if cursor_x = 8 + 240 then
1559         newline
1560       else if cursor_x - 8 and $1F = 0 then
1561         break;
1562     end
1563   else if Byte(ch) = $0A then
1564     newline
1565   else if Byte(ch) = $0D then
1566
1567   else
1568   begin
1569     putfonts8_asc(cursor_x, cursor_y, 1, ch);
1570     if move <> 0 then
1571     begin
1572       inc(cursor_x, 8);
1573       if cursor_x = 8 + 240 then
1574         newline;
1575     end;
1576   end;
1577 end;
1578
1579 procedure TConsole.putstr0(str: string);
1580 var
1581   i: integer;
1582 begin
1583   for i := 1 to length(str) do
1584     putchar(str[i], 1);
1585 end;
1586
1587 procedure TConsole.putstrl(str: string; length: integer);
1588 var
1589   i: integer;
1590 begin
1591   for i := 1 to length do
1592     putchar(str[i], 1);
1593 end;
1594
1595 { TIdle }
1596
1597 constructor TIdle.Create;
1598 begin
1599   inherited;
1600   with tss do
1601   begin
1602     esp := Pointer(integer(Self) + SizeOf(TIdle));
1603     eip := Self;
1604     es := 1 * 8;
1605     cs := 2 * 8;
1606     ss := 1 * 8;
1607     ds := 1 * 8;
1608     fs := 1 * 8;
1609     gs := 1 * 8;
1610   end;
1611 end;
1612
1613 { TPic }
1614
1615 constructor TPic.Create;
1616 begin
1617   io_out8(PIC0_IMR, $FF);
1618   io_out8(PIC1_IMR, $FF);
1619
1620   io_out8(PIC0_ICW1, $11);
1621   io_out8(PIC0_ICW2, $20);
1622   io_out8(PIC0_ICW3, 1 shl 2);
1623   io_out8(PIC0_ICW4, $01);
1624
1625   io_out8(PIC1_ICW1, $11);
1626   io_out8(PIC1_ICW2, $28);
1627   io_out8(PIC1_ICW3, 2);
1628   io_out8(PIC1_ICW4, $01);
1629
1630   io_out8(PIC0_IMR, $FB);
1631   io_out8(PIC1_IMR, $FF);
1632 end;
1633
1634 procedure TPic.inthandler27(var esp: integer);
1635 begin
1636   io_out8(PIC0_OCW2, $67);
1637 end;
1638
1639 { TDesk }
1640
1641 constructor TDesk.Create;
1642 begin
1643
1644 end;
1645
1646 end.