|
DataMuseum.dkPresents historical artifacts from the history of: DANOSI |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about DANOSI Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 24571 (0x5ffb)
Types: TextFile
Names: »DEAS.PAS«
└─⟦02956c927⟧ Bits:30010510 DVBS1.SW2114.src.2.14-1 SW2114 REAL #1/4 TIME PASCAL SOURCE REL 2.14
└─⟦this⟧ »RTP\DEAS.PAS«
└─⟦4f587ad96⟧ Bits:30010518 DVBS1.SW2114.src.2.7-1 SW2114 1/4 Real Time Pascal 2.7 92.06.16
└─⟦this⟧ »RTP\DEAS.PAS«
└─⟦a2a9e188c⟧ Bits:30010526 DVBS1.SW2114.src.2.6-4 RTP Compiler Source SW2104+SW2114 Disk 1 92.02.03 HEJ HHA
└─⟦this⟧ »RTP\DEAS.PAS«
└─⟦b607d6035⟧ Bits:30010532 RTP compiler Source 1 2.14 26/9(?)-92 DVBS1.SW2114.src.2.14-8
└─⟦this⟧ »DEAS.PAS«
└─⟦fd2665794⟧ Bits:30010523 DVBS1.SW2114.src.2.6-1 RTP compiler source SW2104+SW2114 Disk#1 30/1-92 HHA
└─⟦this⟧ »RTP\DEAS.PAS«
PROGRAM deas; \r
{$R-,K-}\r
\r
{ This program will output a symbolic dump af any occam file. }\r
{ Witch symbolic dump depend on extention }\r
\r
TYPE\r
instruction_string = string[6];\r
CONST\r
instruction1: ARRAY[0..15] of instruction_string =\r
( 'j ', 'ldlp ', 'pfix ', 'ldnl ',\r
'ldc ', 'ldnlp ', 'nfix ', 'ldl ',\r
'adc ', 'call ', 'cj ', 'ajw ',\r
'eqc ', 'stl ', 'stnl ', 'opr ' );\r
instruction1_cycles: ARRAY[0..15] of byte =\r
( 3, 1, 1, 2, 1, 1, 1, 2, 1, 7, 3, 1, 2, 1, 2, 0 );\r
instruction2: ARRAY[0..15] of instruction_string =\r
( 'rev ', 'lb ', 'bsub ', 'endp ',\r
'diff ', 'add ', 'gcall ', 'in ',\r
'prod ', 'gt ', 'wsub ', 'out ',\r
'sub ', 'startp', 'outbyt', 'outwor' );\r
instruction2_cycles: ARRAY[0..15] of byte =\r
( 1, 5, 1, 13, 1, 1, 10, 19, 12, 1, 2, 19, 1, 12, 23, 23 );\r
instruction21: array[0..15] of instruction_string =\r
( 'seterr', '#21#F1', 'resetc', 'csub0 ',\r
'#21#F4', 'stopp ', 'ladd ', 'stlb ',\r
'sthf ', 'norm ', 'ldiv ', 'ldpi ', \r
'stlf ', 'xdble ', 'ldpri ', 'rem ' );\r
instruction21_cycles: ARRAY[0..15] of byte =\r
( 1, 0, 3, 2, 0, 11, 2, 1, 1, 13, 35, 2, 1, 2, 1, 37 );\r
instruction22: array[0..15] of instruction_string =\r
( 'ret ', 'lend ', 'ldtime', '#22#F3', \r
'#22#F4', '#22#F5', '#22#F6', '#22#F7',\r
'#22#F8', 'tester', 'testpr', 'tin ',\r
'div ', '#22#FD', 'dist ', 'disc ' );\r
instruction22_cycles: ARRAY[0..15] of byte =\r
( 5, 10, 2, 100, 100, 100, 100, 100, 100, 3, 2, 30, 39, 100, 23, 8 );\r
instruction23: array[0..15] of instruction_string =\r
( 'diss ', 'lmul ', 'not ', 'xor ',\r
'bcnt ', 'lshr ', 'lshl ', 'lsum ',\r
'lsub ', 'runp ', 'xword ', 'sb ',\r
'gajw ', 'savel ', 'saveh ', 'wcnt ' );\r
instruction23_cycles: ARRAY[0..15] of byte =\r
( 4, 33, 1, 1, 2, 8, 8, 2, 2, 10, 4, 5, 2, 4, 4, 5 );\r
instruction24: array[0..15] of instruction_string =\r
( 'shr ', 'shl ', 'mint ', 'alt ',\r
'altwt ', 'altend', 'and ', 'enbt ',\r
'enbc ', 'enbs ', 'move ', 'or ',\r
'csngl ', 'ccnt1 ', 'talt ', 'ldiff ' );\r
instruction24_cycles: ARRAY[0..15] of byte =\r
( 10, 10, 1, 2, 17, 4, 1, 8, 7, 3, 8, 1, 3, 3, 4, 2 );\r
instruction25: array[0..15] of instruction_string =\r
( 'sthb ', 'taltwt', 'sum ', 'mult ',\r
'sttime', 'stoper', 'cword ', 'clther',\r
'sthaer', 'tshaer', '#25#FA', '#25#FB',\r
'#25#FC','#25#FD', '#25#FE', '#25#FF' ); \r
instruction25_cycles: ARRAY[0..15] of byte =\r
( 1, 48, 1, 38, 1, 2, 5, 1, 1, 2, 100, 100, 100, 100, 100, 100 );\r
\r
TYPE\r
hexstring = STRING[8];\r
string128 = STRING[128];\r
\r
VAR\r
record_length, routine_length, file_length, read_length: real;\r
address, \r
byteaddress: real; \r
routine_nr,\r
i, cycles, totalcycles: integer;\r
last_address_offset: real;\r
operand: string[10];\r
operand_int: integer;\r
bytestring: string[20];\r
b, op: byte;\r
ch: char;\r
x: integer;\r
y: integer;\r
l: integer;\r
l_bytes: array[1..4] of 0..255;\r
lib_count: integer;\r
cex_file: boolean;\r
dump_file: boolean;\r
open_file, pas_file: boolean;\r
pas_code_begin, pas_code_end: real;\r
print_code: boolean;\r
linepos: integer;\r
infile: FILE of byte;\r
outfile: text;\r
\r
last_extern: integer;\r
extern: array[0..100] of string[16];\r
\r
FUNCTION hex(number,digits: integer): hexstring;\r
CONST\r
hexdigit: ARRAY[0..15] OF char = '0123456789ABCDEF';\r
VAR\r
d: integer;\r
h: hexstring;\r
BEGIN\r
h[0]:=chr(digits);\r
FOR d:=digits DOWNTO 1 DO\r
BEGIN\r
h[d]:=hexdigit[number AND 15];\r
number:=number SHR 4;\r
END;\r
hex:=h;\r
END;\r
\r
FUNCTION rhex(number: real; digits: integer): hexstring;\r
CONST\r
hexdigit: ARRAY[0..15] OF char = '0123456789ABCDEF';\r
VAR\r
d: integer;\r
h: hexstring;\r
x: real;\r
BEGIN\r
number:= number + 0.2;\r
h[0]:=chr(digits);\r
FOR d:=digits DOWNTO 1 DO\r
BEGIN\r
x:= trunc( number / 16);\r
number:= number - x * 16; \r
h[d]:= hexdigit[ round( number )];\r
number:= x;\r
END;\r
rhex:=h;\r
END;\r
\r
FUNCTION invershex(h: hexstring): hexstring;\r
var\r
i: byte;\r
BEGIN\r
for i:=1 to ord(h[0]) do\r
case h[i] of\r
'0': h[i] := 'F'; '1': h[i] := 'E'; '2': h[i] := 'D'; '3': h[i] := 'C';\r
'4': h[i] := 'B'; '5': h[i] := 'A'; '6': h[i] := '9'; '7': h[i] := '8';\r
'8': h[i] := '7'; '9': h[i] := '6'; 'A': h[i] := '5'; 'B': h[i] := '4';\r
'C': h[i] := '3'; 'D': h[i] := '2'; 'E': h[i] := '1'; 'F': h[i] := '0';\r
end;\r
for i:=ord(h[0])+1 to 8 do h:= 'F' + h;\r
invershex:= h;\r
END; \r
\r
FUNCTION extend(h: hexstring; b: byte): hexstring;\r
var\r
i: byte;\r
BEGIN\r
if ord(h[0]) = 8 then\r
begin\r
for i:=1 to 7 do h[i]:= h[i+1];\r
h[0]:= pred(h[0]);\r
end;\r
extend:= h + hex(b, 1);\r
END;\r
\r
procedure read_int16(var i:integer);\r
var l, h: byte;\r
begin\r
read(infile, l);\r
read(infile, h);\r
i:= (h SHL 8) + l;\r
read_length:= read_length + 2.0;\r
end;\r
\r
procedure readcode(var b: byte);\r
const\r
record_element = 0;\r
prefix_byte = 3;\r
var\r
tag, operand: integer;\r
begin\r
while record_length<0.5 do begin\r
operand:= 0;\r
repeat\r
if read_length>(file_length - 0.5)\r
then begin\r
if dump_file then writeln(outfile) else\r
begin\r
write(outfile, rhex(address, 4),': ');\r
writeln(outfile, ' ':15, bytestring); \r
end;\r
close(infile); close(outfile);\r
halt;\r
end; \r
read(infile,b);\r
read_length:= read_length + 1.0;\r
tag:= b shr 6;\r
operand:= (operand shl 6) + (b and 63);\r
until tag<>prefix_byte;\r
totalcycles:= totalcycles + cycles;\r
if dump_file then\r
begin\r
if linepos>=12 then writeln(outfile,'>')\r
else writeln(outfile);\r
linepos:= 0;\r
case tag of\r
0: begin write(outfile,'T <'); linepos:= 12; end; \r
1: write(outfile,'N', operand:7);\r
2: case operand of\r
0: write(outfile,'Start list');\r
1: write(outfile,'End list');\r
2: write(outfile,'Start fold');\r
3: write(outfile,'End fold');\r
4: write(outfile,'Start filed');\r
5: write(outfile,'End filed');\r
otherwise write(outfile,'F', operand:7);\r
end; \r
3: ;\r
end;\r
end else if totalcycles <> 0 then\r
begin\r
writeln(outfile, ' Total cycles: ', cycles:10, totalcycles:10);\r
writeln(outfile);\r
end;\r
cycles:= 0;\r
if tag=record_element\r
then begin\r
record_length:= operand;\r
end;\r
end;\r
read(infile,b);\r
record_length:= record_length - 1.0;\r
read_length:= read_length + 1.0;\r
end;\r
\r
procedure readrtpcode(var b: byte);\r
var do_special: boolean;\r
h: byte;\r
i: integer;\r
begin\r
while record_length<0.5 do\r
begin\r
do_special:= true;\r
while routine_length<0.5 do\r
begin\r
if read_length>(file_length - 0.5)\r
then begin\r
write(outfile, rhex(address, 4),': ');\r
writeln(outfile, ' ':15, bytestring); \r
close(infile); close(outfile);\r
halt;\r
end; \r
read_int16(i);\r
routine_length:= i - 2.0;\r
if cycles > 0 then begin\r
writeln(outfile);\r
writeln(outfile, ' Total cycles: ', cycles:10);\r
end; \r
writeln(outfile);\r
writeln(outfile);\r
writeln(outfile, 'ROUTINE: ',routine_nr,' codelength: ',routine_length - 2.0 );\r
writeln(outfile);\r
routine_nr:= routine_nr + 1;\r
do_special:= false;\r
byteaddress:= byteaddress + 2.0;\r
address:= byteaddress;\r
cycles:= 0\r
end;\r
if do_special then begin\r
do_special:= false;\r
read(infile, b);\r
read(infile, b);\r
read(infile, b);\r
routine_length:= routine_length - 3.0;\r
end;\r
read_int16(i);\r
routine_length:= i - 2.0;\r
end;\r
read(infile, b); \r
routine_length:= routine_length - 1.0;\r
record_length:= record_length - 1.0;\r
read_length:= read_length + 1.0;\r
end;\r
\r
procedure read_pasarg(var i: real);\r
var b:byte;\r
begin\r
read(infile, b);\r
i:= b AND $7F;\r
while (b AND $80) <> 0 do\r
begin\r
read(infile, b);\r
i:= i * 128.0 + (b AND $7F);\r
(* i:= (i SHL 7) + (b AND $7F); *)\r
end;\r
end;\r
\r
\r
procedure read_pasname(var s: string128);\r
var l,i:integer;\r
b: byte;\r
r:real;\r
begin\r
read_pasarg(r);\r
l:= round(r);\r
i:= 1;\r
for i:=1 to l do\r
begin\r
read(infile, b);\r
if i <= 128 then s[i]:= chr(b);\r
end;\r
if l <= 128 then s[0]:= chr(l) else s[0]:= chr(128);\r
end;\r
\r
procedure read_fixtype;\r
var b: byte;\r
int: integer;\r
r: real;\r
begin\r
read(infile, b);\r
case b of\r
$25: begin\r
read_pasarg( r );\r
int:= round( r );\r
write(outfile,' Codefix ', int);\r
if int <= last_extern then write(outfile,' ',extern[int]);\r
end;\r
$2C: write(outfile,' Modnum');\r
$2B: write(outfile,' Maininit');\r
$27: write(outfile,' Staticfix');\r
$28: write(outfile,' Limit');\r
$29: write(outfile,' Init');\r
$26: begin\r
write(outfile,' Datafix');\r
read_pasarg(r); \r
int:= round(r);\r
write(outfile, ' ',int);\r
if int <= last_extern then write(outfile,' ',extern[int]);\r
read_pasarg(r); \r
write(outfile, ' ',rhex(r,4));\r
end;\r
otherwise write(outfile, ' Unknown: ',hex(b,2));\r
end;\r
end;\r
\r
\r
procedure readpascode(var b: byte);\r
var s, s2: string128;\r
int, int2, int3: integer;\r
r, r2, r3: real;\r
b1, b2: byte;\r
writeln_done: boolean;\r
begin\r
writeln_done:= false;\r
while record_length<0.5 do\r
begin\r
if writeln_done then begin\r
writeln(outfile);\r
writeln_done:= true;\r
end;\r
\r
(* read new record *)\r
if eof(infile)\r
then begin\r
writeln(outfile);\r
close(infile); close(outfile);\r
halt;\r
end; \r
read(infile, b);\r
case b of\r
$62: (* library *)\r
begin\r
read_pasname(s);\r
writeln(outfile,'Library: ',lib_count,' ',s);\r
lib_count:= lib_count + 1;\r
last_extern:= -1;\r
end;\r
$2E: (* nextmodule *)\r
begin\r
writeln(outfile,'Next Module: ');\r
last_extern:= -1;\r
end;\r
$6F: (* comment *)\r
begin\r
read_pasname(s);\r
writeln(outfile,'-- ',s);\r
if (len(s) > 2) and (s[1] = '$') then\r
begin\r
if s[2]='C' then\r
begin\r
delete(s,1,2);\r
val(s,r,int);\r
pas_code_end:= r + pas_code_begin;\r
end else\r
if s[2]='B' then\r
begin\r
delete(s,1,2);\r
val(s,r,int);\r
pas_code_begin:= r;\r
pas_code_end:= pas_code_end + pas_code_begin;\r
end; \r
end; \r
end;\r
$78: (* description *)\r
begin\r
read_pasname(s);\r
writeln(outfile,'Desc: ',s);\r
end;\r
$70: (* id *)\r
begin\r
read(infile, b);\r
read_pasname(s);\r
read_pasname(s2);\r
writeln(outfile,'ID: ',b,' ',s,' ',s2);\r
end;\r
$59: (* newid *)\r
begin\r
read(infile, b);\r
read_pasarg(r);\r
read_pasname(s);\r
read_pasname(s2);\r
writeln(outfile,'NewID: ',b,' ',r:1:0);\r
writeln(outfile,' ',s);\r
writeln(outfile,' ',s2);\r
end;\r
$71: (* address offset *)\r
begin\r
read_pasarg(r);\r
if not print_code then\r
writeln(outfile,'Address offset: ', rhex(r,4)) else\r
if byteaddress = last_address_offset\r
then writeln(outfile,rhex(last_address_offset,4),':');\r
byteaddress:= r;\r
address:= byteaddress;\r
last_address_offset:= r;\r
end;\r
$72: (* SC *)\r
begin \r
read(infile, b);\r
writeln(outfile,'SC: ',hex(b,2));\r
end;\r
$75: (* code *)\r
begin\r
read_pasarg(record_length);\r
if not print_code then\r
writeln(outfile,'Code: ', record_length:1:0, ' bytes') \r
else\r
\r
if (byteaddress < (pas_code_begin-0.5)) or ((pas_code_end+0.5) <= byteaddress) then\r
begin\r
s:=' ';\r
r:= 0;\r
int:= 0;\r
if record_length > 0.5 then\r
begin\r
write(outfile, rhex(byteaddress, 4), ': ');\r
end;\r
while r < (record_length - 0.5) do\r
(* for int:=0 to record_length - 1 do *)\r
begin\r
if int = 16 then begin\r
writeln(outfile, ' ',s);\r
write(outfile, rhex(byteaddress,4), ': ');\r
s:=' ';\r
int:= 0\r
end else int:= int + 1;\r
read(infile, b);\r
byteaddress:= byteaddress + 1.0;\r
write(outfile, hex(b,2), ' ');\r
if (32 > b) or (b > 127) then b:= ord('.');\r
s[ int mod 16 + 1]:= chr(b);\r
r:= r + 1.0;\r
end;\r
for int:= 0 to 15 - (int + 15) mod 16 do write(outfile, ' ');\r
writeln(outfile, s);\r
record_length:= 0.0;\r
end;\r
end;\r
$76: (* total code *)\r
begin\r
read_pasarg(r);\r
read_pasarg(r2);\r
writeln(outfile,'Total code, size: ',r:1:0, ' nested: ', r2:1:0);\r
end;\r
$23: (* static *)\r
begin\r
read_pasarg(r);\r
writeln(outfile,'Static: ', r:1:0);\r
end;\r
$2D: (* codesymb *)\r
begin\r
read_pasname(s);\r
read_pasarg(r);\r
writeln(outfile,'Code Symb: ',s,' offset: ',rhex(r,4));\r
byteaddress:= r;\r
address:= byteaddress;\r
end;\r
$74: (* entry *)\r
begin\r
read_pasname(s);\r
read_pasarg(r);\r
write(outfile,'Entry: ',s,' offset: ',rhex(r,4));\r
byteaddress:= r;\r
address:= byteaddress;\r
read_pasarg(r);\r
writeln(outfile,' ws: ',r:1:0);\r
end;\r
$2F: (* entrysymb *)\r
begin\r
read_pasname(s);\r
read_pasarg(r);\r
write(outfile,'Entry Symb: ',s,' offset: ',rhex(r,4));\r
byteaddress:= r;\r
address:= byteaddress;\r
read_pasarg(r);\r
writeln(outfile,' ws: ',r:1:0);\r
end;\r
$21: (* datasymb *)\r
begin\r
read_pasname(s);\r
read_pasarg(r);\r
writeln(outfile,'Data Symb: ',s,' offset: ',rhex(r,4));\r
byteaddress:= r;\r
address:= byteaddress;\r
end;\r
$61, $31 : (* newentry *)\r
begin\r
read_pasname(s);\r
read_pasarg(r);\r
read_pasarg(r2);\r
read_pasarg(r3);\r
write(outfile,'Newentry');\r
if b=$31 then write(outfile,' Symb');\r
write(outfile,': ',s,' offset: ',rhex(r,4));\r
write(outfile,' workspace: ',r2:1:0);\r
writeln(outfile,' vectorspace: ',r3:1:0);\r
end;\r
$00..$0F: (* instruction patch *)\r
begin\r
read_pasarg(r);\r
write(outfile,'Inst patch: ',b,' ',rhex(r,4));\r
read_fixtype;\r
writeln(outfile);\r
end;\r
$10: (* long instruction patch *)\r
begin\r
read_pasarg(r);\r
write(outfile,'Long Inst patch: ',rhex(r,4));\r
read_fixtype;\r
writeln(outfile);\r
end;\r
$22: (* external *)\r
begin\r
read_pasname(s);\r
if last_extern < 100 then\r
begin\r
last_extern:= last_extern + 1;\r
extern[last_extern]:= s;\r
end;\r
writeln(outfile,'External: ',s);\r
end;\r
$73: (* debug *) \r
begin\r
writeln(outfile,'Debug: ');\r
read_pasarg(record_length);\r
s:=' ';\r
r:= 0;\r
int:= 0;\r
write(outfile, rhex(byteaddress,4), ': ');\r
while r < (record_length - 0.5) do \r
begin\r
if int = 16 then begin\r
writeln(outfile, ' ',s);\r
write(outfile, rhex(byteaddress,4), ': ');\r
s:=' ';\r
int:= 0\r
end else int:= int + 1;\r
read(infile, b);\r
byteaddress:= byteaddress + 1.0;\r
write(outfile, hex(b,2), ' ');\r
if (32 > b) or (b > 127) then b:= ord('.');\r
s[ int + 1]:= chr(b);\r
r:= r + 1.0;\r
end;\r
for int:= 0 to 15 - (int + 15) mod 16 do write(outfile, ' ');\r
writeln(outfile, s);\r
record_length:= 0.0;\r
end;\r
otherwise\r
begin\r
writeln(outfile); \r
writeln(outfile,'Unknown tag: ',hex(b,2));\r
end;\r
end;\r
end;\r
read(infile, b); \r
record_length:= record_length - 1;\r
read_length:= read_length + 1;\r
end;\r
\r
procedure read_int(VAR l:integer);\r
var l_bytes: array[0..3] of byte;\r
x, high_l: integer;\r
begin\r
for x:= 0 to 3 do\r
readcode( l_bytes[x] );\r
l:= 0;\r
for x:=1 downto 0 do\r
l:= (l SHL 8) + l_bytes[x];\r
high_l:= 0;\r
for x:=3 downto 2 do\r
high_l:= (high_l SHL 8) + l_bytes[x];\r
IF high_l <> 0 THEN writeln(outfile, ' BIG integer: ', high_l:7, l:7 )\r
end;\r
\r
BEGIN\r
print_code:= true;\r
IF (argcnt<1) OR (argcnt>2) THEN\r
BEGIN\r
IF argcnt = 3 then begin\r
print_code:= pos('s', argstr(3) ) = 0; \r
end else\r
begin\r
writeln('Syntax: DEAS <infile> [<outfile>]'); \r
halt;\r
end;\r
END;\r
assign(infile,argstr(1)); {$I-} reset(infile) {$I+};\r
IF iores>0 THEN\r
BEGIN\r
writeln('DEAS: "',argstr(1),'" does not exist'); halt;\r
END;\r
cex_file:= pos('.cex', argstr(1) ) <> 0;\r
if cex_file then dump_file:= false else\r
dump_file:= (pos('.dds', argstr(1) ) <> 0) OR\r
(pos('.dlk', argstr(1) ) <> 0) OR\r
(pos('.ddb', argstr(1) ) <> 0);\r
open_file:= pos('.ope', argstr(1) ) <> 0;\r
pas_file:= (pos('.bin', argstr(1) ) <> 0) OR\r
(pos('.t4', argstr(1) ) <> 0) OR\r
(pos('.t8', argstr(1) ) <> 0) OR\r
(pos('.c4', argstr(1) ) <> 0) OR\r
(pos('.pof',argstr(1) ) <> 0) OR\r
(pos('.c8', argstr(1) ) <> 0);\r
IF argcnt>=2 THEN\r
assign(outfile,argstr(2)) ELSE\r
assign(outfile,'CON:');\r
rewrite(outfile);\r
writeln(outfile,'File length = ',length(infile):8);\r
operand:= ''; bytestring:= ' '; address:= 0;\r
operand_int:= 0;\r
file_length:= length(infile);\r
record_length:= 0.0;\r
routine_length:= 0.0;\r
routine_nr:= 0;\r
lib_count:= 0;\r
read_length:= 1.0;\r
\r
\r
if cex_file\r
then begin\r
\r
byteaddress:= 0;\r
cycles:= 0;\r
totalcycles:= 0;\r
\r
\r
writeln(outfile);\r
read_int(l);\r
write(outfile,'interface descriptor ':30);\r
for y:= 1 to l do\r
begin\r
readcode(b);\r
if (b >= 32) AND (b < 127)\r
then write(outfile, chr(b))\r
else write(outfile, '(',b:1,')');\r
end;\r
writeln(outfile);\r
\r
read_int(l);\r
write(outfile,'compiler identifier ':30);\r
for y:= 1 to l do\r
begin\r
readcode(b);\r
if (b >= 32) AND (b < 127)\r
then write(outfile, chr(b))\r
else write(outfile, '(',b:1,')');\r
end;\r
writeln(outfile);\r
writeln(outfile);\r
\r
read_int(l);\r
writeln(outfile,'target processor ':26, l:6);\r
read_int(l);\r
writeln(outfile,'compiler version ':26, l:6);\r
read_int(l);\r
writeln(outfile,'workspace requirement ':26, l:6);\r
read_int(l);\r
writeln(outfile,'vector space requirement ':26, l:6);\r
read_int(l);\r
writeln(outfile,'entry point offset $':28, hex(l,4));\r
read_int(l);\r
writeln(outfile,'code length ':26, l:6);\r
writeln(outfile);\r
\r
end; (* cex_file *)\r
\r
if open_file then\r
begin\r
read_int16(l);\r
writeln(outfile);\r
writeln(outfile,'Total length: ', l);\r
writeln(outfile);\r
read_int16(l);\r
writeln(outfile,'Entry 0: #', hex(l,4));\r
address:= l;\r
for i:= 1 to l div 2 - 1 do\r
begin\r
read_int16(x);\r
if x <> l then begin\r
l:= x;\r
routine_nr:= routine_nr + 1;\r
end;\r
writeln(outfile,'Entry',i:3,', Routine',routine_nr:3,': #',hex(l,4));\r
end;\r
writeln(outfile);\r
end (* open_file *) else\r
if pas_file then begin\r
\r
end; (* pas_file *) \r
\r
pas_code_begin:= -1; \r
pas_code_end:= 32000;\r
last_extern:= -1;\r
routine_nr:= 0;\r
byteaddress:= address;\r
last_address_offset:= -1;\r
cycles:= 0;\r
totalcycles:= 0;\r
linepos:= 0;\r
if dump_file then\r
repeat\r
readcode(b);\r
if linepos > 75 then\r
begin\r
writeln(outfile,'>');\r
write(outfile,' <');\r
linepos:= 12;\r
end;\r
if (32<=b) and (b<127) then begin\r
write(outfile, chr( b ));\r
linepos:= linepos + 1;\r
end else\r
begin\r
write(outfile,'#',hex( b, 2) );\r
linepos:= linepos + 3;\r
end;\r
until false\r
else\r
if not print_code then\r
repeat readpascode(b) until false\r
else\r
repeat\r
if open_file then readrtpcode(b) else \r
if pas_file then readpascode(b) else readcode(b);\r
byteaddress:= byteaddress + 1;\r
bytestring:= bytestring + '#' + hex( b, 2 );\r
op:= b div 16;\r
case op of\r
0,1,3,4,5,7,8,\r
9,10,11,12,13,14: \r
begin\r
write(outfile, rhex(address, 4),': ');\r
operand:= extend( operand, b mod 16);\r
operand_int:= (operand_int SHL 4) + b mod 16;\r
IF (op = 0) OR (op = 9) OR (op = 10)\r
THEN BEGIN\r
(*$R-*)\r
writeln(outfile, instruction1[ op ], ' $', \r
rhex( byteaddress + operand_int, 4),\r
bytestring);\r
(*$R-*)\r
END\r
ELSE writeln(outfile, instruction1[ op ], operand_int:9, bytestring);\r
operand:= ''; bytestring:= ' '; address:= byteaddress;\r
operand_int:= 0;\r
cycles:= cycles + instruction1_cycles[ op ];\r
end;\r
2:\r
begin\r
operand:= extend( operand, b mod 16);\r
operand_int:= (operand_int SHL 4) + b mod 16;\r
cycles:= cycles + instruction1_cycles[ op ];\r
if operand_int = 0\r
then begin\r
write(outfile, rhex(address, 4),': ');\r
writeln(outfile, 'noop ', ' ':9, bytestring); \r
address:= byteaddress;\r
operand:= '';\r
bytestring:= ' ';\r
end;\r
end;\r
6:\r
begin\r
operand:= invershex( extend(operand, b mod 16));\r
operand_int := ((operand_int SHL 4) + b mod 16) EXOR $FFFF;\r
cycles:= cycles + instruction1_cycles[ op ];\r
end;\r
15:\r
begin\r
write(outfile, rhex(address, 4),': ');\r
if operand=''\r
then begin \r
writeln(outfile, instruction2[ b mod 16 ], ' ':9, bytestring);\r
cycles:= cycles + instruction2_cycles[ b mod 16 ];\r
end else if operand='1'\r
then begin\r
writeln(outfile, instruction21[ b mod 16 ], ' ':9, bytestring);\r
cycles:= cycles + instruction21_cycles[ b mod 16 ];\r
end else if operand='2'\r
then begin\r
writeln(outfile, instruction22[ b mod 16 ], ' ':9, bytestring);\r
cycles:= cycles + instruction22_cycles[ b mod 16 ];\r
end else if operand='3'\r
then begin\r
writeln(outfile, instruction23[ b mod 16 ], ' ':9, bytestring);\r
cycles:= cycles + instruction23_cycles[ b mod 16 ];\r
end else if operand='4'\r
then begin\r
writeln(outfile, instruction24[ b mod 16 ], ' ':9, bytestring);\r
cycles:= cycles + instruction24_cycles[ b mod 16 ];\r
end else if operand='5'\r
then begin\r
writeln(outfile, instruction25[ b mod 16 ], ' ':9, bytestring);\r
cycles:= cycles + instruction25_cycles[ b mod 16 ];\r
end else writeln(outfile, ' ':6+9, bytestring);\r
operand:= ''; bytestring:= ' '; address:= byteaddress;\r
operand_int:= 0\r
end;\r
end;\r
until false; \r
END.\r