Add files via upload

This commit is contained in:
Tito Hinostroza 2018-08-09 22:04:37 -05:00 committed by GitHub
parent 38809bf81b
commit 8b36a3178c
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
10 changed files with 2501 additions and 1 deletions

555
CPUCore.pas Normal file
View File

@ -0,0 +1,555 @@
{PICCore
Contains basic definitions applicable to all PIC microcontroller Cores
Created by Tito Hinostroza 28/04/2018
}
unit CPUCore;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LCLProc;
const
PIC_MAX_PINES = 64; //Max. number of pines for the package
type
//Union to access bytes of a word
TWordRec = record
case byte of
1 : (W : Word);
{$IFDEF ENDIAN_LITTLE}
2 : (L, H: Byte);
{$ELSE}
2 : (H, L: Byte);
{$ENDIF}
end;
TCPUCellState = (
cs_impleGPR, //Implemented. Can be used.
cs_unimplem //Not implemented.
);
TCPUPinType = (
pptVcc, //Alimentación
pptGND, //Tierra
pptControl,//Pin de control
pptPort, //Puerto Entrada/Salida
pptUnused //Pin no usado
);
{ TCPUPin }
//Model for a phisycal pin of the PIC
TCPUPin = object
nam: string; //Eqtiueta o nombre
typ: TCPUPinType; //Tipo de pin
add: word; //Dirección en RAM
bit: byte; //Bit en RAM
function GetLabel: string;
end;
TCPUPinPtr = ^TCPUPin;
type //Models for RAM memory
{ TCPURamCell }
{Modela a una dirección lógica de la memoria RAM. Se ha taratdo de hacer una
definición eficiente de esta estructura para facilitar la implementación de
simuladores en tiempo real. Podemos usar un tamaño mediano para este registro,
porque no esperamos tener muchas celdas de RAM (<1K).}
TCPURamCellPtr = ^TCPURamCell;
TCPURamCell = object
private
Fvalue : byte; //value of the memory
function Getvalue: byte;
procedure Setvalue(AValue: byte);
public
addr : word; //dirección física de memoria, en donde está la celda.
name : string; //Name of the register (or variable)
used : boolean; //Indicates if have been written
shared : boolean; //Used to share this register
state : TCPUCellState; //Status of the cell
property value: byte read Getvalue write Setvalue;
property dvalue: byte read Fvalue write Fvalue; //Direct access to "Fvalue".
function AvailGPR: boolean;
public //Campos para deputación
breakPnt : boolean; //Indicates if this cell have a Breakpoint
{Be careful on the size of this record, because it's going to be multiplied by 64K}
public //Information of position in source code. Used for debug
rowSrc : word; //Row number
colSrc : word; //Column number
idFile : SmallInt; //Index to a file. No load the name to save space.
{Estos campos de cadena ocupan bastante espacio, aún cuado están en NULL. Si se
quisiera optimizar el uso de RAM, se podría pensar en codificar, varios campos en
una sola cadena.}
topLabel : string; //Label on the top of the cell.
topComment : string; //Comment on the top of the cell.
sideComment: string; //Right comment to code
end;
TCPURam = array of TCPURamCell;
TCPURamPtr = ^TCPURam;
TCPURutExplorRAM = procedure(offs, bnk: byte; regPtr: TCPURamCellPtr) of object;
type
{ TCPUCore }
{Abcestor of all 8 bits PIC cores}
TCPUCore = class
public //Limits
{This variables are set just one time. So they work as constant.}
CPUMAXRAM : word; //Max virtual RAM used by the CPU
public //General fields
Model : string; //modelo de PIC
frequen : integer; //frecuencia del reloj
MaxFreq : integer; //máxima frecuencia del reloj
//Propiedades que definen la arquitectura del CPU.
MsjError: string;
public //Execution control
nClck : Int64; //Contador de ciclos de reloj
CommStop: boolean; //Bandera para detener la ejecución
OnExecutionMsg: procedure(message: string) of object; //Genera mensaje en ejecución
protected //Generation of HEX files
minUsed : word; //Dirección menor de la ROM usada
maxUsed : word; //Dirección mayor de la ROM usdas
hexLines : TStringList; //Uusado para crear archivo *.hex
public //Memories
ram : TCPURam; //memoria RAM
iRam : integer; //puntero a la memoria RAM, para escribir cuando se ensambla o compila código.
function DisassemblerAt(addr: word; out nBytesProc: byte; useVarName: boolean
): string; virtual; abstract; //Desensambla la instrucción actual
public //RAM memory functions
procedure ClearMemRAM;
procedure DisableAllRAM;
procedure SetStatRAM(i1, i2: word; status0: TCPUCellState);
function SetStatRAMCom(strDef: string): boolean;
function MapRAMtoPIN(strDef: string): boolean;
function HaveConsecRAM(const i, n: word; maxRam: word): boolean; //Indica si hay "n" bytes libres
procedure UseConsecRAM(const i, n: word); //Ocupa "n" bytes en la posición "i"
procedure SetSharedUnused;
procedure SetSharedUsed;
public //ram memory functions
function UsedMemRAM: word; //devuelve el total de memoria ram usada
public //Pins fields
Npins : byte; //Number of pins
pines : array[1..PIC_MAX_PINES] of TCPUPin;
procedure ResetPins;
procedure SetPin(pNumber: integer; pLabel: string; pType: TCPUPinType);
function SetPinName(strDef: string): boolean;
public //RAM name managment
function NameRAM(const addr: word): string;
procedure SetNameRAM(const addr: word; const nam: string); //Fija nombre a una celda de RAM
procedure AddNameRAM(const addr: word; const nam: string); //Agrega nombre a una celda de RAM
public //Execution control
procedure AddBreakpoint(aPC: word);
procedure ToggleBreakpoint(aPC: word);
procedure Exec(aPC: word); virtual; abstract; //Ejecuta la instrucción en la dirección indicada.
procedure Exec; virtual; abstract; //Ejecuta instrucción actual
procedure ExecTo(endAdd: word); virtual; abstract; //Ejecuta hasta cierta dirección
procedure ExecStep; virtual; abstract; //Execute one instruction considering CALL as one instruction
procedure ExecNCycles(nCyc: integer; out stopped: boolean); virtual; abstract; //Ejecuta hasta cierta dirección
procedure Reset; virtual; abstract;
function ReadPC: dword; virtual; abstract; //Defined DWORD to cover the 18F PC register
procedure WritePC(AValue: dword); virtual; abstract;
public //Others
procedure addTopLabel(lbl: string); //Add a comment to the ASM code
procedure addTopComm(comm: string; replace: boolean = true); //Add a comment to the ASM code
procedure addSideComm(comm: string; before: boolean); //Add lateral comment to the ASM code
procedure addPosInformation(rowSrc, colSrc: word; idFile: byte);
public //Initialization
constructor Create; virtual;
destructor Destroy; override;
end;
implementation
{ TCPURamCell }
function TCPURamCell.Getvalue: byte;
begin
Result := Fvalue;
end;
procedure TCPURamCell.Setvalue(AValue: byte);
begin
Fvalue := AValue;
end;
function TCPURamCell.AvailGPR: boolean;
{Indica si el registro es una dirección disponible en la memoria RAM.}
begin
Result := (state = cs_impleGPR);
end;
{ TCPUPin }
function TCPUPin.GetLabel: string;
{Devuelve una etiqueta para el pin}
begin
case typ of
pptUnused: Result := 'NC';
else
Result := nam;
end;
end;
{ TCPUCore }
//RAM memory functions
procedure TCPUCore.ClearMemRAM;
{Limpia el contenido de la memoria}
var
i: Integer;
begin
for i:=0 to high(ram) do begin
ram[i].dvalue := $00;
ram[i].used := false;
ram[i].name:='';
ram[i].shared := false;
ram[i].breakPnt := false;
ram[i].topLabel := '';
ram[i].sideComment:= '';
ram[i].topComment := '';
ram[i].idFile := -1; //Indica no inicializado
// ram[i].state := cs_unimplem; //por defecto se considera no implementado
end;
end;
procedure TCPUCore.DisableAllRAM;
{Inicia el estado de toda la memoria RAM física definida em el Modelo.
Solo debería usarse, para cuando se va a definir el hardware del dispositivo.}
var
i: word;
begin
for i:=0 to high(ram) do begin
ram[i].addr := i;
ram[i].state := cs_unimplem;
end;
//Inicia estado de pines
for i:=1 to high(pines) do begin
pines[i].typ := pptUnused;
end;
end;
procedure TCPUCore.SetStatRAM(i1, i2: word; status0: TCPUCellState);
{Inicia el campo State, de la memoria. Permite definir el estado real de la memoria RAM.
}
var
i: Integer;
begin
for i:=i1 to i2 do begin //verifica 1 a 1, por seguridad
if i>CPUMAXRAM-1 then continue; //protection
ram[i].state := status0;
end;
end;
function TCPUCore.SetStatRAMCom(strDef: string): boolean;
{Define el estado de la memoria RAM, usando una cadena de definición.
La cadena de definición, tiene el formato:
<comando 1>, <comando 2>, ...
Cada comando, tiene el formato:
<dirIni>-<dirFin>:<estado de memoria>
Un ejemplo de cadena de definición, es:
'000-01F:IMP, 020-07F:NIM'
Si hay error, devuelve FALSE, y el mensaje de error en MsjError.
}
var
coms: TStringList;
add1, add2: longint;
state: TCPUCellState;
staMem, com, str: String;
begin
Result := true;
coms:= TStringList.Create;
try
coms.Delimiter := ',';
coms.DelimitedText := strDef;
for str in coms do begin
com := UpCase(trim(str));
if com='' then continue;
if length(com)<>11 then begin
MsjError := 'Memory definition syntax error: Bad string size.';
exit(false);
end;
if com[4] <> '-' then begin
MsjError := 'Memory definition syntax error: Expected "-".';
exit(false);
end;
if com[8] <> ':' then begin
MsjError := 'Memory definition syntax error: Expected ":".';
exit(false);
end;
//Debe tener el formato pedido
if not TryStrToInt('$'+copy(com,1,3), add1) then begin
MsjError := 'Memory definition syntax error: Wrong address.';
exit(false);
end;
if not TryStrToInt('$'+copy(com,5,3), add2) then begin
MsjError := 'Memory definition syntax error: Wrong address.';
exit(false);
end;
staMem := copy(com, 9, 3);
case staMem of
'IMP': state := cs_impleGPR;
'NIM': state := cs_unimplem;
else
MsjError := 'Memory definition syntax error: Expected SFR or GPR';
exit(false);
end;
//Ya se tienen los parámetros, para definir la memoria
SetStatRAM(add1, add2, state);
end;
finally
coms.Destroy;
end;
end;
function TCPUCore.MapRAMtoPIN(strDef: string): boolean;
{Mapea puertos de memoria RAM a pines físicos del dispositivo. Útil para la simulación
La cadena de definición, tiene el formato:
<dirección>:<comando 1>, <comando 2>, ...
Cada comando, tiene el formato:
<dirIni>:<bit>-<pin>
Un ejemplo de cadena de definición, es:
'005:0-17,1-18,2-1,3-2,4-3'
Si hay error, devuelve FALSE, y el mensaje de error en MsjError.
}
var
coms: TStringList;
add1, pin, bit: longint;
com, str, ramName: String;
pSep: SizeInt;
begin
Result := true;
//Obtiene dirección
if length(strDef) < 4 then begin
MsjError := 'Syntax error';
exit(false);
end;
if strDef[4] <> ':' then begin
MsjError := 'Expected "<3-digits address>"';
exit(false);
end;
if not TryStrToInt('$'+copy(strDef,1,3), add1) then begin
MsjError := 'Address format error.';
exit(false);
end;
delete(strDef, 1, 4); //quita la dirección
//Obtiene lista de asociaciones
coms:= TStringList.Create;
try
coms.Delimiter := ',';
coms.DelimitedText := strDef;
for str in coms do begin
com := UpCase(trim(str)); //asociación
if com='' then continue;
pSep := pos('-',com); //Posición de separador
if pSep = 0 then begin
MsjError := 'Expected "-".';
exit(false);
end;
//Debe tener el formato pedido
// debugln(com);
if not TryStrToInt(copy(com,1,pSep-1), bit) then begin
MsjError := 'Error in bit number.';
exit(false);
end;
if not TryStrToInt(copy(com,pSep+1,length(com)), pin) then begin
MsjError := 'Error in pin number.';
exit(false);
end;
if (pin<0) or (pin>PIC_MAX_PINES) then begin
MsjError := 'Pin number out of range.';
exit(false);
end;
if pin>Npins then begin
MsjError := 'Pin number out of range, for this device.';
exit(false);
end;
//Ya se tiene el BIT y el PIN. Configura datos del PIN
pines[pin].add := add1;
pines[pin].bit := bit;
pines[pin].typ := pptPort;
ramName := ram[add1].name;
if ramName='' then ramName := 'PORT';
pines[pin].nam := ramName + '.' + IntToStr(bit); //Nombre por defecto
end;
finally
coms.Destroy;
end;
end;
procedure TCPUCore.ResetPins;
{Reset the pins of the device.}
var
i: byte;
begin
for i:=1 to Npins do begin
pines[i].nam := ' ';
pines[i].typ := pptUnused;
end;
end;
procedure TCPUCore.SetPin(pNumber: integer; pLabel: string; pType: TCPUPinType);
begin
if pNumber>PIC_MAX_PINES then exit;
pines[pNumber].nam := pLabel;
pines[pNumber].typ := pType;
end;
function TCPUCore.SetPinName(strDef: string): boolean;
{Define the name for a specified Pin of the microcontroller, using a string.
"strDef" have the format:
<pin number>:<name of the pin>
On error this function return FALSE, and the error menssage in MsjError.
}
var
com, pinName: String;
pNumber: integer;
pcol: SizeInt;
begin
com := UpCase(trim(strDef));
if com='' then exit;
pcol := Pos(':', strDef);
if pcol=0 then begin
MsjError := 'SetPinName: Expected ":".';
exit(false);
end;
//"com" must have the correct format
if not TryStrToInt( copy(com, 1, pcol-1) , pNumber) then begin
MsjError := 'SetPinName: Wrong Pin Number.';
exit(false);
end;
pinName :=copy(com, pcol+1, 32); //limited to 32
SetPin(pNumber, pinName, pptControl);
end;
function TCPUCore.HaveConsecRAM(const i, n: word; maxRam: word): boolean;
{Indica si hay "n" bytes consecutivos libres en la posicióm "i", en RAM.
La búsqueda se hace solo hasta la posición "maxRam"}
var
c: Integer;
j: word;
begin
Result := false;
c := 0;
j := i;
while (j<=maxRam) and (c<n) do begin
if (ram[j].state <> cs_impleGPR) or (ram[j].used) then exit;
inc(c); //verifica siguiente
inc(j);
end;
if j>maxRam then exit; //no hay más espacio
//Si llega aquí es porque estaban libres los bloques
Result := true;
end;
procedure TCPUCore.UseConsecRAM(const i, n: word);
{Marca "n" bytes como usados en la posición de memoria "i", en la RAM.
Debe haberse verificado previamente que los parámetros son válidos, porque aquí no
se hará ninguna verificación.}
var j: word;
begin
for j:=i to i+n-1 do begin
ram[j].used := true; //todos los bits
end;
end;
procedure TCPUCore.SetSharedUnused;
{Marca las posiciones que estén en "shared", como no usadas, para que se puedan
usar nuevamente.}
var
i: Integer;
begin
for i:=0 to high(ram) do begin
if (ram[i].state = cs_impleGPR) and (ram[i].shared) then begin
ram[i].used := false; //pone en cero
end;
end;
end;
procedure TCPUCore.SetSharedUsed;
{Marca las posiciones que estén en "shared", como usadas, para que no se puedan
usar nuevamente.}
var
i: Integer;
begin
for i:=0 to high(ram) do begin
if (ram[i].state = cs_impleGPR) and (ram[i].shared) then begin
ram[i].used := true; //pone en uno
end;
end;
end;
function TCPUCore.UsedMemRAM: word;
var
i: Integer;
begin
Result := 0;
for i:=$0000 to CPUMAXRAM-1 do begin
if ram[i].used then inc(Result);
end;
end;
//RAM name managment
function TCPUCore.NameRAM(const addr: word): string;
{Devuelve el nombre de una celda de la memoria RAM.}
begin
Result := ram[addr].name;
end;
procedure TCPUCore.SetNameRAM(const addr: word; const nam: string
);
{Escribe en el campo "name" de la RAM en la psoición indicada}
begin
ram[addr].name:=nam;
end;
procedure TCPUCore.AddNameRAM(const addr: word; const nam: string);
{Escribe en el campo "name" de la RAM en la psoición indicada. Si ya existía un nombre,
lo argega después de una coma.}
begin
if ram[addr].name = '' then begin
ram[addr].name:=nam;
end else begin
ram[addr].name+=','+nam;
end;
end;
//Execution control
procedure TCPUCore.AddBreakpoint(aPC: word);
//Agrega un punto de interrupción
begin
if aPC>=CPUMAXRAM then exit;
ram[aPC].breakPnt := true;
end;
procedure TCPUCore.ToggleBreakpoint(aPC: word);
//COnmuta el estado del Punto de Interrupción, en la posición indicada
begin
if aPC>=CPUMAXRAM then exit;
ram[aPC].breakPnt := not ram[aPC].breakPnt;
end;
procedure TCPUCore.addTopLabel(lbl: string);
begin
ram[iRam].topLabel := lbl;
end;
procedure TCPUCore.addTopComm(comm: string; replace: boolean);
{Agrega un comentario de línea al código en la posición de memoria actual}
begin
if replace then begin
ram[iRam].topComment := comm;
end else begin
ram[iRam].topComment := ram[iRam].topComment + comm;
end;
end;
procedure TCPUCore.addSideComm(comm: string; before: boolean);
{Agrega un comentario para que apareza al lado de la instrucción.
"before" = TRUE -> Se debe llamar después de codificar la instrucción
"before" = FALSE -> Se debe llamar antes de codificar la instrucción
}
begin
if before then begin
if iRam= 0 then exit;
ram[iRam-1].sideComment+=comm; //se agrega al que pudiera haber
end else begin
if iRam= 0 then exit;
ram[iRam].sideComment+=comm; //se agrega al que pudiera haber
end;
end;
procedure TCPUCore.addPosInformation(rowSrc, colSrc: word; idFile: byte);
{Agrega information de la posición en el codigo fuente, a la posición actual de la
memoria RAM.}
begin
ram[iRam].rowSrc := rowSrc;
ram[iRam].colSrc := colSrc;
ram[iRam].idFile := idFile;
end;
//Initialization
constructor TCPUCore.Create;
begin
hexLines := TStringList.Create;
frequen := 4000000; //4MHz
end;
destructor TCPUCore.Destroy;
begin
hexLines.Destroy;
inherited Destroy;
end;
initialization
end.
//659

View File

@ -1,5 +1,10 @@
0.1
===
Se eliminan algunos campos no usados, porque esta librería se ha creado a partir de la librería
PicUtils que contiene más detalle en cuanto al hardware.
Se corrige errores en el ejemplo de ensamblador.
0.0
===
Primera versión compilable de la librería.
Aún queda pendiente la implementación de la ejecución de las instrucciones, y revisar todo la librería para quitar elementos no usados ya que esta libraría se ha creado a partir de la librería PicUtils.

View File

@ -0,0 +1,4 @@
poke 0,165
poke 1,0
poke 2,133
poke 3,0

View File

@ -0,0 +1,80 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="10"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="project1"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LCL"/>
</Item1>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="project1"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value=".."/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

View File

@ -0,0 +1,21 @@
program project1;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, Unit1
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource := True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

148
MiniAssembler/project1.lps Normal file
View File

@ -0,0 +1,148 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectSession>
<PathDelim Value="\"/>
<Version Value="10"/>
<BuildModes Active="Default"/>
<Units Count="5">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="-1"/>
<TopLine Value="-1"/>
<CursorPos X="-1" Y="-1"/>
<UsageCount Value="60"/>
</Unit0>
<Unit1>
<Filename Value="unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
<TopLine Value="152"/>
<CursorPos Y="171"/>
<UsageCount Value="60"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit1>
<Unit2>
<Filename Value="..\p6502utils.pas"/>
<UnitName Value="P6502utils"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="1"/>
<FoldState Value=" TL00C1414113 T4H01 T5J0{W11]ACjEK5 T7jPJC T8jQ26132 T3m8051]ZD2]E0nFD7I2K T6n601D THnEF%2?"/>
<UsageCount Value="32"/>
<Bookmarks Count="1">
<Item0 Y="1211" ID="1"/>
</Bookmarks>
<Loaded Value="True"/>
</Unit2>
<Unit3>
<Filename Value="..\CPUCore.pas"/>
<EditorIndex Value="2"/>
<TopLine Value="472"/>
<CursorPos X="6" Y="486"/>
<FoldState Value=" TL0040211193 T4801 T5A[64CED8 T7dC6 T8iE230122145 T3kX0331]mHl8B4]i6lI01A T0leR3C pjAjYN3857 TDmZ2e]ZEnU]+'"/>
<UsageCount Value="25"/>
<Bookmarks Count="1">
<Item0 Y="117" ID="3"/>
</Bookmarks>
<Loaded Value="True"/>
</Unit3>
<Unit4>
<Filename Value="C:\lazarus\lcl\include\control.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="2838"/>
<CursorPos Y="2861"/>
<UsageCount Value="10"/>
</Unit4>
</Units>
<JumpHistory Count="22" HistoryIndex="21">
<Position1>
<Filename Value="..\p6502utils.pas"/>
<Caret Line="1223" Column="3" TopLine="1169"/>
</Position1>
<Position2>
<Filename Value="..\p6502utils.pas"/>
</Position2>
<Position3>
<Filename Value="..\p6502utils.pas"/>
<Caret Line="208" Column="30" TopLine="167"/>
</Position3>
<Position4>
<Filename Value="..\p6502utils.pas"/>
<Caret Line="363" Column="17" TopLine="254"/>
</Position4>
<Position5>
<Filename Value="..\p6502utils.pas"/>
</Position5>
<Position6>
<Filename Value="..\p6502utils.pas"/>
<Caret Line="226" TopLine="211"/>
</Position6>
<Position7>
<Filename Value="..\p6502utils.pas"/>
</Position7>
<Position8>
<Filename Value="..\p6502utils.pas"/>
<Caret Line="259" Column="21" TopLine="218"/>
</Position8>
<Position9>
<Filename Value="..\p6502utils.pas"/>
<Caret Line="355" Column="65" TopLine="252"/>
</Position9>
<Position10>
<Filename Value="..\p6502utils.pas"/>
<Caret Line="368" Column="5" TopLine="265"/>
</Position10>
<Position11>
<Filename Value="..\p6502utils.pas"/>
<Caret Line="373" Column="32" TopLine="265"/>
</Position11>
<Position12>
<Filename Value="..\p6502utils.pas"/>
<Caret Line="1060" Column="49" TopLine="963"/>
</Position12>
<Position13>
<Filename Value="..\p6502utils.pas"/>
<Caret Line="1085" Column="49" TopLine="1064"/>
</Position13>
<Position14>
<Filename Value="..\p6502utils.pas"/>
</Position14>
<Position15>
<Filename Value="..\p6502utils.pas"/>
<Caret Line="370" Column="8" TopLine="354"/>
</Position15>
<Position16>
<Filename Value="..\p6502utils.pas"/>
<Caret Line="369" Column="28" TopLine="354"/>
</Position16>
<Position17>
<Filename Value="..\p6502utils.pas"/>
<Caret Line="1148" TopLine="1141"/>
</Position17>
<Position18>
<Filename Value="..\p6502utils.pas"/>
<Caret Line="207" Column="33" TopLine="180"/>
</Position18>
<Position19>
<Filename Value="..\p6502utils.pas"/>
</Position19>
<Position20>
<Filename Value="..\p6502utils.pas"/>
<Caret Line="1077" Column="62" TopLine="957"/>
</Position20>
<Position21>
<Filename Value="..\p6502utils.pas"/>
<Caret Line="1446" Column="12" TopLine="1155"/>
</Position21>
<Position22>
<Filename Value="..\CPUCore.pas"/>
<Caret Line="155" Column="6" TopLine="121"/>
</Position22>
</JumpHistory>
</ProjectSession>
</CONFIG>

BIN
MiniAssembler/project1.res Normal file

Binary file not shown.

55
MiniAssembler/unit1.lfm Normal file
View File

@ -0,0 +1,55 @@
object Form1: TForm1
Left = 265
Height = 368
Top = 159
Width = 530
Caption = 'Form1'
ClientHeight = 368
ClientWidth = 530
OnCreate = FormCreate
OnDestroy = FormDestroy
LCLVersion = '1.8.0.6'
object Memo1: TMemo
Left = 10
Height = 312
Top = 40
Width = 190
Lines.Strings = (
'LDA'
'STA $10'
)
TabOrder = 0
end
object Button1: TButton
Left = 216
Height = 25
Top = 40
Width = 88
Caption = 'Assemble>>'
OnClick = Button1Click
TabOrder = 1
end
object Memo2: TMemo
Left = 320
Height = 312
Top = 40
Width = 190
TabOrder = 2
end
object Label1: TLabel
Left = 10
Height = 15
Top = 10
Width = 31
Caption = 'CODE'
ParentColor = False
end
object Label2: TLabel
Left = 328
Height = 15
Top = 10
Width = 46
Caption = 'HEX FILE'
ParentColor = False
end
end

186
MiniAssembler/unit1.pas Normal file
View File

@ -0,0 +1,186 @@
{Sample of how to create a very basic assembler tool, using the unit pic16utils.}
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
P6502utils;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
Label2: TLabel;
Memo1: TMemo;
Memo2: TMemo;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
pic: TP6502;
function CaptureComma(var lin: string): boolean;
function ExtractNumber(var lin: string; out num: word): boolean;
function ExtractString(var lin: string; var str: string): boolean;
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
function TForm1.ExtractString(var lin: string; var str: string): boolean;
var
tmp: String;
i: Integer;
begin
Result := true;
lin := trim(lin); //trim
if lin='' then begin
Application.MessageBox('Expected identifier.','');
Result := false;
exit;
end;
tmp := '';
i:=1;
while lin[i] in ['a'..'z','A'..'Z'] do begin
tmp += lin[i];
inc(i);
end;
lin := copy(lin,i,100);
lin := trim(lin); //trim
str := tmp;
if str = '' then begin
//No string found
exit(false);
end;
end;
function TForm1.ExtractNumber(var lin: string; out num: word): boolean;
var
tmp: String;
i: Integer;
begin
Result := true;
lin := trim(lin); //trim
if lin='' then begin
Application.MessageBox('Expected number.','');
Result := false;
exit;
end;
tmp := '';
i:=1;
while lin[i] in ['$','0'..'9','x','X'] do begin
tmp += lin[i];
inc(i);
end;
lin := copy(lin,i,100);
lin := trim(lin); //trim
if LowerCase( copy(tmp,1,2)) = '0x' then
num := StrToInt('$' + copy(tmp,3,100))
else
num := StrToInt(tmp);
end;
function TForm1.CaptureComma(var lin: string): boolean;
begin
Result := true;
lin := trim(lin); //trim
if lin='' then begin
Application.MessageBox('Expected comma.','');
Result := false;
exit;
end;
if lin[1]<>',' then begin
Application.MessageBox('Expected comma.','');
Result := false;
exit;
end;
lin := copy(lin,2,100);
lin := trim(lin); //trim
end;
procedure TForm1.Button1Click(Sender: TObject);
var
l: String;
idInst: TP6502Inst;
Inst: String;
stx, lin, Par: String;
n: word;
begin
pic.iRam:=0; //Start to code at $0000
pic.MsjError:=''; //Clear error
for lin in Memo1.Lines do begin
l := lin; //crea copia para modificar
if trim(l) = '' then continue;
if not ExtractString(l, Inst) then begin //extract mnemonic
Application.MessageBox('Syntax Error','');
exit;
end;
//Find mnemonic, and parameters
idInst := pic.FindOpcode(Inst);
if idInst = i_Inval then begin
Application.MessageBox(PChar('Invalid Opcode: '+ Inst),'');
exit;
end;
//Extract parameters
if l = '' then begin
//No parameters. Must be Implicit
pic.codAsmFD(idInst, aImplicit , 0);
if pic.MsjError<>'' then begin
Application.MessageBox(PChar(lin + ':' + pic.MsjError),'');
exit;
end;
end else if ExtractString(l, Par) then begin //extract mnemonic
//It's a string
if Par = 'A' then begin
//Accumulator mode
pic.codAsmFD(idInst, aAcumulat , 0);
if pic.MsjError<>'' then begin
Application.MessageBox(PChar(lin + ':' + pic.MsjError),'');
exit;
end;
end else begin
Application.MessageBox(PChar(lin + ': Syntax error' ),'');
end;
end else if ExtractNumber(l, n) then begin
//There is a number
if n<256 then begin
//Zero page. Although could be ,X
pic.codAsmFD(idInst, aZeroPage , 0);
if pic.MsjError<>'' then begin
Application.MessageBox(PChar(lin + ':' + pic.MsjError),'');
exit;
end;
end else begin
//Absolute. Although could be ,X
pic.codAsmFD(idInst, aAbsolute , 0);
if pic.MsjError<>'' then begin
Application.MessageBox(PChar(lin + ':' + pic.MsjError),'');
exit;
end;
end;
end else begin
//Not a string, nor a number, nor empty
Application.MessageBox('Syntax Error','');
exit;
end;
end;
pic.GenHex(Application.ExeName + '.hex');
Memo2.Lines.LoadFromFile(Application.ExeName + '.hex');
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
pic := TP6502.Create;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
pic.Destroy;
end;
end.

1446
P6502utils.pas Normal file

File diff suppressed because it is too large Load Diff