PROGRAM deas; 
{$R-,K-}

{ This program will output a symbolic dump af any occam file.   }
{ Witch symbolic dump depend on extention                       }

TYPE
  instruction_string = string[6];
CONST
  instruction1: ARRAY[0..15] of instruction_string =
    ( 'j     ', 'ldlp  ', 'pfix  ', 'ldnl  ',
      'ldc   ', 'ldnlp ', 'nfix  ', 'ldl   ',
      'adc   ', 'call  ', 'cj    ', 'ajw   ',
      'eqc   ', 'stl   ', 'stnl  ', 'opr   ' );
  instruction1_cycles: ARRAY[0..15] of byte =
    ( 3, 1, 1, 2, 1, 1, 1, 2, 1, 7, 3, 1, 2, 1, 2, 0 );
  instruction2: ARRAY[0..15] of instruction_string =
    ( 'rev   ', 'lb    ', 'bsub  ', 'endp  ',
      'diff  ', 'add   ', 'gcall ', 'in    ',
      'prod  ', 'gt    ', 'wsub  ', 'out   ',
      'sub   ', 'startp', 'outbyt', 'outwor' );
  instruction2_cycles: ARRAY[0..15] of byte =
    ( 1, 5, 1, 13, 1, 1, 10, 19, 12, 1, 2, 19, 1, 12, 23, 23 );
  instruction21: array[0..15] of instruction_string =
    ( 'seterr', '#21#F1', 'resetc', 'csub0 ',
      '#21#F4', 'stopp ', 'ladd  ', 'stlb  ',
      'sthf  ', 'norm  ', 'ldiv  ', 'ldpi  ', 
      'stlf  ', 'xdble ', 'ldpri ', 'rem   ' );
  instruction21_cycles: ARRAY[0..15] of byte =
    ( 1, 0, 3, 2, 0, 11, 2, 1, 1, 13, 35, 2, 1, 2, 1, 37 );
  instruction22: array[0..15] of instruction_string =
    ( 'ret   ', 'lend  ', 'ldtime', '#22#F3', 
      '#22#F4', '#22#F5', '#22#F6', '#22#F7',
      '#22#F8', 'tester', 'testpr', 'tin   ',
      'div   ', '#22#FD', 'dist  ', 'disc  ' );
  instruction22_cycles: ARRAY[0..15] of byte =
    ( 5, 10, 2, 100, 100, 100, 100, 100, 100, 3, 2, 30, 39, 100, 23, 8 );
  instruction23: array[0..15] of instruction_string =
    ( 'diss  ', 'lmul  ', 'not   ', 'xor   ',
      'bcnt  ', 'lshr  ', 'lshl  ', 'lsum  ',
      'lsub  ', 'runp  ', 'xword ', 'sb    ',
      'gajw  ', 'savel ', 'saveh ', 'wcnt  ' );
  instruction23_cycles: ARRAY[0..15] of byte =
    ( 4, 33, 1, 1, 2, 8, 8, 2, 2, 10, 4, 5, 2, 4, 4, 5 );
  instruction24: array[0..15] of instruction_string =
    ( 'shr   ', 'shl   ', 'mint  ', 'alt   ',
      'altwt ', 'altend', 'and   ', 'enbt  ',
      'enbc  ', 'enbs  ', 'move  ', 'or    ',
      'csngl ', 'ccnt1 ', 'talt  ', 'ldiff ' );
  instruction24_cycles: ARRAY[0..15] of byte =
    ( 10, 10, 1, 2, 17, 4, 1, 8, 7, 3, 8, 1, 3, 3, 4, 2 );
  instruction25: array[0..15] of instruction_string =
    ( 'sthb  ', 'taltwt', 'sum   ', 'mult  ',
      'sttime', 'stoper', 'cword ', 'clther',
      'sthaer', 'tshaer', '#25#FA', '#25#FB',
       '#25#FC','#25#FD', '#25#FE', '#25#FF' );     
  instruction25_cycles: ARRAY[0..15] of byte =
    ( 1, 48, 1, 38, 1, 2, 5, 1, 1, 2, 100, 100, 100, 100, 100, 100 );

