{$symtab-,$linesize:131,$pagesize:86,
$title:'TOKEN.PAS -- Tokenize the script files'}
{	COPYRIGHT @ 1982
	Jim Holtman and Eric Holtman
	35 Dogwood Trail
	Randolph, NJ 07869
	(201) 361-3395
}
module tokens;
var
     i,j : integer;
     buf : lstring(255);
     str : lstring(255);
     lineno [public] : integer;
     charno [public] : integer;
     line_inc : boolean;
     back_stack : lstring(255);
     back_ptr : integer;
     comp_file_name [external] : lstring(20);
     current_line : lstring(255);
value
      lineno := 0;
      charno := 0;
      line_inc := false;
      back_ptr := 0;
function getbchar : integer;
begin
     if (back_ptr > 0) then begin
	getbchar := ord(back_stack[back_ptr]);
	back_ptr := back_ptr - 1;
     end
     else getbchar := -1;
end;
procedure putbchar(ch : char)[public];
begin
      back_ptr := back_ptr + 1;
      back_stack[back_ptr] := ch;
end;
procedure putbstr(const s : lstring)[public];
var
     i : integer;
begin
      for i := ord(s.len) downto 1 do
	putbchar(s[i]);
end;
function getnextchar(var fd : text) : integer;
var
    c : char;
    i : integer;
    s : lstring(255);
begin
     i := getbchar;
     if (i > -1) then begin
	getnextchar := i;
	charno := charno + 1;
	return;
     end;
     if (eof(fd)) then begin
	getnextchar := - 1;
	return;
     end;
	lineno := lineno + 1;
	charno := 0;
	readln(fd, current_line);
	putbchar(' ');
	putbstr(current_line);
     getnextchar := getnextchar(fd);
end;

procedure print_error(const mess : lstring;back : integer) [public];
var
    i,j : integer;
    buf : lstring(255);
    c : char;
begin
      write(lineno:3,': ');
      writeln(current_line);
      write('-----');
      j := 1;
      for i := 1 to charno-1-back do begin
	if (current_line[i] <> chr(9)) then begin
	j := j + 1;
	write('-')
	end
	else begin
		repeat
			write('-');
			j := j + 1;
		until (j mod 8) = 1;
	end;
      end;
      writeln('^ ',mess);
end;
function next_token(var d : lstring;var fil : text) : integer [public];
var
    i,j : integer;
    state : integer;
    s : char;
    nc : integer;
    st : integer;
    typ : integer;
{$include:'token.h'}
begin
      i := 0;
      j := 0;
      s := chr(0);
      st := 1;
      typ := 0;
	  nc := getnextchar(fil);
      if (nc > -1) then begin
      while ((chr(nc) = ' ') or (chr(nc) = chr(9))) do begin
	  nc := getnextchar(fil);
	  if (nc = -1) then
		break;
      end;
      end;
      state := OUT_QUOTE;
      if (nc > -1) then s := chr(nc);
      while true do begin
      {writeln('parsing -',s,'-   -',ord(s));]}
	if (eof(fil) and (s = chr(0))) then begin
		next_token := -1;
		d.len := wrd(j);
		return;
	end
	else if ( ((s = ' ') or (s = chr(9))) and (state = OUT_QUOTE)) then begin
		d.len := wrd(j);
		if (d = 'if') then next_token := TOK_IF
		else if (d = 'dial') then next_token := TOK_DIAL
		else if (d = 'send') then next_token := TOK_SEND
		else if (d = 'say') then next_token := TOK_SAY
		else if (d = 'goto') then next_token := TOK_GOTO
		else if (d = 'name') then next_token := TOK_NAME
		else if (d = 'else') then next_token := TOK_ELSE
		else if (d = 'quit') then next_token := TOK_QUIT
		else if (d = 'gosub') then next_token := TOK_GOSUB
		else if (d = 'return') then next_token := TOK_RETURN
		else if (d = '{') then next_token := TOK_LBRACK
		else if (d = '}') then next_token := TOK_RBRACK
		else if (d = 'input') then next_token := TOK_INPUT
		else if (d = 'settime') then next_token := TOK_SETTIME
		else if (d = 'openlog') then next_token := TOK_OPENLOG
		else if (d = 'closelog') then next_token := TOK_CLOSELOG
		else if (d = 'toggle_tr') then next_token := TOK_TOGGLE_TR
		else if (d = 'case') then next_token := TOK_CASE
		else if (d = 'caseend') then next_token := TOK_CASEEND
		else if (d = 'otherwise') then next_token := TOK_OTHERWISE
		else if (d[j] = ':') then next_token := TOK_LABEL
		else begin
			writeln;
			print_error('Warning: constants should have quotes',j);
		 next_token := TOK_STR;
		 writeln;
		 end;
		return;
	end
	else if ( (s = '"') and (state = IN_QUOTE) ) then begin
		next_token := TOK_STR;
		d.len := wrd(j);
		return;
	end
	else if (s = '"') then state := -1 * state
	else if (s = '\') then begin
		st := st + 1;
		j := j + 1;
		nc := getnextchar(fil);
		if (nc = -1) then begin
			next_token := -1;
			d.len := wrd(j);
			return;
		end;
		s := chr(nc);
		d[j] := s;
	end
	else begin
		j := j + 1;
		d[j] := s;
	end;
	st := st + 1;
	nc := getnextchar(fil);
	if (nc > -1) then s := chr(nc) else s := chr(0);
    end;
end;
end.