Not in the initial distribution.
This commit is contained in:
keie
parent
e9aa4befbb
commit
a54514d56f
384
util/ass/asprint.p
Normal file
384
util/ass/asprint.p
Normal file
|
|
@ -0,0 +1,384 @@
|
|||
#
|
||||
{$d+}
|
||||
program asprint(prog,output);
|
||||
|
||||
const
|
||||
|
||||
{ header words }
|
||||
NTEXT = 1;
|
||||
NDATA = 2;
|
||||
NPROC = 3;
|
||||
ENTRY = 4;
|
||||
NLINE = 5;
|
||||
SZDATA = 6;
|
||||
|
||||
escape1 = 254; { escape to secondary opcodes }
|
||||
escape2 = 255; { escape to tertiary opcodes }
|
||||
|
||||
type
|
||||
byte= 0..255; { memory is an array of bytes }
|
||||
adr= {0..maxadr} long; { the range of addresses }
|
||||
word= {0..maxuint} long;{ the range of unsigned integers }
|
||||
size= 0..32766; { the range of sizes is the positive offsets }
|
||||
sword= {-signbit..maxsint} long; { the range of signed integers }
|
||||
full= {-maxuint..maxuint} long; { intermediate results need this range }
|
||||
double={-maxdbl..maxdbl} long; { double precision range }
|
||||
insclass=(prim,second,tert); { tells which opcode table is in use }
|
||||
instype=(implic,explic); { does opcode have implicit or explicit operand }
|
||||
iflags= (mini,short,sbit,wbit,zbit,ibit);
|
||||
ifset= set of iflags;
|
||||
|
||||
mnem = ( NON,
|
||||
AAR, ADF, ADI, ADP, ADS, ADU,XAND, ASP, ASS, BEQ,
|
||||
BGE, BGT, BLE, BLM, BLS, BLT, BNE, BRA, CAI, CAL,
|
||||
CFF, CFI, CFU, CIF, CII, CIU, CMF, CMI, CMP, CMS,
|
||||
CMU, COM, CSA, CSB, CUF, CUI, CUU, DCH, DEC, DEE,
|
||||
DEL, DUP, DUS, DVF, DVI, DVU, EXG, FEF, FIF, FIL,
|
||||
GTO, INC, INE, INL, INN, IOR, LAE, LAL, LAR, LDC,
|
||||
LDE, LDF, LDL, LFR, LIL, LIM, LIN, LNI, LOC, LOE,
|
||||
LOF, LOI, LOL, LOR, LOS, LPB, LPI, LXA, LXL, MLF,
|
||||
MLI, MLU, MON, NGF, NGI, NOP, RCK, RET, RMI, RMU,
|
||||
ROL, ROR, RTT, SAR, SBF, SBI, SBS, SBU, SDE, SDF,
|
||||
SDL,XSET, SIG, SIL, SIM, SLI, SLU, SRI, SRU, STE,
|
||||
STF, STI, STL, STR, STS, TEQ, TGE, TGT, TLE, TLT,
|
||||
TNE, TRP, XOR, ZEQ, ZER, ZGE, ZGT, ZLE, ZLT, ZNE,
|
||||
ZRE, ZRF, ZRL);
|
||||
|
||||
dispatch = record
|
||||
iflag: ifset;
|
||||
instr: mnem;
|
||||
case instype of
|
||||
implic: (implicit:sword);
|
||||
explic: (ilength:byte);
|
||||
end;
|
||||
|
||||
var
|
||||
{ variables indicating the size of words and addresses }
|
||||
wsize: integer; { number of bytes in a word }
|
||||
asize: integer; { number of bytes in an address }
|
||||
pdsize: integer; { size of procedure descriptor in bytes = 2*asize }
|
||||
|
||||
pc,lb,sp,hp,pd: adr; { internal machine registers }
|
||||
i: integer; { integer scratch variable }
|
||||
s,t :word; { scratch variables }
|
||||
sz:size; { scratch variables }
|
||||
ss,st: sword; { scratch variables }
|
||||
k :double; { scratch variables }
|
||||
j:size; { scratch variable used as index }
|
||||
a,b:adr; { scratch variable used for addresses }
|
||||
dt,ds:double; { scratch variables for double precision }
|
||||
found:boolean; { scratch }
|
||||
opcode: byte;
|
||||
iclass: insclass;
|
||||
dispat: array[insclass, byte] of dispatch ;
|
||||
insr: mnem; { holds the instructionnumber }
|
||||
header: array[1..8] of adr;
|
||||
|
||||
prog: file of byte; { program and initialized data }
|
||||
|
||||
procedure getit; { start the ball rolling }
|
||||
var cset:set of char;
|
||||
f:ifset;
|
||||
insno:byte;
|
||||
nops:integer;
|
||||
opcode:byte;
|
||||
i,j,n:integer;
|
||||
wtemp:sword;
|
||||
count:integer;
|
||||
repc:adr;
|
||||
nexta,firsta:adr;
|
||||
elem:byte;
|
||||
amount,ofst:size;
|
||||
c:char;
|
||||
|
||||
function readb(n:integer):double;
|
||||
var b:byte;
|
||||
begin
|
||||
if eof(prog) then
|
||||
begin writeln('Premature EOF on EM load file') ; halt end;
|
||||
read(prog,b); if n>1 then readb:=readb(n-1)*256+b else readb:=b
|
||||
end;
|
||||
|
||||
function readbyte:byte;
|
||||
begin readbyte:=readb(1) end;
|
||||
|
||||
procedure skipbyte;
|
||||
var dummy: byte;
|
||||
begin dummy:=readb(1) end;
|
||||
|
||||
function readword:word;
|
||||
begin readword:=readb(wsize) end;
|
||||
|
||||
function readadr:adr;
|
||||
begin readadr:=readb(asize) end;
|
||||
|
||||
function ifind(ordinal:byte):mnem;
|
||||
var loopvar:mnem;
|
||||
found:boolean;
|
||||
begin ifind:=NON;
|
||||
loopvar:=insr; found:=false;
|
||||
repeat
|
||||
if ordinal=ord(loopvar) then
|
||||
begin found:=true; ifind:=loopvar end;
|
||||
if loopvar<>ZRL then loopvar:=succ(loopvar) else loopvar:=NON;
|
||||
until found or (loopvar=insr) ;
|
||||
end;
|
||||
|
||||
procedure readhdr;
|
||||
type hdrw=0..32767 ; { 16 bit header words }
|
||||
var hdr: hdrw;
|
||||
i: integer;
|
||||
begin
|
||||
for i:=0 to 7 do
|
||||
begin hdr:=readb(2);
|
||||
case i of
|
||||
0: if hdr<>3757 then { 07255 }
|
||||
begin writeln('Not an em load file'); halt end;
|
||||
1: writeln('Test flags: ',hdr);
|
||||
2: if hdr<>0 then
|
||||
begin writeln('Unsolved references: ',hdr) end;
|
||||
3: if hdr<>3 then
|
||||
begin writeln('Incorrect load file version') end;
|
||||
4: wsize:=hdr ;
|
||||
5: begin asize:=hdr ; pdsize:= asize+asize end;
|
||||
6,7:
|
||||
if hdr<>0 then
|
||||
begin writeln('First header entry ',i,', is ',hdr) end;
|
||||
end
|
||||
end;
|
||||
writeln('word size',wsize,', pointer size',asize)
|
||||
end;
|
||||
|
||||
procedure noinit;
|
||||
begin writeln('Illegal initialization'); halt end;
|
||||
|
||||
procedure readint(a:adr;s:size);
|
||||
const mrange = 4;
|
||||
var i:size;
|
||||
val:double;
|
||||
cont: array[1..mrange] of byte;
|
||||
begin { construct integer out of byte sequence }
|
||||
if s<=mrange then
|
||||
begin
|
||||
for i:=1 to s do cont[i]:=readbyte ;
|
||||
if cont[s]>=128 then val:=cont[s]-256 else val:=cont[s];
|
||||
for i:= s-1 downto 1 do val:= val*256 + cont[i];
|
||||
writeln(', value ',val)
|
||||
end
|
||||
else
|
||||
begin
|
||||
write(', bytes(little endian) ');
|
||||
for i:=1 to s do write(readbyte:4) ;
|
||||
writeln
|
||||
end
|
||||
end;
|
||||
|
||||
procedure readuns(a:adr;s:size);
|
||||
const mrange=3;
|
||||
var i:size;
|
||||
val:double;
|
||||
cont: array[1..mrange] of byte;
|
||||
begin { construct unsigned integer out of byte sequence }
|
||||
if s<=mrange then
|
||||
begin
|
||||
for i:=1 to s do cont[i]:=readbyte ;
|
||||
val:=0;
|
||||
for i:= s downto 1 do val:= val*256 + cont[i];
|
||||
writeln(', value ',val)
|
||||
end
|
||||
else
|
||||
begin
|
||||
write(', bytes(little endian) ');
|
||||
for i:=1 to s do write(readbyte:4) ;
|
||||
writeln
|
||||
end
|
||||
end;
|
||||
|
||||
procedure readfloat(a:adr;s:size);
|
||||
var i:size; b:byte;
|
||||
begin { construct float out of string}
|
||||
i:=0;
|
||||
repeat { eat the bytes, construct the value and intialize at a }
|
||||
write(chr(readbyte)); i:=i+1;
|
||||
until b=0 ;
|
||||
end;
|
||||
|
||||
begin
|
||||
|
||||
#ifdef INSRT
|
||||
{ initialize tables }
|
||||
for iclass:=prim to tert do
|
||||
for i:=0 to 255 do
|
||||
with dispat[iclass][i] do
|
||||
begin instr:=NON; iflag:=[zbit] end;
|
||||
|
||||
{ read instruction table file. see appendix B }
|
||||
{ The table read here is a simple transformation of the table on page xx }
|
||||
{ - instruction names were transformed to numbers }
|
||||
{ - the '-' flag was transformed to an 'i' flag for 'w' type instructions }
|
||||
{ - the 'S' flag was added for instructions having signed operands }
|
||||
reset(tables);
|
||||
insr:=NON;
|
||||
repeat
|
||||
read(tables,insno) ; cset:=[]; f:=[];
|
||||
insr:=ifind(insno);
|
||||
if insr=NON then begin writeln('Incorrect table'); halt end;
|
||||
repeat read(tables,c) until c<>' ' ;
|
||||
repeat
|
||||
cset:=cset+[c];
|
||||
read(tables,c)
|
||||
until c=' ' ;
|
||||
if 'm' in cset then f:=f+[mini];
|
||||
if 's' in cset then f:=f+[short];
|
||||
if '-' in cset then f:=f+[zbit];
|
||||
if 'i' in cset then f:=f+[ibit];
|
||||
if 'S' in cset then f:=f+[sbit];
|
||||
if 'w' in cset then f:=f+[wbit];
|
||||
if (mini in f) or (short in f) then read(tables,nops) else nops:=1 ;
|
||||
readln(tables,opcode);
|
||||
if ('4' in cset) or ('8' in cset) then
|
||||
begin iclass:=tert end
|
||||
else if 'e' in cset then
|
||||
begin iclass:=second end
|
||||
else iclass:=prim;
|
||||
for i:=0 to nops-1 do
|
||||
begin
|
||||
with dispat[iclass,opcode+i] do
|
||||
begin
|
||||
iflag:=f; instr:=insr;
|
||||
if '2' in cset then ilength:=2
|
||||
else if '4' in cset then ilength:=4
|
||||
else if '8' in cset then ilength:=8
|
||||
else if (mini in f) or (short in f) then
|
||||
begin
|
||||
if 'N' in cset then wtemp:=-1-i else wtemp:=i ;
|
||||
if 'o' in cset then wtemp:=wtemp+1 ;
|
||||
if short in f then wtemp:=wtemp*256 ;
|
||||
implicit:=wtemp
|
||||
end
|
||||
end
|
||||
end
|
||||
until eof(tables);
|
||||
|
||||
#endif
|
||||
{ read in program text, data and procedure descriptors }
|
||||
reset(prog);
|
||||
readhdr; { verify first header }
|
||||
for i:=1 to 8 do header[i]:=readadr; { read second header }
|
||||
writeln('textsize ',header[NTEXT],', datasize ',header[SZDATA]);
|
||||
writeln('data descriptors: ',header[NDATA]);
|
||||
writeln('procedure descriptors: ',header[NPROC]);
|
||||
writeln('entry procedure: ',header[ENTRY]);
|
||||
if header[7]<>0 then writeln('Second header entry 7 is ',header[7]);
|
||||
if header[8]<>0 then writeln('Second header entry 8 is ',header[8]);
|
||||
{ read program text }
|
||||
for i:=0 to header[NTEXT]-1 do skipbyte;
|
||||
{ read data blocks }
|
||||
writeln; writeln('Data descriptors:');
|
||||
nexta:=0;
|
||||
for i:=1 to header[NDATA] do
|
||||
begin
|
||||
n:=readbyte;
|
||||
write(nexta:5,'- ');
|
||||
if n<>0 then
|
||||
begin
|
||||
elem:=readbyte; firsta:=nexta;
|
||||
case n of
|
||||
1: { uninitialized words }
|
||||
begin
|
||||
writeln(elem,' uninitialised word(s)');
|
||||
nexta:= nexta+ elem*wsize ;
|
||||
end;
|
||||
2: { initialized bytes }
|
||||
begin
|
||||
write(elem,' initialised byte(s)');
|
||||
for j:=1 to elem do
|
||||
begin
|
||||
if j mod 10 = 1 then
|
||||
begin writeln ; write(nexta:6,':') end ;
|
||||
write(readbyte:4); nexta:=nexta+1
|
||||
end;
|
||||
writeln
|
||||
end;
|
||||
3: { initialized words }
|
||||
begin
|
||||
write(elem,' initialised word(s)');
|
||||
for j:=1 to elem do
|
||||
begin
|
||||
if j mod 8 = 1 then
|
||||
begin writeln ; write(nexta:6,':') end ;
|
||||
write(readword:9); nexta:=nexta+wsize
|
||||
end;
|
||||
writeln
|
||||
end;
|
||||
4,5: { instruction and data pointers }
|
||||
begin
|
||||
if n=4 then
|
||||
write(elem,' initialised data pointers')
|
||||
else
|
||||
write(elem,' initialised instruction pointers');
|
||||
for j:=1 to elem do
|
||||
begin
|
||||
if j mod 8 = 1 then
|
||||
begin writeln ; write(nexta:6,':') end ;
|
||||
write(readadr:9); nexta:=nexta+asize
|
||||
end;
|
||||
writeln
|
||||
end;
|
||||
6: { signed integers }
|
||||
begin
|
||||
write(elem,'-byte signed integer ');
|
||||
readint(nexta,elem); nexta:=nexta+elem
|
||||
end;
|
||||
7: { unsigned integers }
|
||||
begin
|
||||
write(elem,'-byte unsigned integer ');
|
||||
readuns(nexta,elem); nexta:=nexta+elem
|
||||
end;
|
||||
8: { floating point numbers }
|
||||
begin
|
||||
write(elem,'-byte floating point number ');
|
||||
readfloat(nexta,elem); nexta:=nexta+elem
|
||||
end;
|
||||
end
|
||||
end
|
||||
else
|
||||
begin
|
||||
repc:=readadr;
|
||||
amount:=nexta-firsta;
|
||||
writeln(repc,' copies of the data from ',firsta:2,' to ',nexta:2);
|
||||
nexta:= nexta + repc*amount ;
|
||||
end
|
||||
end;
|
||||
if header[SZDATA]<>nexta then writeln('Data initialization error');
|
||||
{ read descriptor table }
|
||||
pd:=header[NTEXT];
|
||||
for i:=1 to header[NPROC]*pdsize do skipbyte;
|
||||
end;
|
||||
|
||||
begin getit;
|
||||
#ifdef RTC
|
||||
repeat
|
||||
opcode := nextpc; { fetch the first byte of the instruction }
|
||||
if opcode=escape1 then iclass:=second
|
||||
else if opcode=escape2 then iclass:=tert
|
||||
else iclass:=prim;
|
||||
if iclass<>prim then opcode := nextpc;
|
||||
with dispat[iclass][opcode] do
|
||||
begin insr:=instr;
|
||||
if not (zbit in iflag) then
|
||||
if ibit in iflag then k:=pop else
|
||||
begin
|
||||
if mini in iflag then k:=implicit else
|
||||
begin
|
||||
if short in iflag then k:=implicit+nextpc else
|
||||
begin k:=nextpc;
|
||||
if (sbit in iflag) and (k>=128) then k:=k-256;
|
||||
for i:=2 to ilength do k:=256*k + nextpc
|
||||
end
|
||||
end;
|
||||
if wbit in iflag then k:=k*wsize;
|
||||
end
|
||||
end;
|
||||
#endif
|
||||
end.
|
||||
Loading…
Reference in a new issue