unit uTokenize;
{
This code is part of the TiCodEd Application, designed to develop for the
TI-99/4a Homecomputer in a modern, structured way.

BSD License
Copyright (c) 2026, Stefan Bauch, TiCodEd <at> lizardware <dot> de


Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:

1. Redistributions of source code must retain the above copyright notice, this
   list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright notice,
   this list of conditions and the following disclaimer in the documentation
   and/or other materials provided with the distribution.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR
ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

}
{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils;

const cMaxToken = 112;

      keywords : Array[1..cMaxToken] of Record
                                          key : String[14];
                                          tkn : Integer;
                                        end
      = (
      ( Key: 'Unquotedstring' ; Tkn: 200),
      ( Key: 'Quotedstring' ; Tkn: 199),
      ( Key: 'Linenumber' ; Tkn: 201),
      ( Key: 'SEQUENTIAL' ; Tkn: 246),
      ( Key: 'PERMANENT' ; Tkn: 251),
      ( Key: 'RANDOMIZE' ; Tkn: 149),
      ( Key: 'INTERNAL' ; Tkn: 245),
      ( Key: 'RELATIVE' ; Tkn: 244),
      ( Key: 'VALIDATE' ; Tkn: 254),
      ( Key: 'VARIABLE' ; Tkn: 243),
      ( Key: 'DISPLAY' ; Tkn: 162),
      ( Key: 'NUMERIC' ; Tkn: 232),
      ( Key: 'RESTORE' ; Tkn: 148),
      ( Key: 'SUBEXIT' ; Tkn: 167),
      ( Key: 'UNBREAK' ; Tkn: 143),
      ( Key: 'UNTRACE' ; Tkn: 145),
      ( Key: 'WARNING' ; Tkn: 166),
      ( Key: 'ACCEPT' ; Tkn: 164),
      ( Key: 'APPEND' ; Tkn: 249),
      ( Key: 'DELETE' ; Tkn: 153),
      ( Key: 'LINPUT' ; Tkn: 170),
      ( Key: 'OPTION' ; Tkn: 158),
      ( Key: 'OUTPUT' ; Tkn: 247),
      ( Key: 'RETURN' ; Tkn: 136),
      ( Key: 'SUBEND' ; Tkn: 168),
      ( Key: 'UPDATE' ; Tkn: 248),
      ( Key: 'BREAK' ; Tkn: 142),
      ( Key: 'ALPHA' ; Tkn: 231),
      ( Key: 'CLOSE' ; Tkn: 160),
      ( Key: 'DIGIT' ; Tkn: 233),
      ( Key: 'ERASE' ; Tkn: 239),
      ( Key: 'ERROR' ; Tkn: 165),
      ( Key: 'FIXED' ; Tkn: 250),
      ( Key: 'GOSUB' ; Tkn: 135),
      ( Key: 'IMAGE' ; Tkn: 163),
      ( Key: 'INPUT' ; Tkn: 146),
      ( Key: 'PRINT' ; Tkn: 156),
      ( Key: 'TRACE' ; Tkn: 144),
      ( Key: 'USING' ; Tkn: 237),
      ( Key: 'BASE' ; Tkn: 241),
      ( Key: 'BEEP' ; Tkn: 238),
      ( Key: 'CALL' ; Tkn: 157),
      ( Key: 'CHR$' ; Tkn: 214),
      ( Key: 'DATA' ; Tkn: 147),
      ( Key: 'ELSE' ; Tkn: 129),
      ( Key: 'GOTO' ; Tkn: 134),
      ( Key: 'NEXT' ; Tkn: 150),
      ( Key: 'OPEN' ; Tkn: 159),
      ( Key: 'READ' ; Tkn: 151),
      ( Key: 'RPT$' ; Tkn: 225),
      ( Key: 'SEG$' ; Tkn: 216),
      ( Key: 'SIZE' ; Tkn: 235),
      ( Key: 'STEP' ; Tkn: 178),
      ( Key: 'STOP' ; Tkn: 152),
      ( Key: 'STR$' ; Tkn: 219),
      ( Key: 'THEN' ; Tkn: 176),
      ( Key: 'ABS' ; Tkn: 203),
      ( Key: 'ALL' ; Tkn: 236),
      ( Key: 'AND' ; Tkn: 187),
      ( Key: 'ASC' ; Tkn: 220),
      ( Key: 'ATN' ; Tkn: 204),
      ( Key: 'COS' ; Tkn: 205),
      ( Key: 'DEF' ; Tkn: 137),
      ( Key: 'DIM' ; Tkn: 138),
      ( Key: 'END' ; Tkn: 139),
      ( Key: 'EOF' ; Tkn: 202),
      ( Key: 'EXP' ; Tkn: 206),
      ( Key: 'FOR' ; Tkn: 140),
      ( Key: 'INT' ; Tkn: 207),
      ( Key: 'LEN' ; Tkn: 213),
      ( Key: 'LET' ; Tkn: 141),
      ( Key: 'LOG' ; Tkn: 208),
      ( Key: 'MAX' ; Tkn: 223),
      ( Key: 'MIN' ; Tkn: 224),
      ( Key: 'NOT' ; Tkn: 189),
      ( Key: 'POS' ; Tkn: 217),
      ( Key: 'REC' ; Tkn: 222),
      ( Key: 'REM' ; Tkn: 154),
      ( Key: 'RND' ; Tkn: 215),
      ( Key: 'RUN' ; Tkn: 169),
      ( Key: 'SGN' ; Tkn: 209),
      ( Key: 'SIN' ; Tkn: 210),
      ( Key: 'SQR' ; Tkn: 211),
      ( Key: 'SUB' ; Tkn: 161),
      ( Key: 'TAB' ; Tkn: 252),
      ( Key: 'TAN' ; Tkn: 212),
      ( Key: 'VAL' ; Tkn: 218),
      ( Key: 'XOR' ; Tkn: 188),
      ( Key: 'AT' ; Tkn: 240),
      ( Key: 'GO' ; Tkn: 133),
      ( Key: 'IF' ; Tkn: 132),
      ( Key: 'ON' ; Tkn: 155),
      ( Key: 'OR' ; Tkn: 186),
      ( Key: 'PI' ; Tkn: 221),
      ( Key: 'TO' ; Tkn: 177),
      ( Key: '::' ; Tkn: 130),
      ( Key: '^' ; Tkn: 197),
      ( Key: '-' ; Tkn: 194),
      ( Key: ',' ; Tkn: 179),
      ( Key: ';' ; Tkn: 180),
      ( Key: ':' ; Tkn: 181),
      ( Key: '!' ; Tkn: 131),
      ( Key: '(' ; Tkn: 183),
      ( Key: ')' ; Tkn: 182),
      ( Key: '*' ; Tkn: 195),
      ( Key: '/' ; Tkn: 196),
      ( Key: '&' ; Tkn: 184),
      ( Key: '#' ; Tkn: 253),
      ( Key: '+' ; Tkn: 193),
      ( Key: '<' ; Tkn: 191),
      ( Key: '=' ; Tkn: 190),
      ( Key: '>' ; Tkn: 192) );

     seperator : Set of Char = [' ','^','-',',',';',':','!','(',')','*','/'
                                ,'&','#','+','<','=','>'];

      tkn_ELSE = chr($81);
      tkn_GOTO = chr($86);
      tkn_GOSUB = chr($87);
      tkn_RETURN = chr($88);
      tkn_BREAK = chr($8e);
      tkn_UNBREAK = chr($8f);
      tkn_RESTORE = chr($94);
      tkn_ERROR = chr($a5);
      tkn_RUN = chr($a9);
      tkn_THEN = chr($b0);
      tkn_USING = chr($ed);
      tkn_GO = chr($85);
      tkn_TO = chr($b1);

      tkn_COMMA = chr($b3);
      tkn_LINENR = chr($c9);
      tkn_CALL = chr($9d);
      tkn_SUB = chr($a1);
      tkn_DATA = chr(147);
      tkn_IMAGE = chr(163);
      tkn_REM = chr($9a);
      tkn_BANG = chr($83);
      tkn_QString = chr($c7);

      MaxVDPRAM = 11775;

type TLogProc = Procedure(l:Integer; txt:ShortString);


TTIFile = record case byte of
      1 : ( b   :  Array[0..32767] of byte );
      2 : ( hdr : Array[0..3] of Word );
      3 : ( lnt : Array[-2..4093] of record
                       lnhi : Byte;
                       lnlo : Byte;
                       adrhi: Byte;
                       adrlo: Byte;
                     end );
          end;

TTIHeader = Record
              id   : String[7];
              sechi: Byte;
              seclo: Byte;
              flags: Byte;
              rs   : Byte;
              EOFoff : Byte;
              RecL : Byte;
              l3lo : Byte;
              l3hi : Byte;
              fn   : Array[0..9] of Byte;
              mxt  : Byte;
              ExtH : Word;
              CrTm : Array[0..3] of Byte;
              UpTm : Array[0..3] of Byte;
              unused: Array[0..90] of Byte;
            end;

TV9T9Header = Record
                fn   : Array[0..9] of Byte;
                erl  : Word;
                flags: Byte;
                rs   : Byte;
                sechi: Byte;
                seclo: Byte;
                EOFoff : Byte;
                RecL : Byte;
                l3lo : Byte;
                l3hi : Byte;
                unused: Array[0..107] of Byte;
              end;


VAR  StatRec : Record
                 warnings : Integer;
                 errors   : Integer;
                 size     : Integer;
               End;

Function tokenize(xbin,tknout,mrgout,vxr: String; WriteLogProc:TLogProc; opt:String):Integer;

implementation

uses ctype,strutils,fileutil,math;

CONST cMaxLines = 2048;
      cMaxVar   = 128;

TYPE

TLine = Record
    nr   : integer;
    stmt : String;
    tk   : String;
  end;

TVarRef = Record
            vname : String[32];
            vshort: String[8];
            vref  : String;
          end;


VAR
  WriteLog : TLogProc;
  xb,vxrf : Textfile;
  tkf : file of byte;
  mrg : file of byte;
  prg   : Array[1..cMaxLines] of TLine;
  VList : Array[1..cMaxVar]   of TVarRef;
  maxl  : Integer;
  psize : word;
  iv254 : boolean;
  TiBas : boolean;
  v9t9  : boolean;
  MemBase: string[10];
  TknOut9, MrgOut9 : String[9];


Procedure dbg(l:Integer; txt:ShortString);
begin
  // insert unit specific logfile handling when needed
  writelog(l,txt);
end;

function gettoken(s:string):integer;
var i : integer;
begin
  i:=1;
  s := Uppercase(trim(s));
  while (i<=cMaxToken) and (s<>keywords[i].key) do inc(i);
  if (s='') or (i>cMaxToken) then gettoken := -1
                             else gettoken := keywords[i].tkn;
end;

Function HexOut(s:ShortString):ShortString;
VAR i,j:Integer;
    r:ShortString;
begin
  r := '';
  for i := 1 to length(s) do begin
     if s[i] < char($80) then
       r:=r+IntToHex(word(s[i]),2)+' '
       else begin
         j:=1;
         while (j<113) and (keywords[j].tkn <> integer(s[i])) do inc(j);
         if j<113 then r:=r+IntToHex(word(s[i]),2)+'['+trim(keywords[j].key)+'] '
                  else r:=r+IntToHex(word(s[i]),2)+' ';
       end;
     if not isprint(s[i]) then s[i]:='?';

  end;
  HexOut := r + '('+s+')';
end;

function TiWord(w:word):word;  // swaps bytes
var hi,lo : byte;
begin
  hi := w DIV 256;
  lo := w MOD 256;
  TiWord := lo*256+hi;
end;

procedure InsertVar(VAR v: String; lnr: LongInt);
VAR i:Integer;
begin
  i:=1;
  while (vlist[i].vname<>'') and (vlist[i].vname<>v) do inc(i);
  if (vlist[i].vname='') then vlist[i].vname := v;
  if (vlist[i].vref='') then vlist[i].vref:=IntToStr(lnr)
                        else if Pos(', '+IntToStr(lnr), ', '+vlist[i].vref)=0 then
                                vlist[i].vref:=vlist[i].vref + ', '+IntToStr(lnr);
  if (vlist[i].vshort<>'') then v := vlist[i].vshort;
end;


Procedure WriteMergeFile;
VAR  m : TTIFile;
     h : TTIHeader;
     h9: TV9T9Header;
     l,p,i,j : Integer;
begin
  // Create Merge Program-File
  p := 0;
  for l:=1 to MaxL do with m do begin
    // check length ... no line across 256 byte boundery
    if length(prg[l].tk)+4 >= 256-(p MOD 256) then begin      //token plus 2 byte linenr plus $00 + $ff
      b[p] := $ff; inc(p);
      if (p MOD 256) > 0 then
        for j:=(p MOD 256) to 255 do begin
          b[p] := 0;
          inc(p);
        end;
    end;
    // write Length of line (token plus 2 byte linenr plus $00)
    b[p] := length(prg[l].tk)+3; inc(p);
    // write LineNr
    b[p] := (prg[l].nr DIV 256); inc(p);
    b[p] := (prg[l].nr MOD 256); inc(p);
    for i:= 1 to length(prg[l].tk) do b[p+i-1] := byte(prg[l].tk[i]);
    inc(p,length(prg[l].tk));
    b[p] := $00;
    inc(p);
  end;
  m.b[p+0] := $02;
  m.b[p+1] := $ff;
  m.b[p+2] := $ff;
  m.b[p+3] := $ff;
  inc(p,4);

  // Create TIFILES-Header
  FillByte(h,128,0);
  h.id     := 'TIFILES';
  h.seclo  := ((p-1) DIV 256) + 1;
  h.flags  := $80;
  h.rs     := $01;
  h.EOFoff := ((p-1) MOD 256);
  h.RecL   := $A3;
  h.l3lo   := ((p-1) DIV 256) + 1;
  h.l3hi   := $00;
  for i:=0 to 90 do h.unused[i]:=$00;

  // Create V9T9-Header
  if v9t9 then begin // fill V9T9 Header
      FillByte(h9,128,0);
      h9.flags := h.flags;
      h9.fn    := h.fn;
      h9.RecL  := h.RecL;
      h9.sechi := h.sechi;
      h9.seclo := h.seclo;
      h9.EOFoff:= h.EOFoff;
      h9.rs    := h.rs;
      h9.l3lo  := h.l3lo;
      for i:=0 to length(mrgout9)-1 do h9.fn[i] := byte(mrgout9[i+1]);
      for i:=0 to 9 do if h9.fn[i]=0 then h9.fn[i]:=32;
   end;


  // padding 256 byte
  for i:=1 to 256-(p MOD 256) do begin
    m.b[p] := $00;
    inc(p);
  end;

  // Write TIFILES/V9T9-Header
  if v9t9 then blockwrite(mrg,h9,128)
          else blockwrite(mrg,h,128);

  // Write Merge-File
  blockwrite(mrg,m,p);
end;


Procedure WriteProgramFile;
VAR  m : TTIFile;
     h : TTIHeader;
     h9: TV9T9Header;
     l,p,i,j : word;
     base : word;
     s : ShortString;
     d : Array[0..255] of Byte;

begin
  // Create Program-File

  base := $37d7;
  if MemBase='IV254'    then base := $ffe7;
  if MemBase='FILES(3)' then base := $37d7;
  if MemBase='FILES(2)' then base := $39dd;
  if MemBase='FILES(1)' then base := $3be3;
  if MemBase='FILES(0)' then base := $3fff;
  if MemBase='AUTO'     then
     if (psize <= MaxVDPRAM) and not iv254 then base := $37d7
                                           else base := $ffe7;


  // Set start of data after header and linenumber-table
  p := 8 + 4 * MaxL;
  for l:=MaxL downto 1 do with m do begin
    b[p] := length(prg[l].tk)+1; inc(p);
    for i:= 1 to length(prg[l].tk) do b[p+i-1] := byte(prg[l].tk[i]);
    inc(p,length(prg[l].tk));
    b[p] := $00; inc(p);
    lnt[MaxL-l].lnhi := (prg[l].nr DIV 256);
    lnt[MaxL-l].lnlo := (prg[l].nr MOD 256);
    lnt[MaxL-l].adrlo:= length(prg[l].tk)+2;  // save length to calculate address
  end;

  // calculate line addresses
  j := base;
  for i:=MaxL-1 downto 0 do with m do begin
    dec(j,lnt[i].adrlo);
    lnt[i].adrhi := ((j+2) DIV 256);
    lnt[i].adrlo := ((j+2) MOD 256);
  end;

  // Fill program-header

  // Max Memory Location
  m.b[6] := hi(base);
  m.b[7] := lo(base);

  // Start of Line-Nr Table
  j := (m.lnt[0].adrhi*256 + m.lnt[0].adrlo) - (4 * MaxL) - 1;
  m.b[4] := hi(j);
  m.b[5] := lo(j);

  // End of Line-Nr Table
  j := (m.lnt[0].adrhi*256+m.lnt[0].adrlo)-2;
  m.b[2] := hi(j);
  m.b[3] := lo(j);

  // Checksum XOR Line Number Table Address
  m.b[0] := m.b[2] XOR   m.b[4];
  m.b[1] := m.b[3] XOR   m.b[5];


  // Create TIFILES-Header
  FillByte(h,128,0);
  h.id     := 'TIFILES';
  h.sechi  := 0;
  h.seclo  := (p DIV 256) + 1;
  h.flags  := $01;
  h.rs     := $00;
  h.EOFoff := (p MOD 256);
  h.RecL   := $00;
  h.l3lo   := $00;
  h.l3hi   := $00;
  for i:=0 to 90 do h.unused[i]:=$00;

  // Create V9T9-Header
  if v9t9 then begin // fill V9T9 Header
      dbg(2,'Info: Using V9T9 Header.');
      FillByte(h9,128,0);
      h9.flags := h.flags;
      h9.fn    := h.fn;
      h9.RecL  := h.RecL;
      h9.sechi := h.sechi;
      h9.seclo := h.seclo;
      h9.EOFoff:= h.EOFoff;
      h9.rs    := h.rs;
      for i:=0 to length(tknout9)-1 do h9.fn[i] := byte(tknout9[i+1]);
      for i:=0 to 9 do if h9.fn[i]=0 then h9.fn[i]:=32;
   end;

  if  ((psize <= MaxVDPRAM) or (copy(MemBase,1,5)='FILES')) and not iv254 then begin
    // Write TIFILES/V9T9-Header
    if v9t9 then blockwrite(tkf,h9,128)
            else blockwrite(tkf,h,128);
    // Write Token-File
    // padding 256 byte
    for i:=1 to 256-(p MOD 256) do begin
      m.b[p] := $00;
      inc(p);
    end;
    blockwrite(tkf,m,p);
  end else begin

    // repack in long format as INT/VAR254

    dbg(2,'Info: Program too large for VDP RAM, use Long Format for CPU RAM');
    dbg(2,'      Program requires 32k Extension to load.');

    // 1. The TIFILES-Header

    h.seclo  := ((p-8) DIV 254) + 2;    // Start with the 9th byte,
                                        // one additional Record for the new Header
    h.flags  := $82;
    h.rs     := $01;
    h.EOFoff := ((p-8) MOD 254)+1;
    h.RecL   := $fe;
    h.l3lo   := h.seclo;

    if v9t9 then begin
      h9.flags := h.flags;
      h9.RecL  := h.RecL;
      h9.seclo := h.seclo;
      h9.EOFoff:= h.EOFoff;
      h9.rs    := h.rs;
      h9.l3lo  := h.l3lo;
    end;

    if v9t9 then blockwrite(tkf,h9,128)
            else blockwrite(tkf,h,128);

    // 2. Write the program header in seperate record
    d[0] := $0a;  // length 10 byte
    d[1] := $ab;  // fix
    d[2] := $cd;  // fix
    d[3] := m.b[4];  // Start of Line-number Table
    d[4] := m.b[5];
    d[5] := m.b[2];  // End of Line-number Table
    d[6] := m.b[3];
    d[7] := m.b[0];  // Checksum
    d[8] := m.b[1];
    d[9] := $ff;     // Base Address: MemTop
    d[10]:= $e7;
    d[11]:= $ff;     // End of Record marker

    for i:=12 to 255 do d[i] := 0;  // Padding Zeros
    blockwrite(tkf,d,256);

    // 3. Write in Records of 254 byte
    for j:=0 to ((p-8) DIV 254)-1 do begin
      d[0] := $fe;
      for i:=0 to 253 do d[i+1] := m.b[j*254+i+8];      // 8 byte offset for header
      d[255] := $ff;
      blockwrite(tkf,d,256);
    end;

    // 4. write the remainig bytes
    d[0] := ((p-8) MOD 254);
    for i:=0 to d[0] do d[i+1] := m.b[p-d[0]+i];
    d[d[0]+1] := $ff;
    if d[0]<254 then for i:=d[0]+2 to 255 do d[i]:=0;
    blockwrite(tkf,d,256);

  end;
end;


Procedure ConvertLines;
VAR i,j,l : Integer;
    s,r :  ShortString;
    t,v,c : Integer;
    a :  array[1..128] of String;
    ch: char;

begin
  psize := 0; // Program-Size

  for l:=1 to MaxL do begin
    try
      for i:=1 to 128 do a[i]:='';
      j:=1;
      s:=prg[l].stmt;
      r:='';

      i := pos('BIN$("',Uppercase(s));
      while i>0 do begin
         r := copy(s,1,i-1)+'"';
         inc(i,6);
         while (i<length(s)) and (s[i]<>'"') do begin
           ch := char(Hex2Dec(copy(s,i,2)));
           r  := r + ch;
           if ch='"' then r := r + '"'; // Escape Double-Quote
           inc(i,2);
         end;
         s := r + '"' + copy(s,i+2,255);
         r := '';
         i := pos('BIN$("',Uppercase(s));
      end;

      i:=1;
      while i<=length(s) do begin
        if s[i]='"' then begin // quoted String
           a[j] := '"';
           inc(i);
           while (s[i]<>'"') and (i<=length(s)) do begin
             a[j] := a[j]+s[i];
             inc(i);
           end;
           a[j] := a[j]+'"';
           inc(j);
        end // quoted String
        else if s[i] in seperator then
           if a[j]='' then begin
              a[j] := s[i];
              inc(j);
           end else begin
              inc(j);  // save token
              a[j]:=s[i];
              inc(j);  // save seperator
           end else a[j]:=a[j]+s[i];
         inc(i);
      end;
    except
      if j>128 then dbg(0,'Error: Line '+IntToStr(prg[l].nr)+' too long.')
               else dbg(0,'Error atomizing line '+IntToStr(prg[l].nr)+'.')
    end;

    // Special handling of DATA and IMAGE Statements (unquoted Strings with seperators)
    if (UpperCase(a[1]) = 'DATA') or (UpperCase(a[1]) = 'IMAGE')  then begin
      for i:=2 to 128 do a[i]:='';
      j:=2;
      i := length(a[1])+2;
      while i<=length(s) do begin
        while (i<=length(s)) and (s[i]=' ') do inc(i); // skip leading blanks
        if s[i]='"' then begin // quoted String
           a[j] := '"';
           inc(i);
           while ((s[i]<>'"') and (i<=length(s)))
              or ((i<length(s)) and (s[i]='"') and (s[i+1]='"')) do begin
             if ((i<length(s)) and (s[i]='"') and (s[i+1]='"')) then inc(i);
             a[j] := a[j]+s[i];
             inc(i);
           end;
           a[j] := a[j]+'"';
           inc(j); inc(i);
         end
         else begin // unquoted String
           while (i<=length(s)) and (s[i]<>',') do begin
             a[j] := a[j]+s[i];
             inc(i);
           end;
           inc(j);
         end;
         if i<=length(s) then begin
           a[j] := ',';
           inc(j);
         end;
         inc(i);
       end;
       // Prepare output for DATA or IMAGE line
       a[1] := chr(gettoken(a[1]));
       for i:=2 to j-1 do begin
         if a[1]= tkn_DATA
            then dbg(5,'  DATA ['+a[i]+']')
            else dbg(5,'  IMAGE ['+a[i]+']');
         a[i] := trim(a[i]);
         if a[i]=',' then a[i]:= tkn_COMMA
         else if (a[i]<>'') and (a[i,1]='"') then a[i]:= chr($c7) + chr(length(a[i])-2)+copy(a[i],2,length(a[i])-2)
         else if a[i]<>'' then a[i]:= chr($c8) + chr(length(a[i]))+a[i]
       end;
    end else begin
      // re-combine :: to one token
      for i:=1 to j-1 do
        if (a[i]=':') and (a[i+1]=':') then begin
           a[i]   := '::';
           a[i+1] := '';
        end else  if (a[i]='GO') and ((a[i+1]='SUB') or (a[i+1]='TO')) then begin
           a[i]   := a[i] + a[i+1];
           a[i+1] := '';
      end;

      // REM Processing is special : Combine all following Strings
      v:=0;
      for i:=1 to j do if (UpperCase(trim(a[i])) = 'REM') or (a[i]='!') then v:=i;
      if v>0 then begin
        for i:=v+2 to j do begin
         a[v+1] := a[v+1] + a[i];
         a[i] := '';
        end;
        if TiBas then a[v+1] := a[v+1] + ' ';
      end;

      // Remove double-quotes by combining elements falsely seperated
      for i:=1 to j-1 do if (rightstr(a[i],1)='"') and (leftstr(a[i+1],1)='"') then begin
         a[i+1]:=a[i]+rightstr(a[i+1],length(a[i+1])-1);
         a[i] := '';
      end;

      // eliminate empty tokens
      v:=1;
      for i:=1 to j do
        if trim(a[i]) <> '' then begin
          a[v]:=a[i];
          inc(v);
      end;
      j := v-1;

      for i:=1 to j do begin
        r := r + a[i] + '|';
        if (a[i]<>'') and (a[i,1]='"') then begin // quoted string
           a[i]:= chr($c7) + chr(length(a[i])-2)+copy(a[i],2,length(a[i])-2);
        end;
        // check numeric
        c:=0;
        for v:=1 to length(a[i]) do
          if not (isdigit(a[i,v]) or (a[i,v]='.') or ((a[i,v]='E') and (v>1))) then c:=1;

        if (c=0) and (i>=2) and      ((a[i-1]=tkn_ELSE)    or (a[i-1]=tkn_GOTO)
           or (a[i-1]=tkn_GOSUB)   or (a[i-1]=tkn_RETURN)  or (a[i-1]=tkn_BREAK)
           or (a[i-1]=tkn_UNBREAK) or (a[i-1]=tkn_RESTORE) or (a[i-1]=tkn_ERROR)
           or (a[i-1]=tkn_RUN)     or (a[i-1]=tkn_THEN)    or (a[i-1]=tkn_USING)
           or (a[i-1]=tkn_SUB)     or ((i>2) AND (a[i-1]=tkn_TO) AND (a[i-2]=tkn_GO)))
           then begin  // line Number
             val(a[i],v,c);
             a[i] := tkn_LINENR + chr(v DIV 256) + chr(v MOD 256)
        end else if (c=0) and (i>2) and (a[i-1]=tkn_COMMA) and (a[i-2,1]=tkn_LINENR) then begin // LineNr List
          val(a[i],v,c);
          a[i] := tkn_LINENR + chr(v DIV 256) + chr(v MOD 256)
        end else if (c=0) or ((i>=2) and ((a[i-1]=tkn_CALL) or (a[i-1]=tkn_SUB))) then a[i] := chr($c8)+chr(length(a[i]))+uppercase(a[i]);


        t := Gettoken(a[i]);
        if t>0 then a[i]:=chr(t)
               else if (a[i,1]<'z') and (a[1]<>tkn_DATA) and (a[1]<>tkn_IMAGE)
                  and (a[max(1,i-1)]<>tkn_BANG) and (a[1]<>tkn_REM) then begin // Variable
                         a[i]:=UpperCase(a[i]);
                         InsertVar(a[i],prg[l].nr);
                end;
      end;
    end;

    for i:=1 to j do begin
        prg[l].tk := prg[l].tk + a[i];
        a[i] := '';
    end;

    // Validate Tokens : After some Token another Token must follow, not a Label
    for i:=1 to length(prg[l].tk)-1 do begin
      if (prg[l].tk[i] IN [tkn_ELSE,tkn_GOTO,tkn_GOSUB,tkn_RESTORE,tkn_THEN,tkn_USING])
         and (prg[l].tk[i+1]<#128) then begin
           j:=i+1;
           while (j<length(prg[l].tk)) and (prg[l].tk[j]<>#190) and (prg[l].tk[j]<>#130) do inc(j);
           if (prg[l].tk[j]<>#190) and (j<length(prg[l].tk)) then begin
             dbg(3,'ERROR: Unresolved Label in <'+prg[l].stmt+'>');
             dbg(3,'   >>> '+IntToHex(longint(prg[l].tk[j])));
           end;
         end;
    end;

    inc(psize,length(prg[l].tk) + 2 + 4); // Length & Stop-Byte, LNT-Entry 4 Byte
    dbg(5,inttostr(prg[l].nr)+' '+stringreplace(s,#0,'#',[rfReplaceAll])+' -> ' + stringreplace(r,#0,'#',[rfReplaceAll]) + ' -> '+ HexOut(prg[l].tk));
  end;
  dbg(2,'');
  dbg(2,'Program Statistics in Bytes');
  dbg(2,'  Code-Size:        '+IntToStr(psize-6*Maxl));
  dbg(2,'  Line-Nr Table:    '+IntToStr(4*Maxl)+' for '+IntToStr(Maxl)+' lines.');
  dbg(2,'  Length&Stop Byte: '+IntToStr(2*Maxl));
  dbg(2,'  Total Size:       '+IntToStr(psize));
  dbg(2,'');
  StatRec.size:=psize;

  dbg(3,'Variable Cross-Reference');
  i:=1;
  while VList[i].vname<>'' do begin
    dbg(3,PadRight(VList[i].vname,32) + PadRight(VList[i].vshort,9) + VList[i].vref);
    inc(i);
  end;
  dbg(3,'');
end;

Function tokenize(xbin,tknout,mrgout,vxr: String; WriteLogProc:TLogProc; opt:String):Integer;
VAR i,l, rc : Integer;
    s,t : String;
begin
  rc := 0;
  WriteLog := WriteLogProc;

  iv254   := false;
  MemBase := 'AUTO';
  if pos('-MEM=', UpperCase(opt)) > 0 then begin
     MemBase := UpperCase(copy(opt,6,pos(' ',copy(opt,6,10))-1));
     dbg(5,'MemBase: '+MemBase);
     if MemBase='FILES(0)' then
       dbg(1,'Warning: CALL FILES(0) does not work on real hardware!');
     if MemBase='IV254' then iv254 := true;
  end;

  TiBas := (pos('-TIBAS', UpperCase(opt)) > 0);
  v9t9  := (pos('-V9T9', UpperCase(opt)) > 0);
  TknOut9 := uppercase(copy(ExtractFileName(tknout),1,9));
  MrgOut9 := uppercase(copy(ExtractFileName(mrgout),1,9));

  try
    assign(xb,xbin);
    reset(xb);
  except
    dbg(0,'Error opening file '+xbin);
    rc := 10
  end;

  dbg(3,'');
  dbg(2,'Read file '+xbin+' into memory');

  l := 1;
  try
    while not eof(xb) and (rc=0) do begin
      readln(xb,s);
      s:=trim(s);
      if s='' then continue;
      i:=1;
      while (isdigit(s[i])) and (i<length(s)) do inc(i);
      try
        prg[l].nr   := strtoint(copy(s,1,i-1));
        prg[l].stmt := trim(copy(s,i,255));
        prg[l].tk   := '';
        inc(l);
      except
        dbg(1,'Line '+IntToStr(l)+ 'is strange ['+s+']');
      end;
    end;
    maxl := l-1;
    dbg(2,inttostr(maxl)+' lines read.');
    system.close(xb);
    dbg(3,'');
  except
    dbg(0,'Error reading file '+xbin);
    rc := 11
  end;

  for i:=1 to cMaxVar do begin
     VList[i].vname  := '';
     VList[i].vshort := '';
     VList[i].vref   := '';
  end;

  if (vxr<>'') and FileExists(vxr) then
  begin
    try
      assign(vxrf,vxr);
      reset(vxrf);
    except
      dbg(0,'Error opening file '+vxr);
      rc := 13
    end;

    dbg(3,'');
    dbg(2,'Read variable X-Ref file '+vxr+' for shortnames.');

    l := 1;
    try
      while not eof(vxrf) and (rc=0) do begin
        readln(vxrf,s);
        t:=trim(copy(s,33,8));
        if t='' then continue;
        s := trim(copy(s,1,32));
        VList[l].vname :=s;
        VList[l].vshort:=t;
        dbg(4,'  '+s+' -> '+t);
        inc(l);
      end;
      dbg(2,inttostr(l-1)+' variable shortnames read.');
      system.close(vxrf);
      dbg(3,'');
    except
      dbg(0,'Error reading file '+vxr);
      rc := 14
    end;
  end else dbg(2,'No variable X-Ref file found.');

  if rc = 0 then
    try
      ConvertLines;
    except
      dbg(0,'Error converting file '+xbin);
      rc := 20
    end;

  dbg(3,'');

  if (mrgout<>'') and (rc=0) then try
    dbg(2,'Writing MERGE-File   '+mrgout);
    assign(mrg,mrgout);
    rewrite(mrg);
    WriteMergeFile;
    system.close(mrg);
  except
    dbg(0,'Error writing MERGE-File '+mrgout);
    rc := 30
  end;

  if (tknout<>'') and (rc=0) then try
    dbg(2,'Writing PROGRAM-File '+tknout);
    assign(tkf,tknout);
    rewrite(tkf);
    WriteProgramFile;
    system.close(tkf);
    except
      dbg(0,'Error writing PROGRAM-File '+tknout);
      rc := 40
  end;

  if (vxr<>'') and (rc=0) then try
    dbg(2,'Writing variable X-Ref file '+vxr);
    assign(vxrf,vxr);
    rewrite(vxrf);
    i:=1;
    while VList[i].vname<>'' do begin
      writeln(vxrf,PadRight(VList[i].vname,32) + PadRight(VList[i].vshort,9) + VList[i].vref);
      inc(i);
    end;
    system.close(vxrf);
    except
      dbg(0,'Error writing variable X-Ref file '+vxr);
      rc := 50
  end;



  if rc>0 then dbg(2,'Errors found, RC='+IntToStr(rc));

  tokenize:=rc;

end;

end.

