{ standard utilities for Turbo Pascal, a la Kernighan and Plauger } procedure halt; { halts program, returns to operating system } begin bdos(0); end; procedure error(s:string80); { writes msg., then halts } { may require macro implementation on some systems } begin writeln(s); halt; end; function islower(c:character):boolean; { returns 'true' if c is lower case } begin islower := (chartbl[c]='L'); end; function isupper(c:character):boolean; { returns 'true' if c is upper case } begin isupper := (chartbl[c]='U'); end; function toupper(c:character):character; { converts a character to upper case } begin if islower(c) then toupper := c - CASEDIFF else toupper := c; end; function uc(c:character):character; { alias for toupper } begin uc := toupper(c); end; function tolower(c:character):character; { makes a character lower-case } begin if isupper(c) then tolower := c + CASEDIFF else tolower := c; end; function isletter(c:character):boolean; { returns 'true' if c is a letter } begin isletter := (chartbl[c] = 'L') or (chartbl[c] = 'U'); end; function isdigit(c:character):boolean; { returns 'true' if c is a digit } begin isdigit := (chartbl[c] = 'D'); end; function isalphanum(c:character):boolean; { returns 'true' if character is a number or a digit } begin isalphanum := chartbl[c] <> 'X'; end; function max(x,y:integer):integer; { returns maximum of x and y } begin if x>y then max := x else max := y; end; function min(x,y:integer):integer; { returns minimum of x and y } begin if xEOS) do begin ls := ls + 1; i:=i+1 end; slength := ls; end; function addstr(c:character; var outset: textline; var j:integer; maxset: integer):boolean; { add c to outset[j]; if it fits, increment j. } begin if (j>maxset) then addstr := false else begin outset[j] := c; j := j + 1; addstr := true; end; end; function concat(var s1,s2:textline):boolean; { adds s2 to the end of s1, returns true if not overflow } var i,j :integer; toomuch :boolean; begin i := slength(s1)+1; j:=1; toomuch := false; while (not toomuch) and (s2[j]<>EOS) do begin toomuch := not addstr(s2[j],s1,i,MAXSTR); if not toomuch then j := j + 1; end; s1[i] := EOS; concat := not toomuch; end; procedure setstring(var st:textline; ss:string80); { initializes string variable st to literal string ss } { this may require a macro implementation for some compilers } var i :integer; begin i := 1; while i <= min(ord(ss[0]),MAXSTR) do begin st[i] := ord(ss[i]); i := i + 1; end; st[i] := EOS; end; function makestring(var s:textline):string80; { converts our string format to native string format } { needed for implementation of some primitives, should not be called by application programs } var i : integer; ns :string80; begin ns := ''; i := 1; while s[i] <> EOS do begin ns := ns + chr(s[i]); i := i + 1; end; makestring := ns; end; function index(c:character; start:integer; var s:textline):integer; { searches for character c, starting at s[start] } { returns index at which s[index]=c, or 0 if c is not in s } { caution: may bomb if start not in 1..length(s) } var k :integer; begin k := start; while not (s[k] in [c,EOS]) do k := k + 1; if s[k] = EOS then index := 0 else index := k; end; function skipsp(var s:textline;var i:integer):character; { skips spaces and tabs, returns 1st non-blank char. and index to it } begin while s[i] in [SPACE,TAB] do i:=i+1; skipsp := s[i]; end; procedure scopy(var src: textline; i :integer; var dest: textline; j :integer); { copy string from src[i] to dest[j] until EOS } begin while src[i] <> EOS do begin dest[j] := src[i]; i := i + 1; j := j + 1; end; dest[j] := EOS; end; function equal(var s1,s2:textline):boolean; { test two strings for equality } var i :integer; begin i := 1; while (s1[i] = s2[i]) and (s1[i] <> EOS) do i := i + 1; equal := s1[i] = s2[i]; end; function ctoi(var s:textline; var i:integer):integer; { converts string at s[i] to integer, increments i to point past string } var n,sign :integer; c :character; begin if skipsp(s,i) = minus then sign := - 1 else sign := + 1; if s[i] in [PLUS,MINUS] then i := i + 1; n := 0; while isdigit(s[i]) do begin n := 10*n + s[i] - ord('0'); i := i + 1; end; ctoi := sign*n; end; {$a-} function itoc(n:integer; var s:textline; i: integer): integer; { converts integer n to character string s[i], returns end of s } begin if (n<0) then begin s[i] := minus; itoc := itoc(-n,s,i+1); end else begin if (n >= 10) then i := itoc(n div 10,s,i); s[i] := n mod 10 + ord('0'); s[i+1] := EOS; itoc := i + 1; end; end; {$a+}