{ This program is free software; you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation; either version 2 of the License, or
  (at your option) any later version.

  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with this program; if not, write to the Free Software
  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
}

unit Pic;

{ Descripcion
    El objeto tPic contiene las partes criticas del procesador.
    Todavia no es configurable, pero tratamos de disenar las partes
    para que sea facilmente adaptable a diferentes PICs.
  Metodos:
    <p>.Reset
        vuelve el micro a su estado de reset. Una buena extension seria
        agregar un parametro para indicar si el reset fue por hardware,
        watchdog u otro motivo.
    <p>.Step(Opc: word)
        Ejecuta el Opc provisto a la instruccion.
    <p>.GetFile(Nr: byte): byte
        Acceso al contenido de los files - simula IND, timer,
        puertos etc. Tambien toma en cuenta los bancos de registros.
    <p>.SetFile(Nr, V: byte);
        Modificar los registros - mismas observaciones que GetRec
  Datos:
    PC: word      Program counter actual
    Opcode: byte  Ultima instruccion ejecutada
    Files: array  Arreglo con los registros
    W: byte       El acumulador
}

interface

const
  fINDF = 0;     fTMR0 = 1;     fPCL = 2;     fStatus = 3;
  fFSR = 4;      fPORTA = 5;    fPORTB = 6;   fPORTC = 7;
  fOPTION = $81; fTRISA = $85;  fTRISB = $86;  fTRISC = $87;

  bCarry = $01;  bDCarry = $02; bZero = $04;

type
  pPic = ^tPic;
  tPic = object
    Files: array [0..255] of byte;
    W    : byte;
    Stack: array [0..7] of word;
    StkP : 0..7;
    Opcode, PC: word;
    procedure Step(Opc: word);
    procedure Reset;
    function  GetFile(Nr: byte): byte;
    function  GetFileAbs(Nr: word): byte;
    procedure SetFile(Nr, V: byte);
  end;
  TblProc = procedure(var p: tPic);
  TblEntry = record
    M, O: word;
    Pr: TblProc;
  end;

procedure ADDLW(var p: tPic);
procedure ADDWF(var p: tPic);
procedure ANDLW(var p: tPic);
procedure ANDWF(var p: tPic);
procedure BCF(var p: tPic);
procedure BSF(var p: tPic);
procedure BTFSC(var p: tPic);
procedure BTFSS(var p: tPic);
procedure CALL(var p: tPic);
procedure CLRF(var p: tPic);
procedure CLRW(var p: tPic);
procedure CLRWDT(var p: tPic);
procedure COMF(var p: tPic);
procedure DECF(var p: tPic);
procedure DECFSZ(var p: tPic);
procedure GTO(var p: tPic);
procedure INCF(var p: tPic);
procedure INCFSZ(var p: tPic);
procedure IORLW(var p: tPic);
procedure IORWF(var p: tPic);
procedure MOVF(var p: tPic);
procedure MOVLW(var p: tPic);
procedure MOVWF(var p: tPic);
procedure NOP(var p: tPic);
procedure RETFIE(var p: tPic);
procedure RETLW(var p: tPic);
procedure RETURN(var p: tPic);
procedure RLF(var p: tPic);
procedure RRF(var p: tPic);
procedure SLEEP(var p: tPic);
procedure SUBLW(var p: tPic);
procedure SUBWF(var p: tPic);
procedure SWAPF(var p: tPic);
procedure XORLW(var p: tPic);
procedure XORWF(var p: tPic);