TYPE
  hexstring = STRING[8];
  string128 = STRING[128];
  
VAR
  record_length, routine_length, file_length, read_length: real;
  address, 
  byteaddress: real; 
  routine_nr,
  i, cycles, totalcycles: integer;
  last_address_offset: real;
  operand: string[10];
  operand_int: integer;
  bytestring: string[20];
  b, op: byte;
  ch: char;
  x: integer;
  y: integer;
  l: integer;
  l_bytes: array[1..4] of 0..255;
  lib_count: integer;
  cex_file: boolean;
  dump_file: boolean;
  open_file, pas_file: boolean;
  pas_code_begin, pas_code_end: real;
  print_code: boolean;
  linepos: integer;
  infile: FILE of byte;
  outfile: text;

  last_extern: integer;
  extern: array[0..100] of string[16];
  
FUNCTION hex(number,digits: integer): hexstring;
CONST
  hexdigit: ARRAY[0..15] OF char = '0123456789ABCDEF';
VAR
  d: integer;
  h: hexstring;
BEGIN
  h[0]:=chr(digits);
  FOR d:=digits DOWNTO 1 DO
  BEGIN
    h[d]:=hexdigit[number AND 15];
    number:=number SHR 4;
  END;
  hex:=h;
END;

FUNCTION rhex(number: real; digits: integer): hexstring;
CONST
  hexdigit: ARRAY[0..15] OF char = '0123456789ABCDEF';
VAR
  d: integer;
  h: hexstring;
  x: real;
BEGIN
  number:= number + 0.2;
  h[0]:=chr(digits);
  FOR d:=digits DOWNTO 1 DO
  BEGIN
    x:= trunc( number / 16);
    number:= number - x * 16; 
    h[d]:= hexdigit[ round( number )];
    number:= x;
  END;
  rhex:=h;
END;

FUNCTION invershex(h: hexstring): hexstring;
var
  i: byte;
BEGIN
  for i:=1 to ord(h[0]) do
    case h[i] of
      '0': h[i] := 'F'; '1': h[i] := 'E'; '2': h[i] := 'D'; '3': h[i] := 'C';
      '4': h[i] := 'B'; '5': h[i] := 'A'; '6': h[i] := '9'; '7': h[i] := '8';
      '8': h[i] := '7'; '9': h[i] := '6'; 'A': h[i] := '5'; 'B': h[i] := '4';
      'C': h[i] := '3'; 'D': h[i] := '2'; 'E': h[i] := '1'; 'F': h[i] := '0';
    end;
  for i:=ord(h[0])+1 to 8 do h:= 'F' + h;
  invershex:= h;
END; 

FUNCTION extend(h: hexstring; b: byte): hexstring;
var
  i: byte;
BEGIN
  if ord(h[0]) = 8 then
  begin
    for i:=1 to 7 do h[i]:= h[i+1];
    h[0]:= pred(h[0]);
  end;
  extend:= h + hex(b, 1);
END;

procedure read_int16(var i:integer);
var l, h: byte;
begin
  read(infile, l);
  read(infile, h);
  i:= (h SHL 8) + l;
  read_length:= read_length + 2.0;
end;

procedure readcode(var b: byte);
const
  record_element = 0;
  prefix_byte    = 3;
var
  tag, operand: integer;
