strcopy (dvifname.str, logfilnam.str, dvifname.len);
     logfilnam.len := dvifname.len;
     rp := revindex (logfilnam, '.');
     (* add a ".tlog" extension *)
     i := rp - 1;
     logfilnam.str[i + 1] := '.';
     logfilnam.str[i + 2] := 't';
     logfilnam.str[i + 3] := 'l';
     logfilnam.str[i + 4] := 'o';
     logfilnam.str[i + 5] := 'g';
     logfilnam.len := i + 5;

     openlogfile;
end; 


{-----------------------------------------------------}
    function inTFM (z: integer): boolean;
    label
        9997, 9998, 9999;
    var
        k: integer;
        lh: integer;
        nw: integer;
        alpha, beta: integer; 
    begin
        readtfmword;
        lh := b2 * 256 + b3;
        readtfmword;
        font[nf].bc := b0 * 256 + b1;
        font[nf].ec := b2 * 256 + b3;
        if (font[nf].ec < font[nf].bc) then 
            font[nf].bc := font[nf].ec + 1;
        readtfmword;
        nw := b0 * 256 + b1;
        if ((nw = 0) or (nw > 256)) then 
            goto 9997;
        for k := 1 to 3 + lh do 
          begin
            if eof(tfmfile) then 
                goto 9997;
            readtfmword;
            if (k = 4) then 
              if (b0 < 128) then 
                tfmchecksum := ((b0 * 256 + b1) * 256 + b2) * 256 + b3
              else 
                tfmchecksum := (((b0 - 256) * 256 + b1) * 256 + b2) * 256 + b3
          end; 
          
            for k := 0 to (font[nf].ec - font[nf].bc) do
              begin
                readtfmword;
                if (b0 > nw) then 
                    goto 9997;
                font[nf].widths[k] := b0
              end; 
          alpha := 16 * z;
          beta := 16;
          while z >= TWO23 do
            begin
              z := z div 2;
              beta := beta div 2
            end;
        for k := 0 to nw - 1 do
          begin
            readtfmword;
            inwidth[k] := (((b3 * z) div 256 + b2 * z) div 256 + b1 * z) div beta;
            if b0 > 0 then 
                if b0 < 255 then 
                    goto 9997
                else 
                    inwidth[k] := inwidth[k] - alpha;
          end;
        if inwidth[0] <> 0 then 
            goto 9997;
        with font[nf] do
          begin
          for k := 0 to (ec - bc) do 
            if widths[k] = 0 then
              begin
              widths[k + bc] := TWO31;
{              pixelwidths[k + bc] := 0;}
              end
            else
              begin
              widths[k + bc] := inwidth[widths[k]];
{              pixelwidths[k + bc] := round(conv * widths[k]);}
              end;
           end; (* with *)
        inTFM := true;
        goto 9999;
9997:
	complain (ERRREALBAD);
        writestrng(tfmname,true);
	writeln(logfile,'---not loaded, TFM file is bad');
	      
9998:
        inTFM := false;
9999:
        
    end; 



{-----------------------------------------------------}
procedure Fastdefinefont (fn: integer);
var     p, k: integer;
        n, waste: integer;
        c, q, d: integer;

begin  { Fastdefinefont }
  c := Dsign4byte;
  q := Dsign4byte;
  d := Dsign4byte;
  p := Dget1byte;
  n := Dget1byte;
  for k := 1 to (p + n) do
    waste := Dget1byte;                         
end;  { Fastdefinefont }


