ENVIRON DOCDHGLOBDEFSPASF\STDUTIL PASe+ZSTDIO PASG6 Notes on the Pascal environment (GLOBDEFS.PAS, STDIO.PAS, STDUTIL.PAS) by Jon Dart These are "include files" that implement a programming environment similar to that used by Kernighan and Plauger in their book "Software Tools in Pascal" (Addison-Wesley, 1981). The following is a brief explanation of what these files do and why they do it in the way they do, with emphasis on the features in them that are different from K & P. For several reasons, I have chosen not to implement exactly the same environment used by K & P. One reason is that I consider I/O redirection to be unnecessary and even undesirable in some respects. For example, most of the programs written by K & P take their input from the command line. This is nice because it allows redirection (e.g. input can come from a file instead of the keyboard), but it also results in a condensed and rather cryptic command syntax. UNIX hackers may be able to remember all the one-letter switches required by their favorite programs, but ordinary mortals may have trouble with this. I prefer menu-driven programs. Another thing I have noticed is that K & P's programs tend to minimize all "unnecessary" screen output. This is related to the requirement for redirection, since it enables the program to be run as a background job (under UNIX and similar operating systems). But I like a program to let me know what it is doing while it is running. These prejudices aside, what I like about K & P's approach is the degree of machine independence it is able to achieve. Their basic idea is that you write a set of "primitives" that handle machine- dependent functions (like opening a file), and then write all your programs in terms of these primitives. This means that when the time comes to port your programs to another machine or another operating system, all you have to do (in theory) is to rewrite the primitives. For a program to be truly machine independent, it is also necessary to avoid the use of non-standard language features in the body of the program. Turbo Pascal has a lot of really nifty features like string variables, string functions, inline machine code, direct access to memory and ports, etc., but if you use any of these features you are no longer writing in standard Pascal and you are creating a big headache for yourself or for others who may want to run the same program using a different compiler. For this reason, I have avoided as much as possible the use of Turbo Pascal's non-standard extensions, except as necessary to implement the primitives in STDIO and STDUTIL. When string variables are needed, I have declared them to be of type "textline". This type is defined in GLOBDEFS.PAS as an array of type "character". The end of the string is marked with a special character (EOS). This is more convenient than Turbo Pascal's built-in strings, which store the length value at the start of the string and don't mark its end. A number of procedures are available in file STDUTIL.PAS to manipulate arrays of type "textline". One of these procedures, "setstring", allows assigning a quoted string constant to a "textline". E.g. instead of saying: s := 'This is a string'; { s is of type string } you have to say: setstring(s,'This is a string'); { s of type textline } I admit that the first form is more convenient, but it is non- standard and some compilers won't accept it. The second form is also non-standard (quoted strings aren't allowed as procedure parameters in standard Pascal), but at least it formally hides the details of how the assignment is made inside a procedure. As discussed in K & P, setstring can be implemented as a macro for compilers that won't allow quoted strings in a procedure call. For I/O operations, I assume that your computer has a keyboard, a screen, a printer, and one or more disk drives. The keyboard, screen and printer are assigned to logical devices as follows: TRMIN = the keyboard TRMOUT = the screen PRINTER = the printer. The procedure "getc" reads a single character from the keyboard, and "putc" writes a single character to the screen. Since I assume that the "standard input" is always the keyboard, and since redirection is not permitted, putc(c) is equivalent to write(chr(c)). Note that putc expects its argument to be of type "character" (defined as 0..127), while write expects its argument to be of type "char". The procedures "getcf" and "putcf" perform read and write operations to devices other than the screen and keyboard, e.g. "putcf(c,PRINTER)" writes a character to the printer. Getcf returns a special character ENDFILE when it reaches the end of a file, and it translates CR or LF into a character NEWLINE. "Getline" reads a variable of type textline from the keyboard or a file, and "Putstr" writes a variable of type textline to the screen, the printer, or a disk file. I use write and writeln only to send string constants to the screen (e.g. write('Hello')), which is allowed in standard Pascal. When a string variable (textline) has to be sent to the screen, I use putstr, because writeln doesn't recognize my type of string variable. All programs running under this environment must call a procedure "ioinit" before using the procedures in STDIO or STDUTIL. "ioinit" takes a single parameter that is the maximum number of disk files you expect to have open at one time. "ioinit" must be called even if you do not use any disk files, since it also initializes a table used by the routines "toupper", "tolower", "isupper", "islower", "isletter", "isdigit" and "isalphanum". To open a file for I/O operations, you call the procedure "open", which expects the name of the file (as a variable of type textline) and an "access mode", which can be "IOREAD", "IOWRITE" or "IOAPPEND". "IOAPPEND" allows tacking characters onto the end of an already existing file. A constant "BINARY" can also be added to the access mode. Currently the only effect of this is to prevent a ^Z from being added to the file when it is closed. "Open" returns an internal name for the file (of type filedesc), which can then be used by getcf and putcf to access the file. All disk I/O is buffered. When a read operation takes place on a file, a minimum of 1K bytes are read and stored in a buffer. When the buffer is empty, another 1K bytes are read, and so on until the end of the file. Similarly, when something is written to a file, it goes into a 2K buffer and the buffer is written to the disk only when it is full or when the file is closed. This buffering is a built-in option in the CP/M-86 and PCDOS versions of Turbo Pascal, but it is not available in the CP/M-80 version, whose built-in procedures always reads and write 128 bytes at a time. This causes the disk drive to do a lot of unnecessary seeks, especially if the program is reading input from one file and writing output to another file on the same disk. I got tired of listening to my disk drive thrash around like this, so I put in the buffered I/O feature. Because of the overhead this involves, it probably slows down program execution, but at least it is quieter and easier on the disk drives. The disk read procedure goes through some rather awkward code to test for the physical end of a file, because it was written to run under Turbo Pascal 2.0, whose "blockread" procedure doesn't return the number of blocks read. Version 3.0 does return this information, but I haven't modified the program to take advantage of this. const TRMIN = 1; TRMOUT = 2; PRINTER = 3; ENDFILE = 26; {end-of-file char. returned by getc} EOS = 0; ENDSTR = EOS; FBUFSIZE = 1024; {file buffer size, must be multiple of SECTSIZE} SECTSIZE = 128; {CP/M sector size} CASEDIFF = 32; { ord('a') - ord('A') } MAXSTR = 82; MAXTEXT = 80; IOERROR = 0; IONAVAIL = IOERROR; IOAVAIL = 7; IOREAD = 2; IOWRITE = 3; IOAPPEND = 4; MODEMASK = $07; BINMASK = $80; BINARY = $80; {this bit set hi in mode byte means no ^Z at end of file} MAXOPEN = 7; null = 0; bel = 7; bks = 8; tab = 9; newline = 10; lf = 10; cr = 13; eofchar = 26; {CP/M end-of-file} esc = 27; us = 31; space = 32; exclam = 33; dquote = 34; numsign = 35; dollar = 36; percent = 37; amper = 38; squote = 39; lparen = 40; rparen = 41; star = 42; plus = 43; comma = 44; minus = 45; hyphen = 45; period = 46; slash = 47; DIGIT0 = 48; DIGIT1 = 49; DIGIT2 = 50; DIGIT3 = 51; DIGIT4 = 52; DIGIT5 = 53; DIGIT6 = 54; DIGIT7 = 55; DIGIT8 = 56; DIGIT9 = 57; colon = 58; semicol = 59; semicolon = semicol; less = 60; equals = 61; greater = 62; question = 63; atsign = 64; CAPA = 65; CAPB = 66; CAPC = 67; CAPD = 68; CAPE = 69; CAPF = 70; CAPG = 71; CAPH = 72; CAPI = 73; CAPJ = 74; CAPK = 75; CAPL = 76; CAPM = 77; CAPN = 78; CAPO = 79; CAPP = 80; CAPQ = 81; CAPR = 82; CAPS = 83; CAPT = 84; CAPU = 85; CAPV = 86; CAPW = 87; CAPX = 88; CAPY = 89; CAPZ = 90; lbrack = 91; backslash = 92; rbrack = 93; caret = 94; underline = 95; uscore = underline; grave = 96; SMALLA = 97; SMALLB = 98; SMALLC = 99; SMALLD = 100; SMALLE = 101; SMALLF = 102; SMALLG = 103; SMALLH = 104; SMALLI = 105; SMALLJ = 106; SMALLK = 107; SMALLL = 108; SMALLM = 109; SMALLN = 110; SMALLO = 111; SMALLP = 112; SMALLQ = 113; SMALLR = 114; SMALLS = 115; SMALLT = 116; SMALLU = 117; SMALLV = 118; SMALLW = 119; SMALLX = 120; SMALLY = 121; SMALLZ = 122; lbrace = 123; bar = 124; rbrace = 125; tilde = 126; del = 127; type character = 0..127; ctabtype = array[0..127] of char; textline = array[1..MAXSTR] of character; filedesc = IOERROR..MAXOPEN; string80 = string[80]; {internal strings, used to interface w. built-in non-standard procedures, functions } fbuf = array[1..FBUFSIZE] of byte; { file buffer } ioblock = record { info needed to access one disk i/o channel } filevar :file; fbufptr :^fbuf; eofflag :boolean; bufindx :integer; reccnt :integer; {record count, used only in read mode} lastrec :integer; {last record, used only in read mode} mode :byte; end; var openlist :array[1..MAXOPEN] of ioblock; chartbl :ctabtype; { 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+} { last mod 04-Jul-85 } {$X-} procedure ioinit(numfiles:integer); { initialize i/o variables, character table } var i :integer; fbp :^fbuf; begin if numfiles + 3 > MAXOPEN then error('Too many files requested.'); openlist[TRMIN].mode := IOREAD; openlist[TRMOUT].mode := IOWRITE; openlist[PRINTER].mode := IOWRITE; for i:=PRINTER+1 to PRINTER+numfiles do with openlist[i] do begin new(fbp); fbufptr := fbp; mode := IOAVAIL; end; for i:=PRINTER+numfiles+1 to MAXOPEN do openlist[i].mode := IONAVAIL; for i:=0 to 47 do chartbl[i] := 'X'; for i:=48 to 57 do chartbl[i] := 'D'; for i:=58 to 64 do chartbl[i] := 'X'; for i:=65 to 90 do chartbl[i] := 'U'; for i:=91 to 96 do chartbl[i] := 'X'; for i:=97 to 122 do chartbl[i] := 'L'; for i:=123 to 127 do chartbl[i] := 'X'; end; function open(var name:textline; accmode:integer):filedesc; { open a file with the given name for access in the given mode } var intname :string80; found :boolean; i :integer; function openfile(accmode:integer; var iostuff: ioblock; var intname: string80) :boolean; { machine-dependent subroutine, attempts to open file with name intname and mode accmode. If open ok, initializes iostuff and returns 'true'. If error, returns 'false' } var foundcz :boolean; j :integer; fs :integer; mode2 :byte; begin {$i-} openfile := false; with iostuff do begin assign(filevar,intname); if ioresult = 0 then begin mode2 := accmode and MODEMASK; if mode2 = IOREAD then begin reset(filevar); lastrec := filesize(filevar); reccnt := 0; bufindx := FBUFSIZE+1; end else if mode2 = IOWRITE then begin rewrite(filevar); bufindx := 1; end else if mode2 = IOAPPEND then begin reset(filevar); fs := filesize(filevar); if (ioresult = 0) and (fs > 0) then { file already exists } begin seek(filevar,fs-1); blockread(filevar,fbufptr^,1); seek(filevar,fs-1); { to overwrite last sector of file } j := 1; foundcz := false; while (j<=SECTSIZE) and (not foundcz) do begin foundcz := ord(fbufptr^[j]) = eofchar; if not foundcz then j:=j+1; end; bufindx := j; end else { file doesn't exist, create it } begin rewrite(filevar); bufindx := 1; end; end; if ioresult = 0 then begin openfile := true; mode := accmode; { flag file open } eofflag := false; end; end {$i+} end; end; { openfile } begin { open } intname := makestring(name); open := IOERROR; found := false; i := 1; while (i<=MAXOPEN) and (not found) do begin found := (openlist[i].mode = IOAVAIL); if found then begin if openfile(accmode,openlist[i],intname) then open := i; end else i := i + 1; end; end { open }; {$X+} procedure remove(var name:textline); { removes a file } var filvar :file; intname :string80; begin {$i-} intname := makestring(name); assign(filvar,intname); {$i+} if ioresult = 0 then erase(filvar); end; procedure putc(c:character); { puts 1 character to std. output } begin if c = NEWLINE then writeln else write(chr(c)); end; {$b-} function keyin(var c:character):character; { gets a char. from the keyboard, doesn't echo it} var ch :char; begin read(Kbd,ch); c := ord(ch); if (c = eofchar) then c := ENDFILE else if c = CR then c := NEWLINE; keyin := c; end; {$b+} function getc(var c:character):character; { get 1 character from keyboard, echo it to screen} var ch :char; begin c := keyin(c); putc(c); getc := c; end; function getbyte(var b:byte; fd:filedesc): boolean; { reads a binary byte from the file, returns false if physical end of file } begin getbyte := true; with openlist[fd] do begin if eofflag then getbyte := false else begin if (bufindx > FBUFSIZE) then begin if eof(filevar) then begin getbyte := false; eofflag := true; end else begin {$i-} blockread(filevar,fbufptr^[1],FBUFSIZE div SECTSIZE); {$i+} if not (ioresult in [$99,0]) then error('Disk read error'); end; bufindx := 1; end; b := fbufptr^[bufindx]; if bufindx and (SECTSIZE-1) = 0 then {don't read past last record} begin reccnt:=reccnt+1; if reccnt>=lastrec then eofflag := true; end; bufindx := bufindx + 1; end; end; end; { getbyte} function getcf(var c:character; fd: filedesc):character; { get a character from a file } var junk :boolean; b :byte; begin if fd = TRMIN then getcf := getc(c) else with openlist[fd] do begin if getbyte(b,fd) then begin c := b and $7F; if c = eofchar then begin c := ENDFILE; eofflag := true; end else begin if (c = CR) or (c = LF) then begin junk := getbyte(b,fd); c := NEWLINE; end end; end else c:=ENDFILE; getcf := c; end; end { getcf }; procedure putbyte(b:byte; fd:filedesc); { writes a binary byte to the file } begin with openlist[fd] do begin fbufptr^[bufindx] := b; bufindx := bufindx + 1; if bufindx > FBUFSIZE then begin {$i-} blockwrite(filevar,fbufptr^[1],FBUFSIZE div SECTSIZE); {$i+} if ioresult<>0 then error('Disk write error'); bufindx := 1; end end end; { putbyte } procedure putcf(c:character; fd: filedesc); { put a character to a file } begin if fd = TRMOUT then putc(c) else if fd = PRINTER then begin if c = NEWLINE then writeln(lst) else write(lst,chr(c)); end else begin if c = NEWLINE then { do cr first } begin putbyte(CR,fd); c := LF; end; putbyte(c,fd); end; end { putcf }; procedure pclose(fd: filedesc); { close a file } begin if not (fd in [TRMIN,TRMOUT,PRINTER]) then with openlist[fd] do begin if ((mode and MODEMASK) in [IOWRITE,IOAPPEND]) then { flush last buffer } begin if (mode and BINMASK) = 0 then putcf(eofchar,fd); if bufindx > 1 then blockwrite(filevar,fbufptr^[1], ((bufindx-2) div SECTSIZE)+1); end; close(filevar); mode := IOAVAIL; end; end; function getline(var s:textline; fd:filedesc; maxsize:integer):boolean; { gets line from file, returns false if end of file } var i :integer; c :character; begin i := 1; repeat if fd = TRMIN then {handle terminal line editing } begin s[i] := keyin(c); if (c=bks) then begin if (i>1) then begin i := i - 1; putc(bks); putc(space); putc(bks) end end else if ((c>=32) and (c<>127)) or (c=NEWLINE) then begin i := i + 1; putc(c) end end else begin s[i] := getcf(c,fd); i := i + 1; end until (c = NEWLINE) or (c = ENDFILE) or (i>=maxsize); if c = ENDFILE then i := i - 1; s[i] := EOS; getline := (c <> ENDFILE); end; procedure putstr(var str:textline; fd:filedesc); { put string in a file } var i :integer; begin i := 1; while str[i] <> EOS do begin putcf(str[i],fd); i := i + 1; end; end; function getfile(var filevar :filedesc; var prompt:textline; var name:textline; mode:integer) :boolean; { get file name from keyboard and open file, returns 'false' if CR entered after prompt } var openok,nofile :boolean; junk :boolean; fd :filedesc; lenname :integer; begin openok := false; repeat putstr(prompt,TRMOUT); {$u+} junk := getline(name,TRMIN,MAXSTR); {$u-} lenname := slength(name); if name[lenname] = NEWLINE then name[lenname] := EOS; nofile := (name[1] in [EOS,NEWLINE]); if not nofile then begin fd := open(name,mode); openok := fd <> IOERROR; if openok then begin filevar := fd; getfile := true; end else begin writeln; write('Can''t open: '); putstr(name,TRMOUT); writeln; end end else getfile := false; until openok or nofile; end;