begin
  while record_length<0.5 do begin
    operand:= 0;
    repeat
      if read_length>(file_length - 0.5)
      then begin
          if dump_file then writeln(outfile) else
          begin
          write(outfile, rhex(address, 4),': ');
          writeln(outfile, ' ':15, bytestring);   
          end;
          close(infile); close(outfile);
        halt;
      end;  
      read(infile,b);
      read_length:= read_length + 1.0;
      tag:= b shr 6;
      operand:= (operand shl 6) + (b and 63);
    until tag<>prefix_byte;
    totalcycles:= totalcycles + cycles;
    if dump_file then
    begin
      if linepos>=12 then writeln(outfile,'>')
      else writeln(outfile);
      linepos:= 0;
      case tag of
        0: begin write(outfile,'T         <'); linepos:= 12; end; 
        1: write(outfile,'N', operand:7);
        2: case operand of
             0: write(outfile,'Start list');
             1: write(outfile,'End list');
             2: write(outfile,'Start fold');
             3: write(outfile,'End fold');
             4: write(outfile,'Start filed');
             5: write(outfile,'End filed');
             otherwise write(outfile,'F', operand:7);
           end;  
        3: ;
      end;
    end else if totalcycles <> 0 then
    begin
    writeln(outfile, '      Total cycles:        ', cycles:10, totalcycles:10);
    writeln(outfile);
    end;
    cycles:= 0;
    if tag=record_element
    then begin
      record_length:= operand;
    end;
  end;
  read(infile,b);
  record_length:= record_length - 1.0;
  read_length:= read_length + 1.0;
end;

procedure readrtpcode(var b: byte);
var do_special: boolean;
    h: byte;
    i: integer;
begin
  while record_length<0.5 do
  begin
    do_special:= true;
    while routine_length<0.5 do
    begin
      if read_length>(file_length - 0.5)
      then begin
        write(outfile, rhex(address, 4),': ');
        writeln(outfile, ' ':15, bytestring);   
        close(infile); close(outfile);
        halt;
      end;      
      read_int16(i);
      routine_length:= i - 2.0;
      if cycles > 0 then begin
        writeln(outfile);
        writeln(outfile, '      Total cycles:        ', cycles:10);
      end;      
      writeln(outfile);
      writeln(outfile);
      writeln(outfile, 'ROUTINE: ',routine_nr,' codelength: ',routine_length - 2.0 );
      writeln(outfile);
      routine_nr:= routine_nr + 1;
      do_special:= false;
      byteaddress:= byteaddress + 2.0;
      address:= byteaddress;
      cycles:= 0
    end;
    if do_special then begin
      do_special:= false;
      read(infile, b);
      read(infile, b);
      read(infile, b);
      routine_length:= routine_length - 3.0;
    end;
    read_int16(i);
    routine_length:= i - 2.0;
  end;
  read(infile, b);        
  routine_length:= routine_length - 1.0;
  record_length:= record_length - 1.0;
  read_length:= read_length + 1.0;
end;

procedure read_pasarg(var i: real);
var b:byte;
begin
  read(infile, b);
  i:= b AND $7F;
  while (b AND $80) <> 0 do
  begin
    read(infile, b);
    i:= i * 128.0 + (b AND $7F);
    (* i:= (i SHL 7) + (b AND $7F); *)
  end;
end;


procedure read_pasname(var s: string128);
var l,i:integer;
    b: byte;
    r:real;
begin
  read_pasarg(r);
  l:= round(r);
  i:= 1;
  for i:=1 to l do
  begin
    read(infile, b);
    if i <= 128 then s[i]:= chr(b);
  end;
  if l <= 128 then s[0]:= chr(l) else s[0]:= chr(128);
end;

procedure read_fixtype;
var b: byte;
    int: integer;
    r: real;
begin
  read(infile, b);
  case b of
    $25: begin
           read_pasarg( r );
           int:= round( r );
           write(outfile,' Codefix ', int);
           if int <= last_extern then write(outfile,' ',extern[int]);
         end;
    $2C: write(outfile,' Modnum');
    $2B: write(outfile,' Maininit');
    $27: write(outfile,' Staticfix');
    $28: write(outfile,' Limit');
    $29: write(outfile,' Init');
    $26: begin
           write(outfile,' Datafix');
           read_pasarg(r); 
           int:= round(r);
           write(outfile, ' ',int);
           if int <= last_extern then write(outfile,' ',extern[int]);
           read_pasarg(r); 
           write(outfile, ' ',rhex(r,4));
         end;
    otherwise write(outfile, ' Unknown: ',hex(b,2));
  end;
