UNSAFE MODULE RCSFile;

IMPORT
  CText, FileAttr, Fmt, MD5, OSError, Pathname,
  RCSAccess, RCSAccessList, RCSDate, RCSDelta,
  RCSDeltaClass, RCSDeltaList, RCSDeltaListSort, RCSDeltaTbl,
  RCSError, RCSKeyword, RCSPhrase, RCSPhrases, RCSRevNum, RCSString,
  RCSTag, RCSTagList, RCSTagListSort, SortedRCSDeltaTbl, Text,
  TextIntTbl, TextSeq, Thread, TokScan, UnixMisc, Ustat, Word, Wr;

REVEAL
  T = Public BRANDED OBJECT
    attr: FileAttr.T := NIL;
    buf: ADDRESS := NIL;
    len: CARDINAL := 0;

    deltaTbl: SortedRCSDeltaTbl.T;
    accessList: RCSAccessList.T := NIL;
    tagList: RCSTagList.T := NIL;

    newPhrases: RCSPhrases.T := NIL;

    start: UNTRACED REF CHAR := NIL;
    ptr: UNTRACED REF CHAR := NIL;
    limit: UNTRACED REF CHAR := NIL;

    line: CARDINAL := 1;
    curTok: Token;

    head: RCSDelta.T := NIL;
    tail: RCSDelta.T := NIL;
  OVERRIDES
    init := Init;
  END;

VAR
  keyTab := NEW(TextIntTbl.Default).init(2*NUMBER(Keyword));

PROCEDURE CalculateMD5(rf: T; md5: MD5.T) =
  BEGIN
    md5.updateRaw(rf.buf, rf.len);
  END CalculateMD5;

PROCEDURE Close(rf: T) RAISES {OSError.E} =
  BEGIN
    IF rf.buf # NIL THEN
      UnixMisc.Unmap(rf.buf, rf.len);
      rf.buf := NIL;
    END;
    rf.len := 0;
    rf.start := NIL;
    rf.ptr := NIL;
    rf.limit := NIL;
  END Close;

PROCEDURE GetDelta(rf: T; revNum: RCSRevNum.T): RCSDelta.T
  RAISES {RCSError.E} =
  VAR
    delta: RCSDelta.T;
  BEGIN
    IF NOT rf.deltaTbl.get(revNum, delta) THEN
      Oops(rf, "Non-existent revision number " & revNum);
    END;
    RETURN delta;
  END GetDelta;

PROCEDURE GetHeadDelta(rf: T): RCSDelta.T
  RAISES {RCSError.E} =
  BEGIN
    IF rf.head = NIL THEN
      Oops(rf, "File contains no deltas");
    END;
    RETURN rf.head;
  END GetHeadDelta;

PROCEDURE GetTagDelta(rf: T;
                      tag: TEXT := NIL;
		      date: RCSDate.T := NIL): RCSDelta.T
  RAISES {RCSError.E} =
  CONST
    ImportDateFudge = 3.5d0;
    (* If the date stamps of revisions 1.1 and 1.1.1.1 differ by
       less than "ImportDateFudge" seconds, we assume the file was
       originally brought into the repository by a "cvs import". *)
  VAR
    tlp: RCSTagList.T;
    revNum: RCSRevNum.T;
    delta, delta1111: RCSDelta.T;
  BEGIN
    IF tag # NIL THEN  (* The caller specified a tag. *)
      tlp := rf.tagList;
      WHILE tlp # NIL DO
	IF Text.Equal(tlp.head.name, tag) THEN EXIT END;
	tlp := tlp.tail;
      END;
      IF tlp = NIL THEN
	Oops(rf, "No such tag " & tag);
      END;
      revNum := tlp.head.revNum;
    ELSE
      revNum := NIL;
    END;

    delta := GetRevDateDelta(rf, revNum, date);
    IF revNum = NIL AND RCSRevNum.Equal(delta.revision, "1.1") THEN
      (* A date-only search has found revision 1.1.  If this file was
         apparently created by a "cvs import", take the appropriate
	 revision from the vendor branch instead. *)
      TRY
	delta1111 := GetDelta(rf, "1.1.1.1");
	IF ABS(RCSDate.ToTime(delta.date) - RCSDate.ToTime(delta1111.date))
	  < ImportDateFudge
	THEN
	  RETURN GetRevDateDelta(rf, "1.1.1", date);
	END;
      EXCEPT RCSError.E => (* Just continue. *) END;
    END;
    RETURN delta;
  END GetTagDelta;

PROCEDURE GetRevDateDelta(rf: T;
                          revNum: RCSRevNum.T := NIL;
		          date: RCSDate.T := NIL): RCSDelta.T
  RAISES {RCSError.E} =
  VAR
    delta: RCSDelta.T;
    isCVSBranch := FALSE;
    isSpecific := FALSE;
    ok: BOOLEAN;
  BEGIN
    IF revNum # NIL THEN  (* The caller specified a revision number. *)
      IF RCSRevNum.NumParts(revNum) MOD 2 = 0 THEN
	(* Specific revision, or special CVS branch. *)
	WITH last = RCSRevNum.Last(revNum), prefix = RCSRevNum.Prefix(revNum) DO
	  IF NOT Text.Equal(RCSRevNum.Last(prefix), "0") THEN
	    (* Specific revision. *)
	    isSpecific := TRUE;
	    delta := GetDelta(rf, revNum);
	  ELSE
	    isCVSBranch := TRUE;
	    (* Convert the CVS branch into an RCS branch, and try
	       to get the tip of that branch.  If the branch doesn't
	       exist, get the branch-point delta instead. *)
	    revNum := RCSRevNum.Cat(RCSRevNum.Prefix(prefix), last);
	    TRY
	      delta := GetBranchTip(rf, revNum);
	    EXCEPT RCSError.E =>
	      delta := GetDelta(rf, RCSRevNum.Prefix(revNum));
	    END;
	  END;
	END;
      ELSE  (* RCS branch. *)
	delta := GetBranchTip(rf, revNum);
      END;
    ELSIF rf.branch # NIL THEN  (* Use the tip of the default branch. *)
      revNum := rf.branch;
      delta := GetBranchTip(rf, revNum);
    ELSIF rf.head # NIL THEN  (* Use the head. *)
      revNum := RCSRevNum.Prefix(rf.head.revision);
      delta := rf.head;
    ELSE
      Oops(rf, "File contains no deltas");
    END;

    (* At this point, "revNum" is guaranteed to be set non-NIL.  For a
       specific revision, it is the revision number of the specific
       delta.  For a branch, or for the default branch, it is the
       revision number of the branch. *)

    IF date # NIL THEN  (* The caller specified a date. *)
      IF isSpecific THEN
	ok := RCSDate.Compare(delta.date, date) <= 0;
      ELSE
	WHILE delta # NIL AND RCSDate.Compare(delta.date, date) > 0 DO
	  delta := RCSDelta.Predecessor(delta);
	END;
	IF delta = NIL THEN
	  ok := FALSE;
	ELSE
	  (* If the delta is on the correct branch, then it is OK. *)
	  IF RCSRevNum.NumParts(revNum) = 1 THEN  (* Must be on the trunk. *)
	    ok := RCSRevNum.IsTrunk(delta.revision);
	  ELSE  (* Must be on the same branch. *)
	    ok := RCSRevNum.Equal(revNum, RCSRevNum.Prefix(delta.revision));
	  END;
	  (* If it's a CVS branch, then it is also OK if the delta is at
	     the branch point. *)
	  IF NOT ok AND isCVSBranch THEN
	    ok := RCSRevNum.Equal(RCSRevNum.Prefix(revNum), delta.revision);
	  END;
	END;
      END;
      IF NOT ok THEN
	Oops(rf, "Non-existent revision/date combination");
      END;
    END;

    RETURN delta;
  END GetRevDateDelta;

