#!/usr/bin/perl

###############################################################################
# This software is being provided to you, the LICENSEE, by the Massachusetts  #
# Institute of Technology (M.I.T.) under the following license.  By           #
# obtaining, using and/or copying this software, you agree that you have      #
# read, understood, and will comply with these terms and conditions:          #
#                                                                             #
# Permission to use, copy, modify and distribute, including the right to      #
# grant others the right to distribute at any tier, this software and its     #
# documentation for any purpose and without fee or royalty is hereby granted, #
# provided that you agree to comply with the following copyright notice and   #
# statements, including the disclaimer, and that the same appear on ALL       #
# copies of the software and documentation, including modifications that you  #
# make for internal use or for distribution:                                  #
#                                                                             #
# Copyright 1991-4 by the Massachusetts Institute of Technology.  All rights  #
# reserved.                                                                   #
#                                                                             #
# THIS SOFTWARE IS PROVIDED "AS IS", AND M.I.T. MAKES NO REPRESENTATIONS OR   #
# WARRANTIES, EXPRESS OR IMPLIED.  By way of example, but not limitation,     #
# M.I.T. MAKES NO REPRESENTATIONS OR WARRANTIES OF MERCHANTABILITY OR FITNESS #
# FOR ANY PARTICULAR PURPOSE OR THAT THE USE OF THE LICENSED SOFTWARE OR      #
# DOCUMENTATION WILL NOT INFRINGE ANY THIRD PARTY PATENTS, COPYRIGHTS,        #
# TRADEMARKS OR OTHER RIGHTS.                                                 #
#                                                                             #
# The name of the Massachusetts Institute of Technology or M.I.T. may NOT be  #
# used in advertising or publicity pertaining to distribution of the          #
# software.  Title to copyright in this software and any associated           #
# documentation shall at all times remain with M.I.T., and USER agrees to     #
# preserve same.                                                              #
###############################################################################

# preprocessor for WSJ
# assumes 1 sentence per line
#
# 1.  expand numerical exceptions: eg. 386
# 2.  do regular numerical expansions

# Minor modifications by David Graff, Linguistic Data Consortium, in preparation
# for publishing on cdrom;  Aug. 11, 1994.

# Some modifications by Arnab Ghoshal, University of Edinburgh; July 2012
# 1. Stylistic modifications: changed tabs to spaces, 2-space indentations
# 2. Reading and writing in UTF-8

# Modifications by Fergus McInnes (FRM), University of Edinburgh, 2013:
# 1. wider range of numbers treated as years in printnum;
# 2. stricter test for dates in printnum;
# 3. ddd-dddd (often a telephone number) converted to digit sequence;
# 4. scores such as 2-0 distinguished from ranges;
# 5. refinements to treatment of letters in alphanumeric sequences;
# 6. money processing refined to recognise more currencies and number formats;
# 7. some fractions with numerator 1 expressed with "a" rather than "one";
# 8. bug fix for strings with leading 0 in printdigstr;
# 9. bug fix for large round numbers (e.g. 1,000,000) in printint
# 10. numbers with leading decimal point exempted from exception processing

use Unicode::Normalize;
use open ':encoding(utf8)';

binmode(STDIN, ":encoding(utf8)");
binmode(STDOUT, ":encoding(utf8)");
binmode(STDERR, ":encoding(utf8)");

# $POINT='.POINT';		# orthographic notation for .
$POINT='point';		# orthographic notation for .

	# final s in name indicates plural version, otherwise just add s
@ones_z=("zero","one","two","three","four",
	 "five","six","seven","eight","nine");
@ones_oh=("oh","one","two","three","four",
	  "five","six","seven","eight","nine");
@ten=("","ten","twenty","thirty","forty","fifty",
      "sixty","seventy","eighty","ninety");
@teen=("ten","eleven","twelve","thirteen","fourteen","fifteen",
       "sixteen","seventeen","eighteen","nineteen");
@mult=("","thousand","million","billion","trillion",
       "quadrillion","quintillion","sextillion","septillion","octillion");
@den=("","","half","third","quarter","fifth",
      "sixth","seventh","eighth","ninth","tenth",
      "eleventh","twelfth","thirteenth","fourteenth","fifteenth",
      "sixteenth","seventeenth","eighteenth","nineteenth");
@largeden=("","first","second","third","fourth","fifth",
	   "sixth","seventh","eighth","ninth","tenth",
	   "eleventh","twelfth","thirteenth","fourteenth","fifteenth",
	   "sixteenth","seventeenth","eighteenth","nineteenth");
@ordnal=("","first","second","third","fourth","fifth","sixth",
	 "seventh","eighth","ninth","tenth","eleventh",
	 "twelfth","thirteenth","fourteenth","fifteenth","sixteenth");
@months=("Jan.","Feb.","Mar.","Apr.","Jun.","Jul.","Aug.","Sept.","Sep.","Oct.",
	 "Nov.","Dec.","January","February","March","April","May","June",
	 "July","August","September","October","November","December");

$exfile="num_excp";		# default exceptions file name

for ($i=0, $j=0; $i<=$#ARGV; $i++) {
  if ($ARGV[$i] =~ /^-/) {
    if ($ARGV[$i] =~ /^-v/) { $vflg=1; }
    elsif ($ARGV[$i] =~ /^-x/) {
      $exfile=$ARGV[$i];
      $exfile =~ s/^-x//;
    } else { &perr2("illegal flag: $ARGV[$i]"); }
  }
  else { &perr2("no file args"); }
}
@ARGV=();

if (!exfile) { &perr2("no exceptions file specified"); }