{-----------------------------------------------------}
    procedure definefont (e: integer);
    var
        f: 0..MAXFONTS;
        p, k: integer;
        n: integer;
        c, q, d: integer;
        r: integer;
    begin
        if (nf = MAXFONTS) then 
        begin
	  complain (ERRREALBAD);
          writeln(logfile,'TeXtyl capacity exceeded (max fonts=', MAXFONTS: 1, ')!');
          writeln('TeXtyl capacity exceeded (max fonts=', MAXFONTS: 1, ')!');
          jumpout
        end;
        font[nf].num := e;
        f := 0;
        while font[f].num <> e do  (* find first occurrence *)
            f := f + 1; 
        c := Dsign4byte;
        font[nf].checksum := c;
        q := Dsign4byte;
        font[nf].scaledsize := q;
        d := Dsign4byte;
        font[nf].designsize := d;
        p := Dget1byte;
        n := Dget1byte;
        font[nf].name.len := p + n;
        for k := 1 to (p + n) do
           font[nf].name.str[k] := Dget1byte;

        if (f = nf) then 
        begin (* f = nf *)
            for k := 1 to AREALENGTH do 
                tfmname.str[k] := ' ';

              r := 0;
            
            for k := 1 to font[nf].name.len do 
              begin
                r := r + 1;
                tfmname.str[r] := xchr[font[nf].name.str[k]]
              end;
            tfmname.str[r + 1] := '.';
            tfmname.str[r + 2] := 't';
            tfmname.str[r + 3] := 'f';
            tfmname.str[r + 4] := 'm';

	    tfmname.str[r + 5] := chr(32);

	    tfmname.len := r + 4;

            if (not opentfmfile) then
	      begin
	        complain (ERRREALBAD);
                writestrng(tfmname,true);
		writeln(logfile,'---not loaded, TFM file can''t be opened!');
		writestrng(tfmname, false);
		writeln(' cannot be opened. Aborting.');
		jumpout;
   	      end
            else 
              begin
                if (q <= 0) or (q >= TWO27) then 
		  begin
		    complain (ERRREALBAD);
                    writestrng(tfmname,true);
                    writeln(logfile,'---not loaded, bad scale (', q: 1, ')!');
		  end
                else if (d <= 0) or (d >= TWO27) then 
		  begin
		    complain (ERRREALBAD);
                    writestrng(tfmname,true);
                    writeln(logfile,'---not loaded, bad design size (', d: 1, ')!');
		  end
                else
                  if inTFM(q) then
                    begin (* intfm *)
                    font[nf].space := q div 6;
                    if (c <> 0) and (tfmchecksum <> 0) and (c <> tfmchecksum) then 
                      begin
                      writeln(logfile,'Problem in fig#',pgfigurenum:0,' on page ',currpagenum:0);
	              writestrng(tfmname,true);
                      writeln(logfile,'---beware: check sums do not agree!');
                      writeln(logfile,'   (', c: 1, ' vs. ', tfmchecksum: 1, ')');
                      end;
                    d := round(100.0 * conv * q / (trueconv * d));
                    nf := nf + 1;
                    font[nf].space := 0;
                    end (* intfm *)
                 end;
            end;
    end;

{-----------------------------------------------------}
    function firstpar (o: OctByt): integer;
    var fpar : integer;
    begin
       case (o) of
            0, 1, 2, 3, 4, 5, 6,
            7, 8, 9, 10, 11, 12, 13,
            14, 15, 16, 17, 18, 19, 20,
            21, 22, 23, 24, 25, 26, 27,
            28, 29, 30, 31, 32, 33, 34,
            35, 36, 37, 38, 39, 40, 41,
            42, 43, 44, 45, 46, 47, 48,
            49, 50, 51, 52, 53, 54, 55,
            56, 57, 58, 59, 60, 61, 62,
            63, 64, 65, 66, 67, 68, 69,
            70, 71, 72, 73, 74, 75, 76,
            77, 78, 79, 80, 81, 82, 83,
            84, 85, 86, 87, 88, 89, 90,
            91, 92, 93, 94, 95, 96, 97,
            98, 99, 100, 101, 102, 103, 104,
            105, 106, 107, 108, 109, 110, 111,
            112, 113, 114, 115, 116, 117, 118,
            119, 120, 121, 122, 123, 124, 125,
            126, 127:
                fpar := o - 0;
            128, 133, 235, 239, 243:
                fpar := Dget1byte;
            129, 134, 236, 240, 244:
                fpar := Dget2byte;
            130, 135, 237, 241, 245:
                fpar := Dget3byte;
            143, 148, 153, 157, 162, 167:
                fpar := Dsign1byte;
            144, 149, 154, 158, 163, 168:
                fpar := Dsign2byte;
            145, 150, 155, 159, 164, 169:
                fpar := Dsign3byte;
            131, 132, 136, 137, 146, 151, 156,
            160, 165, 170, 238, 242, 246:
                fpar := Dsign4byte;
            138, 139, 140, 141, 142, 247, 248,
            249, 250, 251, 252, 253, 254, 255:
                fpar := 0;
            147:
                fpar := w;
            152:
                fpar := x;
            161:
                fpar := y;
            166:
                fpar := z;
            171, 172, 173, 174, 175, 176, 177,
            178, 179, 180, 181, 182, 183, 184,
            185, 186, 187, 188, 189, 190, 191,
            192, 193, 194, 195, 196, 197, 198,
            199, 200, 201, 202, 203, 204, 205,
            206, 207, 208, 209, 210, 211, 212,
            213, 214, 215, 216, 217, 218, 219,
            220, 221, 222, 223, 224, 225, 226,
            227, 228, 229, 230, 231, 232, 233,
            234:
                fpar := o - 171
        end;
        firstpar := fpar;
    end;

