(*
* pSIMPLETRON 1.0
*
* COMPLETATO IL 07/09/2014
*
* BY NOVA99
*)
unit LMS;
interface
uses crt;
var (*MEMORIE DI SISTEMA*)
InstructionReg:Array[0..100] of integer; //MEMORIA DEL PROGRAMMA
InstructionMem:Array[0..100] of integer; //CRONOLOGIA DELLE ISTRUZIONI ESEGUITE
Memory:Array[0..100] of real; //MEMORIA VARIABILI
(*REGISTRI*)
numI:byte; //CONTATORE ISTRUZIONI
operationCode:integer; //IDENTIFICATORE DELL'OPERAZIONE DA ESEGUIRE
operand:integer; //IDENTIFICATORE DELLA POSZIONE DELLA VARIABILE IN USO
accumulator:real; //ACCUMULATORE ARITMETICO
aux_accumulator:real; //ACCUMULATORE AUSILIARIO
exit_correct:string[12]='SUCCESSFUL'; //REGISTRO DEL TIPO DI USCITA
cont:byte=00; //VARIABILE DI SERVIZIO
const (*OPERAZIONI DI I/O*)
CIN = 10; //INPUT
COUT = 11; //OUTPUT
(*OPERAZIONI DI GESTIONE DELLA MEMORIA (x = Memory[ x ]) *)
LOAD = 20; //CARICA NELL'ACCUMULATORE
STORE = 21; //SALVA IN x
DELETE = 22; //RESETTA x
RESET = 23; //RESETTA LA MEMORIA
RESETINSTR = 24; //RESETTA LA CRONOLOGIA DELLE ISTRUZIONI
LOADAUX = 25; //CARICA x NELL'ACCUMULATORE AUSILIARIO
(*OPERAZIONI MATEMATICHE FONDAMENTALI (x = Memory[ x ]) *)
ADD = 30; //AGGIUNGE x ALL'ACCUMULATORE
SUBTR = 31; //SOTTRAE x " "
DIVIS = 32; //DIVIDE L'ACCUMULATORE PER x
MULT = 33; //MOLTIPLICA L'ACCUMULATORE PER x
QUOZ = 34; //QUOTA L'ACCUMULATORE PER x
RES = 35; //CALCOLA IL RESTO DELL'OP. PRECEDENTE
ROOF = 36; //ARROTONDA x ALL'INTERO MINORE PIU' VICINO
CEIL = 37; // " " " " MAGGIORE PIU' VICINO
FROUND = 38; //ARROTONDA x
FABS = 39; //CALCOLA IL VALORE ASSOLUTO DI x
(*OPERAZIONI DI CONTROLLO (x = Memory[ x ], y = InstructionReg[ y ]) *)
BRANCH = 40; //SALTA A y
BRANCHNEG = 41; // " " " " SE L'ACCUMULATORE E' NEGATIVO
BRANCHZERO = 42; // " " " " " " " ZERO
BRANCHPOS = 43; // " " " " " " " POSITIVO
HALT = 44; //INTERROMPE L'ESECUZIONE
PAUSE = 45; //METTE IN PAUSA L'ESECUZIONE E CHIEDE UN INPUT PER CONTINUARE
RETARD = 46; //RITARDA L'ESECUZIONE PER x SECONDI
BRANCHMORE = 47; //SALTA A y SE ACCUMULATORE > ACCUMULATORE_AUSLIARIO
BRANCHEQL = 48; // " " " " " = "
BRANCHLESS = 49; // " " " " " < "
(*OPERAZIONI MATEMATICHE AVANZATE (x = Memory[ x ]) *)
FSQRT = 50; //CALCOLA LA RADICE DI x |
FSQR = 51; // " IL QUADRATO DI x |
FEXP = 52; // " L'ESPONENZIALE DI x > SALVA IN X
FLOG = 53; // " IL LOGARITMO DECIMALE DI x |
FLN = 54; // " " " NATURALE " "
POW = 55; // " ACCUMULATORE ^ x
ROOT = 56; // " x-esima RADICE DELL'ACCUMULATORE
FSIN = 57; // " IL SENO DI x |
FCOS = 58; // " " COSENO DI x > SALVA IN X
FTAN = 59; // " LA TANGENTE DI x |
(*OPERAZIONE AUSILIARIA*)
STOPLOAD = 9999; //INTERROMPE L'INSERIMENTO DEL PROGRAMMA
CodeMem : SET OF byte = [CIN, COUT, LOAD..LOADAUX, ADD..FABS, BRANCH..BRANCHLESS, FSQRT..FTAN, 99]; //MEMORIA DELLE FUNZIONI UTILIZZABILI
procedure Caption; //VISUALIZZA A VIDEO L'INTESTAZIONE
procedure GetInstr; //ACQUISISCE LE ISTRUZIONI
function InstrOK:boolean; //CONTROLLA IL CODICE INSERITO
procedure ExeInstr; //ESEGUE IL PROGRAMMA
procedure ViewDump; //VISUALIZZA IL DUMP DI MEMORIA
implementation
procedure Caption;
begin
clrscr;
writeln('*** WELCOME TO SIMPLETRON! ***');
writeln('*** PLEASE ENTER YOUR PROGRAM ONE INSTRUCTION ***');
writeln('*** (OR DATA WORD) AT A TIME. I WILL TYPE THE ***');
writeln('*** LOCATION NUMBER AND A QUESTION MARK (?). ***');
writeln('*** YOU THEN TYPE THE WORD FOR THAT LOCATION. ***');
writeln('*** TYPE THE SENTINEL 9999 TO STOP ENTERING ***');
writeln('*** YOUR PROGRAM ***');
writeln;writeln;
end;
procedure GetInstr;
begin
numI:=0;
repeat
begin
write(numI, ' ? ');
readln( InstructionReg[ numI ] );
numI += 1;
end;
until InstructionReg[ numI-1 ] = STOPLOAD;
writeln;writeln;
write('*** PROGRAM LOADING COMPLETE ***');
writeln;writeln;
write('*** START PROGRAM CONTROL... ***');
writeln;writeln;
end;
function InstrOK:boolean;
var err_num:byte = 0;
warn_num:byte = 0;
halt_flag:boolean=false;
begin
numI:=00;
if (InstructionReg[ 0 ] = 9999) then //SE L'UNICA ISTRUZIONE PRESENTE E' STOPLOAD IL PROGRAMMA NON PUO' (OVVIAMENTE) ESSERE ESEGUITO
begin
writeln;
writeln('*** ERROR FOUND IN LINE N°0: ***');
writeln('*** NO INSTRUCTION BEFORE STOPLOAD (9999) ***');
writeln;
err_num:=1;
end
else
begin
repeat
//CONTROLLA SE L'ISTRUZIONE E' COMPRESA TRA STOPLOAD (9999) E L'INPUT ALLA VARIABILE 0 (1000)
if NOT( InstructionReg[ numI ] = STOPLOAD) AND NOT( (InstructionReg[ numI ] < 6000) AND (InstructionReg[ numI ] > 999) ) then
begin
err_num+=1;
writeln;
writeln('*** ERROR FOUND IN LINE N°', numI, ': ***');
writeln('*** INSTRUCTION ''', InstructionReg[ numI ], ''' IS OUT OF THE ALLOWED RANGE ***');
writeln;
end;
operationCode:=InstructionReg[ numI ] div 100;
operand:=InstructionReg[ numI ] mod 100;
//CONTROLLA CHE IL CODICE DELL'OPERAZIONE ESISTA IN MEMORIA
if NOT( operationCode in CodeMem ) then
begin
err_num+=1;
writeln;
writeln('*** ERROR FOUND IN LINE N°', numI:2, ': ***');
writeln('*** INSTRUCTION CODE ''', operationCode, ''' NOT FOUND ***');
writeln;
end
else
begin
if ( operand > 1) AND ( operationCode = PAUSE) then //LA FUNZIONE PAUSE ACCETTA COME ARGOMENTI 0 O 1
begin
err_num+=1;
writeln;
writeln('*** ERROR FOUND IN LINE N°', numI:2, ': ***');
writeln('*** INVALID ARGUMENT (''', operand ,''') FOR PAUSE FUNCTION ***');
writeln;
end;
//LE FUNZIONI RESET, RESETINSTR E HALT NON RICHIEDONO ARGOMENTI. SE QUESTI VENGONO INSERITI SONO IGNORATI
if ((operationCode = RESET) OR (operationCode = RESETINSTR) OR (operationCode = HALT)) AND (operand > 0) then
begin
writeln;
writeln('*** WARNING IN LINE N°', numI:2, ': ***');
writeln('*** THIS FUNCTION DOESN''T USE AN ARGUMENT. ***');
writeln('*** YOUR ARGUMENT (''', operand ,''') WILL BE IGNORED ***');
writeln;
warn_num+=1;
end;
end;
numI+=1;
if operationCode=HALT then halt_flag:=true; //CONTROLLA CHE VI SIA UNA ISTRUZIONE HALT
until InstructionReg[ numI-1 ] = STOPLOAD;
end;
if err_num>0 then
begin
writeln;
writeln('*** ', err_num, ' ERROR(S) FOUND ***');
if warn_num>0 then writeln('*** ', warn_num:2, ' WARNING(S) GENERATED ***');
writeln('*** PROGRAM CAN''T BE EXECUTED ***');
writeln;
InstrOK:=false;
end
else
begin
//SE NON VI SONO HALT IL PROGRAMMA POTREBBE COMPORTARSI IN MODO IMPREVEDIBILE
if halt_flag=false then
begin
writeln;
writeln('*** WARNING: NO HALT FUNCTIONS FOUND ***');
writeln('*** EXECUTION WON''T STOP TILL A STOPLOAD ***');
writeln('*** PROGRAM''S BEAHVIOR COULD BE UNDEFINED ***');
writeln;
warn_num+=1;
end;
writeln;
writeln('*** NO ERRORS FOUND ***');
if warn_num>0 then writeln('*** ', warn_num:2, ' WARNING(S) GENERATED ***');
writeln('*** PROGRAM CAN BE EXECUTED ***');
writeln;
InstrOK:=true;
end;
end;
procedure ExeInstr;
var cont2, cont3:byte;
instruction:integer;
delay_factor:integer;
begin
cont3:=00;
numI:=0;
repeat
begin
instruction:=InstructionReg[ numI ];
operationCode:=instruction div 100;
operand :=instruction mod 100;
//SE LA FUNZIONE ATTUALE PRODUCE UN OUTPUT A VIDEO, SI SCRIVE L'INIZIO DI UNA NUOVA RIGA A VIDEO
if ( ( operationCode = CIN ) OR ( operationCode = COUT ) OR ( operationCode = PAUSE ) ) then
begin
write(cont, ' > ');
end;
case operationCode of
CIN: readln(Memory[ operand ]);
COUT: writeln(Memory[ operand ]:6:4);
LOAD: accumulator:=Memory[ operand ];
STORE: Memory[ operand ]:=accumulator;
DELETE: Memory[ operand ]:=0;
RESET: for cont2:=0 to 100 do Memory[ cont2 ]:=0;
RESETINSTR: begin
for cont2:=0 to 100 do InstructionMem[ cont2 ]:=0;
cont3:=0;
end;
LOADAUX: aux_accumulator:=Memory[ operand ];
ADD: accumulator+=Memory[ operand ];
SUBTR: accumulator-=Memory[ operand ];
DIVIS: begin
//SE SI STA TENTANDO DI DIVIDERE 0/0 O <NUMERO NATURALE>/0 SI PRODUCE UN ERRORE
if ( ( Memory[ operand ]= 0)AND(accumulator = 0) ) OR ( ( Memory[ operand ]= 0)AND(accumulator <> 0) ) then
begin
writeln;
if ( Memory[ operand ]= 0)AND(accumulator = 0) then
begin
writeln('*** ATTEMPT TO DIVIDE 0 BY 0. UNDEFINED RESULT ***');
writeln('*** SIMPLETRON EXECUTON ABNORMALLY TERMINATED ***');
end
else
begin
if ( Memory[ operand ]= 0)AND(accumulator <> 0) then writeln('*** ATTEMPT TO DIVIDE BY 0. IMPOSSIBLE OPERATION ***');
writeln('*** SIMPLETRON EXECUTION ABNORMALLY TERMINATED ***');
end;
exit_correct:='FAILURE';
break;
end
else accumulator /= Memory[ operand ];
end;
MULT: accumulator *= Memory[ operand ];
QUOZ: accumulator := trunc(accumulator) div trunc( Memory[ operand ] );
RES: accumulator := trunc(accumulator) mod trunc( Memory[ operand ] );
ROOF: Memory[ operand ] := trunc(Memory[ operand ]);
CEIL: Memory[ operand ] := trunc(Memory[ operand ]) + 1;
FROUND: Memory[ operand ] := round(Memory[ operand ]);
FABS: Memory[ operand ] := abs(Memory[ operand ]);
BRANCH: numI:=operand;
BRANCHNEG: if(accumulator<0)then numI:=operand else numI+=1;
BRANCHZERO: if(accumulator=0)then numI:=operand else numI+=1;
BRANCHPOS: if(accumulator>0)then numI:=operand else numI+=1;
HALT: begin
writeln;
writeln('*** SIMPLETRON EXECUTION TERMINATED ***');
break;
end;
PAUSE: begin
if operand=1 then write(' *** PRESS A KEY TO PROCEED... ***');
readkey;
writeln;
end;
RETARD: begin
write('*** DELAYING EXECUTION... ***');
delay_factor := trunc(Memory[ operand ]) * 1000;
delay(delay_factor);
gotoXY( 1, WhereY-1);
ClrEOL;
end;
BRANCHMORE:if(accumulator>aux_accumulator)then numI:=operand else numI+=1;
BRANCHEQL: if(accumulator=aux_accumulator)then numI:=operand else numI+=1;
BRANCHLESS:if(accumulator<aux_accumulator)then numI:=operand else numI+=1;
//COM'E' NOTO, CALCOLARE UNA RADICE PARI DI UN NUMERO NEGATIVO PRODUCE UN ERRORE
FSQRT: if (Memory[ operand ]>=0) then accumulator := SQRT(Memory[ operand ])
else
begin
writeln;
writeln('*** ATTEMPT TO CALCULATE THE SQUARE ROOT OF A NEGATIVE NUMBER ***');
writeln('*** SIMPLETRON EXECUTION ABNORMALLY TERMINATED ***');
exit_correct:='FAILURE';
break;
end;
FSQR : Memory[ operand ] := SQR(Memory[ operand ]);
FEXP : Memory[ operand ] := EXP(Memory[ operand ]);
FLOG : Memory[ operand ] := LN(Memory[ operand ]) / LN(10);
FLN : Memory[ operand ] := LN(Memory[ operand ]);
POW : accumulator := EXP( LN(accumulator) * Memory[ operand ] );
ROOT : begin
if (accumulator>=0) then accumulator := EXP( LN(accumulator) / Memory[ operand ] )
else
begin
if ( trunc(Memory[ operand ]) mod 2 ) <> 0 then
begin
writeln;
writeln('*** ATTEMPT TO CALCULATE AN EVEN ROOT OF A NEGATIVE NUMBER ***');
writeln('*** SIMPLETRON EXECUTION ABNORMALLY TERMINATED ***');
exit_correct:='FAILURE';
break;
end
else accumulator := EXP( LN(accumulator) / Memory[ operand ] );
end;
end;
FSIN : Memory[ operand ] := SIN(Memory[ operand ]);
FCOS : Memory[ operand ] := COS(Memory[ operand ]);
FTAN : Memory[ operand ] := SIN(Memory[ operand ])/COS(Memory[ operand ]);
end;
InstructionMem[ cont3 ]:=instruction;
cont3+=1;
//SE NON SONO STATI ESEGUITI SALTI IL CONTATORE VIENE INCREMENTATO NORMALMENTE
if NOT( (operationCode>=BRANCH) AND (operationCode<=BRANCHPOS) ) then
begin
numI+=1;
end;
if ( ( operationCode = CIN ) OR ( operationCode = COUT ) OR ( operationCode = PAUSE ) OR ( operationCode = RETARD ) ) then cont+=1;
end;
until (instruction=HALT) OR (instruction=STOPLOAD); //NORMALMENTE
ViewDump;
end;
procedure ViewDump;
var sn:char;
cont2:byte=00;
begin
writeln;writeln;writeln;
writeln('*** PRESS ''1'' TO SEE THE MEMORY DUMP ***');
sn:=readkey;
gotoXY( 1, WhereY-1);
ClrEOL;
cont := 0;
if sn='1' then
begin
writeln('******** SYSTEM REGISTERS:');
writeln('*');
writeln('* ACCUMULATOR = ', accumulator:5:2);
writeln('*');
writeln('* AUXILIAR ACCUMULATOR = ', aux_accumulator:5:2);
writeln('*');
writeln('* OPERATION CODE = ', operationCode);
writeln('*');
writeln('* OPERAND = ', operand);
writeln('*');
writeln('* INSTRUCTION COUNTER = ', numI);
writeln('*');
writeln('* EXIT TYPE = ', exit_correct );
writeln('*');
writeln;writeln;
writeln('******** VARIABLES MEMORY');
writeln('*');
writeln('* 0 1 2 3 4 5 6 7 8 9');
writeln('*');
write('* ', cont,' ');
while (cont<100) do
begin
for cont2:=0 to 9 do write(Memory[ cont + cont2 ]:5:2,' ');
if (cont<100) then writeln;writeln('*');
cont+=10;
if (cont<100) then write('* ', cont,' ');
end;
cont:=00;
writeln;writeln;
//LA CRONOLOGIA DELLE ISTRUZIONI VIENE VISUALIZZATA (E REGISTRATA) PER RENDERE CONTO DI COME E' STATO ESEGUITO IL PROGRAMMA
writeln('******** INSTRUCTIONS TIMELINE:');
writeln('*');
writeln('* 0 1 2 3 4 5 6 7 8 9');
writeln('*');
write('* ', cont,' ');
while (cont<100) do
begin
for cont2:=0 to 9 do write(InstructionMem[ cont + cont2 ]:4,' ');
if (cont<100) then writeln;writeln('*');
cont+=10;
if (cont<100) then write('* ', cont,' ');
end;
end;
end;
end.