PROCEDURE GetBranchTip(rf: T; branch: RCSRevNum.T): RCSDelta.T
  RAISES {RCSError.E} =
  VAR
    delta: RCSDelta.T;
    dlp: RCSDeltaList.T;
  BEGIN
    IF RCSRevNum.NumParts(branch) = 1 THEN  (* Main branch. *)
      delta := rf.head;
      WHILE delta # NIL DO
	IF RCSRevNum.Equal(RCSRevNum.Prefix(delta.revision), branch) THEN
	  EXIT;
	END;
	delta := delta.next;
      END;
      IF delta = NIL THEN
	Oops(rf, "No such branch " & branch);
      END;
    ELSE  (* A branch off of a delta. *)
      delta := GetDelta(rf, RCSRevNum.Prefix(branch));  (* The branch point. *)
      dlp := delta.branches;
      WHILE dlp # NIL DO
	IF RCSRevNum.Equal(RCSRevNum.Prefix(dlp.head.revision), branch) THEN
	  EXIT;
	END;
	dlp := dlp.tail;
      END;
      IF dlp = NIL THEN
	Oops(rf, "No such branch " & branch);
      END;

      (* Now follow the branch to its tip. *)
      delta := dlp.head;
      WHILE delta.next # NIL DO
	delta := delta.next;
      END;
    END;

    RETURN delta;
  END GetBranchTip;

PROCEDURE GetAttr(rf: T): FileAttr.T =
  BEGIN
    RETURN rf.attr;
  END GetAttr;

PROCEDURE GetToken(rf: T) =
  CONST
    WS = SET OF CHAR{' ', '\010', '\t', '\n', '\013', '\f', '\r'};
    Special = SET OF CHAR{'$', ',', '.', ':', ';', '@'};
    Sym = SET OF CHAR{'!' .. '~'} - Special;
    ID = Sym + SET OF CHAR{'.'};
    Digit = SET OF CHAR{'0' .. '9'};
    Num = Digit + SET OF CHAR{'.'};
  VAR
    start: UNTRACED REF CHAR;
    line: CARDINAL;
    ch: CHAR;
  BEGIN
    WHILE rf.ptr < rf.limit AND rf.ptr^ IN WS DO
      IF rf.ptr^ = '\n' THEN INC(rf.line) END;
      INC(rf.ptr);
    END;
    start := rf.ptr;
    line := rf.line;

    IF rf.ptr = rf.limit THEN
      rf.curTok.type := TokType.EOF;
      rf.curTok.keyword := Keyword.None;
      rf.curTok.line := line;
      rf.curTok.ptr := start;
      rf.curTok.len := 0;
      RETURN;
    END;

    IF rf.ptr^ IN ID THEN
      VAR
	type := TokType.Num;
	keyOrd := ORD(Keyword.None);
	ch: CHAR;
      BEGIN
	WHILE rf.ptr < rf.limit DO
	  ch := rf.ptr^;
	  IF NOT ch IN ID THEN EXIT END;
	  IF NOT ch IN Num THEN
	    type := TokType.Id;
	  END;
	  INC(rf.ptr);
	END;
	rf.curTok.ptr := start;
	rf.curTok.len := rf.ptr - start;
	IF type = TokType.Id THEN
	  EVAL keyTab.get(TokText(rf.curTok), keyOrd);
	END;
	rf.curTok.type := type;
	rf.curTok.keyword := VAL(keyOrd, Keyword);
	rf.curTok.line := line;
	RETURN;
      END;
    END;

    CASE rf.ptr^ OF
    | ';' =>
	INC(rf.ptr);
	rf.curTok.type := TokType.Semicolon;
	rf.curTok.keyword := Keyword.None;
	rf.curTok.line := line;
	rf.curTok.ptr := start;
	rf.curTok.len := 1;
	RETURN;
    | ':' =>
	INC(rf.ptr);
	rf.curTok.type := TokType.Colon;
	rf.curTok.keyword := Keyword.None;
	rf.curTok.line := line;
	rf.curTok.ptr := start;
	rf.curTok.len := 1;
	RETURN;
    | '@' =>
	INC(rf.ptr);
	start := rf.ptr;
	LOOP
	  IF rf.ptr = rf.limit THEN  (* Unterminated string. *)
	    rf.curTok.type := TokType.Bad;
	    rf.curTok.keyword := Keyword.None;
	    rf.curTok.line := line;
	    rf.curTok.ptr := start;
	    rf.curTok.len := rf.ptr - start;
	    RETURN;
	  END;
	  ch := rf.ptr^;
	  INC(rf.ptr);
	  IF ch = '@' THEN
	    IF rf.ptr = rf.limit OR rf.ptr^ # '@' THEN EXIT END;
	    INC(rf.ptr);
	  ELSIF ch = '\n' THEN
	    INC(rf.line);
	  END;
	END;
	rf.curTok.type := TokType.String;
	rf.curTok.keyword := Keyword.None;
	rf.curTok.line := line;
	rf.curTok.ptr := start;
	rf.curTok.len := rf.ptr - 1 - start;
	RETURN;
    ELSE
      INC(rf.ptr);
      rf.curTok.type := TokType.Bad;
      rf.curTok.keyword := Keyword.None;
      rf.curTok.line := line;
      rf.curTok.ptr := start;
      rf.curTok.len := 1;
      RETURN;
    END;
  END GetToken;

PROCEDURE Import(p: Pathname.T;
                 revNum: RCSRevNum.T;
		 author: TEXT;
		 state: TEXT;
		 logLines := -1): T
  RAISES {OSError.E} =
  (* Any RCSError.E that gets raised in this procedure really is due to
     an internal error.  We go ahead and let the core dump happen so that
     we can find the bug. *)
  <* FATAL RCSError.E *>
  VAR
    rf: T;
    statbuf: Ustat.struct_stat;
    np: CARDINAL;
    stack: TextSeq.T;
    date: RCSDate.T;
    delta, pred: RCSDelta.T;
    logEdits: TEXT;
  BEGIN
      rf := NEW(T).init();
      rf.buf := UnixMisc.MapFile(p, statbuf);
      rf.attr := FileAttr.FromStat(statbuf);
      rf.len := VAL(statbuf.st_size, INTEGER);
      rf.start := rf.buf;
      rf.limit := rf.start + rf.len;
      rf.ptr := rf.limit;  (* Already at "end of file". *)

      date := RCSDate.FromTime(FileAttr.GetModTime(rf.attr));

      np := RCSRevNum.NumParts(revNum);
      IF np = 0 THEN
	revNum := "1";
	INC(np);
      END;
      IF np MOD 2 = 1 THEN
	revNum := RCSRevNum.Cat(revNum, "1");
	INC(np);
      END;

      stack := NEW(TextSeq.T).init();
      WHILE np > 2 DO
	stack.addhi(revNum);
	revNum := RCSRevNum.Prefix(RCSRevNum.Prefix(revNum));
	DEC(np, 2);
      END;

      pred := NIL;
      delta := AddDelta(rf,
	revNum := revNum,
	diffBase := pred,
	date := date,
	author := author,
	state := state,
	log := RCSString.FromText("Initial revision\n"),
	text := NEW(SimpleString, ptr := rf.start, len := rf.len));
      delta.isPlaceHolder := TRUE;

      WHILE stack.size() > 0 DO
	revNum := stack.remhi();
	pred := delta;
	delta := AddDelta(rf,
	  revNum := revNum,
	  diffBase := pred,
	  date := date,
	  author := author,
	  state := state,
	  log := RCSString.FromText("Initial import.\n"),
	  text := RCSString.FromText(""));
	delta.isPlaceHolder := TRUE;
      END;

      delta.isPlaceHolder := FALSE;  (* The last delta is the real one. *)

      IF logLines >= 0 THEN
	logEdits := MakeLogEdits(rf, logLines);
	IF NOT Text.Empty(logEdits) THEN
	  DeleteDelta(rf, delta);
	  delta := AddDelta(rf,
	    revNum := revNum,
	    diffBase := delta,
	    date := date,
	    author := author,
	    state := state,
	    log := RCSString.FromText("Initial import.\n"),
	    text := RCSString.FromText(logEdits));
	END;
      END;

      RETURN rf;
  END Import;