end;


procedure readpascode(var b: byte);
var s, s2: string128;
    int, int2, int3: integer;
    r, r2, r3: real;
    b1, b2: byte;
    writeln_done: boolean;
begin
  writeln_done:= false;
  while record_length<0.5 do
  begin
    if writeln_done then begin
      writeln(outfile);
      writeln_done:= true;
    end;
    
    (* read new record *)
      if eof(infile)
      then begin
          writeln(outfile);
          close(infile); close(outfile);
        halt;
      end;  
    read(infile, b);
    case b of
      $62: (* library *)
        begin
          read_pasname(s);
          writeln(outfile,'Library: ',lib_count,' ',s);
          lib_count:= lib_count + 1;
          last_extern:= -1;
        end;
      $2E: (* nextmodule *)
        begin
          writeln(outfile,'Next Module: ');
          last_extern:= -1;
        end;
      $6F: (* comment *)
        begin
          read_pasname(s);
          writeln(outfile,'-- ',s);
          if (len(s) > 2) and (s[1] = '$') then
          begin
            if s[2]='C' then
            begin
              delete(s,1,2);
              val(s,r,int);
              pas_code_end:= r + pas_code_begin;
            end else
            if s[2]='B' then
            begin
              delete(s,1,2);
              val(s,r,int);
              pas_code_begin:= r;
              pas_code_end:= pas_code_end + pas_code_begin;
            end;            
          end; 
        end;
      $78: (* description *)
        begin
          read_pasname(s);
          writeln(outfile,'Desc: ',s);
        end;
      $70: (* id *)
        begin
           read(infile, b);
           read_pasname(s);
           read_pasname(s2);
           writeln(outfile,'ID: ',b,' ',s,' ',s2);
        end;
      $59: (* newid *)
        begin
           read(infile, b);
           read_pasarg(r);
           read_pasname(s);
           read_pasname(s2);
           writeln(outfile,'NewID: ',b,' ',r:1:0);
           writeln(outfile,'       ',s);
           writeln(outfile,'       ',s2);
        end;
      $71: (* address offset *)
        begin
          read_pasarg(r);
          if not print_code then
          writeln(outfile,'Address offset: ', rhex(r,4)) else
          if byteaddress = last_address_offset
          then writeln(outfile,rhex(last_address_offset,4),':');
          byteaddress:= r;
          address:= byteaddress;
          last_address_offset:= r;
        end;
      $72: (* SC *)
        begin 
          read(infile, b);
          writeln(outfile,'SC: ',hex(b,2));
        end;
      $75: (* code *)
        begin
          read_pasarg(record_length);
          if not print_code then
            writeln(outfile,'Code: ', record_length:1:0, ' bytes') 
          else
          
          if (byteaddress < (pas_code_begin-0.5)) or ((pas_code_end+0.5) <= byteaddress) then
          begin
            s:=' ';
            r:= 0;
            int:= 0;
            if record_length > 0.5 then
            begin
              write(outfile, rhex(byteaddress, 4), ': ');
            end;
            while r < (record_length - 0.5) do
            (* for int:=0 to record_length - 1 do *)
            begin
              if int = 16 then begin
                writeln(outfile, '   ',s);
                write(outfile, rhex(byteaddress,4), ': ');
                s:='                ';
                int:= 0
              end else int:= int + 1;
              read(infile, b);
              byteaddress:= byteaddress + 1.0;
              write(outfile, hex(b,2), ' ');
              if (32 > b) or (b > 127) then b:= ord('.');
              s[ int mod 16 + 1]:= chr(b);
              r:= r + 1.0;
            end;
            for int:= 0 to 15 - (int + 15) mod 16 do write(outfile, '   ');
            writeln(outfile, s);
            record_length:= 0.0;
          end;
        end;
      $76: (* total code *)
        begin
          read_pasarg(r);
          read_pasarg(r2);
          writeln(outfile,'Total code, size: ',r:1:0, ' nested: ', r2:1:0);
        end;
      $23: (* static *)
        begin
          read_pasarg(r);
          writeln(outfile,'Static: ', r:1:0);
        end;
      $2D: (* codesymb *)
        begin
          read_pasname(s);
          read_pasarg(r);
          writeln(outfile,'Code Symb: ',s,' offset: ',rhex(r,4));
          byteaddress:= r;
          address:= byteaddress;
        end;
      $74: (* entry *)
        begin
          read_pasname(s);
          read_pasarg(r);
          write(outfile,'Entry: ',s,' offset: ',rhex(r,4));
          byteaddress:= r;
          address:= byteaddress;
          read_pasarg(r);
          writeln(outfile,' ws: ',r:1:0);
        end;
      $2F: (* entrysymb *)
        begin
          read_pasname(s);
          read_pasarg(r);
          write(outfile,'Entry Symb: ',s,' offset: ',rhex(r,4));
          byteaddress:= r;
          address:= byteaddress;
          read_pasarg(r);
          writeln(outfile,' ws: ',r:1:0);
        end;
      $21: (* datasymb *)
        begin
          read_pasname(s);
          read_pasarg(r);
          writeln(outfile,'Data Symb: ',s,' offset: ',rhex(r,4));
          byteaddress:= r;
          address:= byteaddress;
        end;
      $61, $31 : (* newentry *)
        begin
          read_pasname(s);
          read_pasarg(r);
          read_pasarg(r2);
          read_pasarg(r3);
          write(outfile,'Newentry');
          if b=$31 then write(outfile,' Symb');
          write(outfile,': ',s,' offset: ',rhex(r,4));
          write(outfile,' workspace: ',r2:1:0);
          writeln(outfile,' vectorspace: ',r3:1:0);
        end;
      $00..$0F: (* instruction patch *)
        begin
          read_pasarg(r);
          write(outfile,'Inst patch: ',b,' ',rhex(r,4));
          read_fixtype;
          writeln(outfile);
        end;
      $10: (* long instruction patch *)
        begin
          read_pasarg(r);
          write(outfile,'Long Inst patch: ',rhex(r,4));
          read_fixtype;
          writeln(outfile);
        end;
      $22: (* external *)
        begin
          read_pasname(s);
          if last_extern < 100 then
          begin
            last_extern:= last_extern + 1;
            extern[last_extern]:= s;
          end;
          writeln(outfile,'External: ',s);
        end;
      $73: (* debug *)  
        begin
          writeln(outfile,'Debug: ');
          read_pasarg(record_length);
          s:=' ';
          r:= 0;
          int:= 0;
          write(outfile, rhex(byteaddress,4), ': ');
          while r < (record_length - 0.5) do          
          begin
            if int = 16 then begin
              writeln(outfile, '   ',s);
              write(outfile, rhex(byteaddress,4), ': ');
              s:='                ';
              int:= 0
            end else int:= int + 1;
            read(infile, b);
            byteaddress:= byteaddress + 1.0;
            write(outfile, hex(b,2), ' ');
            if (32 > b) or (b > 127) then b:= ord('.');
            s[ int + 1]:= chr(b);
            r:= r + 1.0;
          end;
          for int:= 0 to 15 - (int + 15) mod 16 do write(outfile, '   ');
          writeln(outfile, s);
          record_length:= 0.0;
        end;
      otherwise
        begin
          writeln(outfile); 
          writeln(outfile,'Unknown tag: ',hex(b,2));
        end;
     end;
  end;
  read(infile, b);        
  record_length:= record_length - 1;
  read_length:= read_length + 1;