{-----------------------------------------------------}
    function specialcases (o: OctByt; p: integer): boolean;
    label
        46, 44, 30, 9998;
    var
        pure: boolean;

    begin
        pure := true;
        if ((o < 157) or (o > 249)) then
          begin
	    complain (ERRREALBAD);
            writeln(logfile, 'undefined command ', o: 1, '!');
            goto 30;
          end;
        case (o) of 
            157, 158, 159, 160:
                begin
                    goto 44;
                end;
            161, 162, 163, 164, 165:
                begin
                    y := p;
                    goto 44;
                end;
            166, 167, 168, 169, 170:
                begin
                    z := p;
                    goto 44;
                end; 
            171, 172, 173, 174, 175, 176, 177,
            178, 179, 180, 181, 182, 183, 184,
            185, 186, 187, 188, 189, 190, 191,
            192, 193, 194, 195, 196, 197, 198,
            199, 200, 201, 202, 203, 204, 205,
            206, 207, 208, 209, 210, 211, 212,
            213, 214, 215, 216, 217, 218, 219,
            220, 221, 222, 223, 224, 225, 226,
            227, 228, 229, 230, 231, 232, 233,
            234:
                begin
                    goto 46;
                end;
            235, 236, 237, 238:
                begin
                    goto 46;
                end;
            243, 244, 245, 246:
                begin
                    definefont(p);
                    goto 30;
                end;

            239, 240, 241, 242:
                begin   (* =========specials============= *)
                  mainhandlespecials (o, p);
                  goto 30;
                end; 
            247:
                begin
		  complain (ERRREALBAD);
                  writeln(logfile,'preamble command within a page!');
                  goto 9998;
                end;
            248, 249:
                begin
		  complain (ERRREALBAD);
                  writeln(logfile,'postamble command within a page!');
                  goto 9998;
                end;
       (*     others:
                begin
                  write(' ', 'undefined command ', o: 1, '!');
                  goto 30;
                end   
	*)
        end;
44:  (* label *)
        if (v > 0) and (p > 0) then 
            if (v > TWO31 - p) then 
            begin
                p := TWO31 - v
            end;
        if (v < 0) and (p < 0) then 
            if ((-v) > (p + TWO31)) then 
            begin
                p := -v - TWO31
            end;

        v := v + p;

        goto 30;
46:  (* label *)
        font[nf].num := p;
        curfont := 0;
        while font[curfont].num <> p do 
            curfont := curfont + 1;
        goto 30 ;
9998:
        pure := false;
30:
        specialcases := pure;
    end; 