const
  NrInstr = 35;
  Instr: array [1..NrInstr] of TblEntry =
    ((M: $3E00; O: $3E00; Pr: ADDLW),
     (M: $3F00; O: $0700; Pr: ADDWF),
     (M: $3F00; O: $3900; Pr: ANDLW),
     (M: $3F00; O: $0500; Pr: ANDWF),
     (M: $3C00; O: $1000; Pr: BCF),
     (M: $3C00; O: $1400; Pr: BSF),
     (M: $3C00; O: $1800; Pr: BTFSC),
     (M: $3C00; O: $1C00; Pr: BTFSS),
     (M: $3800; O: $2000; Pr: CALL),
     (M: $3F80; O: $0180; Pr: CLRF),
     (M: $3F80; O: $0100; Pr: CLRW),
     (M: $3FFF; O: $0064; Pr: CLRWDT),
     (M: $3F00; O: $0900; Pr: COMF),
     (M: $3F00; O: $0300; Pr: DECF),
     (M: $3F00; O: $0B00; Pr: DECFSZ),
     (M: $3800; O: $2800; Pr: GTO),
     (M: $3F00; O: $0A00; Pr: INCF),
     (M: $3F00; O: $0F00; Pr: INCFSZ),
     (M: $3F00; O: $3800; Pr: IORLW),
     (M: $3F00; O: $0400; Pr: IORWF),
     (M: $3F00; O: $0800; Pr: MOVF),
     (M: $3C00; O: $3000; Pr: MOVLW),
     (M: $3F80; O: $0080; Pr: MOVWF),
     (M: $3F9F; O: $0000; Pr: NOP),
     (M: $3FFF; O: $0009; Pr: RETFIE),
     (M: $3C00; O: $3400; Pr: RETLW),
     (M: $3FFF; O: $0008; Pr: RETURN),
     (M: $3F00; O: $0D00; Pr: RLF),
     (M: $3F00; O: $0C00; Pr: RRF),
     (M: $3FFF; O: $0063; Pr: SLEEP),
     (M: $3E00; O: $3C00; Pr: SUBLW),
     (M: $3F00; O: $0200; Pr: SUBWF),
     (M: $3F00; O: $0E00; Pr: SWAPF),
     (M: $3F00; O: $3A00; Pr: XORLW),
     (M: $3F00; O: $0600; Pr: XORWF));

implementation

procedure SetZeroFlag(var p: tPic; State: boolean);
begin
  with p do
  if State then
    Files[fStatus] := Files[fStatus] or bZero
  else
    Files[fStatus] := Files[fStatus] and (not bZero);
end;

procedure SetCarryFlag(var p: tPic; State: boolean);
begin
  with p do
  if State then
    Files[fStatus] := Files[fStatus] or bCarry
  else
    Files[fStatus] := Files[fStatus] and (not bCarry);
end;

procedure CALL(var p: tPic);
begin
  with p do begin
    Stack[StkP] := PC + 1;
    StkP := (StkP + 1) mod 8;
    PC := Opcode and $7FF;
  end;
end;

procedure GTO(var p: tPic);
begin
  p.PC := p.Opcode and $7FF;
end;

procedure MOVLW(var p: tPic);
begin
  p.W := p.Opcode and $FF;
  inc(p.PC);
end;

procedure RETURN(var p: tPic);
begin
  with p do begin
    StkP := (StkP + 7) mod 8;
    PC := Stack[StkP];
  end;
end;

procedure ANDWF(var p: tPic);
var
  T: byte;
begin
  with p do begin
    T := GetFile(Opcode and $7F);
    if (Opcode and $80) = 0 then
      W := T
    else
      SetFile(Opcode and $7F, T);
    SetZeroFlag(p, T = 0);
  end;
  inc(p.PC);
end;

procedure ADDWF(var p: tPic);
var
  T: word;
begin
  with p do begin
    T := GetFile(Opcode and $7F) + W;
    SetCarryFlag(p, T > 255);
    if (Opcode and $80) = 0 then
      W := T
    else
      SetFile(Opcode and $7F, T);
    SetZeroFlag(p, T = 0);
  end;
  inc(p.PC);
end;

procedure CLRF(var p: tPic);
begin
  p.SetFile(p.Opcode and $7F, 0);
  SetZeroFlag(p, true);
  inc(p.PC);
end;

procedure CLRW(var p: tPic);
begin
  p.W := 0;
  SetZeroFlag(p, true);
  inc(p.PC);
end;

procedure COMF(var p: tPic);
var
  T: byte;
begin
  with p do begin
    T := GetFile(Opcode and $7F);
    if (Opcode and $80) = 0 then
      W := T
    else
      SetFile(Opcode and $7F, T);
    SetZeroFlag(p, T = 0);
  end;
  inc(p.PC);