if (!open(EXFILE,$exfile)) { &perr2("cannot open $exfile"); }
while (<EXFILE>) {
  if (/^#/) { next; }      # comment
  s/\n//;
  if (!$_) { next; }       # blank
  $y=$_;
  s/^(\S+)\s*//;           # extract 1st word
  $x=$1;
  if ($x eq "") { &perr2("$exfile: no word: $y"); }
  if ($x =~ /^\$\$/) {     # $$word => skip
    $x =~ s/^\$*//;
    $sing_dollar{$x}=2;
  } elsif ($x =~ /^\$/) {  # $word => singular right context
    $x =~ s/^\$*//;
    $sing_dollar{$x}=1;
  } elsif ($x =~ /^\*/) {
    $x =~ s/\**//g;
    if (!$x) { &perr2("$exfile: no serno word"); }
    $sernowd{$x}=1;        # serial no words
  } else {
    if ($x !~ /\d/) { &perr2("$exfile: non-numerical key"); }
    if (!$_) { &perr2("$exfile: no value"); }
    $except{$x}=$_;        # translations
  }
  $n++;
}
close(EXFILE);
if ($vflg) { print STDERR "$n lines read from exceptions file\n"; }

for ($i=0;$i<=$#months;$i++) {  # make months hash
  $_=$months[$i];
  $months{$_}=1;                # mixed case
  tr/a-z/A-Z/;
  $months{$_}=1;                # UC
}

# kdv, we may jump here if we are giving up on a line
toploop:

while (<>) {
  $line = NFD($_);
  local($front);
  local($back);
  local($ptbkflg);
  local($x);

  s/^\s*//;
  s/\n//o;
  if ($vflg) { print "input:\t$_\n"; }

  s/[\x{00B0}\x{00BA}]C(\W)/ degrees Celsius $1/g;
  s/[\x{00B0}\x{00BA}]F(\W)/ degrees Fahrenheit $1/g;
  s/[\x{00B0}\x{00BA}]/ degrees /g;

##############################  exceptproc  ##################################
  if (/\d/ && !/^<\/?[spa]/) {  # opt and protect sgml
    @input = split(/\s+/o);
    @output = ();
    for ($field=0; $field<=$#input; $field++) {  # $field is global
      $_=$input[$field];
      if (!/\d/) {  # only processes numbers
	&pusho($input[$field]);  # not processed
	next;
      }

      s/^(\W*)//;  # strip front
      $front=$1;
      if ($front =~ /^~/) {
        &pusho("about");
        $front =~ s/^~//;
        $input[$field] =~ s/^~//;
      }
      if ($front =~ /[\$\x{00A3}\x{FFE1}\x{00A5}\x{20AC}\.]$/) {
	# protect money and numbers with leading decimal point
	&pusho($input[$field]);  # not processed
	next;
      }

      s/(\W*)$//o;  # strip back
      $back=$1;
      if ($back =~ /^\./o) { $ptbkflg=1; }
      else { $ptbkflg=0; }

      if ($front =~ /'$/ && $except{"'$_"}) {  # eg '20s
	$front =~ s/'$//;
	if ($front) {
	  &pusho($front);
	  if ($front !~ /[\w]$/o) { $appendflg=1; }
	}

	&pusho($except{"'$_"});  # translation

	if ($back) {
	  if ($back !~ /^[\w]/o) { &appendo($back); }
	  else { &pusho($back); }
	}
      } elsif ($except{$_}) {
	if ($front) {
	  &pusho($front);
	  if ($front !~ /[\w]$/o) { $appendflg=1; }
	}

	&pusho($except{$_});  # translation

	if ($back) {
	  if ($back !~ /^[\w]/o) { &appendo($back); }
	  else { &pusho($back); }
	}
      }
      else { &pusho($input[$field]); }  # not processed
    }
    $_=join(" ",@output);
  }
  s/\s+/ /g;
  s/^ */ /o;
  s/ *$/ /o;
  if ($vflg) { print "ex:\t$_\n"; }

############################  numproc  ########################################
  if (!/^<\/?[spa]/) {  # protect sgml, also art
    s/ 1-(\d{3})-(\d)/ one _$1 _$2/g;         # US phone number
    s/ 1-(\d{3})-(\p{L})/ one _$1 $2/g;       # US phone number
    s/ (\d{3})-(\d{3})-(\d)/ _$1 _$2 _$3/g;   # phone number or similar
    s/ (\d{3})-(\d{4,})/ _$1 _$2/g;           # phone number or similar
    s/_(\d+)-(\d)/_$1 _$2/g;                  # rest of phone number
    s/_([1-9])00 /$1 hundred /g;
    s/_([1-9])000 /$1 thousand /g;
    s/(\d+)\s*-\s*(\d+)\s*-\s*(\d+)/$1 $2 $3/g;  # eg. 1-2-3
    s/\s(\p{L}|\d+)\^2\s/ $1 squared /g;
    s/\s(\p{L}|\d+)\^3\s/ $1 cubed /g;
    s/\s(\p{L}|\d+)\^(\d+)/ $1 to the power of $2/g;
    # The next one is needed twice to handle 1x2x3: the second x doesn't match
    # since the position after the first match is after 2.
    s/(\d+)\s*[xX]\s*(\d+)/$1 by $2/g;                  # eg. 2x4
    s/(\d+)\s*[xX]\s*(\d+)/$1 by $2/g;                  # eg. 2x4
    # The next one is needed twice to handle 1+2+3: the second + doesn't match
    # since the position after the first match is after 2.
    s/(\d+)\s*\+\s*(\d+)/$1 plus $2/g;               # eg. 2+2
    s/(\d+)\s*\+\s*(\d+)/$1 plus $2/g;               # eg. 2+2
    while (/(\d+)\s*-\s*(\d+)\s+(loss|defeat|score|record|season)/) {
      if ($1 < $2 && $1 < 1000) {      # losing score or tally: e.g. 3-6
        s/(\d)\s*-\s*(\d+)\s+(loss|defeat|score|record|season)/$1 $2 $3/;
      } else {    # e.g. "1999-2000 season" - modify to prevent infinite loop
        s/(\d)\s*-\s*(\d+)\s+(loss|defeat|score|record|season)/$1-$2 \! $3/;
      }
    }
    s/ \! (loss|defeat|score|record|season)/ $1/g;
    while (/ (los[et]|losing|defeated|beaten) (\d+)\s*-\s*(\d+)/) {
      if ($1 < 1000) {      # losing score or tally: e.g. 3-6
        s/ (los[et]|losing|defeated|beaten) (\d+)\s*-\s*(\d)/ $1 $2 $3/;
      } else {              # range as in "losing 2001-2 team"
        s/ (los[et]|losing|defeated|beaten) (\d+)\s*-\s*(\d)/ $1 $2 to $3/;
      }
    }
    while (/(\d*\.?\d+)\s*-\s*(\d*\.?\d+)/) {
      if ($1 < $2 || $1 > 999) {
        s/(\d)\s*-\s*(\d)/$1 to $2/;   # range: e.g. 1-2 or 2009-10
      } else {
        s/(\d)\s*-\s*(\d)/$1 $2/;      # score: e.g. 3-0
      }
    }
    s/%\s*-\s*(\d)/% to $1/g;                        # % range: eg. 1%-2%
    s/(\d)\s*=\s*(\d)/$1 equals $2/g;                # equation: x=y
    s/(\d)\s*&\s*(\d)/$1 and $2/g;          # often a golf score
#    s/-\s*([^\d-])/ - $1/g;                 # hyphenated words
    s/- +-/--/g; s/- +-/--/g;               # close dashes
    s/-{3,}/--/g;                           # map dashes to --
    s/--/ - - /g;                           # space around --
    s/([a-zA-Z])\//$1 \/ /g;             # text/*
    s/\/([a-zA-Z])/ \/ $1/g;             # */text
    s/([a-zA-Z]\d+)\/(\d+)/$1 \/ $2/g;	 # eg. a1/3 -> a1 / 3
    s/(\/\d*1[123])ths?\.?\s/$1 /ig;     # eg. 1/11th -> 1/11
    s/(\/\d*[04-9])ths?\.?\s/$1 /ig;     # eg. 1/10th -> 1/10
    s/(\/\d*1)sts?\.?\s/$1 /ig;          # eg. 1/x1st -> 1/x1
    s/(\/\d*2)nds?\.?\s/$1 /ig;          # eg. 1/x2nd -> 1/x2
    s/(\/\d*3)rds?\.?\s/$1 /ig;          # eg. 1/x3rd -> 1/x3
    s/(\d+)\/(\d+[a-zA-Z])/$1 \/ $2/g;   # eg. 1/3a -> 1 / 3a
    s/([a-zA-Z])-(19\d\d\D)/$1 - $2/g;   # eg. mid-1990 -> mid - 1990
#    s/([a-zA-Z])-(\d)/$1 $2/g;           # eg. a-1 -> a 1
#    s/(\d)-([a-zA-Z])/$1 $2/g;           # eg. 1-a -> 1 a
    s/([a-zA-Z])-(\d)/$1 - $2/g;         # eg. a-1 -> a - 1
    s/(\d)-([a-zA-Z])/$1 - $2/g;         # eg. 1-a -> 1 - a
    s/\x{00B1}/ plus minus /g;

    # Convert UTF8 fractions to ASCII
    s?\x{00BC}? 1/4 ?g;
    s?\x{00BD}? 1/2 ?g;
    s?\x{00BE}? 3/4 ?g;
    s?\x{2150}? 1/7 ?g;
    s?\x{2151}? 1/9 ?g;
    s?\x{2152}? 1/10 ?g;
    s?\x{2153}? 1/3 ?g;
    s?\x{2154}? 2/3 ?g;
    s?\x{2155}? 1/5 ?g;
    s?\x{2156}? 2/5 ?g;
    s?\x{2157}? 3/5 ?g;
    s?\x{2158}? 4/5 ?g;
    s?\x{2159}? 1/6 ?g;
    s?\x{215A}? 5/6 ?g;
    s?\x{215B}? 1/8 ?g;
    s?\x{215C}? 3/8 ?g;
    s?\x{215D}? 5/8 ?g;
    s?\x{215E}? 7/8 ?g;
    s?\x{215F}? 1/?g;

    s/(\d) +(\d+\/\d)/$1 and $2/g;          # dig frac -> dig and frac

    if (!/\d:\d\d$/o && !/\d:\d\d\D/o) {  # preprocess non-time \d:\d
      s/(\d):(\d)/$1 : $2/g;
      s/(\S):(\d)/$1: $2/g;
    }
  }

  if ($vflg) { print "num1:\t$_\n"; }
  s/^\s*//;
  if (/\d/ && !/^<\/?[spa]/) {  # opt and protect sgml
    @input = split(/\s+/o);
    @output=();
    $monthcontext=0;  # stores context for things like "March 9 to 10"
  wloop:
    for ($field=0; $field<=$#input; $field++) {  # $field is global
      if ($field>0) { $last=$input[$field-1]; }
      else { $last=''; }
      if ($field<$#input) { $next=$input[$field+1]; }
      else { $next=''; }
      if ($field<$#input-1) { $next2=$input[$field+2]; }
      else { $next2=''; }
      if ($field<$#input-2) { $next3=$input[$field+3]; }
      else { $next3=''; }
      $this=$input[$field];
      $_=$input[$field];

      if (/<[\w\.\/]*>/o && !/<p/o && !/<\/p>/o) {  # pass only
	&perr("spurious SGML: $_");	# <p... and </p>
      }

      if (/[0-9]/o && !/<p/o) {  # number but not <p
	if (/[\$\x{00A3}\x{00A5}\x{20AC}]/o ||
         /^(GBP|USD|CHF|RMB|AED|D[Hh]s?\d\P{L}*$|EUR|Rs|Rp|RM|Tk|Y\d\P{L}*$)/)
	  { &money($_,$next); }  # money
	elsif (/\d:\d\d$/o || /\d:\d\d\D/o) { &printtime($_); }  # time
	elsif (/^\d+\/\d+\/\d+$/o) { &printdate($_); }  # x/x/x date
	elsif ((/[a-zA-Z].*\d/ || /\d.*[a-zA-Z]/) && 
	       !(/\dths?\W*$/i || /1sts?\W*$/i || /2nds?\W*$/i ||
		 /3rds?\W*$/i || /\ds\W*$/ || /\d\'s\W*$/ )) {  # serial no
	  &printserno($_);
	} elsif (/\//o)  {         # fraction
          if ($last eq "and") {
            &printfrac($_,1);  # use "a" rather than "one" for numerator 1
	  } else {
            &printfrac($_);
          }
	} elsif (/\d\'-?\d+/o) {   # ft inches
	  &printftin($_);
	} elsif (s/^_(\d*)$/$1/) { # number tagged as digit string
	  &printplaindigstr($_);
	} else { &printnum($_); }  # ordinary number
      }
      else { &pusho($_ ); }        # non-numeric string
      if ($monthcontext == 1) {  # just had month and day
        if ($next =~ /^(to|and|or)$/) {
          $monthcontext = 2;
        } else {
          $monthcontext = 0;
        }
      } elsif ($monthcontext == 2) {  # just had month and day and to/and/or
        $monthcontext = 3;
      } else {
        $monthcontext = 0;
      }
    }
    $_=join(" ",@output);
  }

  s/^/ /o;
  s/$/ /o;
  s/\%/ percent /g;
  s/ {2,}/ /g;
  s/^ //o;
  s/ $//o;

  if ($_) { print NFC($_), "\n"; }
}

sub money {  # money($this,$next)
  $_=$_[0];  # $this
  local($next) = $_[1];
  if ($vflg) { print "money: $_, $next\n"; }

  local($unit);
  local($subunit_sing);
  local($subunit_pl);
  local($punct);
  local($plural);
  local($sing);
  local($frac);
  local($front);
  local($back);
  local($x);
  local($y);
  local($z);
  local($i);
  local($j);

  # Normalize order for "500$" etc:
  s/^(\d+)(.*\D)$/$2$1/;

  # Identify currency and strip out its symbol or abbreviation:
  if (/A\$/) {  # $ stuff
    ($front)=/^(.*)A\$/;
    s/A\$//;
    $unit='Australian dollar';
    $subunit_sing='cent';
    $subunit_pl='cents';
  } elsif (/C\$/) {
    ($front)=/^(.*)C\$/;
    s/C\$//;
    $unit='Canadian dollar';
    $subunit_sing='cent';
    $subunit_pl='cents';
  } elsif (/NZ\$/) {
    ($front)=/^(.*)NZ\$/;
    s/NZ\$//;
    $unit='New Zealand dollar';
    $subunit_sing='cent';
    $subunit_pl='cents';
  } elsif (/HK\$/) {
    ($front)=/^(.*)HK\$/;
    s/HK\$//;
    $unit='Hong Kong dollar';
    $subunit_sing='cent';
    $subunit_pl='cents';
  } elsif (/NT\$/) {
    ($front)=/^(.*)NT\$/;
    s/NT\$//;
    $unit='new Taiwan dollar';
    $subunit_sing='cent';
    $subunit_pl='cents';
  } elsif (/Z\$/) {
    ($front)=/^(.*)Z\$/;
    s/Z\$//;
    $unit='Zimbabwean dollar';
    $subunit_sing='cent';
    $subunit_pl='cents';
  } elsif (/R\$/) {
    ($front)=/^(.*)R\$/;
    s/R\$//;
    $unit='real';
    $subunit_sing='centavo';
    $subunit_pl='centavos';
  } elsif (/US[\$D]/) {
    ($front)=/^(.*)US[\$D]/;
    s/US[\$D]//;
    $unit='U.S. dollar';
    $subunit_sing='cent';
    $subunit_pl='cents';
  } elsif (/\$US/) {
    ($front)=/^(.*)\$US/;
    s/\$US//;
    $unit='U.S. dollar';
    $subunit_sing='cent';
    $subunit_pl='cents';
  } elsif (/\$/) {
    ($front)=/^(.*)\$/;
    s/\$//;
    $unit='dollar';
    $subunit_sing='cent';
    $subunit_pl='cents';
  } elsif (/\x{00A3}/) {
    ($front)=/^(.*)\x{00A3}/;
    s/\x{00A3}//;
    $unit='pound';
    $subunit_sing='penny';
    $subunit_pl='pence';
  } elsif (/\x{FFE1}/) {
    ($front)=/^(.*)\x{FFE1}/;
    s/\x{FFE1}//;
    $unit='pound';
    $subunit_sing='penny';
    $subunit_pl='pence';
  } elsif (/GBP/) {
    ($front)=/^(.*)GBP/;
    s/GBP//;
    $unit='pound';
    $subunit_sing='penny';
    $subunit_pl='pence';
  } elsif (/\x{00A5}/) {
    ($front)=/^(.*)\x{00A5}/;
    s/\x{00A5}//;
    $unit='yen';
    $subunit_sing='';  # Well, maybe we can use 'sen' but it's hardly ever used
    $subunit_pl='';    
  } elsif (/Y/) {
    ($front)=/^(.*)Y/;
    s/Y//;
    $unit='yen';
    $subunit_sing='';  # Well, maybe we can use 'sen' but it's hardly ever used
    $subunit_pl='';    
  } elsif (/CHF/) {
    ($front)=/^(.*)CHF/;
    s/CHF//;
    $unit='Swiss franc';
    $subunit_sing='centime';
    $subunit_pl='centimes';
  } elsif (/EUR/) {
    ($front)=/^(.*)EUR/;
    s/EUR//;
    $unit='euro';
    $subunit_sing='cent';
    $subunit_pl='cents';
  } elsif (/RMB/) {
    ($front)=/^(.*)RMB/;
    s/RMB//;
    $unit='renminbi';
    $subunit_sing='';
    $subunit_pl='';
  } elsif (/AED/) {
    ($front)=/^(.*)AED/;
    s/AED//;
    $unit='dirham';
    $subunit_sing='fils';
    $subunit_pl='fils';
  } elsif (/D[Hh]/) {
    ($front)=/^(.*)D[Hh]/;
    s/D[Hh]s?//;
    $unit='dirham';
    $subunit_sing='fils';
    $subunit_pl='fils';
  } elsif (/Rs/) {
    ($front)=/^(.*)Rs/;
    s/Rs//;
    $unit='rupee';
    $subunit_sing='paisa';
    $subunit_pl='paise';
  } elsif (/Rp/) {
    ($front)=/^(.*)Rp/;
    s/Rp//;
    $unit='rupiah';
    $subunit_sing='';
    $subunit_pl='';
  } elsif (/RM/) {
    ($front)=/^(.*)RM/;
    s/RM//;
    $unit='ringgit';
    $subunit_sing='sen';
    $subunit_pl='sen';
  } elsif (/Tk/) {
    ($front)=/^(.*)Tk/;
    s/Tk//;
    $unit='taka';
    $subunit_sing='poisha';
    $subunit_pl='poisha';
  } elsif (/\x{20AC}/) {
    ($front)=/^(.*)\x{20AC}/;
    s/\x{20AC}//;
    $unit='euro';
    $subunit_sing='cent';
    $subunit_pl='cents';
  }
  else { &perr("money: unknown currency"); }

  ($back) = /(\D*)$/;
  $back =~ s/^s//;    # $40s -> $40

  if ($front) {
    &pusho($front);   # generally punctuation
    if ($front !~ /\w$/) { $appendflg=1; }
  }

  $x = $_;
  if ($x =~ /\//) {
    $x =~ s/^\D*//;
    $x =~ s/\D*$//;
    if ($x =~ /1\/2/) {
      &pusho("half");
    } else {
      &printfrac($x,1);
      &pusho("of");
    }
    if ($next =~ /^(thousand|lakh|crore|[a-z]*illion)(\W*)/i) { &pusho("a"); }
    else { &pusho("a $unit"); return; }
    $x="";
    $plural=0;
  }

  $x =~ s/^\D*([\d,]*)\D*.*$/$1/;     # int part of string
  if ($x ne "") { &printint($x); }    # print int part (eg. dollars)

  if ($next eq "and" && $next2 =~ /\d\/\d/ && $next2 !~ /\/.*\//) {
    if ($unit && $x ne "") { &pusho("and"); }    # frac: eg 4 1/16
    $z=$next2;
    $z =~ s/\D*$//;
    &printfrac($z,1);
    ($punct) = ($next2 =~ /(\D*)$/);
    $field+=2;
    if ($next3 =~ /^(thousands?|lakhs?|crores?|[a-z]*illions?)(\W*)/i) {
      &pusho($1);
      $punct = $2;
      $field++;
    }
    if ($back) { &perr("money: back and 1 1/3"); }
    $plural = 1;
  } elsif ($back eq "" && $next =~ /^(thousands?|lakhs?|crores?|[a-z]*illions?)(\W*)/i) {
    &printdecfrac($_);  # multiplier
    &pusho($1);
    $punct = $2;
    $plural = 1;    ### if adj '', if noun 's'
    $field++;
    $frac=1;
  } elsif (/\.\d$/ || /\.\d\D/ || /\.\d{3}/ ) {  # .d or .ddd+
    &printdecfrac($_);
    $plural = 1;     # can be either
    $frac=1;
  } else {
    $y = $x;
    $y =~ s/,//g;    # remove commas
    if (int($y)!=1) { $plural=1; }
  }

  if ($back eq "" && $input[$field+1] =~ /^($unit)s?\W*$/i) {
    $unit = "";     # fix "$1 dollar" wsj typo
    $subunit_sing = "";
    $subunit_pl = "";
    if (!$frac) { &printdecfrac($_); }
    $frac = 1;
  }

  $sing = 0;
  if ($last =~ /^\W*[aA][nN]?\W*$/) { $sing=1; }  # a $123, an $80
  elsif ($input[$field+1] eq "-") { $sing = 1; }  # eg. $123-a-day
  # next one is chancy
  elsif ($input[$field] !~ /\W$/ && $input[$field+1] !~ /^\W/ &&
	 $input[$field+1] =~ /[a-zA-Z]$/ && $input[$field+2] eq "-" &&
	 $input[$field+3] =~ /^[a-zA-Z]/) { $sing=1; }  # $ after-tax
  elsif ($back eq "" && !$punct) {  # right contexts with no intervening punct
    $j = $field+1;  # includes *ly as a skip
    $z = "";
    for ($i=0;$i<2;$i++,$j++) {  # skip ?
      $y = $input[$j];  # strip final punct
      $y =~ s/\W*$//;
      if ($y !~ /\w*ly$/i && $sing_dollar{$y}!=2) { last; }
      ($y) = ($input[$j] =~ /(\W*)$/);  # get final punct
      $z .= $y;  # accumulate
    }
    $y = $input[$j];  # strip final punct
    $y =~ s/\W*$//;
    if ($z eq "" && $sing_dollar{$y}==1) { $sing=1; }
  }

  if ($unit) {  # print unit
    &pusho($unit);
    if ($plural && !$sing && $unit !~ /(yen|renminbi|rupiah|ringgit|taka)/)
      { &appendo("s"); }  # just add s for plural
  }

  if (!$frac && /\.\d{2}/) {  # .dd	(eg. cents)
    $y = $_;
    $y =~ s/^[^\.]*\.([\d]*)\D?.*$/$1/;  # get fractional part
    if ($unit && $x ne "") { &pusho("and"); }
    &printint($y);
    if ($sing || int($y)==1) { &pusho($subunit_sing); }
    else { &pusho($subunit_pl); }
  }

  if ($back) {  # punctuation from this field
    if ($punct) { &perr("money: back and punct"); }
    if ($back =~ /^\w/) { &pusho($back); }
    else { &appendo($back); }
  }

  if ($punct) { &appendo($punct); }  # punctuation from *illion
}

sub printyear {  # &printyear(x)
  if ($vflg) { print "printyear: $_[0]\n"; }
  &printnum($_[0]);    # for now
}

sub printtime {  # &printtime(x)
  if ($vflg) {print "printtime: $_[0]\n";}
  $_=$_[0];

  local(@x);
  local($front);
  local($back);

  if (/:{2,}/ || !/\d:\d/) { &perr("printtime: not a time"); }

  @x=split(/:/,$_);
  ($front)=($x[0] =~ /^(\D*)/);
  $x[0] =~ s/^(\D*)//;
  ($back)=($x[1] =~ /(\D*)$/);
  $x[1] =~ s/(\D*)$//;
	
  if ($front) {	
    &pusho($front);  # generally punctuation
    if ($front !~ /\w$/) { $appendflg=1; }
  }
  &printint($x[0]);
  if ($x[1]==0) {
    $_=$next;
    if (!/^[aApP]\.?[mM]\.?$/ && !/^(noon|midday|midnight)$/i)
      { &pusho("o'clock"); }
  } elsif ($x[1]<10) {
    &pusho("oh");
    &printint($x[1]);
  }
  else { &printint($x[1]); }
  if ($back) {
    if ($back =~ /^\w/) { &pusho($back); }
    else { &appendo($back); }  # generally punctuation
  }
}

sub printfrac {
  if ($vflg) {print "printfrac: $_[0]\n";}
  local($x)=$_[0];
  my $fracstyle = 0;  # default: use "one" for numerator 1
  if (defined($_[1])) { $fracstyle = $_[1]; }  # 1 for "a", or 2 for nothing

  local(@z);   #BUG lists don't seem to be local
  local($sign);
  local($front);
  local($back);
  local($sign);

  $x =~ s/^([^\d\.]*)//;  # strip front
  $front=$1;
  if ($front =~ /^\+$/) {  # get sign
    $sign="plus";
    $front =~ s/\+$//;
  }
  if ($front =~ /^-$/) {
    $sign="minus";
    $front =~ s/-$//;
  }

  if ($x =~ /\D$/) {
    ($back)=( $x =~ /(\D*)$/ );
    $x =~ s/\D*$//;  # strip back: final . is punct
  }

  @z = split(/\//,$x);
  if ($#z !=1) { &perr("printfrac: illegal fraction: $_[0]"); }

  # kdv, we may have odds like 11/2 which should be "11 to 2"
  if (($z[0] > $z[1]) && ($z[1] > 0)) {
    &printint($z[0]);
    &appendo(" to ");
    &printint($z[1]);
    return;
  }
	
  if ($z[1] <= 1) { &perr("printfrac: den too small: $_[0]"); }

  if ($front) {
    &pusho($front);
    if ($front =~ /[a-zA-Z]$/) { &appendo(" "); }
    $appendflg=1;
  }

  if ($sign) { &pusho($sign); }

  if ($fracstyle > 0 && $z[0] == 1) {
    if ($fracstyle == 1) {
      if ($z[1] =~ /^8/ || $z[1] == 18) { &pusho("an"); }
      else { &pusho("a"); }
    }
  } else {
    &printint($z[0]);  #numerator
  }
  if ($z[1] <= $#den) {  # small den from table (<20)
    &pusho($den[$z[1]]);
    if ($z[0]!=1) { &pluralize; }
  } else {  #large den
    $ones = int($z[1]%100);
    $hun = 100*int($z[1]/100);
    if ($hun>0) { &printint($hun); }
    if ($ones==0) {
      &appendo("th");
      if ($z[0]!=1) { &pluralize; }
    } elsif ($ones<=$#largeden) {  # <20
      &pusho($largeden[$ones]);
      if ($z[0]!=1) { &pluralize; };
    } else {
      $x=int($ones%10);
      if (int($ones/10)) {
	&pusho($ten[int($ones/10)]);
	if ($x) {
	  &appendo(" ");	# eg. twenty five
	  $appendflg=1;
	}
      }
      if ($x==0) {
	&thize("");
	if ($z[0]!=1) { &pluralize; }
      } else {
	&pusho($largeden[$x]);
	if ($z[0]!=1) { &pluralize; }
      }
    }
  }

  if ($back) {  # test below refined by FRM, but apparently always true anyway
                # for existing invocations (as back never begins with a letter)
    $x = &geto;  # in case of 1/10th etc
    if ($back !~ /^(st|nd|rd|th)/ || $x !~ /$back$/) {
      if ($back =~ /^[a-zA-Z]/) { &appendo(" "); }
      &appendo($back);
    }
  }
}

sub printnum {  # printnum(n)
  if ($vflg) { print "printnum: $_[0]\n"; }
  local($x) = $_[0];  # print ordinary numbers

  $leadingzeroflg = '';   # global
  local($front);
  local($back);
  local($intpart);
  local($fracpart);
  local($hun);
  local($ones);
  local($comma);
  local($sign);
  local($y);

  $x =~ s/^(\D*)//;   # strip front
  $front=$1;
  if ($front =~ /^\.$/ || $front =~ /\W\.$/ ||
      ($front =~ /\.$/ && $x =~ /^0/ ))	{  # leading .
    $front =~ s/\.$//;
    $x = "." . $x;
  }
  if ($front =~ /^\+$/) {  # get sign
    $sign="plus";
    $front =~ s/\+$//;
  }
  if ($front =~ /^-$/) {
    $sign="minus";
    $front =~ s/-$//;
  }

  if ($x =~ /\D$/) {
    $back=$x;
    $back =~ s/^[\d\.,]*\d//;
    $x =~ s/\D*$//;			# strip back: final . is punct
  }

  if ($x =~ /[^\d\.,]/) { &perr("printnum: $_[0] is not a number"); }

  if ($x!=0 && $x =~ /^0/ && $x =~ /^\d*$/) {  # "oh" numbers
    if ($front) {
      &pusho($front);
      if ($front !~ /[a-zA-Z]$/) { $appendflg=1; }
    }

    if ($sign) { &pusho($sign); }

    while ($x ne '') {
      $x =~ s/^(.)//;
      &pusho($ones_oh[$1]);
    }

    if ($back) {
      if ($back =~ /^s$/ || $back =~ /^s\W/) {  # back = s
	&pluralize;  # eg. 1960s
	$back =~ s/^s//;
      }
      if ($back) {
	if ($back =~ /^[a-zA-Z]/) { &pusho($back); }
	else { &appendo($back); }  # back = punct or 's
      }
    }
    return;
  }

  if ($x =~ /^\d/) {  # get integer part
    if ($x =~ /,/) {
      $comma=1;
      $x =~ s/,//g;  # strip commas
    }
    $intpart=$x;
    $intpart =~ s/\..*$//;
    if ($x =~ /^0/) { $leadingzeroflg=1; }
  }

  if ($x =~ /\./) {  # get fractional part
    $fracpart=$x;
    $fracpart =~ s/^.*\././;
  }

  if ($front) {
    &pusho($front);
    if ($front !~ /[a-zA-Z]$/) { $appendflg=1; }
  }

  if ($sign) { &pusho($sign); }

  $ones = int($intpart%100);
  if ($comma || $fracpart) { &printint($intpart); }
  elsif (($intpart>1000 && $intpart<2000) || ($intpart>2009 && $intpart<3000))
   {  #4 digit -> 2+2
   # test changed by FRM to accept years 1001-2999, instead of just 1901-1999
   # and century years, but use "two thousand ..." format for 2000-2009
    $hun = int($intpart/100);
    &printint($hun);
    if ($ones>=10) { &printint($ones); }
    elsif ($ones>0) {
      &pusho("oh");
      &printint($ones);
    }
    else { &pusho("hundred"); }
  } else {
    &printint($intpart);
    $y = $last;
    $y =~ s/^\W*//;  # thize dates: May 25th
    if ($intpart<=31 &&
     ($months{$y} || ($monthcontext == 3 && $next !~ /^[ap]\.?m\.?$/i))) {
      &thize("");
      $back =~ s/[a-z]//g;
      $monthcontext = 1;
    }
  }
  if ($fracpart) { &printdecfrac($fracpart); }

  if ($back) {
    if ($back =~ /^s$/ || $back =~ /^s\W/) {  # back = s
      &pluralize;      # eg. 1960s
      $back =~ s/^s//;
    }
    if ($back =~ /^st$/ || $back =~ /^st\W/) {  # back= st
      &thize("st");     # eg. 1st
      $back =~ s/^st//;
    }
    if ($back =~ /^nd$/ || $back =~ /^nd\W/) {  # back= nd
      &thize("nd");     # eg. 2nd
      $back =~ s/^nd//;
    }
    if ($back =~ /^rd$/ || $back =~ /^rd\W/) {  # back= rd
      &thize("rd");     # eg. 3rd
      $back =~ s/^rd//;
    }
    if ($back =~ /^th$/ || $back =~ /^th\W/) {  # back= th
      &thize("th");     # eg. 4th
      $back =~ s/^th//;
    }
    if ($back) {
      if ($back =~ /^[a-zA-Z]/) { &pusho($back); }
      else { &appendo($back); }  # back = punct or 's
    }
  }
}

sub printdate {  # printdate(n):  x/x/x format
  if ($vflg) { print "printdate: $_[0]\n"; }
  local($x)=$_[0];   # print ordinary numbers

  local(@y);
  local($front);
  local($back);

  $x =~ s/^(\D*)//;  # strip front
  $front = $1;

  $x =~ s/(\D*)$//;  # strip back
  $back = $1;

  if ($x !~ /^\d{1,2}\/\d{1,2}\/\d{1,2}$/ &&
   $x !~ /^\d{1,2}\/\d{1,2}\/\d{4}$/) {  # added by FRM: allow 4-digit years
    &perr("printdate: $_[0] is not a date");
  }

  @y = split(/\//,$x);

  if ($front) {
    &pusho($front);
    if ($front =~ /[a-zA-Z]$/) { &appendo(" "); }
    $appendflg = 1;
  }

  &printint($y[0]);
  &appendo("/");

  $appendflg = 1;
  &printint($y[1]);
  &appendo("/");

  $appendflg = 1;
  &printnum($y[2]);

  if ($back) {
    if ($back =~ /^[a-zA-Z]/) { &appendo(" "); }
    &appendo($back);
  }
}

sub printserno {  # printserno(n): eg. B1, 3b2, 10W-40
  if ($vflg) { print "printserno: $_[0]\n"; }
  local($x)=$_[0];  # print mixed sequences of dig and let

  local($y);
  local($z);
  local($front);
  local($back);

  $x =~ s/^(\W*)//;    # strip front
  $front = $1;
  if ($front) {
    &pusho($front);
    if ($front !~ /[a-zA-Z]$/) { $appendflg=1; }
  }

  $x =~ s/(\W*)$//;  # strip back
  $back = $1;

  while ($x) {
    $x =~ s/^(\D*)//;   # strip off non-dig
    $y = $1;
    if ($y) {
      $y =~ s/-//g;     # remove -
      if ($y eq "") {}
      elsif ($sernowd{$y}
       || $y =~ /^[A-Za-z][a-z]{4,}('s)?$/
       || $y =~ /^[a-z][aeiou][a-z][a-z]('s)?$/
       || $y =~ /^[a-z][a-z][aeiou][a-z]('s)?$/
       || $y =~ /^[a-z][a-z][a-z][aeiou]('s)?$/
       || $y =~ /^[A-Z][a-z]*[aeiouy][a-z]*('s)?$/
       || $y =~ /^[aeiou][a-z][a-z][a-z]('s)?$/
       || $y =~ /^[AEIOU][a-z]*('s)?$/)
        { &pusho($y); }  # word
      else {
	while ($y) {  # spell out (with dots after letters - added by FRM)
	  if ($y =~ /^[a-zA-Z]'s$/) {  # corrected by FRM: inserted "^"
            $y =~ s/'/\.'/;
	    &pusho($y);
	    $y =~ s/[a-zA-Z]\.'s*$//;
	  } elsif ($y =~ /^[A-Z]s$/) {  # corrected by FRM: inserted "^"
            $y =~ s/s/\.s/;
	    &pusho($y);
	    $y =~ s/[A-Z]\.s$//;
	  } else {
            $y =~ s/^([a-zA-Z])\.?/$1\./;
	    $y =~ s/^(.\.?)//;
	    &pusho($1);
	  }
	}
      }
    }      # (should expand here unless in dictionary)
    $x =~ s/^(\d*)//;    # strip off dig
    $y = $1;
    if ($y ne "") { &printdigstr($y); }
  }

  if ($back) {
    if ($back =~ /^\w/) { &pusho($back); }
    else { &appendo($back); }
  }
  $appendflg = 0;
}

sub printdigstr {   # printdigstr(x)
  if ($vflg) { print "printdigstr: $_[0]\n"; }
  local($x) = $_[0];

  local(@y);
  local($j);
  local($k);

  if ($x =~ /^0/) {  # leading zero
    while ($x ne "") {
      $x =~ s/^(.)//;
      my $digit = $1;
      if ($digit !~ /\d/) { &perr("printdigstr: non-digit"); }
      &pusho("$ones_z[$digit]");
    }
    return;
  }
  if ($x =~ /^\d0*$/) {  # d, d0, d00, d000, etc
    &printint($x);
    return;
  }

  $_ = $x;
  @y = ();
  for ($j=0;$_ ne "";$j++) { $y[$j]=chop($_); }  # j=no digits
  for ($k=0;$y[$k]==0;$k++) {}                   # k= nr following 0's

  if ($j==2) {  # 2 dig
    &printint($x);
    return;
  }
  if ($j==3) {
    &printint($y[2]);
    if ($y[1]==0) { &pusho("oh"); }
    &printint("$y[1]$y[0]");
    return;
  }
  if ($j==5 && $k<=2) {
    &printint("$y[4]");
    $j=4;
  }
  if ($j==4) {
    &printint("$y[3]$y[2]");
    if ($k==2) { &pusho("hundred"); }
    else {
      if ($y[1]==0) { &pusho("oh"); }
      &printint("$y[1]$y[0]");
    }
    return;
  }
  # >5 dig: just sequential dig
  for ($j--;$j>=0;$j--) { &pusho("$ones_oh[$y[$j]]"); }
}


sub printplaindigstr {   # printplaindigstr(x)
  if ($vflg) { print "printplaindigstr: $_[0]\n"; }
  local($x) = $_[0];

  while ($x =~ s/^(\d)//) {
    &pusho("$ones_oh[$1]");
  }

  #if ($x !~ "") { &perr("printplaindigstr: non-digit $x"); }
}


sub printftin {  # printftin(n): eg. 6'-4"
  if ($vflg) { print "printftin: $_[0]\n"; }
  local($x)=$_[0];  # print mixed sequences of dig and let

  local($y);
  local($front);
  local($back);

  $x =~ s/^(\D*)//;  # strip front
  $front=$1;

  $x =~ s/(\D*)$//;  # strip back
  $back=$1;
  $back =~ s/^\"//;  # remove "

  if ($front) {
    &pusho($front);
    if ($front !~ /[a-zA-Z]$/) { $appendflg=1; }
  }

  $x =~ s/^([\d\.]*)//;	# strip off dig & .
  $y=$1;
  if (!$y) { &perr("printftin: bad feet"); }
  &printnum($y);
  if ($y==1) { &appendo(" foot"); }
  else { &appendo(" feet"); }

  $x =~ s/^\'//;  # strip off '
  $x =~ s/^-//;   # strip off -
  if (!$x) { &perr("printftin: bad intermed"); }

  $x =~ s/^([\d\.]*)//;	# strip off dig & .
  $y=$1;
  if (!$y) { &perr("printftin: bad inches"); }
  &printnum($y);
  if ($y==1) { &appendo(" inch"); }
  else { &appendo(" inches"); }

  if ($back) {
    if ($back !~ /^[a-zA-Z]/) { &appendo($back); }
    else { &pusho($back); }
  }
}

sub printint {  # printint(x)
  if ($vflg) { print "printint: $_[0]\n"; }
  local($x)=$_[0];

  local($comma);
  local($leading_zero);
  local($fractional);
  local(@y);
	
  $fractional = $x =~ /\.\d/;
  $x =~ s/^\D*([\d,]*)\D*.*$/$1/;	# int part of string
  $leading_zero=$x =~ /^0/;
  $comma=$x =~ /,/;
  $x =~ s/,//g;
  if ($x eq "") {return;}

  if ($x == 0) {
    &pusho("zero");
    $leadingzeroflg=1;
    return;
  }
	
  @y=();
  for ($j=0; $x; $j++) { $y[$j]=chop($x); }

  $commanextflg=0;
  if ($comma || $fractional || 1) {  # NB always true! - relic of old code?
    for ($j=3*int($#y/3);$j>=0;$j-=3) {
      if ($y[$j+2]) { &pusho("$ones_z[$y[$j+2]] hundred"); }
      if ($y[$j+1]==1) { &pusho($teen[$y[$j]]); }
      else {
	if ($y[$j+1]>1) {
	  &pusho($ten[$y[$j+1]]);
	  if ($y[$j]) {
	    &appendo(" ");  # twenty five
	    $appendflg=1;
	  }
	}
	if ($y[$j]>0) { &pusho($ones_z[$y[$j]]); }
      }
      if (int($j/3)>0) {
	if (int($j/3) > $#mult) { &perr("printint: too big"); }
	if ($y[$j+2] || $y[$j+1] || $y[$j]) { &pusho($mult[int($j/3)]); }
      }
      #$commanextflg=1;	# changed by FRM: output without commas wanted
    }
  }
}

sub printdecfrac {
  if ($vflg) { print "printdecfrac: $_[0]\n"; }
  $x = @_[0];

  if ($x !~ /\.\d/) { return; }
  $x =~ s/^[^\.]*\.([\d]*)\D?.*$/$1/;  # get fractional part

  &pusho($POINT);
  @y = split(//,$x);
  if ($leadingzeroflg) {
    for ($j=0; $j<=$#y; $j++) { &pusho($ones_z[$y[$j]]); }
  } else {
    for ($j=0; $j<=$#y; $j++) { &pusho($ones_oh[$y[$j]]); }
  }
}

sub pluralize {  # pluralize(): pluralize last entry on output stack
  if ($vflg) { print "pluralize: $_[0]\n"; }
  local($x);

  $_ = &geto;
  if (/st$/ || /nd$/ || /rd$/ || /th$/ || /quarter$/ || /zero$/ || /oh/ ||
      /one$/ || /two$/ || /three$/ || /four$/ || /five$/ ||
      /seven$/ || /eight$/ || /nine$/ ||
      /ten$/ || /eleven$/ || /twelve$/ || /een$/ ||
      /hundred$/ || /thousand$/ || /illion$/ ) {
    &appendo("s");
  } elsif (/six$/) {
    &appendo("es");
  } elsif (/half$/) {
    $x=&popo();
    $x =~ s/f$/ves/;
    &pusho($x);
  } elsif (/ty$/) {  # fifty etc.
    $x = &popo();
    $x =~ s/y$/ies/;
    &pusho($x);
  }
  else { &perr("pluralize: unknown word: $_"); }
}

sub thize {  # thize(): add th to last entry on output stack
  if ($vflg) { print "printthize: $_[0]\n"; }
  local($y)=$_[0];

  local($x);

  $_ = &geto;
  if (/four$/ || /six$/ || /seven$/ || /ten$/ ||
      /eleven$/ || /een$/ || /hundred$/ || /thousand$/ || /illion$/ ) {
    if ($y && $y ne "th") { &perr("thize: mismatch: $_ $y\n"); }   # xth
    &appendo("th");
  } elsif ( /one$/ ) {                                             # 1st
    if ($y && $y ne "st") { &perr("thize: mismatch: $_ $y\n"); }
    $x = &popo();
    $x =~ s/one$/first/;
    &pusho($x);
  } elsif ( /two$/ ) {                                             # 2nd
    if ($y && $y ne "nd") { &perr("thize: mismatch: $_ $y\n"); }
    $x = &popo();
    $x =~ s/two$/second/;
    &pusho($x);
  } elsif ( /three$/ ) {                                           # 3rd
    if ($y && $y ne "rd") { &perr("thize: mismatch: $_ $y\n"); }
    $x = &popo();
    $x =~ s/three$/third/;
    &pusho($x);
  } elsif ( /five$/ || /twelve$/ ) {                               # 5th, 12th
    if ($y && $y ne "th") { &perr("thize: mismatch: $_ $y\n"); }
    $x = &popo();
    $x =~ s/ve$/fth/;
    &pusho($x);
  }
  elsif (/eight$/) {
    if ($y && $y ne "th") { &perr("thize: mismatch: $_ $y\n"); }   # 8th
    &appendo("h");
  } elsif ( /nine$/ ) {
    if ($y && $y ne "th") { &perr("thize: mismatch: $_ $y\n"); }
    $x = &popo();
    $x =~ s/nine$/ninth/;
    &pusho($x);
  } elsif ( /ty$/ ) {
    if ($y && $y ne "th") { &perr("thize: mismatch: $_ $y\n"); }
    $x = &popo();
    $x =~ s/ty$/tieth/;
    &pusho($x);
  }
  else { &perr("thize: unknown word: $_"); }
}

sub pusho {  # pusho($x): push output
  if ($commanextflg) {  # global: used for commas in printint
    $commanextflg=0;
    &appendo(",");
  }
  if ($appendflg) {  # global: used for fronts
    $appendflg=0;		
    &appendo(@_[0]);
  }
  else { push(@output,@_); }
}

sub appendo {  # appendo($x): append to output
  $appendflg=0;		
#  if ($#output < 0) {&pusho("");}
  if ($#output < 0) { &perr("appendo: output empty"); }
  $output[$#output] .= @_[0];
}

sub popo {  # popo(): pop last output
  if ($#output < 0) { &perr("popo: output empty"); }
  pop(@output);
}

sub geto {  # geto(): get last output
  if ($#output < 0) { &perr("geto: output empty"); }
  return $output[$#output];
}

sub perr {
  print STDERR "numproc: $_[0]\n";
  print STDERR "line number=$.: fields=$last, $this, $next\n";
  print STDERR $line . "\n";

# kdv, bail out
#	exit(1);

  # kdv, just skip the line, the original graceful error recovery
  # just spins forever.
  goto toploop;

  $appendflg=0;
  $commanextflg=0;
  &pusho($this);
  $field++;        # graceful error recovery
  goto wloop;
}

sub perr2 {
  print STDERR "numproc: $_[0]\n";
  exit(1);
}