{-----------------------------------------------------}
    function dopage : boolean;
    label
        41, 42, 43, 30, 9998, 9999;
    var
        o: OctByt;
        p, q: integer;

    begin
        curfont := nf;
 	s := 0;
        h := 0;
        v := 0;
        w := 0;
        x := 0;
        y := 0;
        z := 0;
  	
        ourxpos := 0;
	ourypos := 0;
	ourfontnum := (-1);
        while true do 
          begin 
            o := Dget1byte;
            p := firstpar(o);
            if eof(dvifile) then begin
                writeln(logfile, 'Bad DVI file: ', 'the file ended prematurely', '!');
                writeln('Bad DVI file: ', 'the file ended prematurely', '!');
                jumpout
            end; 
            if o <= 131 then 
              begin 
                goto 41;
              end
            else
              begin
               if (o > 156) then
                 begin
                   if specialcases(o, p) then 
                      goto 30
                   else 
                      goto 9998;
                 end;
                                         
                case (o) of
                    133, 134, 135, 136:
                        begin
                          goto 41;
                        end;
                    132, 137:
                        begin
                            goto 42
                        end;
                    138:
                        begin
                            goto 30;
                        end;
                    139:
                        begin (* BOP *)
			  complain (ERRREALBAD);
                          writeln(logfile, 'bop occurred before eop');
                          goto 9998; (* Fail *)
                        end;
                    140:
                        begin (* EOP *)
                            if (s <> 0) then 
			      begin
			      complain (ERRREALBAD);
                              writeln(logfile, 'stack not empty at end of page (level ', s: 1, ')!');
			      end;
			    if (multifigure <> 0) then
			      begin
			        complain (ERRBAD);
			        writeln(logfile,'Some figure definition not closed at end of page ', currpagenum:0,'!');
			      end;
			    			       
                            write (currpagenum:0,']'); 
                            write (logfile,currpagenum:0,']'); 
			    if ((currpagenum mod 10) = 0) then
			      writeln;
                            dopage := true;
                            goto 9999;
                        end;
                    141:
                        begin (* PUSH *)
                          with stack[s] do 
                            begin
                            sh := h;
                            sv := v;
                            sw := w;
                            sx := x;
                            sy := y;
                            sz := z;
                            end; (* with *)
                          s := s + 1;
                          goto 30;
                        end;
                    142:
                        begin (* POP *)
                            if s = 0 then 
			      begin
			      complain (ERRREALBAD);
                              writeln(logfile,'illegal pop at level zero!');
			      end
                            else 
			      begin
                                s := s - 1;
                                with stack[s] do
                                  begin
                                  h := sh;
                                  v := sv;
                                  w := sw;
                                  x := sx;
                                  y := sy;
                                  z := sz;
                                  end;
                               end;
                            goto 30;
                        end; 
                    143, 144, 145, 146:
                        begin
                            q := p;
                            goto 43
                        end;
                    147, 148, 149, 150, 151:
                        begin
                            w := p;
                            q := p;
                            goto 43
                        end;
                    152, 153, 154, 155, 156:
                        begin
                            x := p;
                            q := p;
                            goto 43
                        end; 
                (*    others:
                        if specialcases(o, p) then 
                            goto 30
                        else 
                            goto 9998;
                                *)                          
                end; (* case *)
            end; (* else *)
41:   (* finish cmd to set/put a char *)
            if p < 0 then 
                p := 255 - (-1 - p) mod 256
            else if p >= 256 then 
                p := p mod 256;
            if (p < font[curfont].bc) or (p > font[curfont].ec) then 
                q := TWO31
            else 
                q := font[curfont].widths[p];
            if (q = TWO31) then 
              begin
	        complain (ERRREALBAD);
                writeln(logfile,'Character ', p:1,' invalid in font #',curfont:0);
              end;
            if o >= 133 then 
                goto 30;
            if q = TWO31 then 
                q := 0;
            goto 43;

42:  (* finish cmd to set/put rule *)
            q := Dsign4byte;
            if o = 137 then 
                goto 30;
            goto 43 ;

43:  (*finish cmd that sets h += q *)
            if (h > 0) and (q > 0) then 
                if (h > (TWO31 - q)) then 
                  begin
                    q := TWO31 - h
                  end;
            if (h < 0) and (q < 0) then 
                if ((-h) > (q + TWO31)) then 
                  begin
                    q := (-h) - TWO31
                  end;

            h := h + q;
30:
        end;
9998:
        dopage := false;
9999:

    end; 

{-----------------------------------------------------}
    procedure skippages;
    label
        9999;
    var
        p: integer;
        k: 0..255;
        downthedrain: integer;
    begin
        while true do 
          begin
            if eof(dvifile) then 
              begin
                writeln(logfile, 'Bad DVI file: ', 'the file ended prematurely', '!');
                write(' ', 'Bad DVI file: ', 'the file ended prematurely', '!');
                jumpout
              end;
            k := Dget1byte;
            p := firstpar(k);
            case (k) of
                139:
                    begin (* BOP *)
                        newbackptr := DVIMark + TotBytesWritten - 1;
			currpagenum := Dsign4byte; (* count[0] *)
                        for k := 1 to 9 do 
                            waste := Dsign4byte; (* WAS count[k] := *)
                        downthedrain := Dsign4byte;
                        BackupInBuf (4);
                        cmdSigned (oldbackptr, 4);
                        oldbackptr := newbackptr;
                        write(' ['); 
                        write(logfile,' ['); 
                        goto 9999;
                    end;
                132, 137: (* RULE *)
                    downthedrain := Dsign4byte;
                243, 244, 245, 246:
                    begin
                        definefont(p);
                    end;
                239, 240, 241, 242: (* specials *)
                    begin
                        mainhandlespecials (k, p);
                    end;
                248:
                    begin (* POST *)
                        ourq := DVIMark + TotBytesWritten - 1;
                        inpostamble := true;
                        goto 9999
                    end;
              (*  others:
                    null
		*)
            end
        end;
    9999:

    end; 

