├── orig ├── util │ ├── util.h │ ├── isdigit.p │ ├── max.cc │ ├── min.cc │ ├── islower.p │ ├── isupper.p │ ├── max.p │ ├── min.p │ ├── length.cc │ ├── isletter.p │ ├── fcopy.p │ ├── length.p │ ├── isalphanum.p │ ├── equal.p │ ├── addstr.cc │ ├── putdec.p │ ├── index.cc │ ├── scopy.p │ ├── itoctest.p │ ├── index.p │ ├── mustopen.p │ ├── addstr.p │ ├── mustcreate.p │ ├── itoc.p │ ├── esc.p │ ├── esc.cc │ ├── ctoi.p │ └── utility.p ├── fileio │ ├── fileio.h │ ├── diffmsg.p │ ├── diffmsg.cc │ ├── concat.p │ ├── concat.cc │ ├── dcompare.p │ ├── makecopy.p │ ├── dcompare.cc │ ├── include.p │ ├── makecopy.cc │ ├── getword.p │ ├── include.cc │ ├── getword.cc │ ├── finclude.p │ ├── compare0.p │ ├── finclude.cc │ └── compare0.cc ├── edit │ ├── edittype.p │ ├── editvar.p │ ├── edprim.p │ ├── clrbuf1.p │ ├── putmark.p │ ├── chngcons.p │ ├── getmark.p │ ├── chngproc.p │ ├── clrbuf2.p │ ├── gettxt1.p │ ├── nextln.p │ ├── prevln.p │ ├── skipbl.p │ ├── getpat.p │ ├── getsub.p │ ├── edprim1.p │ ├── edprim2.p │ ├── edtype2.p │ ├── setbuf1.p │ ├── edtype1.p │ ├── reverse.p │ ├── gettxt2.p │ ├── match.p │ ├── amatch0.p │ ├── default.p │ ├── blkmove.p │ ├── lndelete.p │ ├── findcons.p │ ├── amatch1.p │ ├── doprint.p │ ├── puttxt1.p │ ├── move.p │ ├── putsub.p │ ├── ckp.p │ ├── stclose.p │ ├── puttxt2.p │ ├── find.p │ ├── altpatsize.p │ ├── edvar1.p │ ├── patsize.p │ ├── dowrite.p │ ├── getword.p │ ├── locate.p │ ├── patscan.p │ ├── catsub.p │ ├── seek.p │ ├── setbuf2.p │ ├── getrhs.p │ ├── optpat.p │ ├── append.p │ ├── change.p │ ├── getccl.p │ ├── subline.p │ ├── makesub.p │ ├── getfn.p │ ├── doglob.p │ ├── doread.p │ ├── edvar2.p │ ├── editproc.p │ ├── editcons.p │ ├── getnum.p │ ├── getlist.p │ └── ckglob.p ├── ucsdprims │ ├── Call.p │ ├── nargs.p │ ├── putc.p │ ├── getc.p │ ├── endcmd.p │ ├── fcopy.p │ ├── fputcf.p │ ├── putstr.p │ ├── putdec.p │ ├── getarg.p │ ├── strname.p │ ├── mustopen.p │ ├── mustcreate.p │ ├── putcf.p │ ├── fgetcf.p │ ├── ftalloc.p │ ├── getcf.p │ ├── close.p │ ├── remove.p │ ├── fdalloc.p │ ├── create.p │ ├── open.p │ └── getline.p ├── filters │ ├── filters.h │ ├── tabpos.p │ ├── settabs.p │ ├── tabpos.cc │ ├── settabs.cc │ ├── echo.p │ ├── putrep.p │ ├── echo.cc │ ├── putrep.cc │ ├── expand.p │ ├── compress.p │ ├── compress.cc │ ├── expand.cc │ ├── overstrike.p │ └── entab.p ├── intro │ ├── intro.h │ ├── copy.p │ ├── copy.cc │ ├── tabpos.p │ ├── charcount.p │ ├── settabs.p │ ├── tabpos.cc │ ├── linecount.p │ ├── settabs.cc │ ├── charcount.cc │ ├── linecount.cc │ ├── wordcount.p │ ├── wordcount.cc │ ├── detab.p │ └── detab.cc ├── format │ ├── text0.p │ ├── fmtcons.p │ ├── center.p │ ├── skip.p │ ├── skipbl.p │ ├── putfoot.p │ ├── page.p │ ├── break.p │ ├── puthead.p │ ├── puttl.p │ ├── space.p │ ├── width.p │ ├── leadbl.p │ ├── gettl.p │ ├── put.p │ ├── getval.p │ ├── getword.p │ ├── setparam.p │ ├── underln.p │ ├── text1.p │ ├── fmtproc.p │ ├── initfmt.p │ ├── putword0.p │ ├── text.p │ ├── putword.p │ └── spread.p ├── archive │ ├── help.p │ ├── fskip.p │ ├── fmove.p │ ├── notfound.p │ ├── acopy.p │ ├── fsize.p │ ├── tprint.p │ ├── table.p │ ├── makehdr.p │ ├── archproc.p │ ├── replace.p │ ├── getword.p │ ├── filearg.p │ ├── addfile.p │ ├── gethdr.p │ ├── initarch.p │ ├── delete.p │ ├── getfns.p │ ├── update.p │ └── extract.p ├── print │ ├── skip.p │ ├── print0.p │ ├── head.p │ └── print.p ├── ucbprims │ ├── nargs.p │ ├── putc.p │ ├── putstr.p │ ├── close.p │ ├── putcf.p │ ├── remove.p │ ├── getc.p │ ├── prims.p │ ├── initio.p │ ├── getline.p │ ├── getcf.p │ └── getarg.p ├── sort │ ├── quick.p │ ├── makefile.p │ ├── exchange.p │ ├── kwic.p │ ├── sortproc.p │ ├── gopen.p │ ├── gremove.p │ ├── cscopy.p │ ├── sccopy.p │ ├── rotate.p │ ├── bubble.p │ ├── unique.p │ ├── ptext.p │ ├── gname.p │ ├── putrot.p │ ├── sorttest.p │ ├── cmp.p │ ├── reheap.p │ ├── shell0.p │ ├── shell.p │ ├── inmemsort.p │ ├── inmemquick.p │ ├── sortquick.p │ ├── gtext.p │ ├── rquick.p │ └── unrotate.p ├── macro │ ├── pbstr.p │ ├── pbnum.p │ ├── gnbchar.p │ ├── inithash.p │ ├── putback.p │ ├── puttok.p │ ├── hash.p │ ├── doexpr.p │ ├── push.p │ ├── defcons.p │ ├── dolen.p │ ├── defvar.p │ ├── cscopy.p │ ├── getpbc.p │ ├── sccopy.p │ ├── putchr.p │ ├── dodef.p │ ├── lookup.p │ ├── defproc.p │ ├── deftype.p │ ├── initdef.p │ ├── factor.p │ ├── hashfind.p │ ├── mactype.p │ ├── maccons.p │ ├── expr.p │ ├── dochq.p │ ├── doif.p │ ├── term.p │ ├── macproc.p │ ├── gettok.p │ ├── install.p │ ├── dosub.p │ └── define.p ├── wsprims │ ├── length.p │ ├── equal.p │ ├── seek.p │ ├── scopy.p │ ├── index.p │ ├── addstr.p │ ├── putc.p │ ├── fcopy.p │ ├── maxmin.p │ ├── popen.p │ ├── pputstr.p │ ├── pcreate.p │ ├── putdec.p │ ├── itoc.p │ ├── getc.p │ ├── esc.p │ ├── ctoi.p │ └── getline.p ├── pman │ ├── close.m │ ├── message.m │ ├── error.m │ ├── putc.m │ ├── putcf.m │ ├── nargs.m │ ├── putstr.m │ ├── remove.m │ ├── getarg.m │ ├── seek.m │ ├── getc.m │ ├── getline.m │ └── getcf.m ├── man │ ├── remove.m │ ├── linecount.m │ ├── close.m │ ├── echo.m │ ├── error.m │ ├── concat.m │ ├── wordcount.m │ ├── unique.m │ ├── charcount.m │ ├── seek.m │ ├── putstr.m │ ├── open.m │ ├── makecopy.m │ ├── copy.m │ ├── compare.m │ ├── include.m │ ├── getarg.m │ ├── detab.m │ ├── putc.m │ ├── getc.m │ ├── sort.m │ ├── create.m │ ├── print.m │ ├── kwic.m │ ├── expand.m │ ├── getline.m │ └── entab.m └── translit │ ├── makeset.cc │ ├── makeset.p │ ├── translit.h │ ├── xindex.p │ └── xindex.cc ├── cpp ├── intro │ ├── copy.cc │ ├── charcount.cc │ ├── linecount.cc │ ├── wordcount.cc │ └── detab.cc ├── fileio │ ├── concat.cc │ └── makecopy.cc ├── filters │ ├── echo.cc │ └── entab.cc ├── lib.cc └── lib.h └── .gitignore /orig/util/util.h: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /orig/fileio/fileio.h: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /orig/edit/edittype.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | #include "edtype2.p" 3 | -------------------------------------------------------------------------------- /orig/edit/editvar.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | #include "edvar2.p" 3 | -------------------------------------------------------------------------------- /orig/edit/edprim.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | #include "edprim2.p" 3 | -------------------------------------------------------------------------------- /orig/ucsdprims/Call.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | begin 3 | initcmd; 4 | PROG; 5 | endcmd 6 | end. 7 | -------------------------------------------------------------------------------- /orig/filters/filters.h: -------------------------------------------------------------------------------- 1 | #pragma once 2 | 3 | #include "../intro/intro.h" 4 | 5 | const int WARNING = TILDE; // ~ 6 | 7 | void putrep(integer n, character c); 8 | -------------------------------------------------------------------------------- /orig/intro/intro.h: -------------------------------------------------------------------------------- 1 | #pragma once 2 | 3 | using tabtype = boolean[MAXLINE + 1]; 4 | 5 | void settabs(tabtype& tabstops); 6 | boolean tabpos(integer col, tabtype& tabstops); 7 | -------------------------------------------------------------------------------- /cpp/intro/copy.cc: -------------------------------------------------------------------------------- 1 | // copy -- copy input to output 2 | #include 3 | 4 | int main() 5 | { 6 | int c; 7 | 8 | while ( (c = getchar()) != EOF) 9 | putchar(c); 10 | } 11 | -------------------------------------------------------------------------------- /orig/edit/clrbuf1.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { clrbuf (in memory) -- initialize for new file } 3 | procedure clrbuf; 4 | begin 5 | { nothing to do } 6 | end; 7 | -------------------------------------------------------------------------------- /orig/ucsdprims/nargs.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { nargs (UCSD) -- return number of arguments } 3 | function nargs : integer; 4 | begin 5 | nargs := cmdargs 6 | end; 7 | -------------------------------------------------------------------------------- /orig/edit/putmark.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { putmark -- put mark m on nth line } 3 | procedure putmark(n : integer; m : boolean); 4 | begin 5 | buf[n].mark := m 6 | end; 7 | -------------------------------------------------------------------------------- /orig/format/text0.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { text -- process text lines (interim version 1) } 3 | procedure text (var inbuf : string); 4 | begin 5 | put(inbuf) 6 | end; 7 | -------------------------------------------------------------------------------- /orig/edit/chngcons.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { chngcons.p -- const declarations for change } 3 | #include "findcons.p" 4 | DITTO = 1; { risky to store binary value in char } 5 | -------------------------------------------------------------------------------- /orig/edit/getmark.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { getmark -- get mark from nth line } 3 | function getmark (n : integer) : boolean; 4 | begin 5 | getmark := buf[n].mark 6 | end; 7 | -------------------------------------------------------------------------------- /orig/archive/help.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { help -- print diagnostic for archive } 3 | procedure help; 4 | begin 5 | error('usage: archive -[cdptux] archname [files...]') 6 | end; 7 | -------------------------------------------------------------------------------- /orig/edit/chngproc.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { chngproc -- procedures for change } 3 | #include "getpat.p" 4 | #include "getsub.p" 5 | #include "amatch.p" 6 | #include "catsub.p" 7 | -------------------------------------------------------------------------------- /orig/ucsdprims/putc.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { putc (UCSD) -- put one character on standard output } 3 | procedure putc (c : character); 4 | begin 5 | putcf(c, STDOUT) 6 | end; 7 | -------------------------------------------------------------------------------- /cpp/intro/charcount.cc: -------------------------------------------------------------------------------- 1 | // charcount -- count characters in standard input 2 | #include 3 | 4 | int main() 5 | { 6 | size_t nc = 0; 7 | while (getchar() != EOF) 8 | ++nc; 9 | printf("%zd\n", nc); 10 | } 11 | -------------------------------------------------------------------------------- /orig/util/isdigit.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { isdigit -- true if c is a digit } 3 | function isdigit (c : character) : boolean; 4 | begin 5 | isdigit := c in [ord('0')..ord('9')] 6 | end; 7 | -------------------------------------------------------------------------------- /orig/format/fmtcons.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { fmtcons -- constants for format } 3 | const 4 | CMD = PERIOD; 5 | PAGENUM = SHARP; 6 | PAGEWIDTH = 60; 7 | PAGELEN = 66; 8 | HUGE = 10000; 9 | -------------------------------------------------------------------------------- /orig/util/max.cc: -------------------------------------------------------------------------------- 1 | #include "../p2c.h" 2 | #include "util.h" 3 | 4 | // max -- compute maximum of two integers 5 | integer max(integer x, integer y) 6 | { 7 | if (x > y) 8 | return x; 9 | else 10 | return y; 11 | } 12 | -------------------------------------------------------------------------------- /orig/util/min.cc: -------------------------------------------------------------------------------- 1 | #include "../p2c.h" 2 | #include "util.h" 3 | 4 | // min -- compute minimum of two integers 5 | integer min(integer x, integer y) 6 | { 7 | if (x < y) 8 | return x; 9 | else 10 | return y; 11 | } 12 | -------------------------------------------------------------------------------- /orig/edit/clrbuf2.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { clrbuf (scratch file) -- dispose of scratch file } 3 | procedure clrbuf; 4 | begin 5 | close(scrin); 6 | close(scrout); 7 | remove(edittemp) 8 | end; 9 | -------------------------------------------------------------------------------- /orig/edit/gettxt1.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { gettxt (in memory) -- get text from line n into s } 3 | procedure gettxt (n : integer; var s : string); 4 | begin 5 | scopy(buf[n].txt, 1, s, 1) 6 | end; 7 | -------------------------------------------------------------------------------- /orig/format/center.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { center -- center a line by setting tival } 3 | procedure center (var buf : string); 4 | begin 5 | tival := max((rmval+tival-width(buf)) div 2, 0) 6 | end; 7 | -------------------------------------------------------------------------------- /orig/intro/copy.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { copy -- copy input to output } 3 | procedure copy; 4 | var 5 | c : character; 6 | begin 7 | while (getc(c) <> ENDFILE) do 8 | putc(c) 9 | end; 10 | -------------------------------------------------------------------------------- /orig/ucsdprims/getc.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { getc (UCSD) -- get one character from standard input } 3 | function getc (var c : character) : character; 4 | begin 5 | getc := getcf(c, STDIN) 6 | end; 7 | -------------------------------------------------------------------------------- /orig/util/islower.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { islower -- true if c is lower case letter } 3 | function islower (c : character) : boolean; 4 | begin 5 | islower := c in [ord('a')..ord('z')] 6 | end; 7 | -------------------------------------------------------------------------------- /orig/util/isupper.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { isupper -- true if c is upper case letter } 3 | function isupper (c : character) : boolean; 4 | begin 5 | isupper := c in [ord('A')..ord('Z')] 6 | end; 7 | -------------------------------------------------------------------------------- /orig/print/skip.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { skip -- output n blank lines } 3 | procedure skip (n : integer); 4 | var 5 | i : integer; 6 | begin 7 | for i := 1 to n do 8 | putc(NEWLINE) 9 | end; 10 | -------------------------------------------------------------------------------- /orig/format/skip.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { skip -- output n blank lines } 3 | procedure skip (n : integer); 4 | var 5 | i : integer; 6 | begin 7 | for i := 1 to n do 8 | putc(NEWLINE) 9 | end; 10 | -------------------------------------------------------------------------------- /orig/ucbprims/nargs.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { nargs (UCB) -- return number of arguments } 3 | { non-portable. uses Berkeley conventions } 4 | function nargs : integer; 5 | begin 6 | nargs := argc - 1 7 | end; 8 | -------------------------------------------------------------------------------- /orig/util/max.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { max -- compute maximum of two integers } 3 | function max (x, y : integer) : integer; 4 | begin 5 | if (x > y) then 6 | max := x 7 | else 8 | max := y 9 | end; 10 | -------------------------------------------------------------------------------- /orig/util/min.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { min -- compute minimum of two integers } 3 | function min (x, y : integer) : integer; 4 | begin 5 | if (x < y) then 6 | min := x 7 | else 8 | min := y 9 | end; 10 | -------------------------------------------------------------------------------- /orig/edit/nextln.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { nextln -- get line after n } 3 | function nextln (n : integer) : integer; 4 | begin 5 | if (n >= lastln) then 6 | nextln := 0 7 | else 8 | nextln := n + 1 9 | end; 10 | -------------------------------------------------------------------------------- /orig/edit/prevln.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { prevln -- get line before n } 3 | function prevln (n : integer) : integer; 4 | begin 5 | if (n <= 0) then 6 | prevln := lastln 7 | else 8 | prevln := n - 1 9 | end; 10 | -------------------------------------------------------------------------------- /orig/edit/skipbl.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { skipbl -- skip blanks and tabs at s[i]... } 3 | procedure skipbl (var s : string; var i : integer); 4 | begin 5 | while (s[i] = BLANK) or (s[i] = TAB) do 6 | i := i + 1 7 | end; 8 | -------------------------------------------------------------------------------- /orig/sort/quick.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { quick -- quicksort for lines } 3 | procedure quick (var linepos : posbuf; nlines : pos; 4 | var linebuf : charbuf); 5 | #include "rquick.p" 6 | begin 7 | rquick(1, nlines) 8 | end; 9 | -------------------------------------------------------------------------------- /orig/ucsdprims/endcmd.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { endcmd (UCSD) -- close all files on exit } 3 | procedure endcmd; 4 | var 5 | fd : filedesc; 6 | begin 7 | for fd := STDIN to MAXOPEN do 8 | xclose(fd) 9 | end; 10 | -------------------------------------------------------------------------------- /orig/util/length.cc: -------------------------------------------------------------------------------- 1 | #include "../p2c.h" 2 | #include "util.h" 3 | 4 | // length -- compute length of string 5 | integer length(string& s) 6 | { 7 | integer n; 8 | 9 | n = 1; 10 | while (s[n] != ENDSTR) 11 | n = n + 1; 12 | return n - 1; 13 | } 14 | -------------------------------------------------------------------------------- /orig/format/skipbl.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { skipbl -- skip blanks and tabs at s[i]... } 3 | procedure skipbl (var s : string; var i : integer); 4 | begin 5 | while (s[i] = BLANK) or (s[i] = TAB) do 6 | i := i + 1 7 | end; 8 | -------------------------------------------------------------------------------- /orig/macro/pbstr.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { pbstr -- push string back onto input } 3 | procedure pbstr (var s : string); 4 | var 5 | i : integer; 6 | begin 7 | for i := length(s) downto 1 do 8 | putback(s[i]) 9 | end; 10 | -------------------------------------------------------------------------------- /orig/edit/getpat.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { getpat -- convert argument into pattern } 3 | function getpat (var arg, pat : string) : boolean; 4 | #include "makepat.p" 5 | begin 6 | getpat := (makepat(arg, 1, ENDSTR, pat) > 0) 7 | end; 8 | -------------------------------------------------------------------------------- /orig/ucbprims/putc.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { putc (UCB) -- put one character on standard output } 3 | procedure putc (c : character); 4 | begin 5 | if c = NEWLINE then 6 | writeln 7 | else 8 | write(chr(c)) 9 | end; 10 | -------------------------------------------------------------------------------- /orig/util/isletter.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { isletter -- true if c is a letter of either case } 3 | function isletter (c : character) : boolean; 4 | begin 5 | isletter := 6 | c in [ord('a')..ord('z')] + [ord('A')..ord('Z')] 7 | end; 8 | -------------------------------------------------------------------------------- /orig/edit/getsub.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { getsub -- get substitution string into sub } 3 | function getsub (var arg, sub : string) : boolean; 4 | #include "makesub.p" 5 | begin 6 | getsub := (makesub(arg, 1, ENDSTR, sub) > 0) 7 | end; 8 | -------------------------------------------------------------------------------- /orig/format/putfoot.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { putfoot -- put out page footer } 3 | procedure putfoot; 4 | begin 5 | skip(m3val); 6 | if (m4val > 0) then begin 7 | puttl(footer, curpage); 8 | skip(m4val-1) 9 | end 10 | end; 11 | -------------------------------------------------------------------------------- /orig/util/fcopy.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { fcopy -- copy file fin to file fout } 3 | procedure fcopy (fin, fout : filedesc); 4 | var 5 | c : character; 6 | begin 7 | while (getcf(c, fin) <> ENDFILE) do 8 | putcf(c, fout) 9 | end; 10 | -------------------------------------------------------------------------------- /cpp/intro/linecount.cc: -------------------------------------------------------------------------------- 1 | // linecount -- count lines in standard input 2 | #include 3 | 4 | int main() 5 | { 6 | size_t nl = 0; 7 | int c; 8 | 9 | while ( (c = getchar()) != EOF) 10 | if (c == '\n') 11 | ++nl; 12 | 13 | printf("%zd\n", nl); 14 | } 15 | -------------------------------------------------------------------------------- /orig/edit/edprim1.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | #include "setbuf1.p" 3 | #include "clrbuf1.p" 4 | #include "getmark.p" 5 | #include "putmark.p" 6 | #include "gettxt1.p" 7 | #include "reverse.p" 8 | #include "blkmove.p" 9 | #include "puttxt1.p" 10 | -------------------------------------------------------------------------------- /orig/intro/copy.cc: -------------------------------------------------------------------------------- 1 | #include "../p2c.h" 2 | #include "intro.h" 3 | 4 | // Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. 5 | // copy -- copy input to output 6 | void copy() 7 | { 8 | character c; 9 | 10 | while (getc(c) != ENDFILE) 11 | putc(c); 12 | } 13 | -------------------------------------------------------------------------------- /orig/ucsdprims/fcopy.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { fcopy -- copy file fin to file fout } 3 | procedure fcopy (fin, fout : filedesc); 4 | var 5 | c : character; 6 | begin 7 | while (getcf(c, fin) <> ENDFILE) do 8 | putcf(c, fout) 9 | end; 10 | -------------------------------------------------------------------------------- /orig/ucsdprims/fputcf.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { fputcf -- put a character to file } 3 | procedure fputcf (c : character; var fil : text); 4 | begin 5 | if (c = NEWLINE) then 6 | writeln(fil) 7 | else 8 | write(fil, chr(c)) 9 | end; 10 | -------------------------------------------------------------------------------- /cpp/fileio/concat.cc: -------------------------------------------------------------------------------- 1 | // concat -- concatenate files onto standard output 2 | 3 | #include "../lib.h" 4 | #include 5 | 6 | int main(int argc, const char* argv[]) 7 | { 8 | for (int i = 1; i < argc; ++i) { 9 | File f(argv[i], "r"); 10 | fcopy(f.get(), stdout); 11 | } 12 | } 13 | -------------------------------------------------------------------------------- /orig/sort/makefile.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { makefile -- make new file for number n } 3 | function makefile (n : integer) : filedesc; 4 | var 5 | name : string; 6 | begin 7 | gname(n, name); 8 | makefile := mustcreate(name, IOWRITE) 9 | end; 10 | -------------------------------------------------------------------------------- /orig/macro/pbnum.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { pbnum -- convert number to string, push back on input } 3 | procedure pbnum (n : integer); 4 | var 5 | temp : string; 6 | junk : integer; 7 | begin 8 | junk := itoc(n, temp, 1); 9 | pbstr(temp) 10 | end; 11 | -------------------------------------------------------------------------------- /orig/sort/exchange.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { exchange -- exchange linebuf[lp1] with linebuf[lp2] } 3 | procedure exchange (var lp1, lp2 : charpos); 4 | var 5 | temp : charpos; 6 | begin 7 | temp := lp1; 8 | lp1 := lp2; 9 | lp2 := temp 10 | end; 11 | -------------------------------------------------------------------------------- /orig/format/page.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { page -- get to top of new page } 3 | procedure page; 4 | begin 5 | break; 6 | if (lineno > 0) and (lineno <= bottom) then begin 7 | skip(bottom+1-lineno); 8 | putfoot 9 | end; 10 | lineno := 0 11 | end; 12 | -------------------------------------------------------------------------------- /orig/edit/edprim2.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | #include "seek.p" 3 | #include "setbuf2.p" 4 | #include "clrbuf2.p" 5 | #include "getmark.p" 6 | #include "putmark.p" 7 | #include "gettxt2.p" 8 | #include "reverse.p" 9 | #include "blkmove.p" 10 | #include "puttxt2.p" 11 | -------------------------------------------------------------------------------- /orig/edit/edtype2.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { edittype -- types for scratch-file version of edit } 3 | type 4 | stcode = (ENDDATA, ERR, OK); 5 | buftype = 6 | record 7 | txt : integer; { text of line } 8 | mark : boolean { mark for line } 9 | end; 10 | -------------------------------------------------------------------------------- /orig/util/length.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { length -- compute length of string } 3 | function length (var s : string) : integer; 4 | var 5 | n : integer; 6 | begin 7 | n := 1; 8 | while (s[n] <> ENDSTR) do 9 | n := n + 1; 10 | length := n - 1 11 | end; 12 | -------------------------------------------------------------------------------- /orig/wsprims/length.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { length -- compute length of string } 3 | function length (var s : string) : integer; 4 | var 5 | n : integer; 6 | begin 7 | n := 1; 8 | while (s[n] <> ENDSTR) do 9 | n := n + 1; 10 | length := n - 1 11 | end; 12 | -------------------------------------------------------------------------------- /orig/macro/gnbchar.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { gnbchar -- get next non-blank character } 3 | function gnbchar (var s : string; var i : integer) 4 | : character; 5 | begin 6 | while (s[i] in [BLANK, TAB, NEWLINE]) do 7 | i := i + 1; 8 | gnbchar := s[i] 9 | end; 10 | -------------------------------------------------------------------------------- /orig/macro/inithash.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { inithash -- initialize hash table to nil } 3 | procedure inithash; 4 | var 5 | i : 1..HASHSIZE; 6 | begin 7 | nexttab := 1; { first free slot in table } 8 | for i := 1 to HASHSIZE do 9 | hashtab[i] := nil 10 | end; 11 | -------------------------------------------------------------------------------- /orig/macro/putback.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { putback -- push character back onto input } 3 | procedure putback (c : character); 4 | begin 5 | if (bp >= BUFSIZE) then 6 | error('too many characters pushed back'); 7 | bp := bp + 1; 8 | buf[bp] := c 9 | end; 10 | -------------------------------------------------------------------------------- /orig/sort/kwic.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { kwic -- make keyword in context index } 3 | procedure kwic; 4 | const 5 | FOLD = DOLLAR; 6 | var 7 | buf : string; 8 | #include "putrot.p" 9 | begin 10 | while (getline(buf, STDIN, MAXSTR)) do 11 | putrot(buf) 12 | end; 13 | -------------------------------------------------------------------------------- /orig/util/isalphanum.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { isalphanum -- true if c is letter or digit } 3 | function isalphanum (c : character) : boolean; 4 | begin 5 | isalphanum := c in 6 | [ord('a')..ord('z'), 7 | ord('A')..ord('Z'), 8 | ord('0')..ord('9')] 9 | end; 10 | -------------------------------------------------------------------------------- /orig/intro/tabpos.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { tabpos -- return true if col is a tab stop } 3 | function tabpos (col : integer; var tabstops : tabtype) 4 | : boolean; 5 | begin 6 | if (col > MAXLINE) then 7 | tabpos := true 8 | else 9 | tabpos := tabstops[col] 10 | end; 11 | -------------------------------------------------------------------------------- /orig/edit/setbuf1.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { setbuf (in memory) -- initialize line storage buffer } 3 | procedure setbuf; 4 | var 5 | null : string; { value is '' } 6 | begin 7 | null[1] := ENDSTR; 8 | scopy(null, 1, buf[0].txt, 1); 9 | curln := 0; 10 | lastln := 0 11 | end; 12 | -------------------------------------------------------------------------------- /orig/filters/tabpos.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { tabpos -- return true if col is a tab stop } 3 | function tabpos (col : integer; var tabstops : tabtype) 4 | : boolean; 5 | begin 6 | if (col > MAXLINE) then 7 | tabpos := true 8 | else 9 | tabpos := tabstops[col] 10 | end; 11 | -------------------------------------------------------------------------------- /orig/macro/puttok.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { puttok -- put token on output or evaluation stack } 3 | procedure puttok (var s : string); 4 | var 5 | i : integer; 6 | begin 7 | i := 1; 8 | while (s[i] <> ENDSTR) do begin 9 | putchr(s[i]); 10 | i := i + 1 11 | end 12 | end; 13 | -------------------------------------------------------------------------------- /orig/ucbprims/putstr.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { putstr (UCB) -- put out string on file } 3 | procedure putstr (var s : string; f : filedesc); 4 | var 5 | i : integer; 6 | begin 7 | i := 1; 8 | while (s[i] <> ENDSTR) do begin 9 | putcf(s[i], f); 10 | i := i + 1 11 | end 12 | end; 13 | -------------------------------------------------------------------------------- /orig/fileio/diffmsg.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { diffmsg -- print line numbers and differing lines } 3 | procedure diffmsg (n : integer; var line1, line2 : string); 4 | begin 5 | putdec(n, 1); 6 | putc(COLON); 7 | putc(NEWLINE); 8 | putstr(line1, STDOUT); 9 | putstr(line2, STDOUT) 10 | end; 11 | -------------------------------------------------------------------------------- /orig/format/break.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { break -- end current filled line } 3 | procedure break; 4 | begin 5 | if (outp > 0) then begin 6 | outbuf[outp] := NEWLINE; 7 | outbuf[outp+1] := ENDSTR; 8 | put(outbuf) 9 | end; 10 | outp := 0; 11 | outw := 0; 12 | outwds := 0 13 | end; 14 | -------------------------------------------------------------------------------- /orig/macro/hash.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { hash -- compute hash function of a name } 3 | function hash (var name : string) : integer; 4 | var 5 | i, h : integer; 6 | begin 7 | h := 0; 8 | for i := 1 to length(name) do 9 | h := (3 * h + name[i]) mod HASHSIZE; 10 | hash := h + 1 11 | end; 12 | -------------------------------------------------------------------------------- /orig/pman/close.m: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | .NM close close a file descriptor 3 | .SY 4 | .UL "procedure close (fd : filedesc);" 5 | .FU 6 | .UL close 7 | releases the file descriptor and any associated resources 8 | for a file opened by 9 | .UL open 10 | or 11 | .UL create . 12 | .RE 13 | Nothing. 14 | -------------------------------------------------------------------------------- /orig/ucsdprims/putstr.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { putstr (UCSD) -- put out string on file } 3 | procedure putstr (str : xstring; fd : filedesc); 4 | var 5 | i : integer; 6 | begin 7 | i := 1; 8 | while (str[i] <> ENDSTR) do begin 9 | putcf(str[i], fd); 10 | i := i + 1 11 | end 12 | end; 13 | -------------------------------------------------------------------------------- /cpp/fileio/makecopy.cc: -------------------------------------------------------------------------------- 1 | // makecopy -- copy one file to another 2 | 3 | #include "../lib.h" 4 | #include 5 | 6 | int main(int argc, const char* argv[]) 7 | { 8 | if (argc != 3) 9 | error("Usage: makecopy old new"); 10 | 11 | File fin(argv[1], "r"); 12 | File fout(argv[2], "w"); 13 | fcopy(fin.get(), fout.get()); 14 | } 15 | 16 | -------------------------------------------------------------------------------- /orig/filters/settabs.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { settabs -- set initial tab stops } 3 | procedure settabs (var tabstops : tabtype); 4 | const 5 | TABSPACE = 4; { 4 spaces per tab } 6 | var 7 | i : integer; 8 | begin 9 | for i := 1 to MAXLINE do 10 | tabstops[i] := (i mod TABSPACE = 1) 11 | end; 12 | -------------------------------------------------------------------------------- /orig/intro/charcount.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { charcount -- count characters in standard input } 3 | procedure charcount; 4 | var 5 | nc : integer; 6 | c : character; 7 | begin 8 | nc := 0; 9 | while (getc(c) <> ENDFILE) do 10 | nc := nc + 1; 11 | putdec(nc, 1); 12 | putc(NEWLINE) 13 | end; 14 | -------------------------------------------------------------------------------- /orig/intro/settabs.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { settabs -- set initial tab stops } 3 | procedure settabs (var tabstops : tabtype); 4 | const 5 | TABSPACE = 4; { 4 spaces per tab } 6 | var 7 | i : integer; 8 | begin 9 | for i := 1 to MAXLINE do 10 | tabstops[i] := (i mod TABSPACE = 1) 11 | end; 12 | -------------------------------------------------------------------------------- /orig/edit/edtype1.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { edittype -- types for in-memory version of edit } 3 | type 4 | stcode = (ENDDATA, ERR, OK); { status returns } 5 | buftype = { in-memory edit buffer entry } 6 | record 7 | txt : string; { text of line } 8 | mark : boolean { mark for line } 9 | end; 10 | -------------------------------------------------------------------------------- /orig/intro/tabpos.cc: -------------------------------------------------------------------------------- 1 | #include "../p2c.h" 2 | #include "intro.h" 3 | 4 | // Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. 5 | // tabpos -- return true if col is a tab stop 6 | boolean tabpos(integer col, tabtype& tabstops) 7 | { 8 | if (col > MAXLINE) 9 | return true; 10 | else 11 | return tabstops[col]; 12 | } 13 | -------------------------------------------------------------------------------- /orig/macro/doexpr.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { doexpr -- evaluate arithmetic expressions } 3 | procedure doexpr (var argstk : posbuf; i, j : integer); 4 | var 5 | temp : string; 6 | junk : integer; 7 | begin 8 | cscopy(evalstk, argstk[i+2], temp); 9 | junk := 1; 10 | pbnum(expr(temp, junk)) 11 | end; 12 | -------------------------------------------------------------------------------- /orig/archive/fskip.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { fskip -- skip n characters on file fd } 3 | procedure fskip (fd : filedesc; n : integer); 4 | var 5 | c : character; 6 | i : integer; 7 | begin 8 | for i := 1 to n do 9 | if (getcf(c, fd) = ENDFILE) then 10 | error('archive: end of file in fskip') 11 | end; 12 | -------------------------------------------------------------------------------- /orig/filters/tabpos.cc: -------------------------------------------------------------------------------- 1 | #include "../p2c.h" 2 | #include "filters.h" 3 | 4 | // Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. 5 | // tabpos -- return true if col is a tab stop 6 | boolean tabpos(integer col, tabtype& tabstops) 7 | { 8 | if (col > MAXLINE) 9 | return true; 10 | else 11 | return tabstops[col]; 12 | } 13 | -------------------------------------------------------------------------------- /orig/util/equal.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { equal -- test two strings for equality } 3 | function equal (var str1, str2 : string) : boolean; 4 | var 5 | i : integer; 6 | begin 7 | i := 1; 8 | while (str1[i] = str2[i]) and (str1[i] <> ENDSTR) do 9 | i := i + 1; 10 | equal := (str1[i] = str2[i]) 11 | end; 12 | -------------------------------------------------------------------------------- /orig/man/remove.m: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | .ds n PRIMITIVE 3 | .NM remove remove file from secondary storage 4 | .SY 5 | .Q1 6 | name : string; 7 | 8 | remove(name); 9 | .Q2 10 | .FU 11 | .UL remove 12 | removes the named file from secondary storage, 13 | thus making the name and space available for another use. 14 | -------------------------------------------------------------------------------- /orig/ucbprims/close.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { close (UCB) -- release file descriptor slot for open file } 3 | procedure close (fd : filedesc); 4 | begin 5 | if (fd > STDERR) and (fd <= MAXOPEN) then begin 6 | flush(openlist[fd].filevar); { in case buffered } 7 | openlist[fd].mode := IOAVAIL 8 | end 9 | end; 10 | -------------------------------------------------------------------------------- /orig/util/addstr.cc: -------------------------------------------------------------------------------- 1 | #include "../p2c.h" 2 | #include "util.h" 3 | 4 | // addstr -- put c in outset[j] if it fits, increment j 5 | boolean addstr(character c, string& outset, integer& j, integer maxset) 6 | { 7 | if (j > maxset) 8 | return false; 9 | else { 10 | outset[j] = c; 11 | j = j + 1; 12 | return true; 13 | } 14 | } 15 | -------------------------------------------------------------------------------- /orig/wsprims/equal.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { equal -- test two strings for equality } 3 | function equal (var str1, str2 : string) : boolean; 4 | var 5 | i : integer; 6 | begin 7 | i := 1; 8 | while (str1[i] = str2[i]) and (str1[i] <> ENDSTR) do 9 | i := i + 1; 10 | equal := (str1[i] = str2[i]) 11 | end; 12 | -------------------------------------------------------------------------------- /orig/archive/fmove.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { fmove -- move file name1 to name2 } 3 | procedure fmove (var name1, name2 : string); 4 | var 5 | fd1, fd2 : filedesc; 6 | begin 7 | fd1 := mustopen(name1, IOREAD); 8 | fd2 := mustcreate(name2, IOWRITE); 9 | fcopy(fd1, fd2); 10 | close(fd1); 11 | close(fd2) 12 | end; 13 | -------------------------------------------------------------------------------- /orig/format/puthead.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { puthead -- put out page header } 3 | procedure puthead; 4 | begin 5 | curpage := newpage; 6 | newpage := newpage + 1; 7 | if (m1val > 0) then begin 8 | skip(m1val-1); 9 | puttl(header, curpage) 10 | end; 11 | skip(m2val); 12 | lineno := m1val + m2val + 1 13 | end; 14 | -------------------------------------------------------------------------------- /orig/macro/push.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { push -- push ep onto argstk, return new position ap } 3 | function push (ep : integer; var argstk : posbuf; 4 | ap : integer) : integer; 5 | begin 6 | if (ap > ARGSIZE) then 7 | error('macro: argument stack overflow'); 8 | argstk[ap] := ep; 9 | push := ap + 1 10 | end; 11 | -------------------------------------------------------------------------------- /orig/man/linecount.m: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | .NM linecount count lines in input 3 | .SY 4 | .UL "linecount" 5 | .FU 6 | .UL linecount 7 | counts the lines in its input and writes the total as a line of 8 | text to the output. 9 | .EG 10 | .Q1 11 | linecount 12 | A single line of input. 13 | 14 | .S 1 15 | .Q2 16 | -------------------------------------------------------------------------------- /orig/pman/message.m: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | .NM message print a message and continue 3 | .SY 4 | .UL "procedure message ('your message here');" 5 | .FU 6 | .UL message 7 | writes the literal string specified to a highly visible place, 8 | such as the user's terminal, 9 | then continues execution. 10 | .RE 11 | Nothing. 12 | -------------------------------------------------------------------------------- /orig/sort/sortproc.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { sortproc -- procedures for sort } 3 | #include "cmp.p" 4 | #include "exchange.p" 5 | #include "gtext.p" 6 | #include "ptext.p" 7 | #include "quick.p" 8 | #include "gname.p" 9 | #include "makefile.p" 10 | #include "gopen.p" 11 | #include "merge.p" 12 | #include "gremove.p" 13 | -------------------------------------------------------------------------------- /orig/util/putdec.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { putdec -- put decimal integer n in field width >= w } 3 | procedure putdec (n, w : integer); 4 | var 5 | i, nd : integer; 6 | s : string; 7 | begin 8 | nd := itoc(n, s, 1); 9 | for i := nd to w do 10 | putc(BLANK); 11 | for i := 1 to nd-1 do 12 | putc(s[i]) 13 | end; 14 | -------------------------------------------------------------------------------- /orig/intro/linecount.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { linecount -- count lines in standard input } 3 | procedure linecount; 4 | var 5 | nl : integer; 6 | c : character; 7 | begin 8 | nl := 0; 9 | while (getc(c) <> ENDFILE) do 10 | if (c = NEWLINE) then 11 | nl := nl + 1; 12 | putdec(nl, 1); 13 | putc(NEWLINE) 14 | end; 15 | -------------------------------------------------------------------------------- /orig/macro/defcons.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { defcons -- const declarations for define } 3 | const 4 | BUFSIZE = 500; { size of pushback buffer } 5 | MAXCHARS = 5000; { size of name-defn table } 6 | MAXDEF = MAXSTR; { max chars in a defn } 7 | MAXTOK = MAXSTR; { max chars in a token } 8 | HASHSIZE = 53; { size of hash table } 9 | -------------------------------------------------------------------------------- /orig/macro/dolen.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { dolen -- return length of argument } 3 | procedure dolen(var argstk : posbuf; i, j : integer); 4 | var 5 | temp : string; 6 | begin 7 | if (j - i > 1) then begin 8 | cscopy(evalstk, argstk[i+2], temp); 9 | pbnum(length(temp)) 10 | end 11 | else 12 | pbnum(0) 13 | end; 14 | -------------------------------------------------------------------------------- /orig/ucsdprims/putdec.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { putdec -- put decimal integer n in field width >= w } 3 | procedure putdec (n, w : integer); 4 | var 5 | i, nd : integer; 6 | s : xstring; 7 | begin 8 | nd := itoc(n, s, 1); 9 | for i := nd to w do 10 | putc(BLANK); 11 | for i := 1 to nd-1 do 12 | putc(s[i]) 13 | end; 14 | -------------------------------------------------------------------------------- /orig/util/index.cc: -------------------------------------------------------------------------------- 1 | #include "../p2c.h" 2 | #include "util.h" 3 | 4 | // index -- find position of character c in string s 5 | integer index(string& s, character c) 6 | { 7 | integer i; 8 | 9 | i = 1; 10 | while ((s[i] != c) and (s[i] != ENDSTR)) 11 | i = i + 1; 12 | if (s[i] == ENDSTR) 13 | return 0; 14 | else 15 | return i; 16 | } 17 | -------------------------------------------------------------------------------- /orig/wsprims/seek.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { seek (WS) -- special version of primitive for edit } 3 | procedure lseek (fd : filedesc; off, hioff, mode : integer); 4 | external; { PDP-11 long format only } 5 | 6 | procedure seek (recno : integer; fd : filedesc); 7 | begin 8 | lseek(scrout, 0, MAXSTR * recno, 0) 9 | end; 10 | -------------------------------------------------------------------------------- /orig/edit/reverse.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { reverse -- reverse buf[n1]...buf[n2] } 3 | procedure reverse (n1, n2 : integer); 4 | var 5 | temp : buftype; 6 | begin 7 | while (n1 < n2) do begin 8 | temp := buf[n1]; 9 | buf[n1] := buf[n2]; 10 | buf[n2] := temp; 11 | n1 := n1 + 1; 12 | n2 := n2 - 1 13 | end 14 | end; 15 | -------------------------------------------------------------------------------- /orig/format/puttl.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { puttl -- put out title line with optional page number } 3 | procedure puttl (var buf : string; pageno : integer); 4 | var 5 | i : integer; 6 | begin 7 | for i := 1 to length(buf) do 8 | if (buf[i] = PAGENUM) then 9 | putdec(pageno, 1) 10 | else 11 | putc(buf[i]) 12 | end; 13 | -------------------------------------------------------------------------------- /orig/macro/defvar.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { defvar -- var declarations for define } 3 | var 4 | hashtab : array [1..HASHSIZE] of ndptr; 5 | ndtable : charbuf; 6 | nexttab : charpos; { first free position in ndtable } 7 | buf : array [1..BUFSIZE] of character; { for pushback } 8 | bp : 0..BUFSIZE; { next available character; init=0 } 9 | -------------------------------------------------------------------------------- /orig/sort/gopen.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { gopen -- open group of files f1 ... f2 } 3 | procedure gopen (var infile : fdbuf; f1, f2 : integer); 4 | var 5 | name : string; 6 | i : 1..MERGEORDER; 7 | begin 8 | for i := 1 to f2-f1+1 do begin 9 | gname(f1+i-1, name); 10 | infile[i] := mustopen(name, IOREAD) 11 | end 12 | end; 13 | -------------------------------------------------------------------------------- /orig/ucbprims/putcf.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { putcf (UCB) -- put a single character on file fd } 3 | procedure putcf (c : character; fd : filedesc); 4 | begin 5 | if (fd = STDOUT) then 6 | putc(c) 7 | else if c = NEWLINE then 8 | writeln(openlist[fd].filevar) 9 | else 10 | write(openlist[fd].filevar, chr(c)) 11 | end; 12 | -------------------------------------------------------------------------------- /orig/util/scopy.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { scopy -- copy string at src[i] to dest[j] } 3 | procedure scopy (var src : string; i : integer; 4 | var dest : string; j : integer); 5 | begin 6 | while (src[i] <> ENDSTR) do begin 7 | dest[j] := src[i]; 8 | i := i + 1; 9 | j := j + 1 10 | end; 11 | dest[j] := ENDSTR 12 | end; 13 | -------------------------------------------------------------------------------- /cpp/filters/echo.cc: -------------------------------------------------------------------------------- 1 | // echo -- echo command line arguments to output 2 | #include 3 | 4 | int main(int argc, char* argv[]) 5 | { 6 | for (int i = 1; i < argc; ++i) 7 | { 8 | if (i > 1) 9 | putchar(' '); 10 | fputs(argv[i], stdout); // or printf("%s", argv[i]); 11 | } 12 | if (argc > 1) 13 | { 14 | puts(""); // or printf("\n"); 15 | } 16 | } 17 | -------------------------------------------------------------------------------- /orig/wsprims/scopy.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { scopy -- copy string at src[i] to dest[j] } 3 | procedure scopy (var src : string; i : integer; 4 | var dest : string; j : integer); 5 | begin 6 | while (src[i] <> ENDSTR) do begin 7 | dest[j] := src[i]; 8 | i := i + 1; 9 | j := j + 1 10 | end; 11 | dest[j] := ENDSTR 12 | end; 13 | -------------------------------------------------------------------------------- /orig/archive/notfound.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { notfound -- print "not found" warning } 3 | procedure notfound; 4 | var 5 | i : integer; 6 | begin 7 | for i := 1 to nfiles do 8 | if (fstat[i] = false) then begin 9 | putstr(fname[i], STDERR); 10 | message(': not in archive'); 11 | errcount := errcount + 1 12 | end 13 | end; 14 | -------------------------------------------------------------------------------- /orig/sort/gremove.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { gremove -- remove group of files f1 ... f2 } 3 | procedure gremove (var infile : fdbuf; f1, f2 : integer); 4 | var 5 | name : string; 6 | i : 1..MERGEORDER; 7 | begin 8 | for i := 1 to f2-f1+1 do begin 9 | close(infile[i]); 10 | gname(f1+i-1, name); 11 | remove(name) 12 | end 13 | end; 14 | -------------------------------------------------------------------------------- /orig/wsprims/index.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { index -- find c in string s } 3 | function index (var s : string; c : character) : integer; 4 | var 5 | i : integer; 6 | begin 7 | i := 1; 8 | while (s[i] <> c) and (s[i] <> ENDSTR) do 9 | i := i + 1; 10 | if (s[i] = ENDSTR) then 11 | index := 0 12 | else 13 | index := i 14 | end; 15 | -------------------------------------------------------------------------------- /orig/intro/settabs.cc: -------------------------------------------------------------------------------- 1 | #include "../p2c.h" 2 | #include "intro.h" 3 | 4 | // Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. 5 | // settabs -- set initial tab stops 6 | void settabs(tabtype& tabstops) 7 | { 8 | const int TABSPACE = 4; // 4 spaces per tab 9 | integer i; 10 | 11 | for (i = 1; i <= MAXLINE; ++i) 12 | tabstops[i] = (i % TABSPACE == 1); 13 | } 14 | -------------------------------------------------------------------------------- /orig/macro/cscopy.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { cscopy -- copy cb[i]... to string s } 3 | procedure cscopy (var cb : charbuf; i : charpos; 4 | var s : string); 5 | var 6 | j : integer; 7 | begin 8 | j := 1; 9 | while (cb[i] <> ENDSTR) do begin 10 | s[j] := cb[i]; 11 | i := i + 1; 12 | j := j + 1 13 | end; 14 | s[j] := ENDSTR 15 | end; 16 | -------------------------------------------------------------------------------- /orig/macro/getpbc.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { getpbc -- get a (possibly pushed back) character } 3 | function getpbc (var c : character) : character; 4 | begin 5 | if (bp > 0) then 6 | c := buf[bp] 7 | else begin 8 | bp := 1; 9 | buf[bp] := getc(c) 10 | end; 11 | if (c <> ENDFILE) then 12 | bp := bp - 1; 13 | getpbc := c 14 | end; 15 | -------------------------------------------------------------------------------- /orig/macro/sccopy.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { sccopy -- copy string s to cb[i]... } 3 | procedure sccopy (var s : string; var cb : charbuf; 4 | i : charpos); 5 | var 6 | j : integer; 7 | begin 8 | j := 1; 9 | while (s[j] <> ENDSTR) do begin 10 | cb[i] := s[j]; 11 | j := j + 1; 12 | i := i + 1 13 | end; 14 | cb[i] := ENDSTR 15 | end; 16 | -------------------------------------------------------------------------------- /orig/sort/cscopy.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { cscopy -- copy cb[i]... to string s } 3 | procedure cscopy (var cb : charbuf; i : charpos; 4 | var s : string); 5 | var 6 | j : integer; 7 | begin 8 | j := 1; 9 | while (cb[i] <> ENDSTR) do begin 10 | s[j] := cb[i]; 11 | i := i + 1; 12 | j := j + 1 13 | end; 14 | s[j] := ENDSTR 15 | end; 16 | -------------------------------------------------------------------------------- /orig/sort/sccopy.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { sccopy -- copy string s to cb[i]... } 3 | procedure sccopy (var s : string; var cb : charbuf; 4 | i : charpos); 5 | var 6 | j : integer; 7 | begin 8 | j := 1; 9 | while (s[j] <> ENDSTR) do begin 10 | cb[i] := s[j]; 11 | j := j + 1; 12 | i := i + 1 13 | end; 14 | cb[i] := ENDSTR 15 | end; 16 | -------------------------------------------------------------------------------- /orig/util/itoctest.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | procedure itoctest; 3 | var 4 | i, n, d : integer; 5 | s : string; 6 | begin 7 | while (getline(s, STDIN, MAXSTR)) do begin 8 | i := 1; 9 | n := ctoi(s, i); 10 | d := itoc(n, s, 1); 11 | putstr(s, STDOUT); 12 | putdec(n, 10); 13 | putdec(d, 10); 14 | putc(NEWLINE); 15 | end 16 | end; 17 | -------------------------------------------------------------------------------- /orig/filters/settabs.cc: -------------------------------------------------------------------------------- 1 | #include "../p2c.h" 2 | #include "filters.h" 3 | 4 | // Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. 5 | // settabs -- set initial tab stops 6 | void settabs(tabtype& tabstops) 7 | { 8 | const int TABSPACE = 4; // 4 spaces per tab 9 | integer i; 10 | 11 | for (i = 1; i <= MAXLINE; ++i) 12 | tabstops[i] = (i % TABSPACE == 1); 13 | } 14 | -------------------------------------------------------------------------------- /orig/macro/putchr.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { putchr -- put single char on output or evaluation stack } 3 | procedure putchr (c : character); 4 | begin 5 | if (cp <= 0) then 6 | putc(c) 7 | else begin 8 | if (ep > EVALSIZE) then 9 | error('macro: evaluation stack overflow'); 10 | evalstk[ep] := c; 11 | ep := ep + 1 12 | end 13 | end; 14 | -------------------------------------------------------------------------------- /orig/fileio/diffmsg.cc: -------------------------------------------------------------------------------- 1 | #include "../p2c.h" 2 | #include "fileio.h" 3 | 4 | // Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. 5 | // diffmsg -- print line numbers and differing lines 6 | void diffmsg(integer n, string& line1, string& line2) 7 | { 8 | putdec(n, 1); 9 | putc(COLON); 10 | putc(NEWLINE); 11 | putstr(line1, STDOUT); 12 | putstr(line2, STDOUT); 13 | } 14 | -------------------------------------------------------------------------------- /orig/intro/charcount.cc: -------------------------------------------------------------------------------- 1 | #include "../p2c.h" 2 | #include "intro.h" 3 | 4 | // Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. 5 | // charcount -- count characters in standard input 6 | void charcount() 7 | { 8 | integer nc; 9 | character c; 10 | 11 | nc = 0; 12 | while (getc(c) != ENDFILE) 13 | nc = nc + 1; 14 | putdec(nc, 1); 15 | putc(NEWLINE); 16 | } 17 | -------------------------------------------------------------------------------- /orig/archive/acopy.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { acopy -- copy n characters from fdi to fdo } 3 | procedure acopy (fdi, fdo : filedesc; n : integer); 4 | var 5 | c : character; 6 | i : integer; 7 | begin 8 | for i := 1 to n do 9 | if (getcf(c, fdi) = ENDFILE) then 10 | error('archive: end of file in acopy') 11 | else 12 | putcf(c, fdo) 13 | end; 14 | -------------------------------------------------------------------------------- /orig/ucsdprims/getarg.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { getarg (UCSD) -- get n-th command line argument into s } 3 | function getarg (n : integer; var s : xstring; 4 | maxsize : integer) : boolean; 5 | begin 6 | if ((n < 1) or (cmdargs < n)) then 7 | getarg := false 8 | else begin 9 | scopy(cmdlin, cmdidx[n], s, 1); 10 | getarg := true 11 | end 12 | end; 13 | -------------------------------------------------------------------------------- /orig/ucsdprims/strname.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { strname -- map to native string filename } 3 | procedure strname (var str : string; var xstr : xstring); 4 | var 5 | i : integer; 6 | begin 7 | str := '.text'; 8 | i := 1; 9 | while (xstr[i] <> ENDSTR) do begin 10 | insert('x', str, i); 11 | str[i] := chr(xstr[i]); 12 | i := i + 1 13 | end 14 | end; 15 | -------------------------------------------------------------------------------- /orig/util/index.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { index -- find position of character c in string s } 3 | function index (var s : string; c : character) : integer; 4 | var 5 | i : integer; 6 | begin 7 | i := 1; 8 | while (s[i] <> c) and (s[i] <> ENDSTR) do 9 | i := i + 1; 10 | if (s[i] = ENDSTR) then 11 | index := 0 12 | else 13 | index := i 14 | end; 15 | -------------------------------------------------------------------------------- /orig/util/mustopen.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { mustopen -- open file or die } 3 | function mustopen (var name : string; mode : integer) 4 | : filedesc; 5 | var 6 | fd : filedesc; 7 | begin 8 | fd := open(name, mode); 9 | if (fd = IOERROR) then begin 10 | putstr(name, STDERR); 11 | error(': can''t open file') 12 | end; 13 | mustopen := fd 14 | end; 15 | -------------------------------------------------------------------------------- /orig/archive/fsize.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { fsize -- size of file in characters } 3 | function fsize (var name : string) : integer; 4 | var 5 | c : character; 6 | fd : filedesc; 7 | n : integer; 8 | begin 9 | n := 0; 10 | fd := mustopen(name, IOREAD); 11 | while (getcf(c, fd) <> ENDFILE) do 12 | n := n + 1; 13 | close(fd); 14 | fsize := n 15 | end; 16 | -------------------------------------------------------------------------------- /orig/format/space.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { space -- space n lines or to bottom of page } 3 | procedure space (n : integer); 4 | begin 5 | break; 6 | if (lineno <= bottom) then begin 7 | if (lineno <= 0) then 8 | puthead; 9 | skip(min(n, bottom+1-lineno)); 10 | lineno := lineno + n; 11 | if (lineno > bottom) then 12 | putfoot 13 | end 14 | end; 15 | -------------------------------------------------------------------------------- /orig/macro/dodef.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { dodef -- install definition in table } 3 | procedure dodef (var argstk : posbuf; i, j : integer); 4 | var 5 | temp1, temp2 : string; 6 | begin 7 | if (j - i > 2) then begin 8 | cscopy(evalstk, argstk[i+2], temp1); 9 | cscopy(evalstk, argstk[i+3], temp2); 10 | install(temp1, temp2, MACTYPE) 11 | end 12 | end; 13 | -------------------------------------------------------------------------------- /orig/ucsdprims/mustopen.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { mustopen -- open file or die } 3 | function mustopen (var name : string; mode : integer) 4 | : filedesc; 5 | var 6 | fd : filedesc; 7 | begin 8 | fd := open(name, mode); 9 | if (fd = IOERROR) then begin 10 | putstr(name, STDERR); 11 | error(': can''t open file') 12 | end; 13 | mustopen := fd 14 | end; 15 | -------------------------------------------------------------------------------- /orig/util/addstr.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { addstr -- put c in outset[j] if it fits, increment j } 3 | function addstr(c : character; var outset : string; 4 | var j : integer; maxset : integer) : boolean; 5 | begin 6 | if (j > maxset) then 7 | addstr := false 8 | else begin 9 | outset[j] := c; 10 | j := j + 1; 11 | addstr := true 12 | end 13 | end; 14 | -------------------------------------------------------------------------------- /orig/edit/gettxt2.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { gettxt (scratch file) -- get text from line n into s } 3 | procedure gettxt (n : integer; var s : string); 4 | var 5 | junk : boolean; 6 | begin 7 | if (n = 0) then 8 | s[1] := ENDSTR 9 | else begin 10 | seek(buf[n].txt, scrin); 11 | recin := recin + 1; 12 | junk := getline(s, scrin, MAXSTR) 13 | end 14 | end; 15 | -------------------------------------------------------------------------------- /orig/ucbprims/remove.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { remove (UCB) -- remove file s from file system } 3 | { this version just prints a message } 4 | procedure remove (var s : string); 5 | begin 6 | message('If we had remove, we would be removing '); 7 | putcf(TAB, STDERR); 8 | putstr(s, STDERR); 9 | putcf(NEWLINE, STDERR); 10 | flush(openlist[STDERR].filevar) 11 | end; 12 | -------------------------------------------------------------------------------- /orig/util/mustcreate.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { mustcreate -- create file or die } 3 | function mustcreate (var name : string; mode : integer) 4 | : filedesc; 5 | var 6 | fd : filedesc; 7 | begin 8 | fd := create(name, mode); 9 | if (fd = IOERROR) then begin 10 | putstr(name, STDERR); 11 | error(': can''t create file') 12 | end; 13 | mustcreate := fd 14 | end; 15 | -------------------------------------------------------------------------------- /orig/wsprims/addstr.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { addstr -- put c in outset[j] if it fits, increment j } 3 | function addstr(c : character; var outset : string; 4 | var j : integer; maxset : integer) : boolean; 5 | begin 6 | if (j > maxset) then 7 | addstr := false 8 | else begin 9 | outset[j] := c; 10 | j := j + 1; 11 | addstr := true 12 | end 13 | end; 14 | -------------------------------------------------------------------------------- /orig/fileio/concat.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { concat -- concatenate files onto standard output } 3 | procedure concat; 4 | var 5 | i : integer; 6 | junk : boolean; 7 | fd : filedesc; 8 | s : string; 9 | begin 10 | for i := 1 to nargs do begin 11 | junk := getarg(i, s, MAXSTR); 12 | fd := mustopen(s, IOREAD); 13 | fcopy(fd, STDOUT); 14 | close(fd) 15 | end 16 | end; 17 | -------------------------------------------------------------------------------- /orig/man/close.m: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | .ds n PRIMITIVE 3 | .NM close close an open file 4 | .SY 5 | .Q1 6 | fd : filedesc; 7 | 8 | close(fd); 9 | .Q2 10 | .FU 11 | .UL close 12 | releases the file descriptor and any associated resources 13 | for a file opened by 14 | .UL open 15 | or 16 | .UL create . 17 | .BU 18 | Behavior is undefined for closing a file that is not open. 19 | -------------------------------------------------------------------------------- /orig/ucsdprims/mustcreate.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { mustcreate -- create file or die } 3 | function mustcreate (var name : string; mode : integer) 4 | : filedesc; 5 | var 6 | fd : filedesc; 7 | begin 8 | fd := create(name, mode); 9 | if (fd = IOERROR) then begin 10 | putstr(name, STDERR); 11 | error(': can''t create file') 12 | end; 13 | mustcreate := fd 14 | end; 15 | -------------------------------------------------------------------------------- /orig/wsprims/putc.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { putc and putcf (WS) -- put one character of output } 3 | procedure write (fd : filedesc; var c : character; 4 | size : integer); 5 | external; 6 | 7 | procedure putc (c : character); 8 | begin 9 | write(STDOUT, c, 1) 10 | end; 11 | 12 | procedure putcf(c : character; fd : filedesc); 13 | begin 14 | write(fd, c, 1) 15 | end; 16 | -------------------------------------------------------------------------------- /orig/edit/match.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { match -- find match anywhere on line } 3 | function match (var lin, pat : string) : boolean; 4 | var 5 | i, pos : integer; 6 | #include "amatch.p" 7 | begin 8 | pos := 0; 9 | i := 1; 10 | while (lin[i] <> ENDSTR) and (pos = 0) do begin 11 | pos := amatch(lin, i, pat, 1); 12 | i := i + 1 13 | end; 14 | match := (pos > 0) 15 | end; 16 | -------------------------------------------------------------------------------- /orig/intro/linecount.cc: -------------------------------------------------------------------------------- 1 | #include "../p2c.h" 2 | #include "intro.h" 3 | 4 | // Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. 5 | // linecount -- count lines in standard input 6 | void linecount() 7 | { 8 | integer nl; 9 | character c; 10 | 11 | nl = 0; 12 | while (getc(c) != ENDFILE) 13 | if (c == NEWLINE) 14 | nl = nl + 1; 15 | putdec(nl, 1); 16 | putc(NEWLINE); 17 | } 18 | -------------------------------------------------------------------------------- /orig/pman/error.m: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | .NM error print a message and exit 3 | .SY 4 | .UL "procedure error ('your message here');" 5 | .FU 6 | .UL error 7 | writes the literal string specified to a highly visible place, 8 | such as the user's terminal, 9 | then performs an abnormal exit. 10 | .RE 11 | Nothing. 12 | Moreover, 13 | .UL error 14 | never returns control to its caller. 15 | -------------------------------------------------------------------------------- /orig/pman/putc.m: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | .NM putc put a character on standard output 3 | .SY 4 | .UL "procedure putc (c : character);" 5 | .FU 6 | .UL putc 7 | writes the character 8 | .UL c 9 | to the standard output 10 | .UL STDOUT ; 11 | if the value of the argument 12 | .UL c 13 | is 14 | .UL NEWLINE , 15 | an appropriate end-of-line condition is generated. 16 | .RE 17 | Nothing. 18 | -------------------------------------------------------------------------------- /orig/sort/rotate.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { rotate -- output rotated line } 3 | procedure rotate (var buf : string; n : integer); 4 | var 5 | i : integer; 6 | begin 7 | i := n; 8 | while (buf[i] <> NEWLINE) and (buf[i] <> ENDSTR) do begin 9 | putc(buf[i]); 10 | i := i + 1 11 | end; 12 | putc(FOLD); 13 | for i := 1 to n-1 do 14 | putc(buf[i]); 15 | putc(NEWLINE) 16 | end; 17 | -------------------------------------------------------------------------------- /orig/translit/makeset.cc: -------------------------------------------------------------------------------- 1 | #include "../p2c.h" 2 | #include "translit.h" 3 | 4 | // Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. 5 | // makeset -- make set from inset[k] in outset 6 | boolean makeset(string& inset, integer k, string& outset, integer maxset) 7 | { 8 | integer j; 9 | 10 | j = 1; 11 | dodash(ENDSTR, inset, k, outset, j, maxset); 12 | return addstr(ENDSTR, outset, j, maxset); 13 | } 14 | -------------------------------------------------------------------------------- /orig/ucbprims/getc.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { getc (UCB) -- get one character from standard input } 3 | function getc (var c : character) : character; 4 | var 5 | ch : char; 6 | begin 7 | if eof then 8 | c := ENDFILE 9 | else if eoln then begin 10 | readln; 11 | c := NEWLINE 12 | end 13 | else begin 14 | read(ch); 15 | c := ord(ch) 16 | end; 17 | getc := c 18 | end; 19 | -------------------------------------------------------------------------------- /orig/ucsdprims/putcf.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { putcf (UCSD) -- put a single character on fd } 3 | procedure putcf (c : character; fd : filedesc); 4 | begin 5 | case (cmdfil[fd]) of 6 | STDIO: 7 | fputcf(c, output); 8 | FIL1: 9 | fputcf(c, file1); 10 | FIL2: 11 | fputcf(c, file2); 12 | FIL3: 13 | fputcf(c, file3); 14 | FIL4: 15 | fputcf(c, file4) 16 | end 17 | end; 18 | -------------------------------------------------------------------------------- /orig/edit/amatch0.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { amatch -- with no metacharacters } 3 | function amatch (var lin : string; i : integer; 4 | var pat : string; j : integer) : integer; 5 | begin 6 | while (pat[j] <> ENDSTR) and (i > 0) do 7 | if (lin[i] <> pat[j]) then 8 | i := 0 { no match } 9 | else begin 10 | i := i + 1; 11 | j := j + 1 12 | end; 13 | amatch := i 14 | end; 15 | -------------------------------------------------------------------------------- /orig/edit/default.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { default -- set defaulted line numbers } 3 | function default (def1, def2 : integer; 4 | var status : stcode) : stcode; 5 | begin 6 | if (nlines = 0) then begin 7 | line1 := def1; 8 | line2 := def2 9 | end; 10 | if (line1 > line2) or (line1 <= 0) then 11 | status := ERR 12 | else 13 | status := OK; 14 | default := status 15 | end; 16 | -------------------------------------------------------------------------------- /orig/translit/makeset.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { makeset -- make set from inset[k] in outset } 3 | function makeset (var inset : string; k : integer; 4 | var outset : string; maxset : integer) : boolean; 5 | var 6 | j : integer; 7 | #include "dodash.p" 8 | begin 9 | j := 1; 10 | dodash(ENDSTR, inset, k, outset, j, maxset); 11 | makeset := addstr(ENDSTR, outset, j, maxset) 12 | end; 13 | -------------------------------------------------------------------------------- /orig/edit/blkmove.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { blkmove -- move block of lines n1..n2 to after n3 } 3 | procedure blkmove (n1, n2, n3 : integer); 4 | begin 5 | if (n3 < n1-1) then begin 6 | reverse(n3+1, n1-1); 7 | reverse(n1, n2); 8 | reverse(n3+1, n2) 9 | end 10 | else if (n3 > n2) then begin 11 | reverse(n1, n2); 12 | reverse(n2+1, n3); 13 | reverse(n1, n3) 14 | end 15 | end; 16 | -------------------------------------------------------------------------------- /orig/sort/bubble.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { bubble -- bubble sort v[1] ... v[n] increasing } 3 | procedure bubble (var v : intarray; n : integer); 4 | var 5 | i, j, k : integer; 6 | begin 7 | for i := n downto 2 do 8 | for j := 1 to i-1 do 9 | if (v[j] > v[j+1]) then begin { compare } 10 | k := v[j]; { exchange } 11 | v[j] := v[j+1]; 12 | v[j+1] := k 13 | end 14 | end; 15 | -------------------------------------------------------------------------------- /orig/ucsdprims/fgetcf.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { fgetcf -- get character from file } 3 | function fgetcf (var fil : text) : character; 4 | var 5 | ch : char; 6 | begin 7 | if (eof(fil)) then 8 | fgetcf := ENDFILE 9 | else if (eoln(fil)) then begin 10 | readln(fil); 11 | fgetcf := NEWLINE 12 | end 13 | else begin 14 | read(fil, ch); 15 | fgetcf := ord(ch) 16 | end; 17 | end; 18 | -------------------------------------------------------------------------------- /orig/edit/lndelete.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { lndelete -- delete lines n1 through n2 } 3 | function lndelete (n1, n2 : integer; var status : stcode) 4 | : stcode; 5 | begin 6 | if (n1 <= 0) then 7 | status := ERR 8 | else begin 9 | blkmove(n1, n2, lastln); 10 | lastln := lastln - (n2 - n1 + 1); 11 | curln := prevln(n1); 12 | status := OK 13 | end; 14 | lndelete := status 15 | end; 16 | -------------------------------------------------------------------------------- /orig/pman/putcf.m: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | .NM putcf put a character in a file 3 | .SY 4 | .UL "procedure putcf (c : character; fd : filedesc);" 5 | .FU 6 | .UL putcf 7 | writes the character 8 | .UL c 9 | to the file 10 | specified by file descriptor 11 | .UL fd ; 12 | if the value of 13 | .UL c 14 | is 15 | .UL NEWLINE , 16 | an appropriate end-of-line condition is generated. 17 | .RE 18 | Nothing. 19 | -------------------------------------------------------------------------------- /orig/wsprims/fcopy.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { fcopy -- copy file fin to file fout } 3 | function getcf (var c : character; fd : filedesc) : character; 4 | external; 5 | 6 | procedure putcf (c : character; fd : filedesc); 7 | external; 8 | 9 | procedure fcopy (fin, fout : filedesc); 10 | var 11 | c : character; 12 | begin 13 | while (getcf(c, fin) <> ENDFILE) do 14 | putcf(c, fout) 15 | end; 16 | -------------------------------------------------------------------------------- /orig/wsprims/maxmin.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { max -- compute maximum of two integers } 3 | function max (x, y : integer) : integer; 4 | begin 5 | if (x > y) then 6 | max := x 7 | else 8 | max := y 9 | end; 10 | 11 | { min -- compute minimum of two integers } 12 | function min (x, y : integer) : integer; 13 | begin 14 | if (x < y) then 15 | min := x 16 | else 17 | min := y 18 | end; 19 | -------------------------------------------------------------------------------- /orig/wsprims/popen.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { popen (WS) -- Pascal open primitive } 3 | function open (var name : string; mode, rsize : integer) 4 | : filedesc; 5 | external; 6 | 7 | function popen (var name : string; mode : integer) 8 | : filedesc; 9 | var 10 | fd : filedesc; 11 | begin 12 | fd := open(name, mode, 0); 13 | if (fd < 0) then 14 | fd := IOERROR; 15 | popen := fd 16 | end; 17 | -------------------------------------------------------------------------------- /orig/edit/findcons.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { findcons -- const declarations for find } 3 | const 4 | MAXPAT = MAXSTR; 5 | CLOSIZE = 1; { size of a closure entry } 6 | CLOSURE = STAR; 7 | BOL = PERCENT; 8 | EOL = DOLLAR; 9 | ANY = QUESTION; 10 | CCL = LBRACK; 11 | CCLEND = RBRACK; 12 | NEGATE = CARET; 13 | NCCL = EXCLAM; { cannot be the same as NEGATE } 14 | LITCHAR = LETC; { ord('c') } 15 | -------------------------------------------------------------------------------- /orig/macro/lookup.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { lookup -- locate name, get defn and type from table } 3 | function lookup (var name, defn : string; var t : sttype) 4 | : boolean; 5 | var 6 | p : ndptr; 7 | begin 8 | p := hashfind(name); 9 | if (p = nil) then 10 | lookup := false 11 | else begin 12 | lookup := true; 13 | cscopy(ndtable, p^.defn, defn); 14 | t := p^.kind 15 | end 16 | end; 17 | -------------------------------------------------------------------------------- /orig/print/print0.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { print -- print files with headings } 3 | procedure print; 4 | var 5 | name : string; 6 | i : integer; 7 | fin : filedesc; 8 | junk : boolean; 9 | #include "fprint.p" 10 | begin 11 | for i := 1 to nargs do begin 12 | junk := getarg(i, name, MAXSTR); 13 | fin := mustopen(name, IOREAD); 14 | fprint(name, fin); 15 | close(fin) 16 | end 17 | end; 18 | -------------------------------------------------------------------------------- /orig/wsprims/pputstr.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { pputstr (WS) -- Pascal putstr primitive } 3 | procedure write (fd : filedesc; var c : string; 4 | size : integer); 5 | external; 6 | 7 | procedure pputstr (var str : string; fd : filedesc); 8 | var 9 | i : integer; 10 | begin 11 | i := 1; 12 | while (str[i] <> ENDSTR) do 13 | i := i + 1; 14 | if (i > 1) then 15 | write(fd, str, i-1) 16 | end; 17 | -------------------------------------------------------------------------------- /cpp/intro/wordcount.cc: -------------------------------------------------------------------------------- 1 | // wordcount -- count words in standard input 2 | #include 3 | #include 4 | 5 | int main() 6 | { 7 | size_t nw = 0; 8 | bool inword = false; 9 | int c; 10 | 11 | while ( (c = getchar()) != EOF) 12 | if (isspace(c)) 13 | inword = false; 14 | else if (!inword) { 15 | inword = true; 16 | ++nw; 17 | } 18 | 19 | printf("%zd\n", nw); 20 | } 21 | -------------------------------------------------------------------------------- /orig/edit/amatch1.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { amatch -- with some metacharacters } 3 | function amatch (var lin : string; i : integer; 4 | var pat : string; j : integer) : integer; 5 | #include "omatch.p" 6 | begin 7 | while (pat[j] <> ENDSTR) and (i > 0) do 8 | if (omatch(lin, i, pat, j)) then 9 | j := j + patsize(pat, j) 10 | else 11 | i := 0; { no match possible } 12 | amatch := i 13 | end; 14 | -------------------------------------------------------------------------------- /orig/macro/defproc.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { defproc -- procedures needed by define } 3 | #include "cscopy.p" 4 | #include "sccopy.p" 5 | #include "putback.p" 6 | #include "getpbc.p" 7 | #include "pbstr.p" 8 | #include "gettok.p" 9 | #include "getdef.p" 10 | #include "inithash.p" 11 | #include "hash.p" 12 | #include "hashfind.p" 13 | #include "install.p" 14 | #include "lookup.p" 15 | #include "initdef.p" 16 | -------------------------------------------------------------------------------- /orig/man/echo.m: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | .NM echo echo arguments to output 3 | .SY 4 | .UL "echo [ argument ... ]" 5 | .FU 6 | .UL echo 7 | copies its command line arguments to its output as a line 8 | of text with one space between each argument. 9 | If there are no arguments, no output is produced. 10 | .EG 11 | To see if your system is alive: 12 | .Q1 13 | echo hello world! 14 | .S "hello world!" 15 | .Q2 16 | -------------------------------------------------------------------------------- /orig/sort/unique.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { unique -- remove adjacent duplicate lines } 3 | procedure unique; 4 | var 5 | buf : array [0..1] of string; 6 | cur : 0..1; 7 | begin 8 | cur := 1; 9 | buf[1-cur][1] := ENDSTR; 10 | while (getline(buf[cur], STDIN, MAXSTR)) do 11 | if (not equal(buf[cur], buf[1-cur])) then begin 12 | putstr(buf[cur], STDOUT); 13 | cur := 1 - cur 14 | end 15 | end; 16 | -------------------------------------------------------------------------------- /orig/ucbprims/prims.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { prims -- primitive functions and procedures for UCB } 3 | #include "initio.p" 4 | #include "open.p" 5 | #include "create.p" 6 | #include "getc.p" 7 | #include "getcf.p" 8 | #include "getline.p" 9 | #include "putc.p" 10 | #include "putcf.p" 11 | #include "putstr.p" 12 | #include "close.p" 13 | #include "remove.p" 14 | #include "getarg.p" 15 | #include "nargs.p" 16 | -------------------------------------------------------------------------------- /orig/ucsdprims/ftalloc.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { ftalloc -- allocate a file } 3 | function ftalloc : filtyp; 4 | var 5 | done : boolean; 6 | ft : filtyp; 7 | begin 8 | ft := FIL1; 9 | repeat 10 | done := (not cmdopen[ft] or (ft = FIL4)); 11 | if (not done) then 12 | ft := succ(ft) 13 | until (done); 14 | if (cmdopen[ft]) then 15 | ftalloc := CLOSED 16 | else 17 | ftalloc := ft 18 | end; 19 | -------------------------------------------------------------------------------- /orig/edit/doprint.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { doprint -- print lines n1 through n2 } 3 | function doprint (n1, n2 : integer) : stcode; 4 | var 5 | i : integer; 6 | line : string; 7 | begin 8 | if (n1 <= 0) then 9 | doprint := ERR 10 | else begin 11 | for i := n1 to n2 do begin 12 | gettxt(i, line); 13 | putstr(line, STDOUT) 14 | end; 15 | curln := n2; 16 | doprint := OK 17 | end 18 | end; 19 | -------------------------------------------------------------------------------- /orig/format/width.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { width -- compute width of character string } 3 | function width (var buf : string) : integer; 4 | var 5 | i, w : integer; 6 | begin 7 | w := 0; 8 | i := 1; 9 | while (buf[i] <> ENDSTR) do begin 10 | if (buf[i] = BACKSPACE) then 11 | w := w - 1 12 | else if (buf[i] <> NEWLINE) then 13 | w := w + 1; 14 | i := i + 1 15 | end; 16 | width := w 17 | end; 18 | -------------------------------------------------------------------------------- /orig/man/error.m: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | .ds n PRIMITIVE 3 | .NM error,\ message print diagnostic message on STDERR 4 | .SY 5 | .Q1 6 | s : packed array [1..\f2n\fP] of char; 7 | 8 | error(s); 9 | message(s); 10 | .Q2 11 | .FU 12 | .UL error 13 | and 14 | .UL message 15 | write their single argument on 16 | .UL STDERR . 17 | .UL message 18 | returns, 19 | .UL error 20 | terminates execution of the program. 21 | -------------------------------------------------------------------------------- /orig/wsprims/pcreate.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { pcreate (WS) -- Pascal create primitive } 3 | function create (var name : string; mode, rsize : integer) 4 | : filedesc; 5 | external; 6 | 7 | function pcreate (var name : string; mode : integer) 8 | : filedesc; 9 | var 10 | fd : filedesc; 11 | begin 12 | fd := create(name, mode, 0); 13 | if (fd < 0) then 14 | fd := IOERROR; 15 | pcreate := fd 16 | end; 17 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.swp 2 | bin/ 3 | p2c/Pascal* 4 | 5 | # Prerequisites 6 | *.d 7 | 8 | # Compiled Object files 9 | *.slo 10 | *.lo 11 | *.o 12 | *.obj 13 | 14 | # Precompiled Headers 15 | *.gch 16 | *.pch 17 | 18 | # Compiled Dynamic libraries 19 | *.so 20 | *.dylib 21 | *.dll 22 | 23 | # Fortran module files 24 | *.mod 25 | *.smod 26 | 27 | # Compiled Static libraries 28 | *.lai 29 | *.la 30 | *.a 31 | *.lib 32 | 33 | # Executables 34 | *.exe 35 | *.out 36 | *.app 37 | -------------------------------------------------------------------------------- /orig/edit/puttxt1.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { puttxt (in memory) -- put text from lin after curln } 3 | function puttxt (var lin : string) : stcode; 4 | begin 5 | puttxt := ERR; 6 | if (lastln < MAXLINES) then begin 7 | lastln := lastln + 1; 8 | scopy(lin, 1, buf[lastln].txt, 1); 9 | putmark(lastln, false); 10 | blkmove(lastln, lastln, curln); 11 | curln := curln + 1; 12 | puttxt := OK 13 | end 14 | end; 15 | -------------------------------------------------------------------------------- /orig/archive/tprint.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { tprint -- print table entry for one member } 3 | procedure tprint (var buf : string); 4 | var 5 | i : integer; 6 | temp : string; 7 | begin 8 | i := getword(buf, 1, temp); { header } 9 | i := getword(buf, i, temp); { name } 10 | putstr(temp, STDOUT); 11 | putc(BLANK); 12 | i := getword(buf, i, temp); { size } 13 | putstr(temp, STDOUT); 14 | putc(NEWLINE) 15 | end; 16 | -------------------------------------------------------------------------------- /orig/edit/move.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { move -- move line1 through line2 after line3 } 3 | function move (line3 : integer) : stcode; 4 | begin 5 | if (line1<=0) or ((line3>=line1) and (line3 line1) then 10 | curln := line3 11 | else 12 | curln := line3 + (line2 - line1 + 1); 13 | move := OK 14 | end 15 | end; 16 | -------------------------------------------------------------------------------- /orig/filters/echo.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { echo -- echo command line arguments to output } 3 | procedure echo; 4 | var 5 | i, j : integer; 6 | argstr : string; 7 | begin 8 | i := 1; 9 | while (getarg(i, argstr, MAXSTR)) do begin 10 | if (i > 1) then 11 | putc(BLANK); 12 | for j := 1 to length(argstr) do 13 | putc(argstr[j]); 14 | i := i + 1 15 | end; 16 | if (i > 1) then 17 | putc(NEWLINE) 18 | end; 19 | -------------------------------------------------------------------------------- /orig/sort/ptext.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { ptext -- output text lines from linebuf } 3 | procedure ptext (var linepos : posbuf; nlines : integer; 4 | var linebuf : charbuf; outfile : filedesc); 5 | var 6 | i, j : integer; 7 | begin 8 | for i := 1 to nlines do begin 9 | j := linepos[i]; 10 | while (linebuf[j] <> ENDSTR) do begin 11 | putcf(linebuf[j], outfile); 12 | j := j + 1 13 | end 14 | end 15 | end; 16 | -------------------------------------------------------------------------------- /orig/format/leadbl.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { leadbl -- delete leading blanks, set tival } 3 | procedure leadbl (var buf : string); 4 | var 5 | i, j : integer; 6 | begin 7 | break; 8 | i := 1; 9 | while (buf[i] = BLANK) do { find 1st non-blank } 10 | i := i + 1; 11 | if (buf[i] <> NEWLINE) then 12 | tival := tival + i - 1; 13 | for j := i to length(buf)+1 do { move line to left } 14 | buf[j-i+1] := buf[j] 15 | end; 16 | -------------------------------------------------------------------------------- /orig/translit/translit.h: -------------------------------------------------------------------------------- 1 | #pragma once 2 | 3 | // dodash - expand set at src[i] into dest[j], stop at delim 4 | void dodash(character delim, string& src, integer& i, string& dest, integer& j, integer maxset); 5 | 6 | // makeset -- make set from inset[k] in outset 7 | boolean makeset(string& inset, integer k, string& outset, integer maxset); 8 | 9 | // xindex -- conditionally invert value from index 10 | integer xindex(string& inset, character c, boolean allbut, integer lastto); 11 | -------------------------------------------------------------------------------- /orig/ucsdprims/getcf.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { getcf (UCSD) -- get one character from file } 3 | function getcf (var c : character; fd : filedesc) 4 | : character; 5 | begin 6 | case (cmdfil[fd]) of 7 | STDIO: 8 | c := getkbd(c); 9 | FIL1: 10 | c := fgetcf(file1); 11 | FIL2: 12 | c := fgetcf(file2); 13 | FIL3: 14 | c := fgetcf(file3); 15 | FIL4: 16 | c := fgetcf(file4) 17 | end; 18 | getcf := c 19 | end; 20 | -------------------------------------------------------------------------------- /orig/edit/putsub.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { putsub -- output substitution text } 3 | procedure putsub (var lin : string; s1, s2 : integer; 4 | var sub : string); 5 | var 6 | i, j : integer; 7 | junk : boolean; 8 | begin 9 | i := 1; 10 | while (sub[i] <> ENDSTR) do begin 11 | if (sub[i] = DITTO) then 12 | for j := s1 to s2-1 do 13 | putc(lin[j]) 14 | else 15 | putc(sub[i]); 16 | i := i + 1 17 | end 18 | end; 19 | -------------------------------------------------------------------------------- /orig/pman/nargs.m: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | .NM nargs get number of command line arguments 3 | .SY 4 | .UL "function nargs : integer;" 5 | .FU 6 | .UL nargs 7 | determines the number of arguments used on the command line 8 | that invoked the program, 9 | suitable for copying by 10 | .UL getarg . 11 | .RE 12 | .UL nargs 13 | returns the number of arguments found on the command line, i.e., a number 14 | greater than or equal to zero. 15 | -------------------------------------------------------------------------------- /orig/sort/gname.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { gname -- generate unique name for file id n } 3 | procedure gname (n : integer; var name : string); 4 | var 5 | junk : integer; 6 | begin 7 | { setstring(name, 'stemp'); } 8 | name[1] := ord('s'); 9 | name[2] := ord('t'); 10 | name[3] := ord('e'); 11 | name[4] := ord('m'); 12 | name[5] := ord('p'); 13 | name[6] := ENDSTR; 14 | junk := itoc(n, name, length(name)+1) 15 | end; 16 | -------------------------------------------------------------------------------- /orig/translit/xindex.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { xindex -- conditionally invert value from index } 3 | function xindex (var inset : string; c : character; 4 | allbut : boolean; lastto : integer) : integer; 5 | begin 6 | if (c = ENDFILE) then 7 | xindex := 0 8 | else if (not allbut) then 9 | xindex := index(inset, c) 10 | else if (index(inset, c) > 0) then 11 | xindex := 0 12 | else 13 | xindex := lastto + 1 14 | end; 15 | -------------------------------------------------------------------------------- /orig/macro/deftype.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { deftype -- type definitions for define } 3 | type 4 | charpos = 1..MAXCHARS; 5 | charbuf = array [1..MAXCHARS] of character; 6 | sttype = (DEFTYPE, MACTYPE); { symbol table types } 7 | ndptr = ^ndblock; { pointer to a name-defn block } 8 | ndblock = 9 | record { name-defn block } 10 | name : charpos; 11 | defn : charpos; 12 | kind : sttype; 13 | nextptr : ndptr 14 | end; 15 | -------------------------------------------------------------------------------- /orig/macro/initdef.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { initdef -- initialize variables for define } 3 | procedure initdef; 4 | begin 5 | { setstring(defname, 'define'); } 6 | defname[1] := ord('d'); 7 | defname[2] := ord('e'); 8 | defname[3] := ord('f'); 9 | defname[4] := ord('i'); 10 | defname[5] := ord('n'); 11 | defname[6] := ord('e'); 12 | defname[7] := ENDSTR; 13 | bp := 0; { pushback buffer pointer } 14 | inithash 15 | end; 16 | -------------------------------------------------------------------------------- /orig/archive/table.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { table -- print table of archive contents } 3 | procedure table (var aname : string); 4 | var 5 | head, name : string; 6 | size : integer; 7 | afd : filedesc; 8 | #include "tprint.p" 9 | begin 10 | afd := mustopen(aname, IOREAD); 11 | while (gethdr(afd, head, name, size)) do begin 12 | if (filearg(name)) then 13 | tprint(head); 14 | fskip(afd, size) 15 | end; 16 | notfound 17 | end; 18 | -------------------------------------------------------------------------------- /orig/format/gettl.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { gettl -- copy title from buf to ttl } 3 | procedure gettl (var buf, ttl : string); 4 | var 5 | i : integer; 6 | begin 7 | i := 1; { skip command name } 8 | while (not (buf[i] in [BLANK, TAB, NEWLINE])) do 9 | i := i + 1; 10 | skipbl(buf, i); { find argument } 11 | if (buf[i] = SQUOTE) or (buf[i] = DQUOTE) then 12 | i := i + 1; { strip leading quote } 13 | scopy(buf, i, ttl, 1) 14 | end; 15 | -------------------------------------------------------------------------------- /orig/macro/factor.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { factor -- evaluate factor of arithmetic expression } 3 | function factor (var s : string; var i : integer) 4 | : integer; 5 | begin 6 | if (gnbchar(s, i) = LPAREN) then begin 7 | i := i + 1; 8 | factor := expr(s, i); 9 | if (gnbchar(s, i) = RPAREN) then 10 | i := i + 1 11 | else 12 | message('macro: missing paren in expr') 13 | end 14 | else 15 | factor := ctoi(s, i) 16 | end; 17 | -------------------------------------------------------------------------------- /orig/ucsdprims/close.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { xclose (UCSD) -- interface to file close } 3 | procedure xclose (fd : filedesc); 4 | begin 5 | case (cmdfil[fd]) of 6 | CLOSED, STDIO: 7 | ; { do nothing } 8 | FIL1: 9 | close(file1, LOCK); 10 | FIL2: 11 | close(file2, LOCK); 12 | FIL3: 13 | close(file3, LOCK); 14 | FIL4: 15 | close(file4, LOCK) 16 | end; 17 | cmdopen[cmdfil[fd]] := false; 18 | cmdfil[fd] := CLOSED 19 | end; 20 | -------------------------------------------------------------------------------- /orig/edit/ckp.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { ckp -- check for "p" after command } 3 | function ckp (var lin : string; i : integer; 4 | var pflag : boolean; var status : stcode) : stcode; 5 | begin 6 | skipbl(lin, i); 7 | if (lin[i] = PCMD) then begin 8 | i := i + 1; 9 | pflag := true 10 | end 11 | else 12 | pflag := false; 13 | if (lin[i] = NEWLINE) then 14 | status := OK 15 | else 16 | status := ERR; 17 | ckp := status 18 | end; 19 | -------------------------------------------------------------------------------- /orig/edit/stclose.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { stclose -- insert closure entry at pat[j] } 3 | procedure stclose (var pat : string; var j : integer; 4 | lastj : integer); 5 | var 6 | jp, jt : integer; 7 | junk : boolean; 8 | begin 9 | for jp := j-1 downto lastj do begin 10 | jt := jp + CLOSIZE; 11 | junk := addstr(pat[jp], pat, jt, MAXPAT) 12 | end; 13 | j := j + CLOSIZE; 14 | pat[lastj] := CLOSURE { where original pattern began } 15 | end; 16 | -------------------------------------------------------------------------------- /orig/fileio/concat.cc: -------------------------------------------------------------------------------- 1 | #include "../p2c.h" 2 | #include "fileio.h" 3 | 4 | // Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. 5 | // concat -- concatenate files onto standard output 6 | void concat() 7 | { 8 | integer i; 9 | boolean junk; 10 | filedesc fd; 11 | string s; 12 | 13 | for (i = 1; i <= nargs; ++i) { 14 | junk = getarg(i, s, MAXSTR); 15 | fd = mustopen(s, IOREAD); 16 | fcopy(fd, STDOUT); 17 | close(fd); 18 | } 19 | } 20 | -------------------------------------------------------------------------------- /orig/fileio/dcompare.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { dcompare -- drive simple version of compare } 3 | procedure dcompare; 4 | var 5 | arg1, arg2 : string; 6 | infile1, infile2 : filedesc; 7 | #include "compare0.p" 8 | begin 9 | if (not getarg(1, arg1, MAXSTR)) 10 | or (not getarg(2, arg2, MAXSTR)) then 11 | error('usage: compare file1 file2'); 12 | infile1 := mustopen(arg1, IOREAD); 13 | infile2 := mustopen(arg2, IOREAD); 14 | compare 15 | end; 16 | -------------------------------------------------------------------------------- /orig/filters/putrep.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { putrep -- put out representation of run of n 'c's } 3 | procedure putrep (n : integer; c : character); 4 | const 5 | MAXREP = 26; { assuming 'A'..'Z' } 6 | THRESH = 4; 7 | begin 8 | while (n >= THRESH) or ((c = WARNING) and (n > 0)) do begin 9 | putc(WARNING); 10 | putc(min(n, MAXREP) - 1 + ord('A')); 11 | putc(c); 12 | n := n - MAXREP 13 | end; 14 | for n := n downto 1 do 15 | putc(c) 16 | end; 17 | -------------------------------------------------------------------------------- /orig/translit/xindex.cc: -------------------------------------------------------------------------------- 1 | #include "../p2c.h" 2 | #include "translit.h" 3 | 4 | // Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. 5 | // xindex -- conditionally invert value from index 6 | integer xindex(string& inset, character c, boolean allbut, integer lastto) 7 | { 8 | if (c == ENDFILE) 9 | return 0; 10 | else if (not allbut) 11 | return index(inset, c); 12 | else if (index(inset, c) > 0) 13 | return 0; 14 | else 15 | return lastto + 1; 16 | } 17 | -------------------------------------------------------------------------------- /orig/ucbprims/initio.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { initio (UCB) -- initialize open file list } 3 | procedure initio; 4 | var 5 | i : filedesc; 6 | begin 7 | openlist[STDIN].mode := IOREAD; 8 | openlist[STDOUT].mode := IOWRITE; 9 | openlist[STDERR].mode := IOWRITE; 10 | 11 | { connect STDERR to user's terminal ... } 12 | rewrite(openlist[STDERR].filevar, '/dev/tty '); 13 | 14 | for i := STDERR+1 to MAXOPEN do 15 | openlist[i].mode := IOAVAIL; 16 | end; 17 | -------------------------------------------------------------------------------- /orig/fileio/makecopy.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { makecopy -- copy one file to another } 3 | procedure makecopy; 4 | var 5 | inname, outname : string; 6 | fin, fout : filedesc; 7 | begin 8 | if (not getarg(1, inname, MAXSTR)) 9 | or (not getarg(2, outname, MAXSTR)) then 10 | error('usage: makecopy old new'); 11 | fin := mustopen(inname, IOREAD); 12 | fout := mustcreate(outname, IOWRITE); 13 | fcopy(fin, fout); 14 | close(fin); 15 | close(fout) 16 | end; 17 | -------------------------------------------------------------------------------- /orig/pman/putstr.m: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | .NM putstr put string in a file 3 | .SY 4 | .UL "procedure putstr (var str : string; fd : filedesc);" 5 | .FU 6 | .UL putstr 7 | writes the characters in 8 | .UL str , 9 | up to but not including the terminating 10 | .UL ENDSTR , 11 | to the file 12 | specified by file descriptor 13 | .UL fd . 14 | An unsuccessful write may or may not cause a warning message or 15 | early termination of the program. 16 | .RE 17 | Nothing. 18 | -------------------------------------------------------------------------------- /orig/edit/puttxt2.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { puttxt (scratch file) -- put text from lin after curln } 3 | function puttxt (var lin : string) : stcode; 4 | begin 5 | puttxt := ERR; 6 | if (lastln < MAXLINES) then begin 7 | lastln := lastln + 1; 8 | putstr(lin, scrout); 9 | putmark(lastln, false); 10 | buf[lastln].txt := recout; 11 | recout := recout + 1; 12 | blkmove(lastln, lastln, curln); 13 | curln := curln + 1; 14 | puttxt := OK 15 | end 16 | end; 17 | -------------------------------------------------------------------------------- /orig/man/concat.m: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | .NM concat concatenate files 3 | .SY 4 | .UL "concat file ..." 5 | .FU 6 | .UL concat 7 | writes the contents of each of its file arguments in turn to its output, 8 | thus concatenating them into one larger file. 9 | Since 10 | .UL concat 11 | performs no reformatting or interpretation of the input files, 12 | it is useful for displaying the contents of a file. 13 | .EG 14 | To examine a file: 15 | .Q1 16 | concat file 17 | .Q2 18 | -------------------------------------------------------------------------------- /orig/man/wordcount.m: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | .NM wordcount count words in input 3 | .SY 4 | .UL wordcount 5 | .FU 6 | .UL wordcount 7 | counts the words in its input and writes the total as a line of 8 | text to the output. 9 | A ``word'' is a maximal sequence of characters not 10 | containing a blank or tab or newline. 11 | .EG 12 | .Q1 13 | wordcount 14 | A single line of input. 15 | 16 | .S 5 17 | .Q2 18 | .BU 19 | The definition of ``word'' is simplistic. 20 | -------------------------------------------------------------------------------- /orig/util/itoc.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { itoc - convert integer n to char string in s[i]... } 3 | function itoc (n : integer; var s : string; i : integer) 4 | : integer; { returns end of s } 5 | begin 6 | if (n < 0) then begin 7 | s[i] := ord('-'); 8 | itoc := itoc(-n, s, i+1) 9 | end 10 | else begin 11 | if (n >= 10) then 12 | i := itoc(n div 10, s, i); 13 | s[i] := n mod 10 + ord('0'); 14 | s[i+1] := ENDSTR; 15 | itoc := i + 1 16 | end 17 | end; 18 | -------------------------------------------------------------------------------- /orig/archive/makehdr.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { makehdr -- make header line for archive member } 3 | procedure makehdr (var name, head : string); 4 | var 5 | i : integer; 6 | #include "fsize.p" 7 | begin 8 | scopy(archhdr, 1, head, 1); 9 | i := length(head) + 1; 10 | head[i] := BLANK; 11 | scopy(name, 1, head, i+1); 12 | i := length(head) + 1; 13 | head[i] := BLANK; 14 | i := itoc(fsize(name), head, i+1); 15 | head[i] := NEWLINE; 16 | head[i+1] := ENDSTR 17 | end; 18 | -------------------------------------------------------------------------------- /orig/sort/putrot.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { putrot -- create lines with keyword at front } 3 | procedure putrot (var buf : string); 4 | var 5 | i : integer; 6 | #include "rotate.p" 7 | begin 8 | i := 1; 9 | while (buf[i] <> NEWLINE) and (buf[i] <> ENDSTR) do begin 10 | if (isalphanum(buf[i])) then begin 11 | rotate(buf, i); { token starts at "i" } 12 | repeat 13 | i := i + 1 14 | until (not isalphanum(buf[i])) 15 | end; 16 | i := i + 1 17 | end 18 | end; 19 | -------------------------------------------------------------------------------- /orig/format/put.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { put -- put out line with proper spacing and indenting } 3 | procedure put (var buf : string); 4 | var 5 | i : integer; 6 | begin 7 | if (lineno <= 0) or (lineno > bottom) then 8 | puthead; 9 | for i := 1 to inval + tival do { indenting } 10 | putc(BLANK); 11 | tival := 0; 12 | putstr(buf, STDOUT); 13 | skip(min(lsval-1, bottom-lineno)); 14 | lineno := lineno + lsval; 15 | if (lineno > bottom) then 16 | putfoot 17 | end; 18 | -------------------------------------------------------------------------------- /orig/wsprims/putdec.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { putdec -- put decimal integer n in field width >= w } 3 | function itoc (n : integer; var str : string; i : integer) : integer; 4 | external; 5 | 6 | procedure putc (c : character); 7 | external; 8 | 9 | procedure putdec (n, w : integer); 10 | var 11 | i, nd : integer; 12 | s : string; 13 | begin 14 | nd := itoc(n, s, 1); 15 | for i := nd to w do 16 | putc(BLANK); 17 | for i := 1 to nd-1 do 18 | putc(s[i]); 19 | end; 20 | -------------------------------------------------------------------------------- /orig/archive/archproc.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { archproc -- include procedures for archive } 3 | #include "getword.p" 4 | #include "gethdr.p" 5 | #include "filearg.p" 6 | #include "fskip.p" 7 | #include "fmove.p" 8 | #include "acopy.p" 9 | #include "notfound.p" 10 | #include "addfile.p" 11 | #include "replace.p" 12 | #include "help.p" 13 | #include "getfns.p" 14 | #include "update.p" 15 | #include "table.p" 16 | #include "extract.p" 17 | #include "delete.p" 18 | #include "initarch.p" 19 | -------------------------------------------------------------------------------- /orig/edit/find.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { find -- find patterns in text } 3 | procedure find; 4 | #include "findcons.p" 5 | var 6 | arg, lin, pat : string; 7 | #include "getpat.p" 8 | #include "match.p" 9 | begin 10 | if (not getarg(1, arg, MAXSTR)) then 11 | error('usage: find pattern'); 12 | if (not getpat(arg, pat)) then 13 | error('find: illegal pattern'); 14 | while (getline(lin, STDIN, MAXSTR)) do 15 | if (match(lin, pat)) then 16 | putstr(lin, STDOUT) 17 | end; 18 | -------------------------------------------------------------------------------- /orig/sort/sorttest.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | procedure sorttest; 3 | type intarray = array [1..100] of integer; 4 | var 5 | v : intarray; 6 | buf : string; 7 | i, j : integer; 8 | #include "shell0.p" 9 | #include "ctoi.p" 10 | begin 11 | j := 0; 12 | while (getline(buf, STDIN, MAXSTR)) do begin 13 | j := j + 1; 14 | i := 1; 15 | v[j] := ctoi(buf, i) 16 | end; 17 | shell(v, j); 18 | for i := 1 to j do begin 19 | putdec(v[i], 1); 20 | putc(NEWLINE) 21 | end 22 | end; 23 | -------------------------------------------------------------------------------- /orig/fileio/dcompare.cc: -------------------------------------------------------------------------------- 1 | #include "../p2c.h" 2 | #include "fileio.h" 3 | 4 | // Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. 5 | // dcompare -- drive simple version of compare 6 | void dcompare() 7 | { 8 | string arg1, arg2; 9 | filedesc infile1, infile2; 10 | 11 | if ((not getarg(1, arg1, MAXSTR)) 12 | or (not getarg(2, arg2, MAXSTR))) 13 | error("usage: compare file1 file2"); 14 | infile1 = mustopen(arg1, IOREAD); 15 | infile2 = mustopen(arg2, IOREAD); 16 | compare(); 17 | } 18 | -------------------------------------------------------------------------------- /orig/format/getval.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { getval -- evaluate optional numeric argument } 3 | function getval (var buf : string; 4 | var argtype : integer) : integer; 5 | var 6 | i : integer; 7 | begin 8 | i := 1; { skip over command name } 9 | while (not (buf[i] in [BLANK, TAB, NEWLINE])) do 10 | i := i + 1; 11 | skipbl(buf, i); { find argument } 12 | argtype := buf[i]; 13 | if (argtype = PLUS) or (argtype = MINUS) then 14 | i := i + 1; 15 | getval := ctoi(buf, i) 16 | end; 17 | -------------------------------------------------------------------------------- /orig/wsprims/itoc.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { itoc - convert integer n to char string in str[i]... } 3 | function itoc (n : integer; var str : string; i : integer) 4 | : integer; { returns 1st free i } 5 | begin 6 | if (n < 0) then begin 7 | str[i] := ord('-'); 8 | itoc := itoc(-n, str, i+1) 9 | end 10 | else begin 11 | if (n >= 10) then 12 | i := itoc(n div 10, str, i); 13 | str[i] := n mod 10 + ord('0'); 14 | str[i+1] := ENDSTR; 15 | itoc := i + 1 16 | end 17 | end; 18 | -------------------------------------------------------------------------------- /orig/intro/wordcount.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { wordcount -- count words in standard input } 3 | procedure wordcount; 4 | var 5 | nw : integer; 6 | c : character; 7 | inword : boolean; 8 | begin 9 | nw := 0; 10 | inword := false; 11 | while (getc(c) <> ENDFILE) do 12 | if (c = BLANK) or (c = NEWLINE) or (c = TAB) then 13 | inword := false 14 | else if (not inword) then begin 15 | inword := true; 16 | nw := nw + 1 17 | end; 18 | putdec(nw, 1); 19 | putc(NEWLINE) 20 | end; 21 | -------------------------------------------------------------------------------- /orig/macro/hashfind.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { hashfind -- find name in hash table } 3 | function hashfind (var name : string) : ndptr; 4 | var 5 | p : ndptr; 6 | tempname : string; 7 | found : boolean; 8 | begin 9 | found := false; 10 | p := hashtab[hash(name)]; 11 | while (not found) and (p <> nil) do begin 12 | cscopy(ndtable, p^.name, tempname); 13 | if (equal(name, tempname)) then 14 | found := true 15 | else 16 | p := p^.nextptr 17 | end; 18 | hashfind := p 19 | end; 20 | -------------------------------------------------------------------------------- /orig/ucbprims/getline.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { getline (UCB) -- get a line from file } 3 | function getline (var s : string; fd : filedesc; 4 | maxsize : integer) : boolean; 5 | var 6 | i : integer; 7 | c : character; 8 | begin 9 | i := 1; 10 | repeat 11 | s[i] := getcf(c, fd); 12 | i := i + 1 13 | until (c = ENDFILE) or (c = NEWLINE) or (i >= maxsize); 14 | if (c = ENDFILE) then { went one too far } 15 | i := i - 1; 16 | s[i] := ENDSTR; 17 | getline := (c <> ENDFILE) 18 | end; 19 | -------------------------------------------------------------------------------- /orig/util/esc.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { esc -- map s[i] into escaped character, increment i } 3 | function esc (var s : string; var i : integer) : character; 4 | begin 5 | if (s[i] <> ESCAPE) then 6 | esc := s[i] 7 | else if (s[i+1] = ENDSTR) then { @ not special at end } 8 | esc := ESCAPE 9 | else begin 10 | i := i + 1; 11 | if (s[i] = ord('n')) then 12 | esc := NEWLINE 13 | else if (s[i] = ord('t')) then 14 | esc := TAB 15 | else 16 | esc := s[i] 17 | end 18 | end; 19 | -------------------------------------------------------------------------------- /orig/edit/altpatsize.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { patsize -- returns size of pattern entry at pat[n] } 3 | function patsize (var pat : string; n : integer) : integer; 4 | begin 5 | if (pat[n] = LITCHAR) then 6 | patsize := 2 7 | else if (pat[n] in [BOL, EOL, ANY]) then 8 | patsize := 1 9 | else if (pat[n] = CCL) or (pat[n] = NCCL) then 10 | patsize := pat[n+1] + 2 11 | else if (pat[n] = CLOSURE) then 12 | patsize := CLOSIZE 13 | else 14 | error('in patsize: can''t happen') 15 | end; 16 | -------------------------------------------------------------------------------- /orig/util/esc.cc: -------------------------------------------------------------------------------- 1 | #include "../p2c.h" 2 | #include "util.h" 3 | 4 | // esc -- map s[i] into escaped character, increment i 5 | character esc(string& s, integer& i) 6 | { 7 | if (s[i] != ESCAPE) 8 | return s[i]; 9 | else if (s[i + 1] == ENDSTR) // @ not special at end 10 | return ESCAPE; 11 | else { 12 | i = i + 1; 13 | if (s[i] == ord('n')) 14 | return NEWLINE; 15 | else if (s[i] == ord('t')) 16 | return TAB; 17 | else 18 | return s[i]; 19 | } 20 | } 21 | -------------------------------------------------------------------------------- /orig/edit/edvar1.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { editvar -- variables for edit } 3 | var 4 | buf : array [0..MAXLINES] of buftype; 5 | 6 | line1 : integer; { first line number } 7 | line2 : integer; { second line number } 8 | nlines : integer; { # of line numbers specified } 9 | curln : integer; { current line -- value of dot } 10 | lastln : integer; { last line -- value of $ } 11 | 12 | pat : string; { pattern } 13 | lin : string; { input line } 14 | savefile : string; { remembered file name } 15 | -------------------------------------------------------------------------------- /orig/filters/echo.cc: -------------------------------------------------------------------------------- 1 | #include "../p2c.h" 2 | #include "filters.h" 3 | 4 | // Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. 5 | // echo -- echo command line arguments to output 6 | void echo() 7 | { 8 | integer i, j; 9 | string argstr; 10 | 11 | i = 1; 12 | while (getarg(i, argstr, MAXSTR)) { 13 | if (i > 1) 14 | putc(BLANK); 15 | for (j = 1; j <= length(argstr); ++j) 16 | putc(argstr[j]); 17 | i = i + 1; 18 | } 19 | if (i > 1) 20 | putc(NEWLINE); 21 | } 22 | -------------------------------------------------------------------------------- /orig/macro/mactype.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { mactype -- type declarations for macro } 3 | type 4 | charpos = 1..MAXCHARS; 5 | charbuf = array [1..MAXCHARS] of character; 6 | posbuf = array [1..MAXPOS] of charpos; 7 | pos = 0..MAXPOS; 8 | sttype = (DEFTYPE, MACTYPE, IFTYPE, SUBTYPE, 9 | EXPRTYPE, LENTYPE, CHQTYPE); { symbol table types } 10 | ndptr = ^ndblock; 11 | ndblock = 12 | record 13 | name : charpos; 14 | defn : charpos; 15 | kind : sttype; 16 | nextptr : ndptr 17 | end; 18 | -------------------------------------------------------------------------------- /orig/man/unique.m: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | .NM unique delete adjacent duplicate lines 3 | .SY 4 | .UL "unique" 5 | .FU 6 | .UL unique 7 | writes to its output only the first line from each 8 | group of adjacent identical input lines. 9 | It is most useful for text that has been sorted to bring identical lines 10 | together; in this case it passes through only unique instances of input lines. 11 | .EG 12 | To eliminate duplicate lines in the output of a program: 13 | .Q1 14 | program | sort | unique 15 | .Q2 16 | -------------------------------------------------------------------------------- /orig/macro/maccons.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { maccons -- const declarations for macro } 3 | const 4 | BUFSIZE = 1000; { size of pushback buffer } 5 | MAXCHARS = 5000; { size of name-defn table } 6 | MAXPOS = 500; { size of position arrays } 7 | CALLSIZE = MAXPOS; 8 | ARGSIZE = MAXPOS; 9 | EVALSIZE = MAXCHARS; 10 | MAXDEF = MAXSTR; { max chars in a defn } 11 | MAXTOK = MAXSTR; { max chars in a token } 12 | HASHSIZE = 53; { size of hash table } 13 | ARGFLAG = DOLLAR; { macro invocation character } 14 | -------------------------------------------------------------------------------- /orig/wsprims/getc.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { getc and getcf (WS) -- get one character of input } 3 | function read (fd : filedesc; var c : character; 4 | size : integer) : boolean; 5 | external; 6 | 7 | function getc (var c : character) : character; 8 | begin 9 | if (not read(STDIN, c, 1)) then 10 | c := ENDFILE; 11 | getc := c 12 | end; 13 | 14 | function getcf(var c : character; fd : filedesc) : character; 15 | begin 16 | if (not read(fd, c, 1)) then 17 | c := ENDFILE; 18 | getcf := c 19 | end; 20 | -------------------------------------------------------------------------------- /orig/macro/expr.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { expr -- recursive expression evaluation } 3 | function expr (var s : string; var i : integer) : integer; 4 | var 5 | v : integer; 6 | t : character; 7 | #include "gnbchar.p" 8 | #include "term.p" 9 | begin 10 | v := term(s, i); 11 | t := gnbchar(s, i); 12 | while (t in [PLUS, MINUS]) do begin 13 | i := i + 1; 14 | if (t = PLUS) then 15 | v := v + term(s, i) 16 | else 17 | v := v - term(s, i); 18 | t := gnbchar(s, i) 19 | end; 20 | expr := v 21 | end; 22 | -------------------------------------------------------------------------------- /orig/man/charcount.m: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | .NM charcount count characters in input 3 | .SY 4 | .UL "charcount" 5 | .FU 6 | .UL charcount 7 | counts the characters in its input and writes the total as a single 8 | line of text to the output. 9 | Since each line of text is internally delimited by a 10 | .UL NEWLINE 11 | character, the total count is the number of lines plus the number of characters 12 | within each line. 13 | .EG 14 | .Q1 15 | charcount 16 | A single line of input. 17 | 18 | .S 24 19 | .Q2 20 | -------------------------------------------------------------------------------- /orig/man/seek.m: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | .ds n PRIMITIVE 3 | .NM seek position file for reading or writing 4 | .SY 5 | .Q1 6 | pos : integer; 7 | fd : filedesc; 8 | 9 | seek(pos, fd); 10 | .Q2 11 | .FU 12 | .UL seek 13 | arranges that the next input-output operation 14 | that uses 15 | .UL fd 16 | will affect the file at the position specified 17 | by 18 | .UL pos . 19 | .BU 20 | The units for 21 | .UL pos 22 | are not specified. 23 | In particular, characters and records 24 | both have things to recommend them. 25 | -------------------------------------------------------------------------------- /orig/ucsdprims/remove.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { remove -- remove a file } 3 | procedure remove (name : xstring); 4 | var 5 | fd : filedesc; 6 | begin 7 | fd := open(name, IOREAD); 8 | if (fd = IOERROR) then 9 | message('can''t remove file') 10 | else begin 11 | case (cmdfil[fd]) of 12 | FIL1: 13 | close(file1, PURGE); 14 | FIL2: 15 | close(file2, PURGE); 16 | FIL3: 17 | close(file3, PURGE); 18 | FIL4: 19 | close(file4, PURGE) 20 | end 21 | end; 22 | cmdfil[fd] := CLOSED 23 | end; 24 | -------------------------------------------------------------------------------- /orig/edit/patsize.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { patsize -- returns size of pattern entry at pat[n] } 3 | function patsize (var pat : string; n : integer) : integer; 4 | begin 5 | if (not (pat[n] in 6 | [LITCHAR, BOL, EOL, ANY, CCL, NCCL, CLOSURE])) then 7 | error('in patsize: can''t happen') 8 | else 9 | case pat[n] of 10 | LITCHAR: 11 | patsize := 2; 12 | BOL, EOL, ANY: 13 | patsize := 1; 14 | CCL, NCCL: 15 | patsize := pat[n+1] + 2; 16 | CLOSURE: 17 | patsize := CLOSIZE 18 | end 19 | end; 20 | -------------------------------------------------------------------------------- /orig/archive/replace.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { replace -- replace or delete files } 3 | procedure replace (afd, tfd : filedesc; cmd : integer); 4 | var 5 | inline, uname : string; 6 | size : integer; 7 | begin 8 | while (gethdr(afd, inline, uname, size)) do 9 | if (filearg(uname)) then begin 10 | if (cmd = ord('u')) then { add new one } 11 | addfile(uname, tfd); 12 | fskip(afd, size) { discard old one } 13 | end 14 | else begin 15 | putstr(inline, tfd); 16 | acopy(afd, tfd, size) 17 | end 18 | end; 19 | -------------------------------------------------------------------------------- /orig/edit/dowrite.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { dowrite -- write lines n1..n2 into file } 3 | function dowrite (n1, n2 : integer; var fil : string) : stcode; 4 | var 5 | i : integer; 6 | fd : filedesc; 7 | line : string; 8 | begin 9 | fd := create(fil, IOWRITE); 10 | if (fd = IOERROR) then 11 | dowrite := ERR 12 | else begin 13 | for i := n1 to n2 do begin 14 | gettxt(i, line); 15 | putstr(line, fd) 16 | end; 17 | close(fd); 18 | putdec(n2-n1+1, 1); 19 | putc(NEWLINE); 20 | dowrite := OK 21 | end 22 | end; 23 | -------------------------------------------------------------------------------- /orig/edit/getword.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { getword -- get word from s[i] into out } 3 | function getword (var s : string; i : integer; 4 | var out : string) : integer; 5 | var 6 | j : integer; 7 | begin 8 | while (s[i] in [BLANK, TAB, NEWLINE]) do 9 | i := i + 1; 10 | j := 1; 11 | while (not (s[i] in [ENDSTR,BLANK,TAB,NEWLINE])) do begin 12 | out[j] := s[i]; 13 | i := i + 1; 14 | j := j + 1 15 | end; 16 | out[j] := ENDSTR; 17 | if (s[i] = ENDSTR) then 18 | getword := 0 19 | else 20 | getword := i 21 | end; 22 | -------------------------------------------------------------------------------- /orig/fileio/include.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { include -- replace #include "file" by contents of file } 3 | procedure include; 4 | var 5 | incl : string; { value is '#include' } 6 | #include "finclude.p" 7 | begin 8 | { setstring(incl, '#include'); } 9 | incl[1] := ord('#'); 10 | incl[2] := ord('i'); 11 | incl[3] := ord('n'); 12 | incl[4] := ord('c'); 13 | incl[5] := ord('l'); 14 | incl[6] := ord('u'); 15 | incl[7] := ord('d'); 16 | incl[8] := ord('e'); 17 | incl[9] := ENDSTR; 18 | finclude(STDIN) 19 | end; 20 | -------------------------------------------------------------------------------- /orig/fileio/makecopy.cc: -------------------------------------------------------------------------------- 1 | #include "../p2c.h" 2 | #include "fileio.h" 3 | 4 | // Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. 5 | // makecopy -- copy one file to another 6 | void makecopy() 7 | { 8 | string inname, outname; 9 | filedesc fin, fout; 10 | 11 | if ((not getarg(1, inname, MAXSTR)) 12 | or (not getarg(2, outname, MAXSTR))) 13 | error("usage: makecopy old new"); 14 | fin = mustopen(inname, IOREAD); 15 | fout = mustcreate(outname, IOWRITE); 16 | fcopy(fin, fout); 17 | close(fin); 18 | close(fout); 19 | } 20 | -------------------------------------------------------------------------------- /orig/macro/dochq.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { dochq -- change quote characters } 3 | procedure dochq (var argstk : posbuf; i, j : integer); 4 | var 5 | temp : string; 6 | n : integer; 7 | begin 8 | cscopy(evalstk, argstk[i+2], temp); 9 | n := length(temp); 10 | if (n <= 0) then begin 11 | lquote := ord(GRAVE); 12 | rquote := ord(ACUTE) 13 | end 14 | else if (n = 1) then begin 15 | lquote := temp[1]; 16 | rquote := lquote 17 | end 18 | else begin 19 | lquote := temp[1]; 20 | rquote := temp[2] 21 | end 22 | end; 23 | -------------------------------------------------------------------------------- /orig/print/head.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { head -- print top of page header } 3 | procedure head (var name : string; pageno : integer); 4 | var 5 | page : string; { set to ' Page ' } 6 | begin 7 | { setstring(page, ' Page '); } 8 | page[1] := ord(' '); 9 | page[2] := ord('P'); 10 | page[3] := ord('a'); 11 | page[4] := ord('g'); 12 | page[5] := ord('e'); 13 | page[6] := ord(' '); 14 | page[7] := ENDSTR; 15 | putstr(name, STDOUT); 16 | putstr(page, STDOUT); 17 | putdec(pageno, 1); 18 | putc(NEWLINE) 19 | end; 20 | -------------------------------------------------------------------------------- /orig/archive/getword.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { getword -- get word from s[i] into out } 3 | function getword (var s : string; i : integer; 4 | var out : string) : integer; 5 | var 6 | j : integer; 7 | begin 8 | while (s[i] in [BLANK, TAB, NEWLINE]) do 9 | i := i + 1; 10 | j := 1; 11 | while (not (s[i] in [ENDSTR,BLANK,TAB,NEWLINE])) do begin 12 | out[j] := s[i]; 13 | i := i + 1; 14 | j := j + 1 15 | end; 16 | out[j] := ENDSTR; 17 | if (s[i] = ENDSTR) then 18 | getword := 0 19 | else 20 | getword := i 21 | end; 22 | -------------------------------------------------------------------------------- /orig/fileio/getword.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { getword -- get word from s[i] into out } 3 | function getword (var s : string; i : integer; 4 | var out : string) : integer; 5 | var 6 | j : integer; 7 | begin 8 | while (s[i] in [BLANK, TAB, NEWLINE]) do 9 | i := i + 1; 10 | j := 1; 11 | while (not (s[i] in [ENDSTR,BLANK,TAB,NEWLINE])) do begin 12 | out[j] := s[i]; 13 | i := i + 1; 14 | j := j + 1 15 | end; 16 | out[j] := ENDSTR; 17 | if (s[i] = ENDSTR) then 18 | getword := 0 19 | else 20 | getword := i 21 | end; 22 | -------------------------------------------------------------------------------- /orig/format/getword.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { getword -- get word from s[i] into out } 3 | function getword (var s : string; i : integer; 4 | var out : string) : integer; 5 | var 6 | j : integer; 7 | begin 8 | while (s[i] in [BLANK, TAB, NEWLINE]) do 9 | i := i + 1; 10 | j := 1; 11 | while (not (s[i] in [ENDSTR,BLANK,TAB,NEWLINE])) do begin 12 | out[j] := s[i]; 13 | i := i + 1; 14 | j := j + 1 15 | end; 16 | out[j] := ENDSTR; 17 | if (s[i] = ENDSTR) then 18 | getword := 0 19 | else 20 | getword := i 21 | end; 22 | -------------------------------------------------------------------------------- /orig/ucbprims/getcf.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { getcf (UCB) -- get one character from file } 3 | function getcf (var c: character; fd : filedesc) : character; 4 | var 5 | ch : char; 6 | begin 7 | if (fd = STDIN) then 8 | getcf := getc(c) 9 | else if eof(openlist[fd].filevar) then 10 | c := ENDFILE 11 | else if eoln(openlist[fd].filevar) then begin 12 | read(openlist[fd].filevar, ch); 13 | c := NEWLINE 14 | end 15 | else begin 16 | read(openlist[fd].filevar, ch); 17 | c := ord(ch) 18 | end; 19 | getcf := c 20 | end; 21 | -------------------------------------------------------------------------------- /cpp/intro/detab.cc: -------------------------------------------------------------------------------- 1 | // detab -- convert tabs to equivalent number of blanks 2 | #include 3 | 4 | const int TABSPACE = 4; 5 | 6 | int main() 7 | { 8 | int col = 0; 9 | int c; 10 | 11 | while ( (c = getchar()) != EOF) 12 | if (c == '\t') { 13 | do { 14 | putchar(' '); 15 | col = col + 1; 16 | } while (col % TABSPACE != 0); 17 | } else { 18 | putchar(c); 19 | if (c == '\n') 20 | col = 0; 21 | else 22 | ++col; 23 | } 24 | } 25 | -------------------------------------------------------------------------------- /orig/archive/filearg.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { filearg -- check if name matches argument list } 3 | function filearg (var name : string) : boolean; 4 | var 5 | i : integer; 6 | found : boolean; 7 | begin 8 | if (nfiles <= 0) then 9 | filearg := true 10 | else begin 11 | found := false; 12 | i := 1; 13 | while (not found) and (i <= nfiles) do begin 14 | if (equal(name, fname[i])) then begin 15 | fstat[i] := true; 16 | found := true 17 | end; 18 | i := i + 1 19 | end; 20 | filearg := found 21 | end 22 | end; 23 | -------------------------------------------------------------------------------- /orig/edit/locate.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { locate -- look for c in character class at pat[offset] } 3 | function locate (c : character; var pat : string; 4 | offset : integer) : boolean; 5 | var 6 | i : integer; 7 | begin 8 | { size of class is at pat[offset], characters follow } 9 | locate := false; 10 | i := offset + pat[offset]; { last position } 11 | while (i > offset) do 12 | if (c = pat[i]) then begin 13 | locate := true; 14 | i := offset { force loop termination } 15 | end 16 | else 17 | i := i - 1 18 | end; 19 | -------------------------------------------------------------------------------- /orig/pman/remove.m: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | .NM remove remove a file 3 | .SY 4 | .UL "procedure remove (name : string);" 5 | .FU 6 | .UL remove 7 | causes the file with external name 8 | .UL name 9 | to be discarded, 10 | i.e., a subsequent call to 11 | .UL open 12 | with the same name will fail and a subsequent 13 | .UL create 14 | will be obliged to make a new instance of the file. 15 | In general, the file to be removed should not be connected to any file 16 | descriptor at the time of the 17 | .UL remove 18 | call. 19 | .RE 20 | Nothing. 21 | -------------------------------------------------------------------------------- /orig/wsprims/esc.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { esc -- map inset[i] into escaped character if appropriate } 3 | function esc (var inset : string; var i : integer) : character; 4 | 5 | begin 6 | if (inset[i] <> ESCAPE) then 7 | esc := inset[i] 8 | else if (inset[i+1] = ENDSTR) then { @ not special at end } 9 | esc := ESCAPE 10 | else begin 11 | i := i + 1; 12 | if (inset[i] = ord('n')) then 13 | esc := NEWLINE 14 | else if (inset[i] = ord('t')) then 15 | esc := TAB 16 | else 17 | esc := inset[i] 18 | end 19 | end; 20 | -------------------------------------------------------------------------------- /orig/archive/addfile.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { addfile -- add file "name" to archive } 3 | procedure addfile (var name : string; fd : filedesc); 4 | var 5 | head : string; 6 | nfd : filedesc; 7 | #include "makehdr.p" 8 | begin 9 | nfd := open(name, IOREAD); 10 | if (nfd = IOERROR) then begin 11 | putstr(name, STDERR); 12 | message(': can''t add'); 13 | errcount := errcount + 1 14 | end; 15 | if (errcount = 0) then begin 16 | makehdr(name, head); 17 | putstr(head, fd); 18 | fcopy(nfd, fd); 19 | close(nfd) 20 | end 21 | end; 22 | -------------------------------------------------------------------------------- /orig/edit/patscan.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { patscan -- find next occurrence of pattern after line n } 3 | function patscan (way : character; var n : integer) : stcode; 4 | var 5 | done : boolean; 6 | line : string; 7 | begin 8 | n := curln; 9 | patscan := ERR; 10 | done := false; 11 | repeat 12 | if (way = SCAN) then 13 | n := nextln(n) 14 | else 15 | n := prevln(n); 16 | gettxt(n, line); 17 | if (match(line, pat)) then begin 18 | patscan := OK; 19 | done := true 20 | end 21 | until (n = curln) or (done) 22 | end; 23 | -------------------------------------------------------------------------------- /orig/filters/putrep.cc: -------------------------------------------------------------------------------- 1 | #include "../p2c.h" 2 | #include "filters.h" 3 | 4 | // Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. 5 | // putrep -- put out representation of run of n 'c's 6 | void putrep(integer n, character c) 7 | { 8 | const int MAXREP = 26; // assuming 'A'..'Z' 9 | const int THRESH = 4; 10 | while ((n >= THRESH) or ((c == WARNING) and (n > 0))) { 11 | putc(WARNING); 12 | putc(min(n, MAXREP) - 1 + ord('A')); 13 | putc(c); 14 | n = n - MAXREP; 15 | } 16 | for (n = n; n >= 1; --n) 17 | putc(c); 18 | } 19 | -------------------------------------------------------------------------------- /orig/macro/doif.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { doif -- select one of two arguments } 3 | procedure doif (var argstk : posbuf; i, j : integer); 4 | var 5 | temp1, temp2, temp3 : string; 6 | begin 7 | if (j - i >= 4) then begin 8 | cscopy(evalstk, argstk[i+2], temp1); 9 | cscopy(evalstk, argstk[i+3], temp2); 10 | if (equal(temp1, temp2)) then 11 | cscopy(evalstk, argstk[i+4], temp3) 12 | else if (j - i >= 5) then 13 | cscopy(evalstk, argstk[i+5], temp3) 14 | else 15 | temp3[1] := ENDSTR; 16 | pbstr(temp3) 17 | end 18 | end; 19 | -------------------------------------------------------------------------------- /orig/archive/gethdr.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { gethdr -- get header info from fd } 3 | function gethdr (fd : filedesc; var buf, name : string; 4 | var size : integer) : boolean; 5 | var 6 | temp : string; 7 | i : integer; 8 | begin 9 | if (getline(buf, fd, MAXSTR) = false) then 10 | gethdr := false 11 | else begin 12 | i := getword(buf, 1, temp); 13 | if (not equal(temp, archhdr)) then 14 | error('archive not in proper format'); 15 | i := getword(buf, i, name); 16 | size := ctoi(buf, i); 17 | gethdr := true 18 | end 19 | end; 20 | -------------------------------------------------------------------------------- /orig/archive/initarch.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { initarch -- initialize variables for archive } 3 | procedure initarch; 4 | begin 5 | { setstring(archtemp, 'artemp'); } 6 | archtemp[1] := ord('a'); 7 | archtemp[2] := ord('r'); 8 | archtemp[3] := ord('t'); 9 | archtemp[4] := ord('e'); 10 | archtemp[5] := ord('m'); 11 | archtemp[6] := ord('p'); 12 | archtemp[7] := ENDSTR; 13 | { setstring(archhdr, '-h-'); } 14 | archhdr[1] := ord('-'); 15 | archhdr[2] := ord('h'); 16 | archhdr[3] := ord('-'); 17 | archhdr[4] := ENDSTR; 18 | end; 19 | -------------------------------------------------------------------------------- /orig/format/setparam.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { setparam -- set parameter and check range } 3 | procedure setparam (var param : integer; 4 | val, argtype, defval, minval, maxval : integer); 5 | begin 6 | if (argtype = NEWLINE) then { defaulted } 7 | param := defval 8 | else if (argtype = PLUS) then { relative + } 9 | param := param + val 10 | else if (argtype = MINUS) then { relative - } 11 | param := param - val 12 | else { absolute } 13 | param := val; 14 | param := min(param, maxval); 15 | param := max(param, minval) 16 | end; 17 | -------------------------------------------------------------------------------- /orig/edit/catsub.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { catsub -- add replacement text to end of new } 3 | procedure catsub (var lin : string; s1, s2 : integer; 4 | var sub : string; var new : string; 5 | var k : integer; maxnew : integer); 6 | var 7 | i, j : integer; 8 | junk : boolean; 9 | begin 10 | i := 1; 11 | while (sub[i] <> ENDSTR) do begin 12 | if (sub[i] = DITTO) then 13 | for j := s1 to s2-1 do 14 | junk := addstr(lin[j], new, k, maxnew) 15 | else 16 | junk := addstr(sub[i], new, k, maxnew); 17 | i := i + 1 18 | end 19 | end; 20 | -------------------------------------------------------------------------------- /orig/man/putstr.m: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | .ds n PRIMITIVE 3 | .NM putstr put a string on a file 4 | .SY 5 | .Q1 6 | s : string; 7 | fd : filedesc; 8 | 9 | putstr(s, fd); 10 | .Q2 11 | .FU 12 | .UL putstr 13 | puts the string 14 | .UL s 15 | on the specified file descriptor. 16 | .IP 17 | .UL putstr 18 | and 19 | .UL putcf 20 | calls may be interleaved. 21 | .BU 22 | There is no explicit error mechanism. 23 | .br 24 | The behavior of 25 | .UL putstr 26 | is undefined if the converted value of 27 | any character 28 | is not in the standard character set. 29 | -------------------------------------------------------------------------------- /orig/util/ctoi.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { ctoi -- convert string at s[i] to integer, increment i } 3 | function ctoi (var s : string; var i : integer) : integer; 4 | var 5 | n, sign : integer; 6 | begin 7 | while (s[i] = BLANK) or (s[i] = TAB) do 8 | i := i + 1; 9 | if (s[i] = MINUS) then 10 | sign := -1 11 | else 12 | sign := 1; 13 | if (s[i] = PLUS) or (s[i] = MINUS) then 14 | i := i + 1; 15 | n := 0; 16 | while (isdigit(s[i])) do begin 17 | n := 10 * n + s[i] - ord('0'); 18 | i := i + 1 19 | end; 20 | ctoi := sign * n 21 | end; 22 | -------------------------------------------------------------------------------- /orig/wsprims/ctoi.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { ctoi -- convert string at s[i] to integer, increment i } 3 | function ctoi (var s : string; var i : integer) : integer; 4 | var 5 | n, sign : integer; 6 | begin 7 | while (s[i] = BLANK) or (s[i] = TAB) do 8 | i := i + 1; 9 | if (s[i] = MINUS) then 10 | sign := -1 11 | else 12 | sign := 1; 13 | if (s[i] = PLUS) or (s[i] = MINUS) then 14 | i := i + 1; 15 | n := 0; 16 | while (isdigit(s[i])) do begin 17 | n := 10 * n + s[i] - ord('0'); 18 | i := i + 1 19 | end; 20 | ctoi := sign * n 21 | end; 22 | -------------------------------------------------------------------------------- /orig/edit/seek.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { seek (UCB) -- special version of primitive for edit } 3 | procedure seek (recno : integer; var fd : filedesc); 4 | var 5 | junk : boolean; 6 | temp : string; 7 | begin 8 | flush(openlist[scrout].filevar); { necessary for UCB } 9 | if (recno < recin) then begin 10 | close(fd); 11 | { cheat: open scratch file by name } 12 | fd := mustopen(edittemp, IOREAD); 13 | recin := 1; 14 | end; 15 | while (recin < recno) do begin 16 | junk := getline(temp, fd, MAXSTR); 17 | recin := recin + 1 18 | end 19 | end; 20 | -------------------------------------------------------------------------------- /orig/fileio/include.cc: -------------------------------------------------------------------------------- 1 | #include "../p2c.h" 2 | #include "fileio.h" 3 | 4 | // Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. 5 | // include -- replace #include "file" by contents of file 6 | void include() 7 | { 8 | string incl; 9 | // value is '#include' 10 | // setstring(incl, '#include'); 11 | incl[1] = ord('#'); 12 | incl[2] = ord('i'); 13 | incl[3] = ord('n'); 14 | incl[4] = ord('c'); 15 | incl[5] = ord('l'); 16 | incl[6] = ord('u'); 17 | incl[7] = ord('d'); 18 | incl[8] = ord('e'); 19 | incl[9] = ENDSTR; 20 | finclude(STDIN); 21 | } 22 | -------------------------------------------------------------------------------- /orig/util/utility.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { utility -- generally useful functions and procedures } 3 | #include "addstr.p" 4 | #include "equal.p" 5 | #include "esc.p" 6 | #include "index.p" 7 | #include "isalphanum.p" 8 | #include "isdigit.p" 9 | #include "isletter.p" 10 | #include "islower.p" 11 | #include "isupper.p" 12 | #include "itoc.p" 13 | #include "length.p" 14 | #include "max.p" 15 | #include "min.p" 16 | #include "scopy.p" 17 | #include "ctoi.p" 18 | #include "fcopy.p" 19 | #include "mustcreate.p" 20 | #include "mustopen.p" 21 | #include "putdec.p" 22 | -------------------------------------------------------------------------------- /orig/edit/setbuf2.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { setbuf (scratch file) -- create scratch file, set up line 0 } 3 | procedure setbuf; 4 | begin 5 | { setstring(edittemp, 'edtemp'); } 6 | edittemp[1] := ord('e'); 7 | edittemp[2] := ord('d'); 8 | edittemp[3] := ord('t'); 9 | edittemp[4] := ord('e'); 10 | edittemp[5] := ord('m'); 11 | edittemp[6] := ord('p'); 12 | edittemp[7] := ENDSTR; 13 | scrout := mustcreate(edittemp, IOWRITE); 14 | scrin := mustopen(edittemp, IOREAD); 15 | recout := 1; 16 | recin := 1; 17 | curln := 0; 18 | lastln := 0 19 | end; 20 | -------------------------------------------------------------------------------- /orig/man/open.m: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | .ds n PRIMITIVE 3 | .NM open open a file for reading or writing 4 | .SY 5 | .Q1 6 | name : string; 7 | fd : filedesc; 8 | mode : IOREAD..IOWRITE; 9 | 10 | fd := open(name, mode); 11 | .Q2 12 | .FU 13 | .UL open 14 | arranges for access to file 15 | .UL name 16 | with the specified access mode. 17 | It returns a file descriptor 18 | if the access succeeds, and 19 | .UL IOERROR 20 | if not. 21 | .UL fd 22 | may be used in subsequent calls to 23 | .UL getcf, 24 | .UL getline , 25 | .UL putcf , 26 | .UL putstr , 27 | etc. 28 | -------------------------------------------------------------------------------- /cpp/lib.cc: -------------------------------------------------------------------------------- 1 | #include "lib.h" 2 | 3 | #include 4 | #include 5 | 6 | void error(const char* message) 7 | { 8 | fprintf(stderr, "%s\n", message); 9 | exit(EXIT_FAILURE); 10 | } 11 | 12 | void error_open(const char* filename) 13 | { 14 | fprintf(stderr, "%s", filename); 15 | error(": can't open file"); 16 | } 17 | 18 | void fcopy(FILE* fin, FILE* fout) 19 | { 20 | char buf[BUFSIZ]; 21 | size_t nr = 0; 22 | while ( (nr = fread(buf, 1, sizeof buf, fin)) > 0) { 23 | size_t nw = fwrite(buf, 1, nr, fout); 24 | if (nr != nw) 25 | error("Failed to copy files."); 26 | } 27 | } 28 | -------------------------------------------------------------------------------- /orig/man/makecopy.m: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | .NM makecopy copy a file to new file 3 | .SY 4 | .UL "makecopy old new" 5 | .FU 6 | .UL makecopy 7 | copies the file 8 | .UL old 9 | to a new instance of the file 10 | .UL new , 11 | i.e., if 12 | .UL new 13 | already exists it is truncated and rewritten, otherwise it is made to exist. 14 | The new file is an exact replica of the old. 15 | .EG 16 | To make a backup copy of a precious file: 17 | .Q1 18 | makecopy precious backup 19 | .Q2 20 | .BU 21 | Copying a file onto itself is very system dependent and usually disastrous. 22 | -------------------------------------------------------------------------------- /orig/fileio/getword.cc: -------------------------------------------------------------------------------- 1 | #include "../p2c.h" 2 | #include "fileio.h" 3 | 4 | // Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. 5 | // getword -- get word from s[i] into out 6 | integer getword(string& s, integer i, string& out) 7 | { 8 | integer j; 9 | 10 | while (s[i] in[BLANK, TAB, NEWLINE]) 11 | i = i + 1; 12 | j = 1; 13 | while (not(s[i] in[ENDSTR, BLANK, TAB, NEWLINE])) { 14 | out[j] = s[i]; 15 | i = i + 1; 16 | j = j + 1; 17 | } 18 | out[j] = ENDSTR; 19 | if (s[i] == ENDSTR) 20 | return 0; 21 | else 22 | return i; 23 | } 24 | -------------------------------------------------------------------------------- /orig/intro/wordcount.cc: -------------------------------------------------------------------------------- 1 | #include "../p2c.h" 2 | #include "intro.h" 3 | 4 | // Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. 5 | // wordcount -- count words in standard input 6 | void wordcount() 7 | { 8 | integer nw; 9 | character c; 10 | boolean inword; 11 | 12 | nw = 0; 13 | inword = false; 14 | while (getc(c) != ENDFILE) 15 | if ((c == BLANK) or (c == NEWLINE) or (c == TAB)) 16 | inword = false; 17 | else if (not inword) { 18 | inword = true; 19 | nw = nw + 1; 20 | } 21 | putdec(nw, 1); 22 | putc(NEWLINE); 23 | } 24 | -------------------------------------------------------------------------------- /orig/macro/term.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { term -- evaluate term of arithmetic expression } 3 | function term (var s : string; var i : integer) : integer; 4 | var 5 | v : integer; 6 | t : character; 7 | #include "factor.p" 8 | begin 9 | v := factor(s, i); 10 | t := gnbchar(s, i); 11 | while (t in [STAR, SLASH, PERCENT]) do begin 12 | i := i + 1; 13 | case t of 14 | STAR: 15 | v := v * factor(s, i); 16 | SLASH: 17 | v := v div factor(s, i); 18 | PERCENT: 19 | v := v mod factor(s, i) 20 | end; 21 | t := gnbchar(s, i) 22 | end; 23 | term := v 24 | end; 25 | -------------------------------------------------------------------------------- /orig/print/print.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { print (default input STDIN) -- print files with headings } 3 | procedure print; 4 | var 5 | name : string; 6 | null : string; { value '' } 7 | i : integer; 8 | fin : filedesc; 9 | junk : boolean; 10 | #include "fprint.p" 11 | begin 12 | { setstring(null, ''); } 13 | null[1] := ENDSTR; 14 | if (nargs = 0) then 15 | fprint(null, STDIN) 16 | else 17 | for i := 1 to nargs do begin 18 | junk := getarg(i, name, MAXSTR); 19 | fin := mustopen(name, IOREAD); 20 | fprint(name, fin); 21 | close(fin) 22 | end 23 | end; 24 | -------------------------------------------------------------------------------- /orig/archive/delete.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { delete -- delete files from archive } 3 | procedure delete (var aname : string); 4 | var 5 | afd, tfd : filedesc; 6 | begin 7 | if (nfiles <= 0) then { protect innocents } 8 | error('archive: -d requires explicit file names'); 9 | afd := mustopen(aname, IOREAD); 10 | tfd := mustcreate(archtemp, IOWRITE); 11 | replace(afd, tfd, ord('d')); 12 | notfound; 13 | close(afd); 14 | close(tfd); 15 | if (errcount = 0) then 16 | fmove(archtemp, aname) 17 | else 18 | message('fatal errors - archive not altered'); 19 | remove(archtemp) 20 | end; 21 | -------------------------------------------------------------------------------- /orig/edit/getrhs.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { getrhs -- get right hand side of "s" command } 3 | function getrhs (var lin : string; var i : integer; 4 | var sub : string; var gflag : boolean) : stcode; 5 | begin 6 | getrhs := OK; 7 | if (lin[i] = ENDSTR) then 8 | getrhs := ERR 9 | else if (lin[i+1] = ENDSTR) then 10 | getrhs := ERR 11 | else begin 12 | i := makesub(lin, i+1, lin[i], sub); 13 | if (i = 0) then 14 | getrhs := ERR 15 | else if (lin[i+1] = ord('g')) then begin 16 | i := i + 1; 17 | gflag := true 18 | end 19 | else 20 | gflag := false 21 | end 22 | end; 23 | -------------------------------------------------------------------------------- /orig/sort/cmp.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { cmp -- compare linebuf[i] with linebuf[j] } 3 | function cmp (i, j : charpos; var linebuf : charbuf) 4 | : integer; 5 | begin 6 | while (linebuf[i] = linebuf[j]) 7 | and (linebuf[i] <> ENDSTR) do begin 8 | i := i + 1; 9 | j := j + 1 10 | end; 11 | if (linebuf[i] = linebuf[j]) then 12 | cmp := 0 13 | else if (linebuf[i] = ENDSTR) then { 1st is shorter } 14 | cmp := -1 15 | else if (linebuf[j] = ENDSTR) then { 2nd is shorter } 16 | cmp := +1 17 | else if (linebuf[i] < linebuf[j]) then 18 | cmp := -1 19 | else 20 | cmp := +1 21 | end; 22 | -------------------------------------------------------------------------------- /orig/man/copy.m: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | .NM copy copy input to output 3 | .SY 4 | .UL copy 5 | .FU 6 | .UL copy 7 | copies its input to its output unchanged. 8 | It is useful for copying from a terminal to a file, from file to file, 9 | or even from terminal to terminal. 10 | It may be used for displaying the contents of a file, without interpretation 11 | or formatting, by copying from a file to terminal. 12 | .EG 13 | To echo lines typed at your terminal: 14 | .Q1 15 | copy 16 | hello there, are you listening? 17 | .S "hello there, are you listening?" 18 | yes, I am. 19 | .S "yes, I am." 20 | 21 | .Q2 22 | -------------------------------------------------------------------------------- /orig/format/underln.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { underln -- underline a line } 3 | procedure underln (var buf : string; size : integer); 4 | var 5 | i, j : integer; 6 | tbuf : string; 7 | begin 8 | j := 1; { expand into tbuf } 9 | i := 1; 10 | while (buf[i] <> NEWLINE) and (j < size-1) do begin 11 | if (isalphanum(buf[i])) then begin 12 | tbuf[j] := UNDERLINE; 13 | tbuf[j+1] := BACKSPACE; 14 | j := j + 2 15 | end; 16 | tbuf[j] := buf[i]; 17 | j := j + 1; 18 | i := i + 1 19 | end; 20 | tbuf[j] := NEWLINE; 21 | tbuf[j+1] := ENDSTR; 22 | scopy(tbuf, 1, buf, 1) { copy it back to buf } 23 | end; 24 | -------------------------------------------------------------------------------- /orig/format/text1.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { text -- process text lines (interim version 2) } 3 | procedure text (var inbuf : string); 4 | var 5 | wordbuf : string; 6 | i : integer; 7 | begin 8 | if (inbuf[1] = BLANK) or (inbuf[1] = NEWLINE) then 9 | leadbl(inbuf); { move left, set tival } 10 | if (inbuf[1] = NEWLINE) then { all blank line } 11 | put(inbuf) 12 | else if (not fill) then { unfilled text } 13 | put(inbuf) 14 | else begin { filled text } 15 | i := 1; 16 | repeat 17 | i := getword(inbuf, i, wordbuf); 18 | if (i > 0) then 19 | putword(wordbuf) 20 | until (i = 0) 21 | end 22 | end; 23 | -------------------------------------------------------------------------------- /orig/man/compare.m: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | .NM compare compare files for equality 3 | .SY 4 | .UL "compare file1 file2" 5 | .FU 6 | .UL compare 7 | performs a line-by-line comparison of 8 | .UL file1 9 | and 10 | .UL file2 , 11 | printing each pair of differing lines, preceded 12 | by a line containing the offending line number and a colon. 13 | If the files are identical, no output is produced. 14 | If one file is a prefix of the other, 15 | .UL compare 16 | reports end of file on the shorter file. 17 | .EG 18 | .Q1 19 | compare old new 20 | .Q2 21 | .BU 22 | .UL compare 23 | can produce voluminous output for small differences. 24 | -------------------------------------------------------------------------------- /orig/edit/optpat.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { optpat -- get optional pattern from lin[i], increment i } 3 | function optpat (var lin : string; var i : integer) : stcode; 4 | #include "makepat.p" 5 | begin 6 | if (lin[i] = ENDSTR) then 7 | i := 0 8 | else if (lin[i+1] = ENDSTR) then 9 | i := 0 10 | else if (lin[i+1] = lin[i]) then { repeated delimiter } 11 | i := i + 1 { leave existing pattern alone } 12 | else 13 | i := makepat(lin, i+1, lin[i], pat); 14 | if (pat[1] = ENDSTR) then 15 | i := 0; 16 | if (i = 0) then begin 17 | pat[1] := ENDSTR; 18 | optpat := ERR 19 | end 20 | else 21 | optpat := OK 22 | end; 23 | -------------------------------------------------------------------------------- /orig/pman/getarg.m: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | .NM getarg get a command line argument 3 | .SY 4 | .UL "function getarg (n : integer; var str : string; maxsize : integer)" 5 | .br 6 | .UL " : boolean;" 7 | .FU 8 | .UL getarg 9 | writes up to 10 | .UL maxsize 11 | characters (including an 12 | .UL ENDSTR ) 13 | of the 14 | .UL n th 15 | command line argument 16 | into the string 17 | .UL str . 18 | The first argument on the command line is argument 19 | number one. 20 | No error is reported if the argument string is truncated. 21 | .RE 22 | .UL getarg 23 | returns 24 | .UL true 25 | if the argument is present, otherwise 26 | .UL false . 27 | -------------------------------------------------------------------------------- /orig/ucsdprims/fdalloc.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { fdalloc -- allocate a file descriptor } 3 | function fdalloc : filedesc; 4 | var 5 | done : boolean; 6 | fd : filedesc; 7 | begin 8 | fd := STDIN; 9 | done := false; 10 | while (not done) do 11 | if ((cmdfil[fd] = CLOSED) or (fd = MAXOPEN)) then 12 | done := true 13 | else 14 | fd := succ(fd); 15 | if (cmdfil[fd] <> CLOSED) then 16 | fdalloc := IOERROR 17 | else begin 18 | cmdfil[fd] := ftalloc; 19 | if (cmdfil[fd] = CLOSED) then 20 | fdalloc := IOERROR 21 | else begin 22 | cmdopen[cmdfil[fd]] := true; 23 | fdalloc := fd 24 | end 25 | end 26 | end; 27 | -------------------------------------------------------------------------------- /orig/format/fmtproc.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { fmtproc -- procedures needed for format } 3 | #include "skipbl.p" 4 | #include "skip.p" 5 | #include "getcmd.p" 6 | #include "setparam.p" 7 | #include "getval.p" 8 | #include "gettl.p" 9 | #include "puttl.p" 10 | #include "puthead.p" 11 | #include "putfoot.p" 12 | #include "width.p" 13 | #include "put.p" 14 | #include "break.p" 15 | #include "space.p" 16 | #include "page.p" 17 | #include "leadbl.p" 18 | #include "spread.p" 19 | #include "putword.p" 20 | #include "getword.p" 21 | #include "center.p" 22 | #include "underln.p" 23 | #include "initfmt.p" 24 | #include "command.p" 25 | #include "text.p" 26 | -------------------------------------------------------------------------------- /orig/sort/reheap.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { reheap -- put linebuf[linepos[1]] in proper place in heap } 3 | procedure reheap (var linepos : posbuf; nf : pos; 4 | var linebuf : charbuf); 5 | var 6 | i, j : integer; 7 | begin 8 | i := 1; 9 | j := 2 * i; 10 | while (j <= nf) do begin 11 | if (j < nf) then { find smaller child } 12 | if (cmp(linepos[j],linepos[j+1],linebuf)>0) then 13 | j := j + 1; 14 | if (cmp(linepos[i], linepos[j], linebuf)<=0) then 15 | i := nf { proper position found; terminate loop } 16 | else 17 | exchange(linepos[i], linepos[j]); { percolate } 18 | i := j; 19 | j := 2 * i 20 | end 21 | end; 22 | -------------------------------------------------------------------------------- /orig/sort/shell0.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { shell -- Shell sort v[1]...v[n] increasing } 3 | procedure shell (var v : intarray; n : integer); 4 | var 5 | gap, i, j, jg, k : integer; 6 | begin 7 | gap := n div 2; 8 | while (gap > 0) do begin 9 | for i := gap+1 to n do begin 10 | j := i - gap; 11 | while (j > 0) do begin 12 | jg := j + gap; 13 | if (v[j] <= v[jg]) then { compare } 14 | j := 0 { force loop termination } 15 | else begin 16 | k := v[j]; { exchange } 17 | v[j] := v[jg]; 18 | v[jg] := k 19 | end; 20 | j := j - gap 21 | end 22 | end; 23 | gap := gap div 2 24 | end 25 | end; 26 | -------------------------------------------------------------------------------- /orig/filters/expand.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { expand -- uncompress standard input } 3 | procedure expand; 4 | const 5 | WARNING = TILDE; { ~ } 6 | var 7 | c : character; 8 | n : integer; 9 | begin 10 | while (getc(c) <> ENDFILE) do 11 | if (c <> WARNING) then 12 | putc(c) 13 | else if (isupper(getc(c))) then begin 14 | n := c - ord('A') + 1; 15 | if (getc(c) <> ENDFILE) then 16 | for n := n downto 1 do 17 | putc(c) 18 | else begin 19 | putc(WARNING); 20 | putc(n - 1 + ord('A')) 21 | end 22 | end 23 | else begin 24 | putc(WARNING); 25 | if (c <> ENDFILE) then 26 | putc(c) 27 | end 28 | end; 29 | -------------------------------------------------------------------------------- /orig/ucsdprims/create.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { create (UCSD) -- create a file } 3 | (*$I-*) 4 | function create (var name : xstring; mode : integer) : filedesc; 5 | var 6 | fd : filedesc; 7 | snm : string; 8 | begin 9 | fd := fdalloc; 10 | if (fd <> IOERROR) then begin 11 | strname(snm, name); 12 | case (cmdfil[fd]) of 13 | FIL1: 14 | rewrite(file1, snm); 15 | FIL2: 16 | rewrite(file2, snm); 17 | FIL3: 18 | rewrite(file3, snm); 19 | FIL4: 20 | rewrite(file4, snm) 21 | end; 22 | if (ioresult <> 0) then begin 23 | xclose(fd); 24 | fd := IOERROR 25 | end 26 | end; 27 | create := fd 28 | end; 29 | (*$I+*) 30 | -------------------------------------------------------------------------------- /orig/archive/getfns.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { getfns -- get filenames into fname, look for duplicates } 3 | procedure getfns; 4 | var 5 | i, j : integer; 6 | junk : boolean; 7 | begin 8 | errcount := 0; 9 | nfiles := nargs - 2; 10 | if (nfiles > MAXFILES) then 11 | error('archive: too many file names'); 12 | for i := 1 to nfiles do 13 | junk := getarg(i+2, fname[i], MAXSTR); 14 | for i := 1 to nfiles do 15 | fstat[i] := false; 16 | for i := 1 to nfiles - 1 do 17 | for j := i + 1 to nfiles do 18 | if (equal(fname[i], fname[j])) then begin 19 | putstr(fname[i], STDERR); 20 | error(': duplicate file name') 21 | end 22 | end; 23 | -------------------------------------------------------------------------------- /orig/ucsdprims/open.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { open (UCSD) -- open a file for reading or writing } 3 | (*$I-*) 4 | function open (var name : xstring; mode : integer) : filedesc; 5 | var 6 | fd : filedesc; 7 | snm : string; 8 | begin 9 | fd := fdalloc; 10 | if (fd <> IOERROR) then begin 11 | strname(snm, name); 12 | case (cmdfil[fd]) of 13 | FIL1: 14 | reset(file1, snm); 15 | FIL2: 16 | reset(file2, snm); 17 | FIL3: 18 | reset(file3, snm); 19 | FIL4: 20 | reset(file4, snm) 21 | end; 22 | if (ioresult <> 0) then begin 23 | xclose(fd); 24 | fd := IOERROR 25 | end 26 | end; 27 | open := fd 28 | end; 29 | (*$I+*) 30 | -------------------------------------------------------------------------------- /orig/format/initfmt.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { initfmt -- set format parameters to default values } 3 | procedure initfmt; 4 | begin 5 | fill := true; 6 | dir := 0; 7 | inval := 0; 8 | rmval := PAGEWIDTH; 9 | tival := 0; 10 | lsval := 1; 11 | spval := 0; 12 | ceval := 0; 13 | ulval := 0; 14 | lineno := 0; 15 | curpage := 0; 16 | newpage := 1; 17 | plval := PAGELEN; 18 | m1val := 3; m2val := 2; m3val := 2; m4val := 3; 19 | bottom := plval - m3val - m4val; 20 | header[1] := NEWLINE; { initial titles } 21 | header[2] := ENDSTR; 22 | footer[1] := NEWLINE; 23 | footer[2] := ENDSTR; 24 | outp := 0; 25 | outw := 0; 26 | outwds := 0 27 | end; 28 | -------------------------------------------------------------------------------- /orig/macro/macproc.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { macproc -- procedures for macro } 3 | #include "cscopy.p" 4 | #include "sccopy.p" 5 | #include "putback.p" 6 | #include "getpbc.p" 7 | #include "pbstr.p" 8 | #include "pbnum.p" 9 | #include "gettok.p" 10 | #include "inithash.p" 11 | #include "hash.p" 12 | #include "hashfind.p" 13 | #include "install.p" 14 | #include "lookup.p" 15 | #include "push.p" 16 | #include "putchr.p" 17 | #include "puttok.p" 18 | #include "expr.p" 19 | #include "dodef.p" 20 | #include "doif.p" 21 | #include "doexpr.p" 22 | #include "dolen.p" 23 | #include "dochq.p" 24 | #include "dosub.p" 25 | #include "eval.p" 26 | #include "initmacro.p" 27 | -------------------------------------------------------------------------------- /orig/fileio/finclude.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { finclude -- include file desc f } 3 | procedure finclude (f : filedesc); 4 | var 5 | line, str : string; 6 | loc, i : integer; 7 | f1 : filedesc; 8 | #include "getword.p" 9 | begin 10 | while (getline(line, f, MAXSTR)) do begin 11 | loc := getword(line, 1, str); 12 | if (not equal(str, incl)) then 13 | putstr(line, STDOUT) 14 | else begin 15 | loc := getword(line, loc, str); 16 | str[length(str)] := ENDSTR; { remove quotes } 17 | for i := 1 to length(str) do 18 | str[i] := str[i+1]; 19 | f1 := mustopen(str, IOREAD); 20 | finclude(f1); 21 | close(f1) 22 | end 23 | end 24 | end; 25 | -------------------------------------------------------------------------------- /orig/macro/gettok.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { gettok -- get token for define } 3 | function gettok (var token : string; toksize : integer) 4 | : character; 5 | var 6 | i : integer; 7 | done : boolean; 8 | begin 9 | i := 1; 10 | done := false; 11 | while (not done) and (i < toksize) do 12 | if (isalphanum(getpbc(token[i]))) then 13 | i := i + 1 14 | else 15 | done := true; 16 | if (i >= toksize) then 17 | error('define: token too long'); 18 | if (i > 1) then begin { some alpha was seen } 19 | putback(token[i]); 20 | i := i - 1 21 | end; 22 | { else single non-alphanumeric } 23 | token[i+1] := ENDSTR; 24 | gettok := token[1] 25 | end; 26 | -------------------------------------------------------------------------------- /orig/man/include.m: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | .NM include include copies of subfiles 3 | .SY 4 | .UL "include" 5 | .FU 6 | .UL include 7 | copies its input to its output unchanged, except that each 8 | line beginning 9 | .Q1 10 | #include "filename" 11 | .Q2 12 | is replaced by the contents of the file whose name is 13 | .UL filename . 14 | .UL include d 15 | files may contain further 16 | .UL #include 17 | lines, to arbitrary depth. 18 | .EG 19 | To piece together a Pascal program such as 20 | .UL include : 21 | .Q1 22 | #include "include.p" 23 | .Q2 24 | .BU 25 | A file that includes itself will not be diagnosed, but will eventually 26 | cause something to break. 27 | -------------------------------------------------------------------------------- /orig/edit/append.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { append -- append lines after "line" } 3 | function append (line : integer; glob : boolean) : stcode; 4 | var 5 | inline : string; 6 | stat : stcode; 7 | done : boolean; 8 | begin 9 | if (glob) then 10 | stat := ERR 11 | else begin 12 | curln := line; 13 | stat := OK; 14 | done := false; 15 | while (not done) and (stat = OK) do 16 | if (not getline(inline, STDIN, MAXSTR)) then 17 | stat := ENDDATA 18 | else if (inline[1] = PERIOD) 19 | and (inline[2] = NEWLINE) then 20 | done := true 21 | else if (puttxt(inline) = ERR) then 22 | stat := ERR 23 | end; 24 | append := stat 25 | end; 26 | -------------------------------------------------------------------------------- /orig/format/putword0.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { putword -- put word in outbuf } 3 | procedure putword (var wordbuf : string); 4 | var 5 | last, llval, nextra, w : integer; 6 | begin 7 | w := width(wordbuf); 8 | last := length(wordbuf) + outp + 1; { new end of outbuf } 9 | llval := rmval - tival - inval; 10 | if (outp > 0) 11 | and ((outw+w > llval) or (last >= MAXSTR)) then begin 12 | last := last - outp; { remember end of wordbuf } 13 | break { flush previous line } 14 | end; 15 | scopy(wordbuf, 1, outbuf, outp+1); 16 | outp := last; 17 | outbuf[outp] := BLANK; { blank between words } 18 | outw := outw + w + 1; { 1 for blank } 19 | outwds := outwds + 1 20 | end; 21 | -------------------------------------------------------------------------------- /orig/wsprims/getline.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { getline (WS) -- get a line from file } 3 | function read (fd : filedesc; var c : character; 4 | size : integer) : boolean; 5 | external; 6 | 7 | function getline (var s : string; fd : filedesc; 8 | maxsize : integer) : boolean; 9 | var 10 | i : integer; 11 | c : character; 12 | done : boolean; 13 | begin 14 | i := 1; 15 | done := false; 16 | repeat 17 | if (read(fd, c, 1)) then 18 | s[i] := c 19 | else 20 | done := true; 21 | i := i + 1 22 | until (done) or (c = NEWLINE) or (i >= maxsize); 23 | if (done) then { went one too far } 24 | i := i - 1; 25 | s[i] := ENDSTR; 26 | getline := (not done) 27 | end; 28 | -------------------------------------------------------------------------------- /orig/edit/change.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { change -- change "from" into "to" on each line } 3 | procedure change; 4 | #include "findcons.p" 5 | DITTO = -1; 6 | var 7 | lin, pat, sub, arg : string; 8 | #include "getpat.p" 9 | #include "getsub.p" 10 | #include "subline.p" 11 | begin 12 | if (not getarg(1, arg, MAXSTR)) then 13 | error('usage: change from [to]'); 14 | if (not getpat(arg, pat)) then 15 | error('change: illegal "from" pattern'); 16 | if (not getarg(2, arg, MAXSTR)) then 17 | arg[1] := ENDSTR; 18 | if (not getsub(arg, sub)) then 19 | error('change: illegal "to" string'); 20 | while (getline(lin, STDIN, MAXSTR)) do 21 | subline(lin, pat, sub) 22 | end; 23 | -------------------------------------------------------------------------------- /orig/man/getarg.m: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | .ds n PRIMITIVE 3 | .NM getarg,\ nargs command-line argument handling 4 | .SY 5 | .Q1 6 | arg : string; 7 | n : integer; 8 | b : boolean; 9 | 10 | b := getarg(n, arg, MAXSTR); 11 | n := nargs; 12 | .Q2 13 | .UL getarg 14 | accesses the 15 | .UL n -th 16 | command-line argument, returns it in 17 | .UL arg , 18 | and sets 19 | .UL b 20 | to 21 | .UL true . 22 | If there is no such argument, 23 | .UL b 24 | is 25 | .UL false . 26 | The argument will be at most 27 | .UL MAXSTR 28 | characters long, 29 | including the terminating 30 | .UL ENDSTR . 31 | .IP 32 | The function 33 | .UL nargs 34 | returns the total number of available arguments. 35 | -------------------------------------------------------------------------------- /orig/edit/getccl.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { getccl -- expand char class at arg[i] into pat[j] } 3 | function getccl (var arg : string; var i : integer; 4 | var pat : string; var j : integer) : boolean; 5 | var 6 | jstart : integer; 7 | junk : boolean; 8 | #include "dodash.p" 9 | begin 10 | i := i + 1; { skip over '[' } 11 | if (arg[i] = NEGATE) then begin 12 | junk := addstr(NCCL, pat, j, MAXPAT); 13 | i := i + 1 14 | end 15 | else 16 | junk := addstr(CCL, pat, j, MAXPAT); 17 | jstart := j; 18 | junk := addstr(0, pat, j, MAXPAT); { room for count } 19 | dodash(CCLEND, arg, i, pat, j, MAXPAT); 20 | pat[jstart] := j - jstart - 1; 21 | getccl := (arg[i] = CCLEND) 22 | end; 23 | -------------------------------------------------------------------------------- /orig/sort/shell.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { shell -- ascending Shell sort for lines } 3 | procedure shell (var linepos : posbuf; nlines : integer; 4 | var linebuf : charbuf); 5 | var 6 | gap, i, j, jg : integer; 7 | #include "cmp.p" 8 | #include "exchange.p" 9 | begin 10 | gap := nlines div 2; 11 | while (gap > 0) do begin 12 | for i := gap+1 to nlines do begin 13 | j := i - gap; 14 | while (j > 0) do begin 15 | jg := j + gap; 16 | if (cmp(linepos[j],linepos[jg],linebuf)<=0) then 17 | j := 0 { force loop termination } 18 | else 19 | exchange(linepos[j], linepos[jg]); 20 | j := j - gap 21 | end 22 | end; 23 | gap := gap div 2 24 | end 25 | end; 26 | -------------------------------------------------------------------------------- /orig/filters/compress.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { compress -- compress standard input } 3 | procedure compress; 4 | const 5 | WARNING = TILDE; { ~ } 6 | var 7 | c, lastc : character; 8 | n : integer; 9 | #include "putrep.p" 10 | begin 11 | n := 1; 12 | lastc := getc(lastc); 13 | while (lastc <> ENDFILE) do begin 14 | if (getc(c) = ENDFILE) then begin 15 | if (n > 1) or (lastc = WARNING) then 16 | putrep(n, lastc) 17 | else 18 | putc(lastc) 19 | end 20 | else if (c = lastc) then 21 | n := n + 1 22 | else if (n > 1) or (lastc = WARNING) then begin 23 | putrep(n, lastc); 24 | n := 1 25 | end 26 | else 27 | putc(lastc); 28 | lastc := c 29 | end 30 | end; 31 | -------------------------------------------------------------------------------- /orig/edit/subline.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { subline -- substitute sub for pat in lin and print } 3 | procedure subline (var lin, pat, sub : string); 4 | var 5 | i, lastm, m : integer; 6 | junk : boolean; 7 | #include "amatch.p" 8 | #include "putsub.p" 9 | begin 10 | lastm := 0; 11 | i := 1; 12 | while (lin[i] <> ENDSTR) do begin 13 | m := amatch(lin, i, pat, 1); 14 | if (m > 0) and (lastm <> m) then begin 15 | { replace matched text } 16 | putsub(lin, i, m, sub); 17 | lastm := m 18 | end; 19 | if (m = 0) or (m = i) then begin 20 | { no match or null match } 21 | putc(lin[i]); 22 | i := i + 1 23 | end 24 | else { skip matched text } 25 | i := m 26 | end 27 | end; 28 | -------------------------------------------------------------------------------- /orig/man/detab.m: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | .NM detab convert tabs to blanks 3 | .SY 4 | .UL "detab" 5 | .FU 6 | .UL detab 7 | copies its input to its output, expanding horizontal tabs to blanks along 8 | the way, so that the output is visually the same as the input, but contains 9 | no tab characters. 10 | Tab stops are assumed to be set every four columns 11 | (i.e., 1, 5, 9, ...), 12 | so that each tab 13 | character is replaced by from one to four blanks. 14 | .EG 15 | Using 16 | .UL \(-> 17 | as a visible tab: 18 | .Q1 19 | detab 20 | \(->col 1\(->2\(->34\(->rest 21 | .S " col 1 2 34 rest" 22 | .BU 23 | .UL detab 24 | is naive about backspaces, vertical motions, and non-printing characters. 25 | -------------------------------------------------------------------------------- /orig/ucbprims/getarg.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { getarg (UCB) -- copy n-th command line argument into s } 3 | { uses the Berkeley function argv(i,s), } 4 | { which returns the 0th to argc-1th argument in s. } 5 | function getarg (n : integer; var s : string; 6 | maxs : integer) : boolean; 7 | var 8 | arg : array [1..MAXSTR] of char; 9 | i, lnb : integer; 10 | begin 11 | lnb := 0; 12 | if (n >= 0) and (n < argc) then begin { in the list } 13 | argv(n, arg); { get the argument } 14 | for i := 1 to MAXSTR-1 do begin 15 | s[i] := ord(arg[i]); 16 | if arg[i] <> ' ' then 17 | lnb := i 18 | end; 19 | getarg := true 20 | end 21 | else 22 | getarg := false; 23 | s[lnb+1] := ENDSTR 24 | end; 25 | -------------------------------------------------------------------------------- /orig/fileio/compare0.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { compare (simple version) -- compare two files for equality } 3 | procedure compare; 4 | var 5 | line1, line2 : string; 6 | lineno : integer; 7 | f1, f2 : boolean; 8 | #include "diffmsg.p" 9 | begin 10 | lineno := 0; 11 | repeat 12 | lineno := lineno + 1; 13 | f1 := getline(line1, infile1, MAXSTR); 14 | f2 := getline(line2, infile2, MAXSTR); 15 | if (f1 and f2) then 16 | if (not equal(line1, line2)) then 17 | diffmsg(lineno, line1, line2) 18 | until (f1 = false) or (f2 = false); 19 | if (f2 and not f1) then 20 | message('compare: end of file on file1') 21 | else if (f1 and not f2) then 22 | message('compare: end of file on file2') 23 | end; 24 | -------------------------------------------------------------------------------- /orig/man/putc.m: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | .ds n PRIMITIVE 3 | .NM putc,\ putcf put one character on output 4 | .SY 5 | .Q1 6 | c : character; 7 | fd : filedesc; 8 | 9 | putc(c); 10 | putcf(c, fd); 11 | .Q2 12 | .FU 13 | .UL putc 14 | and 15 | .UL putcf 16 | output a single 17 | .UL character 18 | onto 19 | .UL STDOUT 20 | or the named file descriptor respectively. 21 | .UL NEWLINE 22 | is converted into an appropriate action 23 | by calling 24 | .UL writeln 25 | or its logical equivalent. 26 | .BU 27 | There is no explicit error mechanism. 28 | .br 29 | The behavior of 30 | .UL putc 31 | and 32 | .UL putcf 33 | is undefined if the converted value of 34 | .UL c 35 | is not a character in the standard character set. 36 | -------------------------------------------------------------------------------- /orig/pman/seek.m: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | .NM seek position file access pointer 3 | .SY 4 | .UL "procedure seek (recno : integer; fd : filedesc);" 5 | .FU 6 | .UL seek 7 | positions the file controlled by 8 | .UL fd 9 | so that a subsequent 10 | .UL read 11 | or 12 | .UL write 13 | call will access the record whose ordinal number is 14 | .UL recno . 15 | Records are presumed to be of type 16 | .UL string ; 17 | the first record is number one. 18 | .RE 19 | Nothing. 20 | .BU 21 | Our version of this primitive is far from general, having been written just 22 | to satisfy the needs of one form of the program 23 | .UL edit . 24 | It assumes a system that can support simultaneous read and write 25 | access to the same file. 26 | -------------------------------------------------------------------------------- /orig/edit/makesub.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { makesub -- make substitution string from arg in sub } 3 | function makesub (var arg : string; from : integer; 4 | delim : character; var sub : string) : integer; 5 | var 6 | i, j : integer; 7 | junk : boolean; 8 | begin 9 | j := 1; 10 | i := from; 11 | while (arg[i] <> delim) and (arg[i] <> ENDSTR) do begin 12 | if (arg[i] = ord('&')) then 13 | junk := addstr(DITTO, sub, j, MAXPAT) 14 | else 15 | junk := addstr(esc(arg, i), sub, j, MAXPAT); 16 | i := i + 1 17 | end; 18 | if (arg[i] <> delim) then { missing delimiter } 19 | makesub := 0 20 | else if (not addstr(ENDSTR, sub, j, MAXPAT)) then 21 | makesub := 0 22 | else 23 | makesub := i 24 | end; 25 | -------------------------------------------------------------------------------- /orig/man/getc.m: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | .ds n PRIMITIVE 3 | .NM getc,\ getcf get one character from input 4 | .SY 5 | .Q1 6 | c, c1 : character; 7 | fd : filedesc; 8 | 9 | c := getc(c1); 10 | c := getcf(c1, fd); 11 | .Q2 12 | .FU 13 | .UL getc 14 | and 15 | .UL getcf 16 | return a single 17 | .UL character 18 | from 19 | .UL STDIN 20 | or the named file descriptor respectively. 21 | The value is also returned through the 22 | .UL c1 23 | argument. 24 | .UL ENDFILE 25 | is returned the first time 26 | that end of file is encountered. 27 | .UL NEWLINE 28 | is returned at the end of each line. 29 | .BU 30 | There is no explicit error mechanism. 31 | .br 32 | Behavior of calls after the first 33 | .UL ENDFILE 34 | is undefined. 35 | -------------------------------------------------------------------------------- /orig/edit/getfn.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { getfn -- get file name from lin[i]... } 3 | function getfn (var lin : string; var i : integer; 4 | var fil : string) : stcode; 5 | var 6 | k : integer; 7 | stat : stcode; 8 | #include "getword.p" 9 | begin 10 | stat := ERR; 11 | if (lin[i+1] = BLANK) then begin 12 | k := getword(lin, i+2, fil); { get new filename } 13 | if (k > 0) then 14 | if (lin[k] = NEWLINE) then 15 | stat := OK 16 | end 17 | else if (lin[i+1] = NEWLINE) 18 | and (savefile[1] <> ENDSTR) then begin 19 | scopy(savefile, 1, fil, 1); 20 | stat := OK 21 | end; 22 | if (stat = OK) and (savefile[1] = ENDSTR) then 23 | scopy(fil, 1, savefile, 1); { save if no old one } 24 | getfn := stat 25 | end; 26 | -------------------------------------------------------------------------------- /cpp/lib.h: -------------------------------------------------------------------------------- 1 | #pragma once 2 | #include 3 | 4 | // TODO: use std::string_view in C++17. 5 | void error(const char* message) __attribute__ ((noreturn)); 6 | void error_open(const char* filename) __attribute__ ((noreturn)); 7 | 8 | // An RAII handle for FILE*. 9 | class File 10 | { 11 | public: 12 | File(const char* filename, const char* mode) 13 | : file_(fopen(filename, mode)) 14 | { 15 | if (file_ == nullptr) 16 | error_open(filename); 17 | } 18 | 19 | File(const File&) = delete; 20 | void operator=(const File&) = delete; 21 | // TODO: Add move ctor 22 | 23 | ~File() 24 | { 25 | fclose(file_); 26 | } 27 | 28 | FILE* get() { return file_; } 29 | 30 | private: 31 | FILE* file_ = nullptr; 32 | }; 33 | 34 | void fcopy(FILE* fin, FILE* fout); 35 | -------------------------------------------------------------------------------- /orig/edit/doglob.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { doglob -- do command at lin[i] on all marked lines } 3 | function doglob (var lin : string; var i, cursave : integer; 4 | var status : stcode) : stcode; 5 | var 6 | count, istart, n : integer; 7 | begin 8 | status := OK; 9 | count := 0; 10 | n := line1; 11 | istart := i; 12 | repeat 13 | if (getmark(n)) then begin 14 | putmark(n, false); 15 | curln := n; 16 | cursave := curln; 17 | i := istart; 18 | if (getlist(lin, i, status) = OK) then 19 | if (docmd(lin, i, true, status) = OK) then 20 | count := 0 21 | end 22 | else begin 23 | n := nextln(n); 24 | count := count + 1 25 | end 26 | until (count > lastln) or (status <> OK); 27 | doglob := status 28 | end; 29 | -------------------------------------------------------------------------------- /orig/edit/doread.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { doread -- read "fil" after line n } 3 | function doread (n : integer; var fil : string) : stcode; 4 | var 5 | count : integer; 6 | t : boolean; 7 | stat : stcode; 8 | fd : filedesc; 9 | inline : string; 10 | begin 11 | fd := open(fil, IOREAD); 12 | if (fd = IOERROR) then 13 | stat := ERR 14 | else begin 15 | curln := n; 16 | stat := OK; 17 | count := 0; 18 | repeat 19 | t := getline(inline, fd, MAXSTR); 20 | if (t) then begin 21 | stat := puttxt(inline); 22 | if (stat <> ERR) then 23 | count := count + 1 24 | end 25 | until (stat <> OK) or (t = false); 26 | close(fd); 27 | putdec(count, 1); 28 | putc(NEWLINE) 29 | end; 30 | doread := stat 31 | end; 32 | -------------------------------------------------------------------------------- /orig/intro/detab.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { detab -- convert tabs to equivalent number of blanks } 3 | procedure detab; 4 | const 5 | MAXLINE = 1000; { or whatever } 6 | type 7 | tabtype = array [1..MAXLINE] of boolean; 8 | var 9 | c : character; 10 | col : integer; 11 | tabstops : tabtype; 12 | #include "tabpos.p" 13 | #include "settabs.p" 14 | begin 15 | settabs(tabstops); { set initial tab stops } 16 | col := 1; 17 | while (getc(c) <> ENDFILE) do 18 | if (c = TAB) then 19 | repeat 20 | putc(BLANK); 21 | col := col + 1 22 | until (tabpos(col, tabstops)) 23 | else if (c = NEWLINE) then begin 24 | putc(NEWLINE); 25 | col := 1 26 | end 27 | else begin 28 | putc(c); 29 | col := col + 1 30 | end 31 | end; 32 | -------------------------------------------------------------------------------- /orig/man/sort.m: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | .NM sort sort text lines 3 | .SY 4 | .UL "sort" 5 | .FU 6 | .UL sort 7 | sorts its input into ascending lexicographic order. 8 | Two lines are in order if they are identical or if the leftmost character 9 | position in which they differ contains characters which are in order, 10 | using the internal numeric representation of the characters. 11 | If a line is a proper prefix of another line, it precedes that line in 12 | sort order. 13 | .IP 14 | .UL sort 15 | writes intermediate data to files 16 | named 17 | .UL stemp #, 18 | where # is a small decimal digit string; 19 | these filenames should be avoided. 20 | .EG 21 | To print the sorted output of a program: 22 | .Q1 23 | program | sort | print 24 | .Q2 25 | -------------------------------------------------------------------------------- /orig/archive/update.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { update -- update existing files, add new ones at end } 3 | procedure update (var aname : string; cmd : character); 4 | var 5 | i : integer; 6 | afd, tfd : filedesc; 7 | begin 8 | tfd := mustcreate(archtemp, IOWRITE); 9 | if (cmd = ord('u')) then begin 10 | afd := mustopen(aname, IOREAD); 11 | replace(afd, tfd, ord('u')); { update existing } 12 | close(afd) 13 | end; 14 | for i := 1 to nfiles do { add new ones } 15 | if (fstat[i] = false) then begin 16 | addfile(fname[i], tfd); 17 | fstat[i] := true 18 | end; 19 | close(tfd); 20 | if (errcount = 0) then 21 | fmove(archtemp, aname) 22 | else 23 | message('fatal errors - archive not altered'); 24 | remove(archtemp) 25 | end; 26 | -------------------------------------------------------------------------------- /orig/sort/inmemsort.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { sort -- sort text lines in memory } 3 | procedure inmemsort; 4 | const 5 | MAXCHARS = 10000; { maximum # of text characters } 6 | MAXLINES = 300; { maximum # of lines } 7 | type 8 | charbuf = array [1..MAXCHARS] of character; 9 | charpos = 1..MAXCHARS; 10 | posbuf = array [1..MAXLINES] of charpos; 11 | pos = 0..MAXLINES; 12 | var 13 | linebuf : charbuf; 14 | linepos : posbuf; 15 | nlines : pos; 16 | #include "gtext.p" 17 | #include "shell.p" 18 | #include "ptext.p" 19 | begin 20 | if (gtext(linepos, nlines, linebuf, STDIN)) then begin 21 | shell(linepos, nlines, linebuf); 22 | ptext(linepos, nlines, linebuf, STDOUT) 23 | end 24 | else 25 | error('sort: input too big to sort') 26 | end; 27 | -------------------------------------------------------------------------------- /orig/edit/edvar2.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { editvar -- variables for edit } 3 | var 4 | buf : array [0..MAXLINES] of buftype; 5 | scrout : filedesc; { scratch input fd } 6 | scrin : filedesc; { scratch output fd } 7 | recin : integer; { next record to read from scrin } 8 | recout : integer; { next record to write on scrout } 9 | edittemp : string; { temp file name 'edtemp' } 10 | 11 | line1 : integer; { first line number } 12 | line2 : integer; { second line number } 13 | nlines : integer; { # of line numbers specified } 14 | curln : integer; { current line -- value of dot } 15 | lastln : integer; { last line -- value of $ } 16 | 17 | pat : string; { pattern } 18 | lin : string; { input line } 19 | savefile : string; { remembered file name } 20 | -------------------------------------------------------------------------------- /orig/sort/inmemquick.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { sort -- sort text lines in memory } 3 | procedure inmemquick; 4 | const 5 | MAXCHARS = 10000; { maximum # of text characters } 6 | MAXLINES = 100; { maximum # of line pointers } 7 | type 8 | charpos = 1..MAXCHARS; 9 | charbuf = array [1..MAXCHARS] of character; 10 | posbuf = array [1..MAXLINES] of charpos; 11 | pos = 0..MAXLINES; 12 | var 13 | linebuf : charbuf; 14 | linepos : posbuf; 15 | nlines : pos; 16 | #include "gtext.p" 17 | #include "quick.p" 18 | #include "ptext.p" 19 | begin 20 | if (gtext(linepos, nlines, linebuf, STDIN)) then begin 21 | quick(linepos, nlines, linebuf); 22 | ptext(linepos, nlines, linebuf, STDOUT) 23 | end 24 | else 25 | error('sort: input too big to sort') 26 | end; 27 | -------------------------------------------------------------------------------- /orig/edit/editproc.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { editproc -- procedures for edit } 3 | #include "edprim.p" { editor buffer primitives } 4 | #include "amatch.p" 5 | #include "match.p" 6 | #include "skipbl.p" 7 | #include "optpat.p" 8 | #include "nextln.p" 9 | #include "prevln.p" 10 | #include "patscan.p" 11 | #include "getnum.p" 12 | #include "getone.p" 13 | #include "getlist.p" 14 | #include "append.p" 15 | #include "lndelete.p" 16 | #include "doprint.p" 17 | #include "doread.p" 18 | #include "dowrite.p" 19 | #include "move.p" 20 | #include "makesub.p" 21 | #include "getrhs.p" 22 | #include "catsub.p" 23 | #include "subst.p" 24 | #include "ckp.p" 25 | #include "default.p" 26 | #include "getfn.p" 27 | #include "docmd.p" 28 | #include "ckglob.p" 29 | #include "doglob.p" 30 | -------------------------------------------------------------------------------- /orig/fileio/finclude.cc: -------------------------------------------------------------------------------- 1 | #include "../p2c.h" 2 | #include "fileio.h" 3 | 4 | // Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. 5 | // finclude -- include file desc f 6 | void finclude(filedesc f) 7 | { 8 | string line, str; 9 | integer loc, i; 10 | filedesc f1; 11 | 12 | while (getline(line, f, MAXSTR)) { 13 | loc = getword(line, 1, str); 14 | if (not equal(str, incl)) 15 | putstr(line, STDOUT); 16 | else { 17 | loc = getword(line, loc, str); 18 | str[length(str)] = ENDSTR; // remove quotes 19 | for (i = 1; i <= length(str); ++i) 20 | str[i] = str[i + 1]; 21 | f1 = mustopen(str, IOREAD); 22 | finclude(f1); 23 | close(f1); 24 | } 25 | } 26 | } 27 | -------------------------------------------------------------------------------- /orig/man/create.m: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | .ds n PRIMITIVE 3 | .NM create initialize a file for writing 4 | .SY 5 | .Q1 6 | name : string; 7 | fd : filedesc; 8 | mode : IOREAD..IOWRITE; 9 | 10 | fd := create(name, mode); 11 | .Q2 12 | .FU 13 | .UL create 14 | arranges for access to file 15 | .UL name 16 | with the specified access mode, 17 | which is generally 18 | .UL IOWRITE . 19 | It returns a file descriptor 20 | if the access succeeds, and 21 | .UL IOERROR 22 | if not. 23 | .UL fd 24 | may be used in subsequent calls to 25 | .UL putcf , 26 | .UL putstr , 27 | etc. 28 | .IP 29 | .UL create 30 | creates the file if it does not exist already. 31 | If the file does exist, the effect is to remove it 32 | and create it anew; it is 33 | .ul 34 | not 35 | an error. 36 | -------------------------------------------------------------------------------- /orig/sort/sortquick.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { sort -- sort text lines in memory } 3 | procedure sort; 4 | const 5 | MAXCHARS = 1000; { maximum number of text characters } 6 | MAXLINES = 100; { maximum number of line pointers } 7 | type 8 | charpos = 1..MAXCHARS; 9 | charbuf = array [1..MAXCHARS] of character; 10 | posbuf = array [1..MAXLINES] of charpos; 11 | pos = 0..MAXLINES; 12 | var 13 | linbuf : charbuf; 14 | linpos : posbuf; 15 | nlines : pos; 16 | 17 | #include "gtext.p" 18 | #include "quick.p" 19 | #include "ptext.p" 20 | 21 | begin 22 | if (gtext(linpos, nlines, linbuf, STDIN) = ENDFILE) then begin 23 | quick(linpos, nlines, linbuf); 24 | ptext(linpos, nlines, linbuf, STDOUT) 25 | end 26 | else 27 | error('sort: input too big to sort') 28 | end; 29 | -------------------------------------------------------------------------------- /orig/ucsdprims/getline.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { getline (UCSD) -- get a line from file } 3 | function getline (var str : xstring; fd : filedesc; 4 | size : integer) : boolean; 5 | var 6 | i : integer; 7 | done : boolean; 8 | ch : character; 9 | begin 10 | i := 0; 11 | repeat 12 | done := true; 13 | ch := getcf(ch, fd); 14 | if (ch = ENDFILE) then 15 | i := 0 16 | else if (ch = NEWLINE) then begin 17 | i := i + 1; 18 | str[i] := NEWLINE 19 | end 20 | else if (size-2 <= i) then begin 21 | message('line too long'); 22 | i := i + 1; 23 | str[i] := NEWLINE 24 | end 25 | else begin 26 | done := false; 27 | i := i + 1; 28 | str[i] := ch 29 | end 30 | until (done); 31 | str[i + 1] := ENDSTR; 32 | getline := (0 < i) 33 | end; 34 | -------------------------------------------------------------------------------- /orig/man/print.m: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | .NM print print files with headings 3 | .SY 4 | .UL "print [ file ... ]" 5 | .FU 6 | .UL print 7 | copies each of its argument files in turn to its output, inserting page 8 | headers and footers and filling the last page of each file to full length. 9 | A header consists of two blank lines, a line giving the filename and 10 | page number, and two more blank lines; 11 | a footer consists of two blank lines. 12 | Pages for each file are numbered starting at one. 13 | If no arguments are specified, 14 | .UL print 15 | prints its standard input; 16 | the file name is null. 17 | .IP 18 | The text of each file is unmodified \(em 19 | no attempt is made to fold long lines or expand tabs to spaces. 20 | .EG 21 | .Q1 22 | print print.p fprint.p 23 | .Q2 24 | -------------------------------------------------------------------------------- /orig/fileio/compare0.cc: -------------------------------------------------------------------------------- 1 | #include "../p2c.h" 2 | #include "fileio.h" 3 | 4 | // Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. 5 | // compare (simple version) -- compare two files for equality 6 | void compare() 7 | { 8 | string line1, line2; 9 | integer lineno; 10 | boolean f1, f2; 11 | 12 | lineno = 0; 13 | do { 14 | lineno = lineno + 1; 15 | f1 = getline(line1, infile1, MAXSTR); 16 | f2 = getline(line2, infile2, MAXSTR); 17 | if (f1 and f2) 18 | if (not equal(line1, line2)) 19 | diffmsg(lineno, line1, line2); 20 | } while (not((f1 == false) or (f2 == false))); 21 | if (f2 and not f1) 22 | message("compare: end of file on file1"); 23 | else if (f1 and not f2) 24 | message("compare: end of file on file2"); 25 | } 26 | -------------------------------------------------------------------------------- /orig/filters/compress.cc: -------------------------------------------------------------------------------- 1 | #include "../p2c.h" 2 | #include "filters.h" 3 | 4 | // Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. 5 | // compress -- compress standard input 6 | void compress() 7 | { 8 | const int WARNING = TILDE; // ~ 9 | character c, lastc; 10 | integer n; 11 | 12 | n = 1; 13 | lastc = getc(lastc); 14 | while (lastc != ENDFILE) { 15 | if (getc(c) == ENDFILE) { 16 | if ((n > 1) or (lastc == WARNING)) 17 | putrep(n, lastc); 18 | else 19 | putc(lastc); 20 | } else if (c == lastc) 21 | n = n + 1; 22 | else if ((n > 1) or (lastc == WARNING)) { 23 | putrep(n, lastc); 24 | n = 1; 25 | } else 26 | putc(lastc); 27 | lastc = c; 28 | } 29 | } 30 | -------------------------------------------------------------------------------- /orig/filters/expand.cc: -------------------------------------------------------------------------------- 1 | #include "../p2c.h" 2 | #include "filters.h" 3 | 4 | // Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. 5 | // expand -- uncompress standard input 6 | void expand() 7 | { 8 | const int WARNING = TILDE; // ~ 9 | character c; 10 | integer n; 11 | 12 | while (getc(c) != ENDFILE) 13 | if (c != WARNING) 14 | putc(c); 15 | else if (isupper(getc(c))) { 16 | n = c - ord('A') + 1; 17 | if (getc(c) != ENDFILE) 18 | for (n = n; n >= 1; --n) 19 | putc(c); 20 | else { 21 | putc(WARNING); 22 | putc(n - 1 + ord('A')); 23 | } 24 | } else { 25 | putc(WARNING); 26 | if (c != ENDFILE) 27 | putc(c); 28 | } 29 | } 30 | -------------------------------------------------------------------------------- /orig/macro/install.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { install -- add name, definition and type to table } 3 | procedure install (var name, defn : string; t : sttype); 4 | var 5 | h, dlen, nlen : integer; 6 | p : ndptr; 7 | begin 8 | nlen := length(name) + 1; { 1 for ENDSTR } 9 | dlen := length(defn) + 1; 10 | if (nexttab + nlen + dlen > MAXCHARS) then begin 11 | putstr(name, STDERR); 12 | error(': too many definitions') 13 | end 14 | else begin { put it at front of chain } 15 | h := hash(name); 16 | new(p); 17 | p^.nextptr := hashtab[h]; 18 | hashtab[h] := p; 19 | p^.name := nexttab; 20 | sccopy(name, ndtable, nexttab); 21 | nexttab := nexttab + nlen; 22 | p^.defn := nexttab; 23 | sccopy(defn, ndtable, nexttab); 24 | nexttab := nexttab + dlen; 25 | p^.kind := t 26 | end 27 | end; 28 | -------------------------------------------------------------------------------- /orig/pman/getc.m: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | .NM getc get a character from standard input 3 | .SY 4 | .UL "function getc (var c : character) : character;" 5 | .FU 6 | .UL getc 7 | reads at most one character from the standard input 8 | .UL STDIN . 9 | If there are no more characters available, 10 | .UL getc 11 | returns 12 | .UL ENDFILE ; 13 | if the input is at end-of-line, it returns 14 | .UL NEWLINE 15 | and advances to the beginning of the next line; 16 | otherwise it returns the next input character. 17 | .RE 18 | .UL getc 19 | returns the value of type 20 | .UL character 21 | corresponding to the character read from the standard input, or one 22 | of the special values 23 | .UL NEWLINE 24 | or 25 | .UL ENDFILE 26 | as specified above. 27 | The return value is also written in the argument 28 | .UL c . 29 | -------------------------------------------------------------------------------- /orig/macro/dosub.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { dosub -- select substring } 3 | procedure dosub (var argstk : posbuf; i, j : integer); 4 | var 5 | ap, fc, k, nc : integer; 6 | temp1, temp2 : string; 7 | begin 8 | if (j - i >= 3) then begin 9 | if (j - i < 4) then 10 | nc := MAXTOK 11 | else begin 12 | cscopy(evalstk, argstk[i+4], temp1); 13 | k := 1; 14 | nc := expr(temp1, k) 15 | end; 16 | cscopy(evalstk, argstk[i+3], temp1); { origin } 17 | ap := argstk[i+2]; { target string } 18 | k := 1; 19 | fc := ap + expr(temp1, k) - 1; { first char } 20 | cscopy(evalstk, ap, temp2); 21 | if (fc >= ap) and (fc < ap+length(temp2)) then begin 22 | cscopy(evalstk, fc, temp1); 23 | for k := fc+min(nc,length(temp1))-1 downto fc do 24 | putback(evalstk[k]) 25 | end 26 | end 27 | end; 28 | -------------------------------------------------------------------------------- /orig/man/kwic.m: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | .NM kwic produce lines for KWIC index 3 | .SY 4 | .UL "kwic" 5 | .FU 6 | .UL kwic 7 | writes one or more ``folded'' 8 | versions of each input line to its output. 9 | A line is ``folded'' at the beginning of each alphanumeric string within 10 | the line by writing from that string through the end of the line, followed 11 | by the fold character 12 | .UL $ , 13 | followed by the beginning of the line. 14 | .IP 15 | .UL kwic 16 | is used with 17 | .UL sort 18 | and 19 | .UL unrotate 20 | to produce a KeyWord In Context, or KWIC, index. 21 | .EG 22 | .Q1 23 | kwic 24 | This is a test. 25 | .S "This is a test.$" 26 | .S "is a test.$This" 27 | .S "a test.$This is" 28 | .S "test.$This is a" 29 | .Q2 30 | Normal usage is 31 | .Q1 32 | kwic = MAXCHARS-MAXSTR) 24 | or (nlines >= MAXLINES); 25 | gtext := done 26 | end; 27 | -------------------------------------------------------------------------------- /orig/intro/detab.cc: -------------------------------------------------------------------------------- 1 | #include "../p2c.h" 2 | #include "intro.h" 3 | 4 | // Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. 5 | // detab -- convert tabs to equivalent number of blanks 6 | void detab() 7 | { 8 | const int MAXLINE = 1000; // or whatever 9 | using tabtype = boolean[MAXLINE + 1]; 10 | character c; 11 | integer col; 12 | tabtype tabstops; 13 | 14 | settabs(tabstops); // set initial tab stops 15 | col = 1; 16 | while (getc(c) != ENDFILE) 17 | if (c == TAB) 18 | do { 19 | putc(BLANK); 20 | col = col + 1; 21 | } while (not(tabpos(col, tabstops))); 22 | else if (c == NEWLINE) { 23 | putc(NEWLINE); 24 | col = 1; 25 | } else { 26 | putc(c); 27 | col = col + 1; 28 | } 29 | } 30 | -------------------------------------------------------------------------------- /orig/edit/editcons.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { editcons -- const declarations for edit } 3 | const 4 | MAXLINES = 100; { set small for testing } 5 | MAXPAT = MAXSTR; 6 | CLOSIZE = 1; { size of a closure entry } 7 | DITTO = -1; 8 | CLOSURE = STAR; 9 | BOL = PERCENT; 10 | EOL = DOLLAR; 11 | ANY = QUESTION; 12 | CCL = LBRACK; 13 | CCLEND = RBRACK; 14 | NEGATE = CARET; 15 | NCCL = EXCLAM; 16 | LITCHAR = LETC; 17 | CURLINE = PERIOD; 18 | LASTLINE = DOLLAR; 19 | SCAN = SLASH; 20 | BACKSCAN = BACKSLASH; 21 | 22 | ACMD = LETA; { = ord('a') } 23 | CCMD = LETC; 24 | DCMD = LETD; 25 | ECMD = LETE; 26 | EQCMD = EQUALS; 27 | FCMD = LETF; 28 | GCMD = LETG; 29 | ICMD = LETI; 30 | MCMD = LETM; 31 | PCMD = LETP; 32 | QCMD = LETQ; 33 | RCMD = LETR; 34 | SCMD = LETS; 35 | WCMD = LETW; 36 | XCMD = LETX; 37 | -------------------------------------------------------------------------------- /cpp/filters/entab.cc: -------------------------------------------------------------------------------- 1 | // entab -- replace blanks by tabs and blanks 2 | // BUG: it doesn't work properly if the input has tabs. 3 | #include 4 | 5 | const int TABSPACE = 4; 6 | 7 | int main() 8 | { 9 | int col = 0; 10 | int c; 11 | 12 | do { 13 | int newcol = col; 14 | while ( (c = getchar()) == ' ') { // collect blanks 15 | ++newcol; 16 | if (newcol % TABSPACE == 0) { 17 | putchar('\t'); 18 | col = newcol; 19 | } 20 | } 21 | while (col < newcol) { 22 | putchar(' '); // output leftover blanks 23 | ++col; 24 | } 25 | if (c != EOF) { 26 | putchar(c); 27 | if (c == '\n') 28 | col = 0; 29 | else 30 | ++col; 31 | } 32 | } while (c != EOF); 33 | } 34 | -------------------------------------------------------------------------------- /orig/edit/getnum.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { getnum -- get single line number component } 3 | function getnum (var lin : string; var i, num : integer; 4 | var status : stcode) : stcode; 5 | begin 6 | status := OK; 7 | skipbl(lin, i); 8 | if (isdigit(lin[i])) then begin 9 | num := ctoi(lin, i); 10 | i := i - 1 { move back; to be advanced at end } 11 | end 12 | else if (lin[i] = CURLINE) then 13 | num := curln 14 | else if (lin[i] = LASTLINE) then 15 | num := lastln 16 | else if (lin[i] = SCAN) or (lin[i] = BACKSCAN) then begin 17 | if (optpat(lin, i) = ERR) then { build pattern } 18 | status := ERR 19 | else 20 | status := patscan(lin[i], num) 21 | end 22 | else 23 | status := ENDDATA; 24 | if (status = OK) then 25 | i := i + 1; { next character to be examined } 26 | getnum := status 27 | end; 28 | -------------------------------------------------------------------------------- /orig/man/expand.m: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | .NM expand expand compressed input 3 | .SY 4 | .UL "expand" 5 | .FU 6 | .UL expand 7 | copies its input, which has presumably been encoded by 8 | .UL compress , 9 | to its output, replacing code sequences 10 | .UI ~n c 11 | by the repeated characters they stand 12 | for so that the text output exactly matches that which was originally encoded. 13 | The occurrence of the warning character 14 | .UL ~ 15 | in the input means that the next character 16 | is a repetition count; 17 | .UL A ' ` 18 | calls for one instance 19 | of the following character, 20 | .UL B ' ` 21 | calls for 22 | two, and so on 23 | up to 24 | .UL Z .' ` 25 | .EG 26 | .Q1 27 | expand 28 | Item~D Name~I Value 29 | .S "Item Name Value" 30 | 1~G car~J ~A~$7,000.00 31 | .S "1 car ~$7,000.00" 32 | 33 | -------------------------------------------------------------------------------- /orig/sort/rquick.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { rquick -- recursive quicksort } 3 | procedure rquick (lo, hi: integer); 4 | var 5 | i, j : integer; 6 | pivline : charpos; 7 | begin 8 | if (lo < hi) then begin 9 | i := lo; 10 | j := hi; 11 | pivline := linepos[j]; { pivot line } 12 | repeat 13 | while (i < j) 14 | and (cmp(linepos[i],pivline,linebuf) <= 0) do 15 | i := i + 1; 16 | while (j > i) 17 | and (cmp(linepos[j],pivline,linebuf) >= 0) do 18 | j := j - 1; 19 | if (i < j) then { out of order pair } 20 | exchange(linepos[i], linepos[j]) 21 | until (i >= j); 22 | exchange(linepos[i], linepos[hi]); { move pivot to i } 23 | if (i - lo < hi - i) then begin 24 | rquick(lo, i-1); 25 | rquick(i+1, hi) 26 | end 27 | else begin 28 | rquick(i+1, hi); 29 | rquick(lo, i-1) 30 | end 31 | end 32 | end; 33 | -------------------------------------------------------------------------------- /orig/format/text.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { text -- process text lines (final version) } 3 | procedure text (var inbuf : string); 4 | var 5 | wordbuf : string; 6 | i : integer; 7 | begin 8 | if (inbuf[1] = BLANK) or (inbuf[1] = NEWLINE) then 9 | leadbl(inbuf); { move left, set tival } 10 | if (ulval > 0) then begin { underlining } 11 | underln(inbuf, MAXSTR); 12 | ulval := ulval - 1 13 | end; 14 | if (ceval > 0) then begin { centering } 15 | center(inbuf); 16 | put(inbuf); 17 | ceval := ceval - 1 18 | end 19 | else if (inbuf[1] = NEWLINE) then { all-blank line } 20 | put(inbuf) 21 | else if (not fill) then { unfilled text } 22 | put(inbuf) 23 | else begin { filled text } 24 | i := 1; 25 | repeat 26 | i := getword(inbuf, i, wordbuf); 27 | if (i > 0) then 28 | putword(wordbuf) 29 | until (i = 0) 30 | end 31 | end; 32 | -------------------------------------------------------------------------------- /orig/man/getline.m: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | .ds n PRIMITIVE 3 | .NM getline get one line from file 4 | .SY 5 | .Q1 6 | s : string; 7 | b : boolean; 8 | fd : filedesc; 9 | 10 | b := getline(s, fd, MAXSTR); 11 | .Q2 12 | .FU 13 | .UL getline 14 | returns the next line from the specified file descriptor 15 | in the string 16 | .UL s . 17 | .UL b 18 | is 19 | .UL true 20 | if any data was returned, and 21 | .UL false 22 | for end of file. 23 | .UL getline 24 | returns at most 25 | .UL MAXSTR-1 26 | characters plus a terminating 27 | .UL ENDSTR ; 28 | thus if 29 | .UL s[length(s)] 30 | is not a 31 | .UL NEWLINE , 32 | the input line was too long. 33 | .IP 34 | .UL getline 35 | and 36 | .UL getcf 37 | calls may be interleaved. 38 | .BU 39 | There is no explicit error mechanism. 40 | .br 41 | Behavior of calls after the first 42 | .UL ENDFILE 43 | is undefined. 44 | -------------------------------------------------------------------------------- /orig/pman/getcf.m: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | .NM getcf get a character from a file 3 | .SY 4 | .UL "function getcf (var c : character; fd : filedesc) : character;" 5 | .FU 6 | .UL getcf 7 | reads at most one character from the file 8 | specified by the file descriptor 9 | .UL fd . 10 | If there are no more characters available, 11 | .UL getcf 12 | returns 13 | .UL ENDFILE ; 14 | if the input is at end-of-line, it returns 15 | .UL NEWLINE 16 | and advances to the beginning of the next line; 17 | otherwise it returns the next input character and points past it in the file. 18 | .RE 19 | .UL getcf 20 | returns the value of type 21 | .UL character 22 | corresponding to the character read from the file, or one 23 | of the special values 24 | .UL NEWLINE 25 | or 26 | .UL ENDFILE 27 | as specified above. 28 | The return value is also written in the argument 29 | .UL c . 30 | -------------------------------------------------------------------------------- /orig/format/putword.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { putword -- put word in outbuf; does margin justification } 3 | procedure putword (var wordbuf : string); 4 | var 5 | last, llval, nextra, w : integer; 6 | begin 7 | w := width(wordbuf); 8 | last := length(wordbuf) + outp + 1; { new end of outbuf } 9 | llval := rmval - tival - inval; 10 | if (outp > 0) 11 | and ((outw+w > llval) or (last >= MAXSTR)) then begin 12 | last := last - outp; { remember end of wordbuf } 13 | nextra := llval - outw + 1; 14 | if (nextra > 0) and (outwds > 1) then begin 15 | spread(outbuf, outp, nextra, outwds); 16 | outp := outp + nextra 17 | end; 18 | break { flush previous line } 19 | end; 20 | scopy(wordbuf, 1, outbuf, outp+1); 21 | outp := last; 22 | outbuf[outp] := BLANK; { blank between words } 23 | outw := outw + w + 1; { 1 for blank } 24 | outwds := outwds + 1 25 | end; 26 | -------------------------------------------------------------------------------- /orig/edit/getlist.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { getlist -- get list of line nums at lin[i], increment i } 3 | function getlist (var lin : string; var i : integer; 4 | var status : stcode) : stcode; 5 | var 6 | num : integer; 7 | done : boolean; 8 | begin 9 | line2 := 0; 10 | nlines := 0; 11 | done := (getone(lin, i, num, status) <> OK); 12 | while (not done) do begin 13 | line1 := line2; 14 | line2 := num; 15 | nlines := nlines + 1; 16 | if (lin[i] = SEMICOL) then 17 | curln := num; 18 | if (lin[i] = COMMA) or (lin[i] = SEMICOL) then begin 19 | i := i + 1; 20 | done := (getone(lin, i, num, status) <> OK) 21 | end 22 | else 23 | done := true 24 | end; 25 | nlines := min(nlines, 2); 26 | if (nlines = 0) then 27 | line2 := curln; 28 | if (nlines <= 1) then 29 | line1 := line2; 30 | if (status <> ERR) then 31 | status := OK; 32 | getlist := status 33 | end; 34 | -------------------------------------------------------------------------------- /orig/man/entab.m: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | .NM entab convert runs of blanks into tabs 3 | .SY 4 | .UL "entab" 5 | .FU 6 | .UL entab 7 | copies its input to its output, replacing strings of blanks 8 | by tabs so that the output is visually the same as the input, but contains 9 | fewer characters. 10 | Tab stops are assumed to be set every four columns (i.e., 1, 5, 9, ...), 11 | so that each sequence 12 | of one to four blanks ending on a tab stop is replaced by a tab character. 13 | .EG 14 | Using 15 | .UL \(-> 16 | as a visible tab: 17 | .Q1 18 | entab 19 | col 1 2 34 rest 20 | .S "\(->col\(->1\(->2\(->34\(->rest" 21 | .Q2 22 | .BU 23 | .UL entab 24 | is naive about backspaces, vertical motions, and non-printing characters. 25 | .br 26 | .UL entab 27 | will convert a single blank to a tab if it occurs 28 | at a tab stop. 29 | Thus 30 | .UL entab 31 | is not an exact inverse of 32 | .UL detab . 33 | -------------------------------------------------------------------------------- /orig/sort/unrotate.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { unrotate -- unrotate lines rotated by kwic } 3 | procedure unrotate; 4 | const 5 | MAXOUT = 80; 6 | MIDDLE = 40; 7 | FOLD = DOLLAR; 8 | var 9 | inbuf, outbuf : string; 10 | i, j, f : integer; 11 | begin 12 | while (getline(inbuf, STDIN, MAXSTR)) do begin 13 | for i := 1 to MAXOUT-1 do 14 | outbuf[i] := BLANK; 15 | f := index(inbuf, FOLD); 16 | j := MIDDLE - 1; 17 | for i := length(inbuf)-1 downto f+1 do begin 18 | outbuf[j] := inbuf[i]; 19 | j := j - 1; 20 | if (j <= 0) then 21 | j := MAXOUT - 1 22 | end; 23 | j := MIDDLE + 1; 24 | for i := 1 to f-1 do begin 25 | outbuf[j] := inbuf[i]; 26 | j := j mod (MAXOUT-1) + 1 27 | end; 28 | for j := 1 to MAXOUT-1 do 29 | if (outbuf[j] <> BLANK) then 30 | i := j; 31 | outbuf[i+1] := ENDSTR; 32 | putstr(outbuf, STDOUT); 33 | putc(NEWLINE) 34 | end 35 | end; 36 | -------------------------------------------------------------------------------- /orig/archive/extract.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { extract -- extract files from archive } 3 | procedure extract (var aname: string; cmd : character); 4 | var 5 | ename, inline : string; 6 | afd, efd : filedesc; 7 | size : integer; 8 | begin 9 | afd := mustopen(aname, IOREAD); 10 | if (cmd = ord('p')) then 11 | efd := STDOUT 12 | else { cmd is 'x' } 13 | efd := IOERROR; 14 | while (gethdr(afd, inline, ename, size)) do 15 | if (not filearg(ename)) then 16 | fskip(afd, size) 17 | else begin 18 | if (efd <> STDOUT) then 19 | efd := create(ename, IOWRITE); 20 | if (efd = IOERROR) then begin 21 | putstr(ename, STDERR); 22 | message(': can''t create'); 23 | errcount := errcount + 1; 24 | fskip(afd, size) 25 | end 26 | else begin 27 | acopy(afd, efd, size); 28 | if (efd <> STDOUT) then 29 | close(efd) 30 | end 31 | end; 32 | notfound 33 | end; 34 | -------------------------------------------------------------------------------- /orig/filters/overstrike.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { overstrike -- convert backspaces into multiple lines } 3 | procedure overstrike; 4 | const 5 | SKIP = BLANK; 6 | NOSKIP = PLUS; 7 | var 8 | c : character; 9 | col, newcol, i : integer; 10 | begin 11 | col := 1; 12 | repeat 13 | newcol := col; 14 | while (getc(c) = BACKSPACE) do { eat backspaces } 15 | newcol := max(newcol-1, 1); 16 | if (newcol < col) then begin 17 | putc(NEWLINE); { start overstrike line } 18 | putc(NOSKIP); 19 | for i := 1 to newcol-1 do 20 | putc(BLANK); 21 | col := newcol 22 | end 23 | else if (col = 1) and (c <> ENDFILE) then 24 | putc(SKIP); { normal line } 25 | { else middle of line } 26 | if (c <> ENDFILE) then begin 27 | putc(c); { normal character } 28 | if (c = NEWLINE) then 29 | col := 1 30 | else 31 | col := col + 1 32 | end 33 | until (c = ENDFILE) 34 | end; 35 | -------------------------------------------------------------------------------- /orig/format/spread.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { spread -- spread words to justify right margin } 3 | procedure spread (var buf : string; 4 | outp, nextra, outwds : integer); 5 | var 6 | i, j, nb, nholes : integer; 7 | begin 8 | if (nextra > 0) and (outwds > 1) then begin 9 | dir := 1 - dir; { reverse previous direction } 10 | nholes := outwds - 1; 11 | i := outp - 1; 12 | j := min(MAXSTR-2, i+nextra); { room for NEWLINE } 13 | while (i < j) do begin { and ENDSTR } 14 | buf[j] := buf[i]; 15 | if (buf[i] = BLANK) then begin 16 | if (dir = 0) then 17 | nb := (nextra-1) div nholes + 1 18 | else 19 | nb := nextra div nholes; 20 | nextra := nextra - nb; 21 | nholes := nholes - 1; 22 | while (nb > 0) do begin 23 | j := j - 1; 24 | buf[j] := BLANK; 25 | nb := nb - 1 26 | end 27 | end; 28 | i := i - 1; 29 | j := j - 1 30 | end 31 | end 32 | end; 33 | -------------------------------------------------------------------------------- /orig/macro/define.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { define -- simple string replacement macro processor } 3 | procedure define; 4 | #include "defcons.p" 5 | #include "deftype.p" 6 | #include "defvar.p" 7 | defn : string; 8 | token : string; 9 | toktype : sttype; { type returned by lookup } 10 | defname : string; { value is 'define' } 11 | null : string; { value is '' } 12 | #include "defproc.p" 13 | begin 14 | null[1] := ENDSTR; 15 | initdef; 16 | install(defname, null, DEFTYPE); 17 | while (gettok(token, MAXTOK) <> ENDFILE) do 18 | if (not isletter(token[1])) then 19 | putstr(token, STDOUT) 20 | else if (not lookup(token, defn, toktype)) then 21 | putstr(token, STDOUT) { undefined } 22 | else if (toktype = DEFTYPE) then begin { defn } 23 | getdef(token, MAXTOK, defn, MAXDEF); 24 | install(token, defn, MACTYPE) 25 | end 26 | else 27 | pbstr(defn) { push replacement onto input } 28 | end; 29 | -------------------------------------------------------------------------------- /orig/edit/ckglob.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { ckglob -- if global prefix, mark lines to be affected } 3 | function ckglob (var lin : string; var i : integer; 4 | var status : stcode) : stcode; 5 | var 6 | n : integer; 7 | gflag : boolean; 8 | temp : string; 9 | begin 10 | if (lin[i] <> GCMD) and (lin[i] <> XCMD) then 11 | status := ENDDATA 12 | else begin 13 | gflag := (lin[i] = GCMD); 14 | i := i + 1; 15 | if (optpat(lin, i) = ERR) then 16 | status := ERR 17 | else if (default(1,lastln,status) <> ERR) then begin 18 | i := i + 1; { mark affected lines } 19 | for n := line1 to line2 do begin 20 | gettxt(n, temp); 21 | putmark(n, (match(temp, pat) = gflag)) 22 | end; 23 | for n := 1 to line1-1 do { erase other marks } 24 | putmark(n, false); 25 | for n := line2+1 to lastln do 26 | putmark(n, false); 27 | status := OK 28 | end 29 | end; 30 | ckglob := status 31 | end; 32 | -------------------------------------------------------------------------------- /orig/filters/entab.p: -------------------------------------------------------------------------------- 1 | { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. } 2 | { entab -- replace blanks by tabs and blanks } 3 | procedure entab; 4 | const 5 | MAXLINE = 1000; { or whatever } 6 | type 7 | tabtype = array [1..MAXLINE] of boolean; 8 | var 9 | c : character; 10 | col, newcol : integer; 11 | tabstops : tabtype; 12 | #include "tabpos.p" 13 | #include "settabs.p" 14 | begin 15 | settabs(tabstops); 16 | col := 1; 17 | repeat 18 | newcol := col; 19 | while (getc(c) = BLANK) do begin { collect blanks } 20 | newcol := newcol + 1; 21 | if (tabpos(newcol, tabstops)) then begin 22 | putc(TAB); 23 | col := newcol 24 | end 25 | end; 26 | while (col < newcol) do begin 27 | putc(BLANK); { output leftover blanks } 28 | col := col + 1 29 | end; 30 | if (c <> ENDFILE) then begin 31 | putc(c); 32 | if (c = NEWLINE) then 33 | col := 1 34 | else 35 | col := col + 1 36 | end 37 | until (c = ENDFILE) 38 | end; 39 | --------------------------------------------------------------------------------