end;

procedure DECF(var p: tPic);
var
  T: byte;
begin
  with p do begin
    T := GetFile(Opcode and $7F) - 1;
    if (Opcode and $80) = 0 then
      W := T
    else
      SetFile(Opcode and $7F, T);
    SetZeroFlag(p, T = 0);
  end;
  inc(p.PC);
end;

procedure DECFSZ(var p: tPic);
begin
  DECF(p);
  if (p.Files[fStatus] and bZero) <> 0 then
    inc(p.PC);
end;

procedure INCF(var p: tPic);
var
  T: byte;
begin
  with p do begin
    T := GetFile(Opcode and $7F) + 1;
    if (Opcode and $80) = 0 then
      W := T
    else
      SetFile(Opcode and $7F, T);
    SetZeroFlag(p, T = 0);
  end;
  inc(p.PC);
end;

procedure INCFSZ(var p: tPic);
begin
  INCF(p);
  if (p.Files[fStatus] and bZero) <> 0 then
    inc(p.PC);
end;

procedure IORWF(var p: tPic);
var
  T: byte;
begin
  with p do begin
    T := W or GetFile(Opcode and $7F);
    if (Opcode and $80) = 0 then
      W := T
    else
      SetFile(Opcode and $7F, T);
    SetZeroFlag(p, T = 0);
  end;
  inc(p.PC);
end;

procedure MOVF(var p: tPic);
var
  T: byte;
begin
  with p do begin
    T := GetFile(Opcode and $7F);
    if (Opcode and $80) = 0 then
      W := T
    else
      SetFile(Opcode and $7F, T);
    SetZeroFlag(p, T = 0);
  end;
  inc(p.PC);
end;

procedure MOVWF(var p: tPic);
begin
  with p do
    SetFile(Opcode and $7F, W);
  inc(p.PC);
end;

procedure NOP(var p: tPic);
begin
  inc(p.PC);
end;

procedure RLF(var p: tPic);
var
  T, tC: byte;
begin
  with p do begin
    T := GetFile(Opcode and $7F);
    tC := T shr 7;
    T := (T shl 1) or (Files[fStatus] and bCarry);
    if (Opcode and $80) = 0 then
      W := T
    else
      SetFile(Opcode and $7F, T);
    SetZeroFlag(p, T = 0);
    SetCarryFlag(p, tC = 1);
  end;
  inc(p.PC);
end;

procedure RRF(var p: tPic);
var
  T, tC: byte;
begin
  with p do begin
    T := GetFile(Opcode and $7F);
    tC := T and 1;
    T := (T shr 1) or ((Files[fStatus] and bCarry) shl 7);
    if (Opcode and $80) = 0 then
      W := T
    else
      SetFile(Opcode and $7F, T);
    SetZeroFlag(p, T = 0);
    SetCarryFlag(p, tC = 1);
  end;
  inc(p.PC);
end;

procedure SUBWF(var p: tPic);
var
  T: byte;
begin
  with p do begin
    T := GetFile(Opcode and $7F) - W;
    SetCarryFlag(p, GetFile(Opcode and $FF) >= W);
    if (Opcode and $80) = 0 then
      W := T
    else
      SetFile(Opcode and $7F, T);
    SetZeroFlag(p, T = 0);
  end;
  inc(p.PC);
end;

procedure SWAPF(var p: tPic);
var
  T: byte;
begin
  with p do begin
    T := GetFile(Opcode and $7F);
    T := (T shr 4) or (T shl 4);
    if (Opcode and $80) = 0 then
      W := T
    else
      SetFile(Opcode and $7F, T);
  end;
  inc(p.PC);
end;

procedure XORWF(var p: tPic);
var
  T: byte;
begin
  with p do begin
    T := GetFile(Opcode and $7F) xor W;
    if (Opcode and $80) = 0 then
      W := T
    else
      SetFile(Opcode and $7F, T);
    SetZeroFlag(p, T = 0);
  end;
  inc(p.PC);
end;

procedure BCF(var p: tPic);
var
  Nrbits: integer;