{-----------------------------------------------------}
    procedure readpostamble;
    var
        k: integer;
        p, q, m: integer;
        indx : integer;
    begin
        if (Dsign4byte <> numerator) then 
            writeln(logfile,'Postamble',' numerator',' doesn''t match the preamble!');
        if (Dsign4byte <> denominator) then 
            writeln(logfile,'Postamble',' denominator',' doesn''t match the preamble!');
        if (Dsign4byte <> mag) then 
           begin
           writeln(logfile,'Postamble',' magnification',' doesn''t match the preamble!');
           end;
        maxv := Dsign4byte;
        maxh := Dsign4byte;
        maxs := Dget2byte;
        BackupInBuf (2);
        cmd2byte (maxs + 2); (* pretend the stack depth 
			      * does not increase by
			      * more than two
			      *)
        
        totalpages := Dget2byte;
        repeat
            k := Dget1byte;
            if (k >= 243) and (k < 247) then 
              begin
                p := firstpar(k);
                Fastdefinefont(p);
                k := 138;
              end
        until k <> 138; (* NOP *)

       (* here, backup 1, enter all our fonts and 
        then output the 249 that we backed over *)
        BackupInBuf (1);
        for indx := 1 to MFontsDefd do
          begin
          with MFontTable[indx]^ do 
            enterfont (DVIFontNum, Cksum, DesSize,
                       DesSize, FontName );
          end; (* for *)
        for indx := 1 to VFontsDefd do
          begin
          with VFontTable[indx]^ do
            enterfont (DVIFontNum, Cksum, DesSize,
                        DesSize, FontName);
          end;  (* for *)
	for indx := 1 to LFontsDefd do
	  begin
	  with LFontTable[indx]^ do
	    enterfont (DVIFontNum, Cksum, DesSize,
	    		DesSize, FontName);    
	  end;
        cmd1byte(249);  (* post post *)

        if (k <> 249) then 
            writeln(logfile,'byte ',k:0,' is not postpost!');
        q := Dsign4byte;
        BackupInBuf (4);
        cmd4byte (ourq);
        m := Dget1byte;
        if (m <> 2) then 
            writeln(logfile,'identification should be ', 2: 1, '!');
        m := 223;
        while (m = 223) and not eof(dvifile) do 
            m := Dget1byte;
        if not eof(dvifile) then 
	begin
            writeln(' ', 'Bad DVI file: ', 'signature in should be 223', '!');
            writeln(logfile, 'Bad DVI file: ', 'signature in should be 223', '!');
            jumpout
        end;
    end;


