{*
 *  emu1.tml
 *
 *  Main unit for sequential program tests running
 *  on the Z80 emulator (zemu).
 *
 *  960904 FrGo, initial issue.
 *
 *  960905 FrGo, added machine coded list functions.
 *}

UNIT emu1;
IMPLEMENTATION

  uses
    hardware,
    memory,
    strings,
    system;

  const
    max_memory = 2048;
    max_buf    = 4096;

  type
    dlink;
    dcell = record
              next : dlink;
              prev : dlink;
              prio : char;
              id   : ^string;
            end;

    dlink = ^dcell;

  var
    i       : int;
    time    : int;
    item    : dlink;
    list    : dcell;
    cell    : array[16] of dcell;
    line    : string;

    {
    freep   : int;
    storage : array[max_memory] of char;
    buf     : array[max_buf] of int;
    }


{
  PROCEDURE mem_change(blk: pointer; size,id: int; map: char);
  BEGIN
    putln("mem_change(blk=",int(blk),",size=",size,",id=",id,")");
  END;


  PROCEDURE mem_alloc(size: int): pointer;
   var
     p : pointer;
  BEGIN
    p := nil;
    lock();
    if freep + size < max_memory then
       p := @storage[freep];
       freep := freep + size;
    end;
    unlock();
    putln("mem_alloc(size=",size,") => ",int(p));
    return p;
  END;


  PROCEDURE mem_release(blk: pointer; size: int);
  BEGIN
    putln("mem_release(blk=",int(blk),",size=",size,")");
    lock();
    if int(blk) + size = int(@storage[freep]) then
       freep := freep - size;
    end;
    unlock();
  END;


  PROCEDURE mem_clean(id: int);
  BEGIN
    putln("mem_clean(id=",id,")");
  END;
}


  PROCEDURE tty_read(): char;
  BEGIN
    while in(ttycmd) = #0 loop
    end loop;
    return in(ttydat);
  END;


  PROCEDURE tty_write(ch: char);
  BEGIN
    out(ttydat,ch);
  END;


  PROCEDURE delay(time: int);
  BEGIN
    while time <> 0 loop
      dec(time);
    end loop;
  END;


  PROCEDURE lock();
  BEGIN
    inline($F3);
  END lock;


  PROCEDURE unlock();
  BEGIN
    inline($FB);
  END unlock;


  PROCEDURE int_handler;
  BEGIN
    inline($F3);                  {            DI }
    inline($F5);                  {            PUSH AF }
    inline($C5);                  {            PUSH BC }
    inline($D5);                  {            PUSH DE }
    inline($E5);                  {            PUSH HL }
    inline($DD,$E5);              {            PUSH IX }
    inline($D9);                  {            EXX }
    inline($08);                  {            EX   AF,AF' }
    inline($F5);                  {            PUSH AF }
    inline($C5);                  {            PUSH BC }
    inline($D5);                  {            PUSH DE }
    inline($E5);                  {            PUSH HL }
    inline($FD,$E5);              {            PUSH IY }
    inline($2A,time);             {            LD   HL,(time) }
    inline($23);                  {            INC  HL }
    inline($22,time);             {            LD   (time),HL }

    {putln("CTC interrupt.");}

    inline($FD,$E1);              { POP  IY }
    inline($E1);                  { POP  HL }
    inline($D1);                  { POP  DE }
    inline($C1);                  { POP  BC }
    inline($F1);                  { POP  AF }
    inline($08);                  { EX   AF,AF' }
    inline($D9);                  { EXX }
    inline($DD,$E1);              { POP  IX }
    inline($E1);                  { POP  HL }
    inline($D1);                  { POP  DE }
    inline($C1);                  { POP  BC }
    inline($F1);                  { POP  AF }
    inline($FB);                  { EI }
    inline($ED,$4D);              { RETI }
  END;


  { Double linked list management }

  {
  PROCEDURE unlink(lp: dlink);
  BEGIN
    putln("unlink(",lp^.id^,")");
    if lp^.next <> nil then
       lp^.next^.prev := lp^.prev;
    end;
    if lp^.prev <> nil then
       lp^.prev^.next := lp^.next;
    end;
    lp^.next := nil;
    lp^.prev := nil;
  END;

  PROCEDURE insert(qp,item: dlink);
  BEGIN
    putln("insert(",item^.id^,")");
    item^.next := qp^.next;
    item^.prev := qp;
    if qp^.next <> nil then
       qp^.next^.prev := item;
    end;
    qp^.next := item;
  END;

  PROCEDURE append(qp,item: dlink);
  BEGIN
    putln("append(",item^.id^,")");
    while qp^.next <> nil loop
      qp := qp^.next;
    end loop;
    insert(qp,item);
  END;

  PROCEDURE extract(qp: dlink): dlink;
   var
     item : dlink;
  BEGIN
    putln("extract()");
    item := qp^.next;
    if item <> nil then
       unlink(item);
    end;
    return item;
  END;

  { Insert item last in it's priority level }
  PROCEDURE prio_append(qp,item: dlink);
  BEGIN
    putln("prio_append(",item^.id^,")");
    while qp^.next <> nil loop
      if qp^.next^.prio < item^.prio then
         insert(qp,item);
         return;
      end;
      qp := qp^.next;
    end loop;
    insert(qp,item);
  END;

  { Insert item first in it's priority level }
  PROCEDURE prio_insert(qp,item: dlink);
  BEGIN
    putln("prio_insert(",item^.id^,")");
    while qp^.next <> nil loop
      if qp^.next^.prio <= item^.prio then
         insert(qp,item);
         return;
      end;
      qp := qp^.next;
    end loop;
    insert(qp,item);
  END;
  }


  { Remove item from list, HL=item }
  PROCEDURE _unlink();
  BEGIN
    inline($E5);                  { UNLINK     PUSH HL        }
    inline($DD,$E1);              {            POP  IX        }
    inline($DD,$6E,$00);          {            LD   L,(IX+0)  ; HL := item^.next }
    inline($DD,$66,$01);          {            LD   H,(IX+1)  }
    inline($7D);                  {            LD   A,L       ; HL = 0? }
    inline($B4);                  {            OR   H         }
    inline($28,$0B);              {            JR   Z,NO_NEXT }

    inline($DD,$5E,$02);          {            LD   E,(IX+2)  ; DE := item^.prev }
    inline($DD,$56,$03);          {            LD   D,(IX+3)  }
    inline($23);                  {            INC  HL        }
    inline($23);                  {            INC  HL        }
    inline($73);                  {            LD   (HL),E    ; HL^.prev := DE }
    inline($23);                  {            INC  HL        }
    inline($72);                  {            LD   (HL),D    }

    inline($DD,$6E,$02);          { NO_NEXT    LD   L,(IX+2)  ; HL := item^.prev }
    inline($DD,$66,$03);          {            LD   H,(IX+3)  }
    inline($7D);                  {            LD   A,L       ; HL = 0? }
    inline($B4);                  {            OR   H         }
    inline($28,$09);              {            JR   Z,NO_PREV }

    inline($DD,$5E,$00);          {            LD   E,(IX+0)  ; DE := item^.next }
    inline($DD,$56,$01);          {            LD   D,(IX+1)  }
    inline($73);                  {            LD   (HL),E    ; HL^.next := DE }
    inline($23);                  {            INC  HL        }
    inline($72);                  {            LD   (HL),D    }

    inline($3E,$00);              { NO_PREV    LD   A,0       ; item^.next := nil }
    inline($DD,$77,$00);          {            LD   (IX+0),A  }
    inline($DD,$77,$01);          {            LD   (IX+1),A  }
    inline($DD,$77,$02);          {            LD   (IX+2),A  ; item^.prev := nil }
    inline($DD,$77,$03);          {            LD   (IX+3),A  }
  END _unlink;


  { Insert item first in list, IX=list, HL=item }
  PROCEDURE _insert();
  BEGIN
    inline($DD,$E5);              { INSERT     PUSH IX        ; BC := list }
    inline($C1);                  {            POP  BC        }
    inline($DD,$5E,$00);          {            LD   E,(IX+0)  ; DE := list^.next }
    inline($DD,$56,$01);          {            LD   D,(IX+1)  }
    inline($E5);                  {            PUSH HL        ; save item }
    inline($73);                  {            LD   (HL),E    ; item^.next := DE }
    inline($23);                  {            INC  HL        }
    inline($72);                  {            LD   (HL),D    }
    inline($23);                  {            INC  HL        }
    inline($71);                  {            LD   (HL),C    ; item^.prev := BC }
    inline($23);                  {            INC  HL        }
    inline($70);                  {            LD   (HL),B    }
    inline($E1);                  {            POP  HL        ; restore item }
    inline($7B);                  {            LD   A,E       ; DE = 0? }
    inline($B2);                  {            OR   D         }
    inline($28,$07);              {            JR   Z,EMPTY   }

    inline($13);                  {            INC  DE        }
    inline($13);                  {            INC  DE        }
    inline($EB);                  {            EX   DE,HL     ; DE := item, HL := list^.next }
    inline($73);                  {            LD   (HL),E    ; list^.next^.prev := item }
    inline($23);                  {            INC  HL        }
    inline($72);                  {            LD   (HL),D    }
    inline($EB);                  {            EX   DE,HL     ; HL := item }

    inline($DD,$75,$00);          { EMPTY      LD   (IX+0),L  ; list^.next := item }
    inline($DD,$74,$01);          {            LD   (IX+1),H  }
  END _insert;


  { Append item last in list, IX=list, HL=item }
  PROCEDURE _append();
  BEGIN
    inline($DD,$5E,$00);          { APPEND     LD   E,(IX+0)  ; DE := list^.next }
    inline($DD,$56,$01);          {            LD   D,(IX+1)  }
    inline($7B);                  {            LD   A,E       ; DE = 0? }
    inline($B2);                  {            OR   D         }
    inline($28,$05);              {            JR   Z,EMPTY   }

    inline($D5);                  {            PUSH DE        ; list := DE }
    inline($DD,$E1);              {            POP  IX        }
    inline($18,$F1);              {            JR   APPEND }
    inline($CD,_insert);          { EMPTY      CALL _INSERT   }
  END _append;


  { Extract first element from list, IX=list, returns HL=item }
  PROCEDURE _extract();
  BEGIN
    inline($DD,$6E,$00);          { EXTRACT    LD   L,(IX+0)  ; HL := list^.next }
    inline($DD,$66,$01);          {            LD   H,(IX+1)  }
    inline($7D);                  {            LD   A,L       ; HL = 0? }
    inline($B4);                  {            OR   H         }
    inline($C8);                  {            RET  Z         ; Empty list }
    inline($E5);                  {            PUSH HL        ; save item }
    inline($CD,_unlink);          {            CALL _UNLINK   }
    inline($E1);                  {            POP  HL        ; restore item }
  END _extract;


  { Append item last in it's priority level, IX=list, HL=item }
  PROCEDURE _prio_append();
  BEGIN
    inline($DD,$E5);              {            PUSH IX        ; save list }
    inline($E5);                  {            PUSH HL        ; IX := item }
    inline($DD,$E1);              {            POP  IX        }
    inline($DD,$4E,$04);          {            LD   C,(IX+4)  ; C := item^.prio }
    inline($DD,$E1);              {            POP  IX        ; restore list }
    inline($DD,$5E,$00);          { LOOP       LD   E,(IX+0)  ; DE := list^.next }
    inline($DD,$56,$01);          {            LD   D,(IX+1)  }
    inline($7B);                  {            LD   A,E       ; DE = 0? }
    inline($B2);                  {            OR   D         }
    inline($28,$10);              {            JR   Z,EMPTY   }

    inline($DD,$E5);              {            PUSH IX        ; save list }
    inline($D5);                  {            PUSH DE        ; list := DE }
    inline($DD,$E1);              {            POP  IX        }
    inline($DD,$7E,$04);          {            LD   A,(IX+4)  ; A := list^.prio }
    inline($B9);                  {            CP   C         ; A < C? }
    inline($38,$03);              {            JR   C,DONE    }
    inline($D1);                  {            POP  DE        ; discard saved list }
    inline($18,$E8);              {            JR   LOOP      }
    inline($DD,$E1);              { DONE       POP  IX        ; restore list }
    inline($CD,_insert);          { EMPTY      CALL _INSERT   }
  END _prio_append;


  { Insert item first in it's priority level, IX=list, HL=item }
  PROCEDURE _prio_insert();
  BEGIN
    inline($DD,$E5);              {            PUSH IX        ; save list }
    inline($E5);                  {            PUSH HL        ; IX := item }
    inline($DD,$E1);              {            POP  IX        }
    inline($DD,$4E,$04);          {            LD   C,(IX+4)  ; C := item^.prio }
    inline($DD,$E1);              {            POP  IX        ; restore list }
    inline($DD,$5E,$00);          { LOOP       LD   E,(IX+0)  ; DE := list^.next }
    inline($DD,$56,$01);          {            LD   D,(IX+1)  }
    inline($7B);                  {            LD   A,E       ; DE = 0? }
    inline($B2);                  {            OR   D         }
    inline($28,$10);              {            JR   Z,EMPTY   }

    inline($DD,$E5);              {            PUSH IX        ; save list }
    inline($D5);                  {            PUSH DE        ; list := DE }
    inline($DD,$E1);              {            POP  IX        }
    inline($79);                  {            LD   A,C       }
    inline($DD,$BE,$04);          {            CP   (IX+4)    ; C < list^.prio }
    inline($30,$03);              {            JR   NC,DONE   }
    inline($D1);                  {            POP  DE        ; discard saved list }
    inline($18,$E8);              {            JR   LOOP      }
    inline($DD,$E1);              { DONE       POP  IX        ; restore list }
    inline($CD,_insert);          { EMPTY      CALL _INSERT   }
  END _prio_insert;


  PROCEDURE unlink(lp: dlink);
  BEGIN
    putln("unlink(",lp^.id^,")");
    inline($FD,$6E,$04);          {            LD   L,(IY+4)  }
    inline($FD,$66,$05);          {            LD   H,(IY+5)  }
    inline($CD,_unlink);          {            CALL _UNLINK  }
  END;


  PROCEDURE insert(qp,item: dlink);
  BEGIN
    putln("insert(",item^.id^,")");
    inline($FD,$5E,$04);          {            LD   E,(IY+4)  }
    inline($FD,$56,$05);          {            LD   D,(IY+5)  }
    inline($FD,$6E,$06);          {            LD   L,(IY+6)  }
    inline($FD,$66,$07);          {            LD   H,(IY+7)  }
    inline($D5);                  {            PUSH DE        }
    inline($DD,$E1);              {            POP  IX        }
    inline($CD,_insert);          {            CALL _INSERT   }
  END;


  PROCEDURE append(qp,item: dlink);
  BEGIN
    putln("append(",item^.id^,")");
    inline($FD,$5E,$04);          {            LD   E,(IY+4)  }
    inline($FD,$56,$05);          {            LD   D,(IY+5)  }
    inline($FD,$6E,$06);          {            LD   L,(IY+6)  }
    inline($FD,$66,$07);          {            LD   H,(IY+7)  }
    inline($D5);                  {            PUSH DE        }
    inline($DD,$E1);              {            POP  IX        }
    inline($CD,_append);          {            CALL _APPEND   }
  END;


  PROCEDURE extract(qp: dlink): dlink;
  BEGIN
    putln("extract()");
    inline($FD,$5E,$04);          {            LD   E,(IY+4)  }
    inline($FD,$56,$05);          {            LD   D,(IY+5)  }
    inline($D5);                  {            PUSH DE        }
    inline($DD,$E1);              {            POP  IX        }
    inline($CD,_extract);         {            CALL _EXTRACT  }
  END;


  { Insert item last in it's priority level }
  PROCEDURE prio_append(qp,item: dlink);
  BEGIN
    putln("prio_append(",item^.id^,")");
    inline($FD,$5E,$04);          {            LD   E,(IY+4)  }
    inline($FD,$56,$05);          {            LD   D,(IY+5)  }
    inline($FD,$6E,$06);          {            LD   L,(IY+6)  }
    inline($FD,$66,$07);          {            LD   H,(IY+7)  }
    inline($D5);                  {            PUSH DE        }
    inline($DD,$E1);              {            POP  IX        }
    inline($CD,_prio_append);     {            CALL _PRIO_APPEND   }
  END;


  { Insert item first in it's priority level }
  PROCEDURE prio_insert(qp,item: dlink);
  BEGIN
    putln("prio_insert(",item^.id^,")");
    inline($FD,$5E,$04);          {            LD   E,(IY+4)  }
    inline($FD,$56,$05);          {            LD   D,(IY+5)  }
    inline($FD,$6E,$06);          {            LD   L,(IY+6)  }
    inline($FD,$66,$07);          {            LD   H,(IY+7)  }
    inline($D5);                  {            PUSH DE        }
    inline($DD,$E1);              {            POP  IX        }
    inline($CD,_prio_insert);     {            CALL _PRIO_INSERT   }
  END;


  { Display list }
  PROCEDURE ldisplay(qp: dlink);
  BEGIN
    put("ldisplay: ");
    qp := qp^.next;
    while qp <> nil loop
      put(qp^.id^,' ');
      qp := qp^.next;
    end loop;
    putln();
  END;


  { Display list item }
  PROCEDURE display(qp: dlink);
  BEGIN
    put("display: ");
    if qp = nil then
       putln("(nil)");
    else
       putln(qp^.id^,'(',int(qp^.prio),") ");
    end;
  END;


  PROCEDURE setup(qp: dlink; id: string; prio: int);
  BEGIN
    putln("setup(",id,")");
    qp^.next := nil;
    qp^.prev := nil;
    qp^.prio := char(prio);
    qp^.id := pointer(id);
  END;


  PROCEDURE sys_time(): int;
  BEGIN
    return (time);
  END;


  PROCEDURE ltoa(n: long; var s: string);
   var
     i,j,digit : int;
     d         : long;
     force     : boolean;
  BEGIN
    i := 0;
    j := 1;
    d := 1000000000;
    force := false;
    while i < 10 loop
      digit := int(n / d);
      n := n mod d;
      d := d / long(10);
      inc(i);
      if force or (digit <> 0) or (i = 10) then
         s[j] := char(digit) + '0';
         inc(j);
         force := true;
      end;
    end loop;
    length(s) := j - 1;
  END;


  PROCEDURE lputln(text: string; v: long);
   var
     p    : ^array[2] of int;
     s,s2 : array[16] of char;
  BEGIN
    p := @v;
    hexstr(p^[1],string(s));
    put(text,'$',string(s));
    hexstr(p^[0],string(s));
    ltoa(v,string(s2));
    putln(string(s)," (",string(s2),')');
  END;


  PROCEDURE long_add(x,y: long): long;
  BEGIN
    return x + y;
  END;


  PROCEDURE long_add2(x: long; y : int): long;
   var
     n : int;
  BEGIN
    return x + long(y);
  END;


  {
  PROCEDURE long_mul(x,y: long): long;
   var
     i : int;
     n : long;
  BEGIN
    n := long(0);
    i := 0;
    while i < 32 loop
       if (int(x) and 1) = 1 then
          n := n + y;
       end;
       x := shr(x,1);
       y := shl(y,1);
       inc(i);
    end loop;
    return n;
  END;


  PROCEDURE long_div(x,y: long): long;
   var
     i   : int;
     n,z : long;
  BEGIN
    n := long(0);
    z := long(0);
    i := 0;
    while i < 32 loop
       n := shl(n,1);
       { Shift MSb of x into LSb of z }
       z := shl(z,1);
       if (x and $80000000) = $80000000 then
          z := z or long(1);
       end;
       x := shl(x,1);
       if y <= z then
          z := z - y;
          n := n or long(1);
       end;
       inc(i);
    end loop;
    return n;  { Return "z" instead for modulo division }
  END;


  { Same algorithm as long_div but returns a different variable }
  PROCEDURE long_mod(x,y: long): long;
   var
     i   : int;
     n,z : long;
  BEGIN
    n := long(0);
    z := long(0);
    i := 0;
    while i < 32 loop
       n := shl(n,1);
       { Shift MSb of x into LSb of z }
       z := shl(z,1);
       if (x and $80000000) = $80000000 then
          z := z or long(1);
       end;
       x := shl(x,1);
       if y <= z then
          z := z - y;
          n := n or long(1);
       end;
       inc(i);
    end loop;
    return z;
  END;
  }


  PROCEDURE long_test();
   var
     n       : long;
     v       : array[4] of long;
     p       : ^long;
     r       : record  a : int; b : long; c : int; end;
     i,t0,t1 : int;
  BEGIN
    putln("Long test");
    lputln("65535=",long(65535));
    lputln("65536=",65536);
    n := $ffffffff;
    lputln("n=",n);
    lputln("n+5=",n+long(5));

    putln("n := n + $20000");
    n := n + $20000;
    lputln("n=",n);

    n := long(7);
    lputln("n=",n);
    lputln("n-3=",n-long(3));

    n := $20000;
    lputln("n=",n);
    lputln("n-1=",n-long(1));

    lputln("long_add($8000,$108500) => ",long_add(long($8000),$108500));
    lputln("long_add2($108500,$8000) => ",long_add2($108500,$8000));

    v[0] := long(0);
    v[1] := $11111;
    v[2] := $222222;
    v[3] := $3333333;
    lputln("v[0]=",v[0]);
    lputln("v[1]=",v[1]);
    lputln("v[2]=",v[2]);
    lputln("v[3]=",v[3]);

    p := @v[2];
    putln("p := @v[2]");
    lputln("p^ = ",p^);

    p^ := long(2);
    putln("p^ := long(2)");
    lputln("v[2]=",v[2]);

    r.a := 1;
    r.b := long(2);
    r.c := 3;
    putln("r.a = ",r.a);
    lputln("r.b = ",r.b);
    putln("r.c = ",r.c);

    n := $12345678;
    lputln("n=",n);
    putln("n = $12345678 => ",n = $12345678);
    putln("n = $2345678 => ",n = $2345678);
    putln("n = n => ",n = n);


    putln("n < $55555 => ",n < $55555);
    putln("n < $12345678 => ",n < $12345678);
    putln("n < $55555555 => ",n < $55555555);

    putln("n > $55555 => ",n > $55555);
    putln("n > $12345678 => ",n > $12345678);
    putln("n > $55555555 => ",n > $55555555);

    putln("n >= $55555 => ",n >= $55555);
    putln("n >= $12345678 => ",n >= $12345678);
    putln("n >= $55555555 => ",n >= $55555555);

    lputln("n and $fff0 => ",n and long($fff0));
    lputln("n and $fff00f0 => ",n and $fff00f0);

    lputln("n or $fff0 => ",n or long($fff0));
    lputln("n or $fff00f0 => ",n or $fff00f0);

    lputln("shl($10001,1) => ",shl($10001,1));
    lputln("shl($10001,4) => ",shl($10001,4));

    lputln("shr($10001,1) => ",shr($10001,1));
    lputln("shr($10001,4) => ",shr($10001,4));

    putln("shl($1001,1) => ",shl($1001,1));
    putln("shl($1001,4) => ",shl($1001,4));

    putln("shr($1001,1) => ",shr($1001,1));
    putln("shr($1001,4) => ",shr($1001,4));

    putln("$10 xor 1 => ",$10 xor 1);
    putln("$10 xor $10 => ",$10 xor $10);
    lputln("$12345678 xor long($ffff) => ",$12345678 xor long($ffff));

    putln("-1 => ",-1);
    lputln("-long(1) => ",-long(1));

    {
    lputln("$8000 * $8000 => ",long_mul(long($8000),long($8000)));
    lputln("$20000 * 5 => ",long_mul($20000,long(5)));
    lputln("$40000000 / $8000 => ",long_div($40000000,long($8000)));
    lputln("2550000 / 10000 => ",long_div(2550000,long(10000)));
    lputln("$ffffff / 256 => ",long_div($ffffff,long(256)));
    lputln("$ffffff mod 256 => ",long_mod($ffffff,long(256)));
    }

    lputln("$8000 * $8000 => ",long($8000) * long($8000));
    lputln("$40000000 / $8000 => ",$40000000 / long($8000));
    lputln("$20000 * 5 => ",$20000 * long(5));
    lputln("2550000 / 10000 => ",2550000 / long(10000));

    lputln("$ffffff mod 256 => ",$ffffff mod long(256));
    lputln("$ffffff / 256 => ",$ffffff / long(256));

    
    n := $12345678;
    lputln("n=",n);
    inc(n);
    lputln("inc(n) => n=",n);

    n := $ffffffff;
    lputln("n=",n);
    inc(n);
    lputln("inc(n) => n=",n);
    dec(n);
    lputln("dec(n) => n=",n);


    n := long(0);
    t0 := sys_time();
    while n <> long(5000) loop
      n := n + long(1);
    end;
    t1 := sys_time();
    putln("5000 long adds took ",t1-t0," ms.");

    i := 0;
    t0 := sys_time();
    while i <> 5000 loop
      i := i + 1;
    end;
    t1 := sys_time();
    putln("5000 int adds took ",t1-t0," ms.");

    n := long($777);
    i := 0;
    t0 := sys_time();
    while i < 5000 loop
      n := n * long(2);
      inc(i);
    end;
    t1 := sys_time();
    putln("5000 long muls took ",t1-t0," ms.");

    i := 0;
    t0 := sys_time();
    while i < 5000 loop
      n := long(int(n) * 2);
      inc(i);
    end;
    t1 := sys_time();
    putln("5000 int muls took ",t1-t0," ms.");
  END;


BEGIN
  inline($F3,$31,stack_base);    { Setup stack }
  inline(map0c0,set_map_reg0);
  inline(map0c1,set_map_reg1);   { Setup page map registers }
  inline(map0c2,set_map_reg2);
  inline(map0c3,set_map_reg3);
  init_hardware();
  init_system(tty_read,tty_write);

  time := 0;
  putln("Z80 emulator double linked list test.");
  putln();
  lock();
  set_timer(0,32,@int_handler);
  unlock();

  long_test();

  put("Press any key to start test...");
  { Test new relaxed statement type checking }
  tty_read();
  putln();

  list.next := nil;
  list.prev := nil;
  ldisplay(@list);
  setup(@cell[0],"First",9);
  setup(@cell[1],"Second",9);
  setup(@cell[2],"Last",0);
  setup(@cell[3],"Middle_A",2);
  setup(@cell[4],"Middle_B",2);
  append(@list,@cell[0]);
  ldisplay(@list);
  append(@list,@cell[2]);
  ldisplay(@list);
  insert(@list,@cell[1]);
  ldisplay(@list);
  unlink(@cell[0]);
  ldisplay(@list);
  repeat
     item := extract(@list);
     display(item);
  until item = nil;

  putln();
  putln("Press enter for priority list test");
  gets(line);
  prio_append(@list,@cell[2]);
  ldisplay(@list);
  prio_append(@list,@cell[0]);
  ldisplay(@list);
  prio_append(@list,@cell[4]);
  ldisplay(@list);
  prio_insert(@list,@cell[3]);
  prio_append(@list,@cell[1]);
  ldisplay(@list);
  repeat
     item := extract(@list);
     display(item);
  until item = nil;
  loop
    put(">");
    gets(line);
    putln(line,": unknown command.");
  end loop;
END emu1;