PROCEDURE Init(rf: T;
               desc: RCSString.T := NIL): T =
  BEGIN
    IF desc = NIL THEN desc := RCSString.FromText("") END;

    rf.attr := NEW(FileAttr.T).init(FileAttr.FileType.File);
    rf.deltaTbl := NEW(SortedRCSDeltaTbl.Default).init();
    rf.desc := desc;
    rf.curTok := NEW(Token);

    RETURN rf;
  END Init;

PROCEDURE MakeLogEdits(rf: T; logLines: CARDINAL): TEXT =
  TYPE
    State = {
      Idle, NeedL, Needo, Needg, NeedColon,
      FindDollar, FindNewline, Voila, Ignore
    };
  VAR
    ptr: UNTRACED REF CHAR := rf.start;
    limit: UNTRACED REF CHAR := rf.start + rf.len;
    lineNum := 1;
    state := State.Idle;
    edits := "";
    ch: CHAR;
    ignoreCount: CARDINAL;
  BEGIN
    WHILE ptr < limit DO
      ch := ptr^;
      IF state # State.Idle THEN
	CASE state OF
	| State.Idle =>
	    <* ASSERT FALSE *>
	| State.NeedL =>
	    IF ch = 'L' THEN
	      state := State.Needo;
	    ELSE
	      state := State.Idle;
	    END;
	| State.Needo =>
	    IF ch = 'o' THEN
	      state := State.Needg;
	    ELSE
	      state := State.Idle;
	    END;
	| State.Needg =>
	    IF ch = 'g' THEN
	      state := State.NeedColon;
	    ELSE
	      state := State.Idle;
	    END;
	| State.NeedColon =>
	    IF ch = ':' THEN
	      state := State.FindDollar;
	    ELSE
	      state := State.Idle;
	    END;
	| State.FindDollar =>
	    IF ch = '$' THEN
	      state := State.FindNewline;
	    ELSIF ch = '\n' THEN
	      state := State.Idle;
	    END;
	| State.FindNewline =>
	    IF ch = '\n' THEN
	      state := State.Voila;
	    END;
	| State.Voila =>
	    edits := edits &
	      "d" & Fmt.Int(lineNum) & " " & Fmt.Int(logLines+2) & "\n";
	    ignoreCount := logLines;
	    state := State.Ignore;
	| State.Ignore =>
	    IF ch = '\n' THEN
	      DEC(ignoreCount);
	      IF ignoreCount = 0 THEN
		state := State.Idle;
	      END;
	    END;
	END;
      ELSIF ch = '$' THEN
	state := State.NeedL;
      END;

      IF ch = '\n' THEN INC(lineNum) END;
      INC(ptr);
    END;
    RETURN edits;
  END MakeLogEdits;

PROCEDURE OpenReadonly(p: Pathname.T): T
  RAISES {OSError.E, RCSError.E} =
  VAR
    rf: T;
    statbuf: Ustat.struct_stat;
  BEGIN
    rf := NEW(T).init();
    rf.buf := UnixMisc.MapFile(p, statbuf);
    rf.attr := FileAttr.FromStat(statbuf);
    rf.len := VAL(statbuf.st_size, INTEGER);
    rf.start := rf.buf;
    rf.ptr := rf.start;
    rf.limit := rf.start + rf.len;

    TRY
      ParseAdmin(rf);
      ParseTree(rf);
      ParseDesc(rf);
      RETURN rf;
    EXCEPT RCSError.E(msg) =>
      TRY Close(rf) EXCEPT OSError.E => (* Ignore *) END;
      RAISE RCSError.E(msg);
    END;
  END OpenReadonly;

PROCEDURE ParseAdmin(rf: T) RAISES {RCSError.E} =
  VAR
    lastAccess: RCSAccessList.T := NIL;
    lastTag: RCSTagList.T := NIL;
  BEGIN
    (* head {num}; *)
    EatKeyword(rf, Keyword.Head);
    (* Figure out whether this RCS file is in the format produced by CVS
       for an initial import.  CVS doesn't bother to generate the same
       whitespace as RCS would have, sigh. *)
    IF rf.ptr < rf.limit AND rf.ptr^ = ' ' THEN
      rf.options := rf.options + Options{Option.CVSInitialImport};
    ELSE
      rf.options := rf.options - Options{Option.CVSInitialImport};
    END;
    IF HaveType(rf, TokType.Num) THEN
      rf.head := EnterDelta(rf, TokText(CurTok(rf)));
      EatTok(rf);
    END;
    EatType(rf, TokType.Semicolon);

    (* {branch {num};} *)
    IF HaveKeyword(rf, Keyword.Branch) THEN
      EatTok(rf);
      IF HaveType(rf, TokType.Num) THEN
	rf.branch := TokText(CurTok(rf));
	EatTok(rf);
      END;
      EatType(rf, TokType.Semicolon);
    END;

    (* access {id}*; *)
    EatKeyword(rf, Keyword.Access);
    <* ASSERT rf.accessList = NIL *>
    WHILE HaveType(rf, TokType.Id) DO
      WITH access = NEW(RCSAccess.T) DO
	access.name := TokText(CurTok(rf));
	EatTok(rf);
	WITH l = RCSAccessList.List1(access) DO
	  IF lastAccess = NIL THEN
	    rf.accessList := l;
	  ELSE
	    lastAccess.tail := l;
	  END;
	  lastAccess := l;
	END;
      END;
    END;
    EatType(rf, TokType.Semicolon);

    (* symbols {sym:num}*; *)
    EatKeyword(rf, Keyword.Symbols);
    <* ASSERT rf.tagList = NIL *>
    WHILE HaveType(rf, TokType.Id) DO
      WITH tag = NEW(RCSTag.T) DO
	tag.name := TokText(CurTok(rf));
	EatTok(rf);
	EatType(rf, TokType.Colon);
	NeedType(rf, TokType.Num);
	tag.revNum := TokText(CurTok(rf));
	EatTok(rf);
	WITH l = RCSTagList.List1(tag) DO
	  IF lastTag = NIL THEN
	    rf.tagList := l;
	  ELSE
	    lastTag.tail := l;
	  END;
	  lastTag := l;
	END;
      END;
    END;
    EatType(rf, TokType.Semicolon);

    (* locks {id:num}*; {strict;} *)
    EatKeyword(rf, Keyword.Locks);
    WHILE HaveType(rf, TokType.Id) DO
      EatTok(rf);  (* FIXME *)
      EatType(rf, TokType.Colon);
      EatType(rf, TokType.Num);
    END;
    EatType(rf, TokType.Semicolon);
    IF HaveKeyword(rf, Keyword.Strict) THEN
      rf.strictLocking := TRUE;
      EatTok(rf);
      EatType(rf, TokType.Semicolon);
    ELSE
      rf.strictLocking := FALSE;
    END;

    (* {comment {string};} *)
    IF HaveKeyword(rf, Keyword.Comment) THEN
      EatTok(rf);
      IF HaveType(rf, TokType.String) THEN
	rf.comment := TokText(CurTok(rf));
	EatTok(rf);
      END;
      EatType(rf, TokType.Semicolon);
    END;

    (* {expand {string};} *)
    IF HaveKeyword(rf, Keyword.Expand) THEN
      EatTok(rf);
      IF HaveType(rf, TokType.String) THEN
	rf.expand := RCSKeyword.DecodeExpand(TokText(CurTok(rf)));
	EatTok(rf);
      END;
      EatType(rf, TokType.Semicolon);
    END;

    (* {newphrase}* *)
    rf.newPhrases := ParseNewPhrases(rf);
  END ParseAdmin;