begin
  with p do begin
    NrBits := (Opcode shr 7) and 7;
    SetFile(Opcode and $7F,
      GetFile(Opcode and $7F) and not (1 shl NrBits));
  end;
  inc(p.PC);
end;

procedure BSF(var p: tPic);
var
  Nrbits: integer;
begin
  with p do begin
    NrBits := (Opcode shr 7) and 7;
    SetFile(Opcode and $7F,
      GetFile(Opcode and $7F) or (1 shl NrBits));
  end;
  inc(p.PC);
end;

procedure BTFSC(var p: tPic);
var
  Nrbits: integer;
begin
  with p do begin
    NrBits := (Opcode shr 7) and 7;
    if (GetFile(Opcode and $7F) and (1 shl NrBits)) = 0 then
      inc(PC);
  end;
  inc(p.PC);
end;

procedure BTFSS(var p: tPic);
var
  Nrbits: integer;
begin
  with p do begin
    NrBits := (Opcode shr 7) and 7;
    if (GetFile(Opcode and $7F) and (1 shl NrBits)) <> 0 then
      inc(PC);
  end;
  inc(p.PC);
end;

procedure ADDLW(var p: tPic);
var
  T: word;
begin
  with p do begin
    T := W + (Opcode and $FF);
    SetCarryFlag(p, T > 255);
    W := T;
    SetZeroFlag(p, W = 0);
  end;
  inc(p.PC);
end;

procedure ANDLW(var p: tPic);
begin
  with p do begin
    W := W and (Opcode and $FF);
    SetZeroFlag(p, W = 0);
  end;
  inc(p.PC);
end;

procedure CLRWDT(var p: tPic);
begin
  inc(p.PC);
end;

procedure IORLW(var p: tPic);
begin
  with p do begin
    W := W or (Opcode and $FF);
    SetZeroFlag(p, W = 0);
  end;
  inc(p.PC);
end;

procedure RETFIE(var p: tPic);
begin
end;

procedure SLEEP(var p: tPic);
begin
end;

procedure SUBLW(var p: tPic);
begin
  with p do begin
    W := (Opcode and $FF) - W;
    SetCarryFlag(p, (Opcode and $FF) >= W);
    SetZeroFlag(p, W = 0);
  end;
  inc(p.PC);
end;

procedure XORLW(var p: tPic);
begin
  with p do begin
    W := (Opcode and $FF) xor W;
    SetZeroFlag(p, W = 0);
  end;
  inc(p.PC);
end;

procedure RETLW(var p: tPic);
begin
  RETURN(p);
  p.W := p.Opcode and $FF;
end;

procedure tPic.Step(Opc: word);
var
  i: integer;
begin
  Opcode := Opc;
  i := 1;
  while (i <= NrInstr) and
        ((Opc and Instr[i].M) <> Instr[i].O) do inc(i);
  if (i <= NrInstr) then
    Instr[i].Pr(Self);
end;

procedure tPic.Reset;
begin
  StkP := 0;
  PC := 0;
  Files[fStatus] := (Files[fStatus] and $7) or $18;
  Files[fPORTA] := (Files[fPORTA] and $F0);
  Files[fOPTION] := $FF;
  Files[fTRISA] := $FF;
  Files[fTRISB] := $FF;
end;

function tPic.GetFile(Nr: byte): byte;
var
  Bank: integer;
begin
  Bank := (Files[fSTATUS] shr 5) and 3;
  case Nr of
      0: GetFile := Files[Files[fFSR]];
      2, 3, 4,10, 11:
         GetFile := Files[Nr];
    else GetFile := Files[Bank*128 + Nr];
  end;
end;

function tPic.GetFileAbs(Nr: word): byte;
begin
  case Nr of
      0: GetFileAbs := Files[Files[fFSR]];
    else GetFileAbs := Files[Nr];
  end;
end;

procedure tPic.SetFile(Nr, V: byte);
var
  Bank: integer;
begin
  Bank := (Files[fSTATUS] shr 5) and 3;
  case Nr of
      0: Files[Files[fFSR]] := V;
      2, 3, 4, 10, 11:
         Files[Nr] := V;
    else Files[Bank*128 + Nr] := V;
  end;
end;

begin
end.