end;

procedure read_int(VAR l:integer);
var l_bytes: array[0..3] of byte;
    x, high_l: integer;
begin
  for x:= 0 to 3 do
    readcode( l_bytes[x] );
  l:= 0;
  for x:=1 downto 0 do
    l:= (l SHL 8) + l_bytes[x];
  high_l:= 0;
  for x:=3 downto 2 do
    high_l:= (high_l SHL 8) + l_bytes[x];
  IF high_l <> 0 THEN writeln(outfile, ' BIG integer: ', high_l:7, l:7 )
end;

BEGIN
  print_code:= true;
  IF (argcnt<1) OR (argcnt>2) THEN
  BEGIN
    IF argcnt = 3 then begin
      print_code:= pos('s', argstr(3) ) = 0;   
    end else
    begin
      writeln('Syntax: DEAS <infile> [<outfile>]'); 
      halt;
    end;
  END;
  assign(infile,argstr(1)); {$I-} reset(infile) {$I+};
  IF iores>0 THEN
  BEGIN
    writeln('DEAS: "',argstr(1),'" does not exist'); halt;
  END;
  cex_file:= pos('.cex', argstr(1) ) <> 0;
  if cex_file then dump_file:= false else
  dump_file:= (pos('.dds', argstr(1) ) <> 0) OR
              (pos('.dlk', argstr(1) ) <> 0) OR
              (pos('.ddb', argstr(1) ) <> 0);
  open_file:= pos('.ope', argstr(1) ) <> 0;
  pas_file:= (pos('.bin', argstr(1) ) <> 0) OR
             (pos('.t4', argstr(1) ) <> 0) OR
             (pos('.t8', argstr(1) ) <> 0) OR
             (pos('.c4', argstr(1) ) <> 0) OR
             (pos('.pof',argstr(1) ) <> 0) OR
             (pos('.c8', argstr(1) ) <> 0);
  IF argcnt>=2 THEN
  assign(outfile,argstr(2)) ELSE
  assign(outfile,'CON:');
  rewrite(outfile);
  writeln(outfile,'File length = ',length(infile):8);
  operand:= ''; bytestring:= '   '; address:= 0;
  operand_int:= 0;
  file_length:= length(infile);
  record_length:= 0.0;
  routine_length:= 0.0;
  routine_nr:= 0;
  lib_count:= 0;
  read_length:= 1.0;


  if cex_file
  then begin
  
  byteaddress:= 0;
  cycles:= 0;
  totalcycles:= 0;


  writeln(outfile);
  read_int(l);
  write(outfile,'interface descriptor         ':30);
  for y:= 1 to l do
  begin
    readcode(b);
    if (b >= 32) AND (b < 127)
    then write(outfile, chr(b))
    else write(outfile, '(',b:1,')');
  end;
  writeln(outfile);

  read_int(l);
  write(outfile,'compiler identifier          ':30);
  for y:= 1 to l do
  begin
    readcode(b);
    if (b >= 32) AND (b < 127)
    then write(outfile, chr(b))
    else write(outfile, '(',b:1,')');
  end;
  writeln(outfile);
  writeln(outfile);

  read_int(l);
  writeln(outfile,'target processor         ':26, l:6);
  read_int(l);
  writeln(outfile,'compiler version         ':26, l:6);
  read_int(l);
  writeln(outfile,'workspace requirement    ':26, l:6);
  read_int(l);
  writeln(outfile,'vector space requirement ':26, l:6);
  read_int(l);
  writeln(outfile,'entry point offset        $':28, hex(l,4));
  read_int(l);
  writeln(outfile,'code length              ':26, l:6);
  writeln(outfile);

  end; (* cex_file *)

  if open_file then
  begin
    read_int16(l);
    writeln(outfile);
    writeln(outfile,'Total length:   ', l);
    writeln(outfile);
    read_int16(l);
    writeln(outfile,'Entry  0: #', hex(l,4));
    address:= l;
    for i:= 1 to l div 2 - 1 do
    begin
      read_int16(x);
      if x <> l then begin
        l:= x;
        routine_nr:= routine_nr + 1;
      end;
      writeln(outfile,'Entry',i:3,', Routine',routine_nr:3,': #',hex(l,4));
    end;
    writeln(outfile);
  end (* open_file *) else
  if pas_file then begin
  
  end; (* pas_file *) 

  pas_code_begin:= -1; 
  pas_code_end:= 32000;
  last_extern:= -1;
  routine_nr:= 0;
  byteaddress:= address;
  last_address_offset:= -1;
  cycles:= 0;
  totalcycles:= 0;
  linepos:= 0;
  if dump_file then
  repeat
    readcode(b);
    if linepos > 75 then
    begin
      writeln(outfile,'>');
      write(outfile,'           <');
      linepos:= 12;
    end;
    if (32<=b) and (b<127) then begin
      write(outfile, chr( b ));
      linepos:= linepos + 1;
    end else
    begin
      write(outfile,'#',hex( b, 2) );
      linepos:= linepos + 3;
    end;
  until false
  else
  if not print_code then
    repeat readpascode(b) until false
  else
  repeat
    if open_file then readrtpcode(b) else 
    if pas_file then readpascode(b) else readcode(b);
    byteaddress:= byteaddress + 1;
    bytestring:= bytestring + '#' + hex( b, 2 );
    op:= b div 16;
    case op of
      0,1,3,4,5,7,8,
      9,10,11,12,13,14: 
        begin
          write(outfile, rhex(address, 4),': ');
          operand:= extend( operand, b mod 16);
          operand_int:= (operand_int SHL 4) + b mod 16;
          IF (op = 0) OR (op = 9) OR (op = 10)
          THEN  BEGIN
            (*$R-*)
            writeln(outfile, instruction1[ op ], '    $', 
                    rhex( byteaddress + operand_int, 4),
                    bytestring);
            (*$R-*)
          END
          ELSE writeln(outfile, instruction1[ op ], operand_int:9, bytestring);
          operand:= ''; bytestring:= '   '; address:= byteaddress;
          operand_int:= 0;
          cycles:= cycles + instruction1_cycles[ op ];
        end;
      2:
        begin
          operand:= extend( operand, b mod 16);
          operand_int:= (operand_int SHL 4) + b mod 16;
          cycles:= cycles + instruction1_cycles[ op ];
          if operand_int = 0
          then begin
            write(outfile, rhex(address, 4),': ');
            writeln(outfile, 'noop  ', ' ':9, bytestring);   
            address:= byteaddress;
            operand:= '';
            bytestring:= '   ';
          end;
        end;
      6:
        begin
          operand:= invershex( extend(operand, b mod 16));
          operand_int := ((operand_int SHL 4) + b mod 16) EXOR $FFFF;
          cycles:= cycles + instruction1_cycles[ op ];
        end;
      15:
        begin
          write(outfile, rhex(address, 4),': ');
          if operand=''
          then begin 
            writeln(outfile, instruction2[ b mod 16 ], ' ':9, bytestring);
            cycles:= cycles + instruction2_cycles[ b mod 16 ];
          end else if operand='1'
          then begin
            writeln(outfile, instruction21[ b mod 16 ], ' ':9, bytestring);
            cycles:= cycles + instruction21_cycles[ b mod 16 ];
          end else if operand='2'
          then begin
            writeln(outfile, instruction22[ b mod 16 ], ' ':9, bytestring);
            cycles:= cycles + instruction22_cycles[ b mod 16 ];
          end else if operand='3'
          then begin
            writeln(outfile, instruction23[ b mod 16 ], ' ':9, bytestring);
            cycles:= cycles + instruction23_cycles[ b mod 16 ];
          end else if operand='4'
          then begin
            writeln(outfile, instruction24[ b mod 16 ], ' ':9, bytestring);
            cycles:= cycles + instruction24_cycles[ b mod 16 ];
          end else if operand='5'
          then begin
            writeln(outfile, instruction25[ b mod 16 ], ' ':9, bytestring);
            cycles:= cycles + instruction25_cycles[ b mod 16 ];
          end else writeln(outfile, ' ':6+9, bytestring);
          operand:= ''; bytestring:= '   '; address:= byteaddress;
          operand_int:= 0
        end;
    end;
  until false;    
END.