PROCEDURE ParseTree(rf: T) RAISES {RCSError.E} =
  VAR
    delta: RCSDelta.T;
    ok: BOOLEAN;
  BEGIN
    WHILE HaveType(rf, TokType.Num) DO
      delta := EnterDelta(rf, TokText(CurTok(rf)));
      EatTok(rf);

      (* date num; *)
      EatKeyword(rf, Keyword.Date);
      NeedType(rf, TokType.Num);
      delta.date := TokText(CurTok(rf));
      EatTok(rf);
      EatType(rf, TokType.Semicolon);

      (* author id; *)
      EatKeyword(rf, Keyword.Author);
      NeedType(rf, TokType.Id);
      delta.author := TokText(CurTok(rf));
      EatTok(rf);
      EatType(rf, TokType.Semicolon);

      (* state {id}; *)
      EatKeyword(rf, Keyword.State);
      IF HaveType(rf, TokType.Id) THEN
	delta.state := TokText(CurTok(rf));
	EatTok(rf);
      END;
      EatType(rf, TokType.Semicolon);

      (* branches {num}*; *)
      EatKeyword(rf, Keyword.Branches);
      WHILE HaveType(rf, TokType.Num) DO
	WITH br = TokText(CurTok(rf)) DO
	  IF NOT RCSRevNum.Equal(RCSRevNum.Prefix(RCSRevNum.Prefix(br)),
	    delta.revision)
	  THEN
	    RAISE RCSError.E("Invalid branch " & br & " for delta "
	      & delta.revision);
	  END;
	  RCSDeltaClass.AddBranch(delta, EnterDelta(rf, br), delta);
	END;
	EatTok(rf);
      END;
      EatType(rf, TokType.Semicolon);

      (* next {num}; *)
      EatKeyword(rf, Keyword.Next);
      IF HaveType(rf, TokType.Num) THEN
	WITH next = EnterDelta(rf, TokText(CurTok(rf))) DO
	  IF RCSRevNum.IsTrunk(delta.revision) THEN
	    ok := RCSRevNum.IsTrunk(next.revision)
	      AND RCSRevNum.Compare(next.revision, delta.revision) < 0;
	  ELSE
	    ok := RCSRevNum.Compare(next.revision, delta.revision) > 0
	      AND RCSRevNum.Equal(RCSRevNum.Prefix(next.revision),
		RCSRevNum.Prefix(delta.revision));
	  END;
	  IF NOT ok THEN
	    RAISE RCSError.E("Invalid next delta " & next.revision
	      & " for delta " & delta.revision);
	  END;
	  delta.next := next;
	  next.prev := delta;
	  next.diffBase := delta;
	END;
	EatTok(rf);
      ELSIF RCSRevNum.IsTrunk(delta.revision) THEN
	rf.tail := delta;
      END;
      EatType(rf, TokType.Semicolon);

      (* {newphrase}* *)
      delta.treePhrases := ParseNewPhrases(rf);
    END;
  END ParseTree;

PROCEDURE ParseDelta(rf: T; delta: RCSDelta.T)
  RAISES {RCSError.E} =
  BEGIN
    WHILE NOT delta.isParsed DO
      ParseOneDeltaText(rf);
    END;
  END ParseDelta;

PROCEDURE ParseOneDeltaText(rf: T) RAISES {RCSError.E} =
  VAR
    revision: RCSRevNum.T;
    delta: RCSDelta.T;
  BEGIN
    (* num *)
    NeedType(rf, TokType.Num);
    revision := TokText(CurTok(rf));
    EatTok(rf);
    IF NOT rf.deltaTbl.get(revision, delta) THEN
      Oops(rf, "Missing revision " & revision);
    END;

    (* log string *)
    EatKeyword(rf, Keyword.Log);
    NeedType(rf, TokType.String);
    WITH tok = CurTok(rf) DO
      delta.log := NEW(QuotedString, ptr := tok.ptr, len := tok.len);
    END;
    EatTok(rf);

    (* {newphrase}* *)
    delta.textPhrases := ParseNewPhrases(rf);

    (* text string *)
    EatKeyword(rf, Keyword.Text);
    NeedType(rf, TokType.String);
    WITH tok = CurTok(rf) DO
      delta.text := NEW(QuotedString, ptr := tok.ptr, len := tok.len);
    END;
    EatTok(rf);
    delta.isParsed := TRUE;
  END ParseOneDeltaText;

PROCEDURE ParseDesc(rf: T) RAISES {RCSError.E} =
  VAR
    descEndingLine: CARDINAL;
  BEGIN
    (* desc string *)
    EatKeyword(rf, Keyword.Desc);
    NeedType(rf, TokType.String);
    WITH tok = CurTok(rf) DO
      rf.desc := NEW(QuotedString, ptr := tok.ptr, len := tok.len);
    END;
    EatTok(rf);

    (* Peek ahead at the next token, and figure out how many blank lines
       are between the end of the desc string and the start of the next
       token.  This varies depending on whether the initial checkin was
       done via RCS, or directly by CVS import.  We bother to check this
       so that we can try to generate an exact replica of the original
       file when we write it out. *)
    descEndingLine := rf.line;
    EVAL CurTok(rf);
    IF rf.line - descEndingLine - 1 > 2 THEN
      rf.options := rf.options + Options{Option.ExtraLineAfterDesc};
    ELSE
      rf.options := rf.options - Options{Option.ExtraLineAfterDesc};
    END;
  END ParseDesc;

PROCEDURE ParseNewPhrases(rf: T): RCSPhrases.T
  RAISES {RCSError.E} =
  VAR
    phrases: RCSPhrases.T := NIL;
    phrase: RCSPhrase.T;
  BEGIN
    IF HaveKeyword(rf, Keyword.None) THEN
      phrases := RCSPhrases.New();
      REPEAT
	phrase := RCSPhrase.New(TokText(rf.curTok));
	EatTok(rf);
	WHILE HaveType(rf, TokType.Id)
	OR HaveType(rf, TokType.Num)
	OR HaveType(rf, TokType.String)
	OR HaveType(rf, TokType.Colon)
	DO
	  RCSPhrase.Append(phrase, TokText(rf.curTok),
	    HaveType(rf, TokType.String));
	  EatTok(rf);
	END;
	EatType(rf, TokType.Semicolon);
	RCSPhrases.Append(phrases, phrase);
      UNTIL NOT HaveKeyword(rf, Keyword.None);
    END;
    RETURN phrases;
  END ParseNewPhrases;

PROCEDURE EnterDelta(rf: T; revision: RCSRevNum.T): RCSDelta.T =
  VAR
    delta: RCSDelta.T;
  BEGIN
    IF NOT rf.deltaTbl.get(revision, delta) THEN
      delta := NEW(RCSDelta.T, rcsFile := rf, revision := revision);
      EVAL rf.deltaTbl.put(revision, delta);
    END;
    RETURN delta;
  END EnterDelta;