(* MAIN MAIN MAIN MAIN MAIN MAIN MAIN MAIN MAIN MAIN MAIN MAIN MAIN *)
begin (* main *)
    initialize;
    AskandOpenFiles;  (* ask for filenames of inputdvi and outputfil *)

    writeln(logfile, TylVersion,' for Berkeley Unix');	

    write(logfile,'Reading File: ');
    writestrng(dvifname,true);     
    writeln(logfile);


    p := Dget1byte;
    if (p <> 247) then 
    begin
        write(' ', 'Bad DVI file: ', 'First byte isn''t start of preamble!', '!');
        writeln(logfile,'Bad DVI file: ', 'First byte isn''t start of preamble!', '!');
        jumpout
    end;
    p := Dget1byte;
    if (p <> 2) then 
        writeln(logfile,'identification in byte 1 should be ', 2: 1, '!');
    numerator := Dsign4byte;
    denominator := Dsign4byte;
    if (numerator <= 0) then 
    begin
        write(' ', 'Bad DVI file: ', 'numerator is ', numerator: 1, '!');
        writeln(logfile, 'Bad DVI file: ', 'numerator is ', numerator: 1, '!');	
        jumpout
    end;
    if (denominator <= 0) then 
    begin
        write(' ', 'Bad DVI file: ', 'denominator is ', denominator: 1, '!');
        writeln(logfile, 'Bad DVI file: ', 'denominator is ', denominator: 1, '!');
        jumpout
    end;
    conv := numerator / 254000.0 * (resolution / denominator);
    mag := Dsign4byte;
    if (mag <= 0) then 
    begin
        write(' ', 'Bad DVI file: ', 'magnification is ', mag: 1, '!');
        writeln(logfile, 'Bad DVI file: ', 'magnification is ', mag: 1, '!');
        jumpout
    end;
    magfactor := mag / 1000.0;
    trueconv := conv;
    conv := trueconv * magfactor;
    p := Dget1byte; 	(* the 'k' of the preamble *)
    while p > 0 do 
    begin
        p := p - 1;
        waste := Dget1byte;
    end;

    skippages;
    if not inpostamble then 
    begin 
        while (maxpages > 0) do 
          begin (* while *)
            maxpages := maxpages - 1;
            if (not dopage) then 
              begin
                write(' ', 'Bad DVI file: ', 'page ended unexpectedly', '!');
                writeln(logfile, 'Bad DVI file: ', 'page ended unexpectedly', '!');
                jumpout
              end;
		(* now we are at an EOP ---end of page *)
		(*  flushout GDVIbuffer, and reset counters *)
{ 	    writeln('EOP: bytes used= ',GDVIBuf.TotByteLen:0);  }
            WriteDVIBuf;
            ClearDVIBuf;
            multifigure := 0;
	    pgfigurenum := 0;
            FTBDs := 0;
            didnewfonts := false;
            repeat
                k := Dget1byte;
                if (k >= 243) and (k < 247) then  
                  begin (* fontdefs *)
                    p := firstpar(k);
                    definefont(p);
                    k := 138
                  end;
            until (k <> 138); (* nop *)

            if (k = 248) then 
            begin
                inpostamble := true;
                ourq := DVIMark + TotBytesWritten - 1;
                goto 30
            end;

            if (k = 139) then  (* BOP *)
  	      begin
		newbackptr := DVIMark + TotBytesWritten - 1;
		currpagenum := Dsign4byte; (* Count[0] *)
		for k := 1 to 9 do 
		    waste := Dsign4byte; (* WAS count[k] := *)
		waste := Dsign4byte; (* backpointer *)
		BackupInBuf (4);
		cmdSigned (oldbackptr, 4);
		oldbackptr := newbackptr;
		write(' ['); 
		write(logfile,' ['); 
	      end
	    else
              begin (* NOT bop?? *)
		writeln('We did not find BOP when expected');
		writeln(logfile,'We did not find BOP when expected');
                jumpout;
              end;

        end; (* while *)
30: 
    end; (* if not inpostamble *)
    if (not inpostamble) then 
	skippages;
    waste := Dsign4byte; (* ptr to the last bop in file *)
    BackupInBuf (4);
    cmdSigned (oldbackptr, 4);
    readpostamble;
    WriteDVIBuf;

    while ((TotBytesWritten mod 4) <> 0) do
       OutputByte(223);  (* final signatures *)

    writeln;
    writeln(logfile);
    write ('Output written on '); 
    writestrng(outname, false); 
    write(' (',currpagenum:0,' page');
    if (currpagenum > 1) then
      write('s');
    writeln(', ',TotBytesWritten:0,' bytes).');

    write (logfile,'Output written on ');
    writestrng(outname, true); 
    write(logfile,' (',currpagenum:0,' page');
    if (currpagenum > 1) then
      write(logfile,'s');
    writeln(logfile,', ',TotBytesWritten:0,' bytes).');

    write ('Log written on ');
    writestrng(logfilnam, false); writeln;
    write (logfile,'Log written on '); 
    writestrng(logfilnam, true); writeln (logfile);
    writeln;
    writeln(logfile);
666:
    if (ErrorOccurred) then
      begin
        writeln;
        writeln('Some error(s) occurred. Please check Logfile for details');
        writeln('Assume that the outputfile is incorrect');
      end;
end.