PROCEDURE AddDelta(rf: T;
                   revNum: RCSRevNum.T;
		   diffBase: RCSDelta.T;
                   date: TEXT;
		   author: TEXT;
		   state: TEXT;
		   log: RCSString.T;
		   text: RCSString.T;
		   treePhrases: RCSPhrases.T := NIL;
		   textPhrases: RCSPhrases.T := NIL): RCSDelta.T
  RAISES {RCSError.E} =
  VAR
    delta: RCSDelta.T;
    oldDelta: RCSDelta.T;
    next: RCSDelta.T;
    prev: RCSDelta.T;
    bp: RCSDelta.T;
    branch: RCSDelta.T;
    branchRevNum: RCSRevNum.T;
    bpRevNum: RCSRevNum.T;
  BEGIN
    WITH n = RCSRevNum.NumParts(revNum) DO
      IF n < 2 OR n MOD 2 # 0 THEN
	Oops(rf, "Attempt to add invalid revision number " & revNum);
      END;
    END;
    delta := NEW(RCSDelta.T,
      rcsFile := rf,
      revision := revNum,
      date := date,
      author := author,
      state := state,
      log := log,
      text := text,
      treePhrases := treePhrases,
      textPhrases := textPhrases,
      diffBase := diffBase,
      isParsed := TRUE);

    IF rf.deltaTbl.get(revNum, oldDelta) THEN  (* Delta already exists. *)
      IF NOT oldDelta.isPlaceHolder THEN
	Oops(rf, "Attempt to add existing delta " & revNum);
      END;
      prev := oldDelta.prev;
      next := oldDelta.next;
      delta.branches := oldDelta.branches;
      oldDelta.branches := NIL;
      DeleteDelta(rf, oldDelta);
    ELSE
      oldDelta := NIL;
      prev := NIL;
      next := NIL;
    END;

    IF RCSRevNum.IsTrunk(revNum) THEN
      IF oldDelta = NIL THEN  (* Find the insertion point. *)
	prev := NIL;
	next := rf.head;
	WHILE next # NIL AND RCSRevNum.Compare(next.revision, revNum) >= 0 DO
	  prev := next;
	  next := next.next;
	END;
      END;
      delta.prev := prev;
      delta.next := next;
      IF delta.prev # NIL THEN
	delta.prev.next := delta;
      ELSE
	rf.head := delta;
      END;
      IF delta.next # NIL THEN
	delta.next.prev := delta;
      ELSE
	rf.tail := delta;
      END;
    ELSE
      branchRevNum := RCSRevNum.Prefix(revNum);
      bpRevNum := RCSRevNum.Prefix(branchRevNum);
      IF NOT rf.deltaTbl.get(bpRevNum, bp) THEN
	Oops(rf, "No branch point for adding delta " & revNum);
      END;

      TRY
	branch := RCSDelta.GetBranch(bp, branchRevNum);
      EXCEPT RCSError.E =>
	branch := NIL;
      END;

      IF branch = NIL THEN
	RCSDeltaClass.AddBranch(bp, delta, diffBase);
      ELSE
	IF oldDelta = NIL THEN  (* Find the insertion point. *)
	  prev := bp;
	  next := branch;
	  WHILE next # NIL AND RCSRevNum.Compare(next.revision, revNum) <= 0 DO
	    prev := next;
	    next := next.next;
	  END;
	END;
	delta.prev := prev;
	delta.next := next;
	IF delta.prev # bp THEN
	  delta.prev.next := delta;
	ELSE
	  RCSDeltaClass.ChangeBranch(bp, delta.next, delta);
	END;
	IF delta.next # NIL THEN delta.next.prev := delta END;
      END;
    END;
    EVAL rf.deltaTbl.put(revNum, delta);
    RETURN delta;
  END AddDelta;

PROCEDURE AddTag(rf: T; name: TEXT; revNum: RCSRevNum.T): RCSTag.T
  RAISES {RCSError.E} =
  VAR
    tag := NEW(RCSTag.T, name := name, revNum := revNum);
    rem := RCSRevNum.NumParts(revNum) MOD 2;
    p := rf.tagList;
  BEGIN
    WHILE p # NIL DO
      IF RCSTag.Equal(p.head, tag) AND
	RCSRevNum.NumParts(p.head.revNum) MOD 2 = rem THEN
	Oops(rf, "Attempt to add existing tag " & name);
      END;
      p := p.tail;
    END;
    rf.tagList := RCSTagList.Cons(tag, rf.tagList);
    RETURN tag;
  END AddTag;

PROCEDURE DeleteDelta(rf: T; delta: RCSDelta.T)
  RAISES {RCSError.E} =
  BEGIN
    IF delta.branches # NIL THEN
      Oops(rf, "Attempt to delete delta (" & delta.revision
	& ") with branches");
    END;

    (* Parse the delta, if it has not already been parsed.  We may
       need it to be parsed later, e.g., if it is used as a diff
       base, or if we need to parse through it to get to a delta
       farther down in the file.  Once we have removed it from the
       delta table, it won't be possible to parse it any more, so
       to be safe, we have to do it now. *)
    ParseDelta(rf, delta);

    IF RCSRevNum.IsTrunk(delta.revision) THEN
      IF delta.prev # NIL THEN
	delta.prev.next := delta.next;
      ELSE
	rf.head := delta.next;
      END;
      IF delta.next # NIL THEN
	delta.next.prev := delta.prev;
      ELSE
	rf.tail := delta.prev;
      END;
    ELSE
      IF delta.prev.next # delta THEN  (* First delta on its branch. *)
	IF delta.next = NIL THEN  (* Only delta on its branch. *)
	  RCSDeltaClass.DeleteBranch(delta.prev, delta);
	ELSE
	  RCSDeltaClass.ChangeBranch(delta.prev, delta, delta.next);
	  delta.next.prev := delta.prev;
	END;
      ELSE
	delta.prev.next := delta.next;
	IF delta.next # NIL THEN delta.next.prev := delta.prev END;
      END;
    END;
    delta.next := NIL;
    delta.prev := NIL;
    EVAL rf.deltaTbl.delete(delta.revision, delta);
  END DeleteDelta;

PROCEDURE DeleteTag(rf: T; name: TEXT; revNum: RCSRevNum.T)
  RAISES {RCSError.E} =
  VAR
    p := rf.tagList;
    last: RCSTagList.T := NIL;
  BEGIN
    WHILE p # NIL DO
      IF Text.Equal(p.head.name, name) AND
	RCSRevNum.Equal(p.head.revNum, revNum) THEN
	IF last = NIL THEN
	  rf.tagList := p.tail;
	ELSE
	  last.tail := p.tail;
	END;
	RETURN;
      END;
      last := p;
      p := p.tail;
    END;
    Oops(rf, "No such tag " & name & ":" & revNum);
  END DeleteTag;

PROCEDURE ToWr(rf: T; wr: Wr.T)
  RAISES {RCSError.E, Thread.Alerted, Wr.Failure} =
  BEGIN
    PutAdmin(rf, wr);
    PutDeltas(rf, wr);
    PutDesc(rf, wr);
    PutDeltaTexts(rf, wr);
  END ToWr;

PROCEDURE PutAdmin(rf: T; wr: Wr.T)
  RAISES {Thread.Alerted, Wr.Failure} =
  VAR
    accessIter: AccessIterator;
    access: RCSAccess.T;
    tagIter: TagIterator;
    tag: RCSTag.T;
    headWS: TEXT;
    branchWS: TEXT;
    accessWS: TEXT;
    accessSep: TEXT;
    symbolsWS: TEXT;
    symbolSep: TEXT;
    locksWS: TEXT;
    commentWS: TEXT;
    expandWS: TEXT;
  BEGIN
    IF Option.CVSInitialImport IN rf.options THEN
      headWS := "     ";
      branchWS := "   ";
      accessWS := "   ";
      accessSep := "   ";
      symbolsWS := " ";
      symbolSep := " ";
      locksWS := "    ";
      commentWS := "  ";
      expandWS := "   ";
    ELSE
      headWS := "\t";
      branchWS := "\t";
      accessWS := "";
      accessSep := "\n\t";
      symbolsWS := "";
      symbolSep := "\n\t";
      locksWS := "";
      commentWS := "\t";
      expandWS := "\t";
    END;

    Wr.PutText(wr, "head" & headWS);
    IF rf.head # NIL THEN
      Wr.PutText(wr, rf.head.revision);
    END;
    Wr.PutText(wr, ";\n");
    IF rf.branch # NIL THEN
      Wr.PutText(wr, "branch" & branchWS & rf.branch & ";\n");
    END;

    Wr.PutText(wr, "access" & accessWS);
    accessIter := IterateAccess(rf);
    WHILE accessIter.next(access) DO
      Wr.PutText(wr, accessSep & access.name);
    END;
    Wr.PutText(wr, ";\n");

    Wr.PutText(wr, "symbols" & symbolsWS);
    tagIter := IterateTags(rf);
    WHILE tagIter.next(tag) DO
      Wr.PutText(wr, symbolSep & tag.name & ":" & tag.revNum);
    END;
    Wr.PutText(wr, ";\n");

    Wr.PutText(wr, "locks" & locksWS & ";");  (* FIXME *)
    IF rf.strictLocking THEN
      Wr.PutText(wr, " strict;");
    END;
    Wr.PutChar(wr, '\n');
    IF rf.comment # NIL THEN
      Wr.PutText(wr, "comment" & commentWS & "@");
      PutEscaped(wr, rf.comment);
      Wr.PutText(wr, "@;\n");
    END;
    IF rf.expand # RCSKeyword.ExpandMode.Default THEN
      Wr.PutText(wr, "expand" & expandWS & "@");
      PutEscaped(wr, RCSKeyword.EncodeExpand(rf.expand));
      Wr.PutText(wr, "@;\n");
    END;
    PutPhrases(wr, rf.newPhrases);
    Wr.PutChar(wr, '\n');
  END PutAdmin;

PROCEDURE PutDeltas(rf: T; wr: Wr.T)
  RAISES {Thread.Alerted, Wr.Failure} =
  VAR
    stack: RCSDeltaList.T := NIL;
    delta: RCSDelta.T;
    iter: RCSDelta.Iterator;
    branch: RCSDelta.T;
    dateWS: TEXT;
    authorWS: TEXT;
    stateWS: TEXT;
    branchesWS: TEXT;
    branchesSep: TEXT;
    nextWS: TEXT;
  BEGIN
    IF Option.CVSInitialImport IN rf.options THEN
      dateWS := "     ";
      authorWS := "  ";
      stateWS := "  ";
      branchesWS := " ";
      branchesSep := "";
      nextWS := "     ";
    ELSE
      dateWS := "\t";
      authorWS := "\t";
      stateWS := "\t";
      branchesWS := "";
      branchesSep := "\n\t";
      nextWS := "\t";
    END;

    (* Emit the deltas in preorder.  We use the stack algorithm rather
       than recursion, because the recursion can become quite deep.  Since
       we are running in a thread, we don't have much stack space to waste. *)
    IF rf.head # NIL THEN
      stack := RCSDeltaList.Cons(rf.head, stack);
    END;
    WHILE stack # NIL DO
      (* Pop top delta from stack. *)
      delta := stack.head;
      stack := stack.tail;

      (* Emit the delta. *)
      Wr.PutText(wr, "\n" & delta.revision & "\n");
      Wr.PutText(wr, "date" & dateWS & delta.date & ";" &
	authorWS & "author " & delta.author & ";" &
	stateWS & "state ");
      IF delta.state # NIL THEN Wr.PutText(wr, delta.state) END;
      Wr.PutText(wr, ";\n");

      Wr.PutText(wr, "branches" & branchesWS);
      iter := RCSDelta.IterateBranches(delta);
      WHILE iter.next(branch) DO
	Wr.PutText(wr, branchesSep & branch.revision);
      END;
      Wr.PutText(wr, ";\n");

      Wr.PutText(wr, "next" & nextWS);
      IF delta.next # NIL THEN Wr.PutText(wr, delta.next.revision) END;
      Wr.PutText(wr, ";\n");

      PutPhrases(wr, delta.treePhrases);

      (* Push children in reverse order. *)
      iter := RCSDelta.IterateBranchesReversed(delta);
      WHILE iter.next(branch) DO
	stack := RCSDeltaList.Cons(branch, stack);
      END;
      IF delta.next # NIL THEN
	stack := RCSDeltaList.Cons(delta.next, stack);
      END;
    END;
  END PutDeltas;

PROCEDURE PutDeltaTexts(rf: T; wr: Wr.T)
  RAISES {RCSError.E, Thread.Alerted, Wr.Failure} =
  VAR
    delta: RCSDelta.T;
    stack: RCSDeltaList.T := NIL;
    children: RCSDeltaList.T := NIL;
    iter: RCSDelta.Iterator;
    branch: RCSDelta.T;
  BEGIN
    (* Here again, we use pre-order to output the delta texts.  But when
       a node has multiple children (i.e., there are branches hanging
       off of it), we have to be careful about their relative order.  We
       want the newest children to come first, so we have to push them
       on the stack oldest-first.

       Again here we use a stack algorithm rather than recursion, to
       guard against possible thread stack overflow. *)
    IF rf.head # NIL THEN
      stack := RCSDeltaList.Cons(rf.head, stack);
    END;
    WHILE stack # NIL DO
      (* Pop top delta from stack. *)
      delta := stack.head;
      stack := stack.tail;

      (* Emit the delta text. *)
      Wr.PutText(wr, "\n\n" & delta.revision & "\nlog\n");
      PutString(wr, RCSDelta.GetLog(delta).iterate());
      PutPhrases(wr, delta.textPhrases);
      Wr.PutText(wr, "text\n");
      PutString(wr, RCSDelta.GetText(delta, delta.prev));

      (* Push the children oldest-first.  There is a wrinkle here.
	 We have encountered strange RCS files in which there is
	 a revision 1.1 whose date says it is newer than revision
	 3.0.  This "cannot" have happened, since revision 3.0 is
	 derived from 1.1.  These RCS files were probably created
	 by some sort of hackery, but we would nevertheless like
	 to handle them properly.  To do that, we maintain that
	 any node on the main branch is by definition older than
	 its "prev" node, which is in turn older than any other
	 children (branches). *)

      IF delta.next # NIL THEN
	IF RCSRevNum.IsTrunk(delta.revision) THEN  (* Oldest by definition. *)
	  stack := RCSDeltaList.Cons(delta.next, stack);
	ELSE  (* Handle it like the other children. *)
	  children := RCSDeltaList.Cons(delta.next, children);
	END;
      END;
      iter := RCSDelta.IterateBranches(delta);
      WHILE iter.next(branch) DO
	children := RCSDeltaList.Cons(branch, children);
      END;
      children := RCSDeltaListSort.SortD(children, CompByDate);
      WHILE children # NIL DO
	stack := RCSDeltaList.Cons(children.head, stack);
	children := children.tail;
      END;
    END;
  END PutDeltaTexts;

PROCEDURE PutDesc(rf: T; wr: Wr.T)
  RAISES {Thread.Alerted, Wr.Failure} =
  BEGIN
    Wr.PutText(wr, "\n\ndesc\n");
    PutString(wr, rf.desc.iterate());
    IF Option.ExtraLineAfterDesc IN rf.options THEN
      Wr.PutChar(wr, '\n');
    END;
  END PutDesc;

PROCEDURE PutEscaped(wr: Wr.T; t: TEXT)
  RAISES {Thread.Alerted, Wr.Failure} =
  VAR
    atPos := Text.FindChar(t, '@');
    start: CARDINAL;
  BEGIN
    IF atPos = -1 THEN  (* The usual case, no '@' characters. *)
      Wr.PutText(wr, t);
    ELSE  (* There are some '@' characters that we have to double. *)
      start := 0;
      REPEAT
	Wr.PutText(wr, Text.Sub(t, start, atPos + 1 - start));  (* Thru '@' *)
	start := atPos;  (* Will get the '@' again. *)
	atPos := Text.FindChar(t, '@', atPos + 1);
      UNTIL atPos = -1;
      Wr.PutText(wr, Text.Sub(t, start));
    END;
  END PutEscaped;

PROCEDURE PutPhrase(wr: Wr.T; phrase: RCSPhrase.T)
  RAISES {Thread.Alerted, Wr.Failure} =
  VAR
    iter := RCSPhrase.IterateWords(phrase);
    word: TEXT;
    isString: BOOLEAN;
  BEGIN
    Wr.PutText(wr, RCSPhrase.GetKey(phrase));
    IF iter.next(word, isString) THEN
      LOOP
	Wr.PutChar(wr, '\t');
	IF isString THEN
	  Wr.PutChar(wr, '@'); PutEscaped(wr, word); Wr.PutChar(wr, '@');
	ELSE
	  Wr.PutText(wr, word);
	END;
	IF NOT iter.next(word, isString) THEN EXIT END;
	IF NOT isString AND Text.Equal(word, ":") THEN
	  (* Collapse the common form "word:word" onto a single line. *)
	  Wr.PutChar(wr, ':');
	  IF NOT iter.next(word, isString) THEN EXIT END;
	  IF isString THEN
	    Wr.PutChar(wr, '@'); PutEscaped(wr, word); Wr.PutChar(wr, '@');
	  ELSE
	    Wr.PutText(wr, word);
	  END;
	  IF NOT iter.next(word, isString) THEN EXIT END;
	END;
	Wr.PutText(wr, "\n");
      END;
    END;
    Wr.PutText(wr, ";\n");
  END PutPhrase;

PROCEDURE PutPhrases(wr: Wr.T; phrases: RCSPhrases.T)
  RAISES {Thread.Alerted, Wr.Failure} =
  VAR
    iter: RCSPhrases.Iterator;
    phrase: RCSPhrase.T;
  BEGIN
    IF phrases # NIL THEN
      iter := RCSPhrases.Iterate(phrases);
      WHILE iter.next(phrase) DO
	PutPhrase(wr, phrase);
      END;
    END;
  END PutPhrases;

PROCEDURE PutString(wr: Wr.T; iter: RCSString.Iterator)
  RAISES {Thread.Alerted, Wr.Failure} =
  VAR
    line: RCSString.T;
  BEGIN
    Wr.PutChar(wr, '@');
    WHILE iter.next(line) DO
      PutEscaped(wr, line.toText());
    END;
    Wr.PutText(wr, "@\n");
  END PutString;

PROCEDURE CompByDate(d1, d2: RCSDelta.T): [-1..1] =
  VAR
    c: [-1..1];
  BEGIN
    c := RCSDate.Compare(d1.date, d2.date);

    (* It has occurred that revisions 1.1 and 1.1.1.1 had exactly the
       same date, and 1.1.1.1 happened to come out first from a sort.
       We rely on branches coming out before their respective branch
       points.  To prevent problems, we break date ties by comparing
       revision numbers. *)
    IF c = 0 THEN
      c := RCSRevNum.Compare(d1.revision, d2.revision);
    END;
    RETURN c;
  END CompByDate;

PROCEDURE IteratePhrases(rf: T): RCSPhrases.Iterator =
  BEGIN
    RETURN RCSPhrases.Iterate(rf.newPhrases);
  END IteratePhrases;

PROCEDURE AddPhrase(rf: T; phrase: RCSPhrase.T) =
  BEGIN
    IF rf.newPhrases = NIL THEN
      rf.newPhrases := RCSPhrases.New();
    END;
    RCSPhrases.Append(rf.newPhrases, phrase);
  END AddPhrase;

PROCEDURE DeletePhrases(rf: T) =
  BEGIN
    rf.newPhrases := NIL;
  END DeletePhrases;

TYPE
  AccessIteratorImpl = AccessIterator OBJECT
    cur: RCSAccessList.T;
  OVERRIDES
    next := NextAccess;
  END;

  TagIteratorImpl = TagIterator OBJECT
    cur: RCSTagList.T;
  OVERRIDES
    next := NextTag;
  END;

PROCEDURE IterateByNumber(rf: T; up: BOOLEAN := TRUE): RCSDeltaTbl.Iterator =
  BEGIN
    RETURN rf.deltaTbl.iterateOrdered(up);
  END IterateByNumber;

PROCEDURE IterateAccess(rf: T): AccessIterator =
  BEGIN
    RETURN NEW(AccessIteratorImpl, cur := rf.accessList);
  END IterateAccess;

PROCEDURE IterateTags(rf: T): TagIterator =
  BEGIN
    RETURN NEW(TagIteratorImpl, cur := rf.tagList);
  END IterateTags;

PROCEDURE IterateTagsByName(rf: T): TagIterator =
  BEGIN
    RETURN NEW(TagIteratorImpl, cur := RCSTagListSort.Sort(rf.tagList));
  END IterateTagsByName;

PROCEDURE NextAccess(iter: AccessIteratorImpl; VAR access: RCSAccess.T): BOOLEAN =
  BEGIN
    IF iter.cur = NIL THEN RETURN FALSE END;
    access := iter.cur.head;
    iter.cur := iter.cur.tail;
    RETURN TRUE;
  END NextAccess;

PROCEDURE NextTag(iter: TagIteratorImpl; VAR tag: RCSTag.T): BOOLEAN =
  BEGIN
    IF iter.cur = NIL THEN RETURN FALSE END;
    tag := iter.cur.head;
    iter.cur := iter.cur.tail;
    RETURN TRUE;
  END NextTag;

PROCEDURE EncodeOptions(options: Options): TEXT =
  VAR
    flags: Word.T := 0;
  BEGIN
    FOR o := FIRST(Option) TO LAST(Option) DO
      IF o IN options THEN
	flags := Word.Or(flags, Word.LeftShift(1, ORD(o)));
      END;
    END;
    RETURN Fmt.Unsigned(flags, 10);
  END EncodeOptions;

PROCEDURE DecodeOptions(text: TEXT): Options
  RAISES {RCSError.E} =
  VAR
    options := Options{};
  BEGIN
    TRY
      WITH flags = TokScan.AtoI(text) DO
	FOR o := FIRST(Option) TO LAST(Option) DO
	  IF Word.And(flags, Word.LeftShift(1, ORD(o))) # 0 THEN
	    options := options + Options{o};
	  END;
	END;
      END;
      RETURN options;
    EXCEPT TokScan.Error =>
      RAISE RCSError.E("Invalid RCSFile option encoding");
    END;
  END DecodeOptions;

PROCEDURE EatTok(rf: T) =
  BEGIN
    EVAL CurTok(rf);
    rf.curTok.type := TokType.None;
  END EatTok;

PROCEDURE EatType(rf: T; type: TokType) RAISES {RCSError.E} =
  BEGIN
    NeedType(rf, type);
    EatTok(rf);
  END EatType;

PROCEDURE EatKeyword(rf: T; key: Keyword) RAISES {RCSError.E} =
  BEGIN
    NeedKeyword(rf, key);
    EatTok(rf);
  END EatKeyword;

PROCEDURE NeedType(rf: T; type: TokType) RAISES {RCSError.E} =
  BEGIN
    IF NOT HaveType(rf, type) THEN
      Oops(rf, "\"" & TokTypeName(type) & "\" expected");
    END;
  END NeedType;

PROCEDURE NeedKeyword(rf: T; key: Keyword) RAISES {RCSError.E} =
  BEGIN
    IF NOT HaveKeyword(rf, key) THEN
      Oops(rf, "\"" & KeywordName(key) & "\" expected");
    END;
  END NeedKeyword;

PROCEDURE HaveType(rf: T; type: TokType): BOOLEAN =
  BEGIN
    RETURN CurTok(rf).type = type;
  END HaveType;

PROCEDURE HaveKeyword(rf: T; key: Keyword): BOOLEAN =
  BEGIN
    RETURN HaveType(rf, TokType.Id) AND
      CurTok(rf).keyword = key;
  END HaveKeyword;

PROCEDURE CurTok(rf: T): Token =
  BEGIN
    IF rf.curTok.type = TokType.None THEN
      GetToken(rf);
    END;
    RETURN rf.curTok;
  END CurTok;

PROCEDURE Oops(rf: T; msg: TEXT) RAISES {RCSError.E} =
  BEGIN
    RAISE RCSError.E(Fmt.Int(rf.line) & ": " & msg);
  END Oops;

TYPE
  Token = REF RECORD
    type: TokType := TokType.None;
    keyword: Keyword := Keyword.None;
    line: CARDINAL;
    ptr: UNTRACED REF CHAR;
    len: CARDINAL;
  END;

  TokType = {
    Colon,
    Id,		(* also includes Sym *)
    Num,
    Semicolon,
    String,

    Bad,

    EOF,

    None
  };

  Keyword = {
    Access,
    Author,
    Branch,
    Branches,
    Comment,
    Date,
    Desc,
    Expand,
    Head,
    Locks,
    Log,
    Next,
    State,
    Strict,
    Symbols,
    Text,

    None
  };

PROCEDURE KeywordName(key: Keyword): TEXT =
  BEGIN
    CASE key OF
    | Keyword.Access	=> RETURN "access";
    | Keyword.Author	=> RETURN "author";
    | Keyword.Branch	=> RETURN "branch";
    | Keyword.Branches	=> RETURN "branches";
    | Keyword.Comment	=> RETURN "comment";
    | Keyword.Date	=> RETURN "date";
    | Keyword.Desc	=> RETURN "desc";
    | Keyword.Expand	=> RETURN "expand";
    | Keyword.Head	=> RETURN "head";
    | Keyword.Locks	=> RETURN "locks";
    | Keyword.Log	=> RETURN "log";
    | Keyword.Next	=> RETURN "next";
    | Keyword.State	=> RETURN "state";
    | Keyword.Strict	=> RETURN "strict";
    | Keyword.Symbols	=> RETURN "symbols";
    | Keyword.Text	=> RETURN "text";
    | Keyword.None	=> RETURN "none";
    END;
  END KeywordName;

PROCEDURE TokText(tok: Token): TEXT =
  BEGIN
    IF tok.type = TokType.String THEN
      RETURN CText.CopyQuotedMtoT(tok.ptr, tok.len);
    ELSE
      RETURN CText.CopyMtoT(tok.ptr, tok.len);
    END;
  END TokText;

PROCEDURE TokTypeName(type: TokType): TEXT =
  BEGIN
    CASE type OF
    | TokType.Colon		=> RETURN "Colon";
    | TokType.Id		=> RETURN "Id";
    | TokType.Num		=> RETURN "Num";
    | TokType.Semicolon		=> RETURN "Semicolon";
    | TokType.String		=> RETURN "String";
    | TokType.Bad		=> RETURN "Bad";
    | TokType.EOF		=> RETURN "EOF";
    | TokType.None		=> RETURN "None";
    END;
  END TokTypeName;

TYPE
  (* Base classes with common portions of the implementation. *)

  String = RCSString.T OBJECT
    ptr: UNTRACED REF CHAR;
    len: CARDINAL;
  OVERRIDES
    numLines := StrNumLines;
    toText := NIL;	(* Must be overridden. *)
    iterate := NIL;	(* Must be overridden. *)
  END;

  StringIter = RCSString.Iterator OBJECT
    ptr: UNTRACED REF CHAR;
    lim: UNTRACED REF CHAR;
  OVERRIDES
    next := NIL;	(* Must be overridden. *)
  END;

PROCEDURE StrNumLines(s: String): CARDINAL =
  VAR
    ptr := s.ptr;
    lim := s.ptr + s.len;
    numLines: CARDINAL := 0;
  BEGIN
    WHILE ptr < lim DO
      INC(numLines);
      WHILE ptr < lim AND ptr^ # '\n' DO  (* Find the next newline. *)
	INC(ptr);
      END;
      IF ptr = lim THEN EXIT END;
      INC(ptr);
    END;
    RETURN numLines;
  END StrNumLines;

TYPE
  SimpleString = String OBJECT OVERRIDES
    toText := SSToText;
    iterate := SSIterate;
  END;

  SimpleStringIter = StringIter OBJECT OVERRIDES
    next := SSNext;
  END;

PROCEDURE SSToText(s: SimpleString): TEXT =
  BEGIN
    RETURN CText.CopyMtoT(s.ptr, s.len);
  END SSToText;

PROCEDURE SSIterate(s: SimpleString): RCSString.Iterator =
  BEGIN
    RETURN NEW(SimpleStringIter, ptr := s.ptr, lim := s.ptr + s.len);
  END SSIterate;

PROCEDURE SSNext(iter: SimpleStringIter; VAR line: RCSString.T): BOOLEAN =
  VAR
    start := iter.ptr;
  BEGIN
    IF iter.ptr >= iter.lim THEN
      RETURN FALSE;
    END;

    WHILE iter.ptr < iter.lim AND iter.ptr^ # '\n' DO
      INC(iter.ptr);
    END;
    IF iter.ptr < iter.lim THEN  (* Include the newline too *)
      INC(iter.ptr);
    END;
    line := NEW(SimpleString, ptr := start, len := iter.ptr-start);
    RETURN TRUE;
  END SSNext;

TYPE
  QuotedString = String OBJECT OVERRIDES
    toText := QSToText;
    iterate := QSIterate;
  END;

  QuotedStringIter = StringIter OBJECT OVERRIDES
    next := QSNext;
  END;

PROCEDURE QSToText(s: QuotedString): TEXT =
  BEGIN
    RETURN CText.CopyQuotedMtoT(s.ptr, s.len);
  END QSToText;

PROCEDURE QSIterate(s: QuotedString): RCSString.Iterator =
  BEGIN
    RETURN NEW(QuotedStringIter, ptr := s.ptr, lim := s.ptr + s.len);
  END QSIterate;

PROCEDURE QSNext(iter: QuotedStringIter; VAR line: RCSString.T): BOOLEAN =
  VAR
    start := iter.ptr;
  BEGIN
    IF iter.ptr >= iter.lim THEN
      RETURN FALSE;
    END;

    WHILE iter.ptr < iter.lim AND iter.ptr^ # '\n' DO
      INC(iter.ptr);
    END;
    IF iter.ptr < iter.lim THEN  (* Include the newline too *)
      INC(iter.ptr);
    END;
    line := NEW(QuotedString, ptr := start, len := iter.ptr-start);
    RETURN TRUE;
  END QSNext;

BEGIN
  FOR key := FIRST(Keyword) TO LAST(Keyword) DO
    IF key # Keyword.None THEN
      EVAL keyTab.put(KeywordName(key), ORD(key));
    END;
  END;
END RCSFile.