IMD 1.18: 6/11/2012 10:55:49 carousel microtools carousel toolkits version 2.0 builder toolbook files - cp/m-80 disk b 2 of 3 televideo 1983    åååååååååååååååååå   åååååååååååååååååå   åååååååååååååååååå   åååååååååååååååååå   C AR €C AR 9 D AR € D AR €D AR € !"#$D AR  %E AR ?&'()ED AR €*+,-./01åå #-h- cat.r 6_26 ascii 08/30/83 12:30:00 # include the standard symbol definitions ## cat - concatenate named files onto standard output DRIVER character buf(MAXLINE) integer getarg, open integer i, int for (i=uments passed call fcopy (STDIN, STDOUT) DRETURN end #-t- cat.r 6_26 ascii 08/30/83 12:30:00 #-t- cat.rat 7_22 ascii 08/30/83 12:30:00 #-t- cat.ar 9_23 ascii E) == EOF) call getdir (HOME_DIRECTORY, buf) if (cwdir (buf) == ERR) { call putlin (buf, ERROUT) call remark (": does not exist.") } DRETURN end #-t- cd.r 2_81 ascii 08/30/83 12:30:00 #-t- cd.rat ED AR €23456789ED AR k:;<=>?@F AR €ABCDEFGHF AR €IJKLMNOPF AR 'QRSFORMAT AR €TUVWXYZ[FORMAT AR €\]^_`abcFORMAT AR Udefghiåå1; getarg(i, buf, MAXLINE) != EOF; i=i+1) { if (buf(1) == MINUS & buf(2) == EOS) int = STDIN else if (buf(1) == QMARK & buf(2) == EOS) call error ('usage: cat [file ] .') 09/02/83 09:15:00 #-h- cd.ar 5_77 ascii 09/02/83 09:15:00 #-h- list 0_8 ascii 08/30/83 12:30:00 cd.rat #-t- list 0_8 ascii 08/30/83 12:30:00 #-h- cd.rat 3_77 ascii 3_77 ascii 08/30/83 12:30:00 #-t- cd.ar 5_77 ascii 09/02/83 09:15:00 #-h- ch.ar 46_56 ascii 09/02/83 09:15:00 #-h- list 0_8 ascii 08/30/83 12:30:00 ch.rat #-t- list I AR >jklmL AR €nopqrstuL AR  vREADME wååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååå#-h- cat.ar 9_23 ascii 09/02/83 09:15:00 #-h- list 0_9 ascii 08/30/83 12:30:00 cat.rat #-t- list 0_9 ascii 08/30/83 12:30:00 #-h- cat.rat 7_22 ascii 08/30/83 12:30:00  else int = open(buf, READ) if (int == ERR) call cant(buf) call fcopy(int, STDOUT) if (int != STDIN) call close(int) } if (i == 1) # no arg08/30/83 12:30:00 #-h- cd.r 2_81 ascii 08/30/83 12:30:00 ## cd - change directory DRIVER(pwd) character buf(FILENAMESIZE) integer getarg integer cwdir call query ("usage: cd [directory].") if (getarg(1, buf, FILENAMESIZ 0_8 ascii 08/30/83 12:30:00 #-h- ch.rat 44_56 ascii 08/30/83 12:30:00 #-h- defns 1_24 ascii 08/30/83 12:30:00 define(NEXPR,10) # max nbr expressions allowed on command line define(DITTO,11111) ifdef(NEGDEF   , define(DITTO,(-3))) # include ratdef #-t- defns 1_24 ascii 08/30/83 12:30:00 #-h- change 21_56 ascii 08/30/83 12:30:00 DRIVER ## change - change 'string1' into 'string2' character lin(MAXLIN; i=i+1) if (arg(1) == MINUS) { call scopy(arg, 1, lin, 1) call fold(lin) if (index(lin, LETA) > 0) andpat = YES if (index(lin, LETX) > 0) except = YES call delarg(i) arg(toarg, arg, MAXARG) == EOF) arg(1) = EOS if (getsub(arg, to) == ERR) call error("illegal toexpr.") for (i=1; i <= npat; i=i+1) { junk = getarg(i, arg, MAXARG) if (getpat(arg, pat(1,i)) == ERR) { call putli if (m == 0 | m == i) { # no match or null match junk = addset(lin(i), new, k, MAXLINE) i = i + 1 } else # skip matched text i = m } if (addseext to end of new. subroutine catsub(lin, from, to, sub, new, k, maxnew) integer addset integer from, i, j, junk, k, maxnew, to character lin(MAXLINE), new(maxnew), sub(MAXPAT) for (i = 1; sub(i) != EOS; i = i + 1)  1_90 ascii 08/30/83 12:30:00 ## getsub - get substitution pattern into sub integer function getsub(arg, sub) character arg(MAXARG), sub(MAXPAT) integer maksub getsub = maksub(arg, 1, EOS, sub) return E), new(MAXLINE), pat(MAXPAT,NEXPR) character arg(MAXARG), from(MAXPAT), to(MAXPAT) integer addset, amatch, getarg, getlin, getpat, getsub integer i, junk, k, lastm, m , index integer except, andpat, narg, frarg, toarg, npat, itoc, sta i = i - 1 } else narg = narg + 1 if (narg == 0) call cherr else if (narg == 1 | narg == 2) { frarg = 1 toarg = 2 npat = 1 } else { toarg = narg frarg = narg - 1 npat = nargn(illpat, ERROUT) call error(arg) } } while (getlin(lin, STDIN) != EOF) { status = gmatch(lin, pat, npat, andpat) if ((status == YES & except == NO) | (status == NO & except == YES)) { k = 1 t(EOS, new, k, MAXLINE) == NO) { k = MAXLINE junk = addset(EOS, new, k, MAXLINE) call remark('line truncated:.') call putlin(new, ERROUT) call putch(NEWLINE, ERROUT) } call pu if (sub(i) == DITTO) for (j = from; j < to; j = j + 1) junk = addset(lin(j), new, k, maxnew) else junk = addset(sub(i), new, k, maxnew) return end #-t- catsub 3_114 ascii 0end #-t- getsub 1_90 ascii 08/30/83 12:30:00 #-h- gmatch 3_72 ascii 08/30/83 12:30:00 integer function gmatch(lin, pat, elevel, andpat) integer elevel, andpat, match, i, status character lin(ARB), pat(MAXPtus integer gmatch string illpat "illegal pattern: " string maxexp "max nbr expressions allowed: " call query ("usage: ch [-ax] [expressions] from [to].") except = NO andpat = NO narg = 0 for (i=1; getarg(i, arg, MAXARG) != EOF - 2 } if (npat > NEXPR) { call putlin(maxexp, ERROUT) i = itoc(NEXPR, arg, MAXARG) call error(arg) } junk = getarg(frarg, arg, MAXARG) if (getpat(arg, from) == ERR) call error("illegal fromexpr pattern.") if (get lastm = 0 for ( i =1; lin(i) != EOS; ) { m = amatch(lin, i, from) if (m > 0 & lastm != m) { # replace matched text call catsub(lin, i, m, to, new, k, MAXLINE) lastm = m } tlin(new, STDOUT) } else call putlin(lin, STDOUT) } DRETURN end #-t- change 21_56 ascii 08/30/83 12:30:00 #-h- catsub 3_114 ascii 08/30/83 12:30:00 ## catsub - add replacement t8/30/83 12:30:00 #-h- cherr 0_96 ascii 08/30/83 12:30:00 subroutine cherr call error ("usage: ch [-ax] [expressions] from [to].") return end #-t- cherr 0_96 ascii 08/30/83 12:30:00 #-h- getsub AT, NEXPR) gmatch = andpat for (i=1; i <= elevel; i=i+1) { status = match(lin, pat(1,i)) if (andpat == NO & status == YES) { gmatch = YES break } else if (andpat == YES & status == NO)    { gmatch = NO break } } return end #-t- gmatch 3_72 ascii 08/30/83 12:30:00 #-h- maksub 5_16 ascii 08/30/83 12:30:00 ## maksub - make substitution string in sub integerno room maksub = ERR else maksub = i return end #-t- maksub 5_16 ascii 08/30/83 12:30:00 #-t- ch.rat 44_56 ascii 08/30/83 12:30:00 #-t- ch.ar 46_56 ascii 09/fil1, infil2, lineno, m1, m2 call query ("usage: cmp file1 [file2].") if (getarg(1, arg, FILENAMESIZE) == EOF ) call error ('usage: cmp file1 [file2].') infil1 = open (arg, READ) if (infil1 == ERR) call cant (arg) if (getargk('eof on file 1.') else if (m2 == EOF & m1 != EOF) call remark('eof on file 2.') if (infil1 != STDIN) call close (infil1) if (infil2 != STDIN) call close (infil2) DRETURN end #-t- cmp 8_122 ascii 08/30/83 12:.rat 13_103 ascii 08/30/83 12:30:00 #-t- cmp.ar 15_104 ascii 09/02/83 09:15:00 #-h- comm.ar 30_89 ascii 09/02/83 09:15:00 #-h- list 0_10 ascii 08/29/83 18:57:00 comm.rat #-t- l---- # comm - print lines common to two files DRIVER character buf(MAXLINE) integer getarg, open, index integer i, file(2), j, one, two, three one = YES # default is all columns two = YES three = YES j = 0 for (i function maksub(arg, from, delim, sub) character esc character arg(MAXARG), delim, sub(MAXPAT) integer addset integer from, i, j, junk j = 1 for (i = from; arg(i) != delim & arg(i) != EOS; i = i + 1) if (ar02/83 09:15:00 #-h- cmp.ar 15_104 ascii 09/02/83 09:15:00 #-h- list 0_9 ascii 08/30/83 12:30:00 cmp.rat #-t- list 0_9 ascii 08/30/83 12:30:00 #-h- cmp.rat 13_103 ascii 08(2, arg, FILENAMESIZE) == EOF) infil2 = STDIN else if (arg(1) == MINUS & arg(2) == EOS) infil2 = STDIN else { infil2 = open(arg, READ) if (infil2 == ERR) call cant(arg) } lineno = 0 repeat { m1 = getlin(30:00 #-h- difmsg 2_117 ascii 08/30/83 12:30:00 #---------------------------------------------------------- ## difmsg - print line number and differing lines of file1 and file2 subroutine difmsg(lineno, line1, line2) charist 0_10 ascii 08/29/83 18:57:00 #-h- comm.rat 28_87 ascii 08/29/83 18:57:00 #-h- defns 1_18 ascii 08/29/83 18:57:00 # include standard definitions # include ratdef #---------------------- = 1; getarg(i, buf, MAXLINE) ^= EOF; i = i + 1) { if (j == 2) break if (buf(1) == QMARK & buf(2) == EOS) call error ("usage: comm [-123] file1 file2.") if (buf(1) == MINUS & buf(2) ^= EOS) { if (index(bufg(i) == AND) junk = addset(DITTO, sub, j, MAXPAT) else junk = addset(esc(arg, i), sub, j, MAXPAT) if (arg(i) != delim) # missing delimiter maksub = ERR else if (addset(EOS, sub, j, MAXPAT) == NO) # /30/83 12:30:00 #-h- cmp 8_122 ascii 08/30/83 12:30:00 DRIVER ## cmp - compare two files for equality character arg (FILENAMESIZE) character line1(MAXLINE), line2(MAXLINE) integer getarg, getlin, open , equal integer inline1, infil1) m2 = getlin(line2, infil2) if (m1 == EOF | m2 == EOF) break lineno = lineno + 1 if (equal(line1, line2) == NO) call difmsg(lineno, line1, line2) } if (m1 == EOF & m2 != EOF) call remaracter line1(MAXLINE), line2(MAXLINE) integer lineno call putdec(lineno, 5) call putc(NEWLINE) call putlin(line1, STDOUT) call putlin(line2, STDOUT) return end #-t- difmsg 2_117 ascii 08/30/83 12:30:00 #-t- cmp-------------------------------------- define(LEADERING,15) #-t- defns 1_18 ascii 08/29/83 18:57:00 #-h- comm 9_14 ascii 08/29/83 18:57:00 #------------------------------------------------------------, DIG1) == 0) one = NO if (index(buf, DIG2) == 0) two = NO if (index(buf, DIG3) == 0) three = NO } else if (buf(1) == MINUS) { j = j + 1 file(j) = STDIN     } else { j = j + 1 file(j) = open(buf,READ) if (file(j) == ERR) call cant(buf) } } if (j == 0) call error ("usage: comm [-123] file1 file2.") if (j == 1) file(2) =te leadering ldr2 = 0 ldr3 = 0 if (one == YES) { ldr2 = LEADERING ldr3 = LEADERING } if (two == YES) ldr3 = ldr3 + LEADERING stat1 = getlin(buf1,file1) stat2 = getlin(buf2,file2) repeat { if (s stat2 = getlin(buf2, file2) } } if (stat1 == EOF) # end of file1, print rest of file2 while (stat2 ^= EOF) { call coln(buf2, ldr2, two) stat2 = getlin(buf2, file2) } else if (stat2for (i = 1; i <= ldr; i = i + 1) call putc(BLANK) i = 1 call skipbl(lin, i) call putlin(lin(i), STDOUT) return end #-t- coln 2_93 ascii 08/29/83 18:57:00 #-t- comm.rat 28_87 ascii 08/29/83x, isopen integer fd1, fd2 character file1(FILENAMESIZE), file2(FILENAMESIZE), temp(FILENAMESIZE) integer len, i, j string dot "." call query ("usage: cp from to.") if (getarg(1, file1, FILENAMESIZE) != EOF) { fd1 = open (file1, READ) if ( character src(ARB), dest(ARB) integer equal, ctoc, index character temp (FILENAMESIZE) integer i, j string dot "." if (equal(dest, dot) == YES) call gwdir (temp, LOCAL) else call mklocl(dest,temp) i = ctoc (temp, dest, FILENAMESIZE)  STDIN call common(file(1), file(2), one, two, three) DRETURN end #-t- comm 9_14 ascii 08/29/83 18:57:00 #-h- common 11_106 ascii 08/29/83 18:57:00 # common - print lines common to file1 & file2 accortat1 == EOF | stat2 == EOF) break k = strcmp(buf1, buf2) # compare lines if (k < 0) { # line only in file1 call coln(buf1, ldr1, one) stat1 = getlin(buf1, file1) } else if (k > == EOF) # end of file2, print rest of file1 while (stat1 ^= EOF) { call coln(buf1, ldr1, one) stat1 = getlin(buf1, file1) } return end #-t- common 11_106 ascii 08/29/83 18:57:00 #-h- coln  18:57:00 #-t- comm.ar 30_89 ascii 09/02/83 09:15:00 #-h- cp.ar 13_11 ascii 09/02/83 09:15:00 #-h- list 0_8 ascii 08/30/83 12:30:00 cp.rat #-t- list 0_8 ascii 08/30/83fd1 == ERR) call cant (file1) } if (getarg(2, file2, FILENAMESIZE) != EOF) { call gdest (file1, file2) if (isopen (file2) != ERR) call error("cp won't copy infile onto itself.") fd2 = create (file2, WRITE) if (fd2 == ERR) call cant ( if (dest(i) == COLON) { call mklocl (src, temp) j = index (temp, COLON) + 1 call ctoc (temp(j), dest(i+1), FILENAMESIZE) } return end #-t- cp.r 10_15 ascii 08/30/83 12:30:00 #-t- cp.rat 11_11 ascii 0ding to flags 1..3 subroutine common(file1, file2, one, two, three) integer file1, file2, one, two, three integer k, stat1, stat2, ldr1, ldr2, ldr3 character buf1(MAXLINE), buf2(MAXLINE) integer getlin, strcmp ldr1 = 0 # compu 0) { # line only in file2 call coln(buf2, ldr2, two) stat2 = getlin(buf2, file2) } else { # line in both files call coln(buf1, ldr3, three) stat1 = getlin(buf1, file1)  2_93 ascii 08/29/83 18:57:00 # coln - print lin with leadering ldr if flag = YES; rm leading blanks subroutine coln(lin, ldr, flag) character lin(ARB) integer ldr, flag integer i if (flag == NO) return  12:30:00 #-h- cp.rat 11_11 ascii 08/30/83 12:30:00 #-h- cp.r 10_15 ascii 08/30/83 12:30:00 ## cp - copy file1 to file2 (binary read/write) DRIVER(cp) integer getarg, open, isatty, create, equal, length, indefile2) } else call error ("usage: cp from to.") if (isatty(fd1) == YES | isatty(fd2) == YES) call error ("use 'cat' for terminal I/O.") call bcopy$ (fd1, fd2) call close (fd1) call close (fd2) return end subroutine gdest (src, dest) 8/30/83 12:30:00 #-t- cp.ar 13_11 ascii 09/02/83 09:15:00 #-h- cpress.ar 24_35 ascii 09/02/83 09:15:00 #-h- list 0_12 ascii 08/30/83 12:30:00 cpress.rat #-t- list 0_12 asc   ii 08/30/83 12:30:00 #-h- cpress.rat 22_31 ascii 08/30/83 12:30:00 #-h- defns 1_70 ascii 08/30/83 12:30:00 # These definitions are used by both the cpress and expand tools #must have RCODE > MAXCHUNK or RCODE = { if (i != 1) break int = STDIN } else if (buf(1) == MINUS & buf(2) == EOS) int = STDIN else { int =K or RCODE = 0 nsave = 0 for (lastc=getch(lastc,int); lastc != EOF; lastc = c) { for (nrep=1; getch(c,int) == lastc; nrep = nrep + 1) if (nrep >= MAXCHUNK) #count repetitions break  call putc(nrep+BASECOUNT) } } call putbuf(buf, nsave) #put last chunk return end #-t- press 8_40 ascii 08/30/83 12:30:00 #-h- putbuf 2_55 ascii 08/30/83 12:30:00 # 16_6 ascii 09/02/83 09:15:00 #-h- list 0_9 ascii 08/30/83 12:30:00 crt.rat #-t- list 0_9 ascii 08/30/83 12:30:00 #-h- crt.rat 14_5 ascii 08/30/83 12:30:00 #-h- crt.r S) int = STDIN else if (buf(1) == MINUS) { j = 2 nlines = max(ctoi(buf,j), 1) next } else { int = open 0 define(MAXCHUNK,92) define(BASECOUNT,32) define(RCODE,125) define(THRESH,4) #-t- defns 1_70 ascii 08/30/83 12:30:00 #-h- cpress 6_10 ascii 08/30/83 12:30:00 # include ratdef ## cpress - comp open(buf,READ) if (int == ERR) call cant(buf) } call press (int) if (int != STDIN) call close(int) } DRETURN end #-t- cpress 6_ if (nrep < THRESH) #append short string for (; nrep > 0; nrep = nrep - 1) { nsave = nsave + 1 buf(nsave) = lastc if (nsave # putbuf - output buf(1) ... buf(nsave), clear nsave subroutine putbuf(buf, nsave) character buf(MAXCHUNK) integer i, nsave if (nsave > 0) { call putc (nsave+BASECOUNT) for (i=1; i<=nsave; i=i+1) call 13_9 ascii 08/30/83 12:30:00 ##crt - prepare output for teletype-like device DRIVER integer getarg, ctoi, open, getlin, crt integer i, j, tt, nlines, input character buf(MAXLINE), terml(FILENAMESIZE) string tty TERMINAL_(buf,READ) if (int == ERR) call cant(buf) } input = YES if (crt(int, nlines, tt) == EOF) break if (int != STDIN) call close(int) ress input files DRIVER character buf(MAXLINE) integer getarg, open integer i #must have RCODE > MAXCHUNK or RCODE = 0 call query ("usage: cpress [file].") for (i=1; ; i=i+1) { if (getarg(i,buf,MAXLINE) == EOF) 10 ascii 08/30/83 12:30:00 #-h- press 8_40 ascii 08/30/83 12:30:00 ## press - compress file -int- subroutine press (int) character getch character buf(MAXCHUNK), c, lastc integer int, nrep, nsave #must have RCODE > MAXCHUN>= MAXCHUNK) call putbuf(buf, nsave) } else { call putbuf(buf, nsave) call putc (RCODE) call putc(lastc)  putc(buf(i)) } nsave = 0 return end #-t- putbuf 2_55 ascii 08/30/83 12:30:00 #-t- cpress.rat 22_31 ascii 08/30/83 12:30:00 #-t- cpress.ar 24_35 ascii 09/02/83 09:15:00 #-h- crt.ar IN data nlines /23/ data input /NO/ call query ("usage: crt [-n] [file].") tt = open(tty, READ) if (tt == ERR) call cant(tty) for (i=1; getarg(i,buf,MAXLINE)!=EOF; i=i+1) { if (buf(1) == MINUS & buf(2) == EO } if (input == NO) call crt(STDIN, nlines, tt) return end ## crt - look at file "fd", stopping after each nl lines integer function crt (fd, nl, tt) integer fd, nl, wait, tt integer getlin, isatty, prompt character buf(MAXLI   NE), what(MAXLINE) string pr "Hit to continue, q to quit: " crt = OK if (getlin(buf,fd) == EOF) return j = 1 repeat { call putlin (buf, STDOUT) if (getlin (buf, fd) == EOF) return j = j+1 if (j > nl) { if (isatt 0_11 ascii 08/30/83 12:30:00 #-h- crypt.rat 12_82 ascii 08/30/83 12:30:00 #-h- defns 3_19 ascii 08/30/83 12:30:00 # include ratdef define(MAXKEY,MAXLINE) # There are 2 versions of crypt haracter c, key(MAXKEY), b character getc integer getarg integer i, keylen, junk keylen = getarg(1, key, MAXKEY) if (keylen == EOF | (key(1) == QMARK & key(2) == 0) ) call error("usage: crypt key.") for (i=1; getc(c) != EOF:30:00 # xor - exclusive-or of a and b character function xor(a,b) character a, b xor = (a & !b) | (!a & b) return end #-t- xor 1_0 ascii 08/30/83 12:30:00 #-t- crypt.rat 12_82 ascii 08/30/83 12:30:å #-h- date 4_17 ascii 08/30/83 12:30:00 DRIVER(date) integer getarg, atodat, setdat integer now(7) character buf(MAXLINE) call query ("usage: date [current_date].") if ( getarg(1, buf, MAXLINE) == EOF) #user wantty (STDOUT) == YES) { if (prompt (pr, what, tt) == EOF) return(EOF) if (what(1) == LETQ | what(1) == BIGQ) return } j = 1 } } return end #-t- crt.r 13_9 ascii 08/30/83 12:30:00 #-t- crt.raere--the one from the book # and a simpler one which does not encrypt control characters # (since some systems have trouble reading/printing various # control characters). If you want the simpler, no-control- # character version, do this: # ; i=mod(i, keylen) +1) { ifnotdef(NOCONTROL, call putc(xor(c, key(i))) ) #leave control characters alone ifdef(NOCONTROL, if (c < BLANK) call putc(c) else 00 #-t- crypt.ar 14_85 ascii 09/02/83 09:15:00  end #-t- xor 1_0 ascii 08/30/83 12:30:00 #-t- crypt.rat 12_82 ascii 08/30/83 12:30:ås to see date { call gdate (buf(1),buf(10)) buf(9) = BLANK call putlin (buf, STDOUT) call putch (NEWLINE, STDOUT) } else #user wants to set date { call getcl (buf, MAXLINE) #get entire command line if (atodat (buf, now) == ERRt 14_5 ascii 08/30/83 12:30:00 #-t- crt.ar 16_6 ascii 09/02/83 09:15:00 #-h- crypt.ar 14_85 ascii 09/02/83 09:15:00 #-h- list 0_11 ascii 08/30/83 12:30:00 crypt.rat #-t- lis define(NOCONTROL,) ifdef(CPM, define(NOCONTROL,)) #-t- defns 3_19 ascii 08/30/83 12:30:00 #-h- crypt 5_75 ascii 08/30/83 12:30:00 # crypt - encrypt and decrypt DRIVER character xor ch { b = xor(c, key(i) & 31) call putc(b) } ) } DRETURN end #-t- crypt 5_75 ascii 08/30/83 12:30:00 #-h- xor 1_0 ascii 08/30/83 12å#-h- date.ar 9_26 ascii 09/02/83 09:15:00 #-h- list 0_10 ascii 08/30/83 12:30:00 date.rat #-t- list 0_10 ascii 08/30/83 12:30:00 #-h- date.rat 7_24 ascii 08/30/83 12:30:00) call error ("invalid date string.") call setdat (now) } return end #-t- date 4_17 ascii 08/30/83 12:30:00 #-h- setdat 1_15 ascii 08/30/83 12:30:00 integer function setdat (now) integer now(7) i   nclude config for (i=1; i<=7; i=i+1) ddate(i) = now(i) call setenv return end #-t- setdat 1_15 ascii 08/30/83 12:30:00 #-t- date.rat 7_24 ascii 08/30/83 12:30:00 #-t- date.ar 9_26 ascs integer kindst # eval stack part 2: kinds of tokens #-t- cexp 2_24 ascii 08/30/83 12:30:00 #-h- cdc 0_45 ascii 08/30/83 12:30:00 common /cdc/ st pointer st # symbol table #-t- cdc 15) define(OPMUL,16) define(OPDIV,17) define(OPNEG,18) define(OPMOD,19) define(OPEXP,20) define(OPPLUS,21) define(MAXOP,21) define(OPERR,-1) define(MAXSTACK,200) # evaluation stack #-t- defns 4_45 ascii 08/30/83 12: else if (name(1) != MINUS) { fd = open(name, READ) if (fd == ERR) call cant(name) } if (fd != ERR) { call dcexp (fd) character line(MAXLINE), name(MAXTOKEN) include cdc string errmsg ": invalid expression" string ten "10" string ibname "ibase" string obname "obase" ibase = 10 obase = 10 call enter(ibname,ten,st) call enter(obname,ten,st) while(get= save + 1 line(eqloc) = EOS call scopy(line, 1, name, 1) if (strcmp(name,ibname) == 0 | strcmp(name,obname) == 0) radeii 09/02/83 09:15:00 #-h- dc.ar 142_70 ascii 09/02/83 09:15:00 #-h- list 0_19 ascii 08/30/83 12:30:00 cexp cdc dc.rat #-t- list 0_19 ascii 08/30/83 12:30:00 #-h- cexp  0_45 ascii 08/30/83 12:30:00 #-h- dc.rat 135_126 ascii 08/30/83 12:30:00 #-h- defns 4_45 ascii 08/30/83 12:30:00 # include ratdef define(MAXTOKEN,MAXLINE) define(OP,1) define(OPND,2) define(SEP,3) defin30:00 #-h- dc 6_99 ascii 08/30/83 12:30:00 ## dc - desk calculator DRIVER character name(FILENAMESIZE) integer getarg, open, mktabl integer fd, i include cdc st = mktabl(CHAR_DEFN) #initialize variable (hash) table if (fd != STDIN) call close (fd) } } if (fd == ERR) call dcexp (STDIN) DRETURN end #-t- dc 6_99 ascii 08/30/83 12:30:00 #-h- dcexp lin(line, fd) != EOF) { radexp = 0 # assume not radix expression call strip(line) #remove blanks, tabs, NEWLINEs i = 1 save = index(line, EQUALS) #see if result should be stored xp = 1 } } else { if (strcmp(line,ibname) == 0 | strcmp(line,obname) == 0) radexp = 1 } ubase = iba 2_24 ascii 08/30/83 12:30:00 ## common for exptoi # put on a file called 'cexp' # Used by macro and dc tools common /cexp/ top, tokst(MAXSTACK), kindst(MAXSTACK) integer top # evaluation stack pointer integer tokst # eval stack part 1: tokene(OPDONE,1) define(OPGO,2) define(OPLP,3) define(OPRP,4) define(OPOR,5) define(OPAND,6) define(OPNOT,7) define(OPEQ,8) define(OPNE,9) define(OPGT,10) define(OPGE,11) define(OPLT,12) define(OPLE,13) define(OPADD,14) define(OPSUB, fd = ERR for (i=1; getarg(i, name, FILENAMESIZE) != EOF; i=i+1) { if (name(1) == QMARK & name(2) == EOS) call error ("usage: dc.") if (name(1) == MINUS & name(2) == EOS) fd = STDIN  20_109 ascii 08/30/83 12:30:00 ## dcexp - read file and process desk calculator expressions subroutine dcexp (fd) integer fd, junk, i, answer, save integer getlin, numtoc, exptoi, index, strcmp integer ibase, obase, ubase, radexp, eqloc  if (save != 0) { if (line(save+1) == EQUALS) #oops, found relational save = 0 else { eqloc = save i se if (radexp == 1) ubase = 10 answer = exptoi(line, i, ubase) if (line(i) != EOS) #error { if (save != 0) line(eqloc) = EQUALS call putlin(line, ERR   OUT) call putlin(errmsg, ERROUT) call putch(NEWLINE, ERROUT) } else { ubase = obase if (radexp == 1 | save != 0) ubase =tlin(line, STDOUT) call putch(NEWLINE, STDOUT) } } } return end #-t- dcexp 20_109 ascii 08/30/83 12:30:00 #-h- strip 2_95 ascii 08/30/rithmetic expression integer function exptoi (exp, ptr, radix) integer exptok, stackx character exp(ARB) integer ptr, radix integer k, tok, kind character prec include cexp k = ptr top = 1 tokst(top) = OPGO kindst(top) = SEP  tok != OPNOT) return(0) if (stackx(0, OPND) == ERR) return(0) if (tok == OPADD) tok = OPPLUS  { if (tok != OPLP) #if tok == ( or tok == EOS { if (kindst(top) != OPND) return(0) while(prec(tokst(top-1)) > prec(tok) ptr = k #normal return return(tokst(top)) } else #remove matching LPAREN {  10 junk = numtoc(answer, line, MAXLINE, ubase) if (save != 0) #store answer { call enter(name, line,st) if (strcmp(ibname,name) == 0) 83 12:30:00 ## strip - string blanks, tabs, and NEWLINES from line subroutine strip (line) character line(ARB) integer i for (i=1; line(i) != EOS; ) { if (line(i) == BLANK | line(i) == TAB | line(i) == NEWLINE)  while (exptok(exp, k, tok, kind, radix) == YES) #loop thru legal toks { if (kind == OPND) { if (kindst(top) == OPND) return(0) } else if (kind == OP)  else if (tok == OPSUB) tok = OPNEG } else #kindst(top) == OPND { if (kindst(top-1) == OP) ) { if (kindst(top-1) == OP) call binop else return(0) # no right paren  tok = tokst(top) kind = kindst(top) top = top -2 } }  ibase = answer if (strcmp(obname,name) == 0) obase = answer } else { call pu call scopy(line, i+1, line, i) else i = i + 1 } return end #-t- strip 2_95 ascii 08/30/83 12:30:00 #-h- exptoi 24_21 ascii 08/30/83 12:30:00 ## exptoi - evalutate a { if (kindst(top) == OP) return(0) else if (kindst(top) == SEP) { #check for unary +,- or ! if (tok != OPADD & tok != OPSUB & { while(prec(tokst(top-1)) >= prec(tok)) call binop } } } else # (kind == SEP)  } if (prec(tokst(top-1)) == prec(tok)) { if (tok == OPDONE) {  else #unbalanced parens return(0) } } # stack new tok, kind if (stackx(tok, kind) == ERR) return(0) } return(0) end #-t   - exptoi 24_21 ascii 08/30/83 12:30:00 #-h- prec 5_112 ascii 08/30/83 12:30:00 # prec - return operator precedence character function prec(opkind) integer opkind character preced(MAXOP) # precedence of respect 6, # * / 8, 6, 7, 8 /# neg, mod, expon, plus return(preced(opkind)) end #-t- prec 5_112 ascii 08/30/83 12:30:00 #-h- binop 10_8 ascii 08/30/83 12:30:00 ## binop - evaluates top 30 case OPNE: if (l != r) result = 1 else result = 0 case OPGT: if (l > r) result = 1 else result = 0 case OPGE: if (l >= r) result = 1 else result = 0 cas 10_8 ascii 08/30/83 12:30:00 #-h- exptok 29_97 ascii 08/30/83 12:30:00 ## exptok - get expression token for evaluation integer function exptok(exp, k, tok, kind, radix) character exp(ARB), defn(MAXTOKEN), name(MAXTOKE return(YES) } else if (c == LETTER) { #found stored variable name call movnam(exp, k, name, 1) k = k + length(name) if (lookup(name, defn, st) == YES) { i  else tok = OPNOT case CARET: if (cn == EQUALS) { tok = OPNE k = k + 1 } ive operators data preced(1), preced(2), preced(3), preced(4), preced(5), preced(6), preced(7), preced(8), preced(9), preced(10), preced(11), preced(12), preced(13), preced(14), preced(15), preced(16), preced(17), preced(18),  items on eval stack subroutine binop integer l, r, result, op include cexp r = tokst(top) op = tokst(top-1) l = tokst(top-2) top = top - 2 switch (op) { case OPOR: if (l != 0 | r != 0) result = 1 else rese OPLT: if (l < r) result = 1 else result = 0 case OPLE: if (l <= r) result = 1 else result = 0 case OPADD: result = l + r case OPSUB: result = l - r case OPNEG: result = (-rN) integer k #index, updated unless EOS integer tok #return value, token found integer kind #return value, kind of token integer radix #default radix for numbers integer ctonum, lookup character type character c, cn string digits= 1 tok = ctonum(defn, i, 10) kind = OPND return(YES) } else return(NO) } else #c is symbol { cn = exp(k+1) kind = else tok = OPNOT case BANG: if (cn == EQUALS) { tok = OPNE k = k + 1 } preced(19), preced(20), preced(21) / 0, 0, # EOS, start_expr 1, 1, # ( ) 2, 2, # | & 3, # ! (or ^ or ~) 4,4,4,4,4,4, # == != > >= < <= 5, 5, # + - 6, ult = 0 case OPAND:if (l != 0 & r != 0) result = 1 else result = 0 case OPNOT: if (r == 0) result = 1 else result = 0 case OPEQ: if (l == r) result = 1 else result = ) case OPMUL: result = l * r case OPDIV: result = l / r case OPMOD: result = mod(l,r) case OPEXP: result = l**r case OPPLUS: result = (+r) } tokst(top) = result return end #-t- binop  "0123456789abcdefABCDEF" include cexp include cdc c = type(exp(k)) if (radix > 10) { if (index(digits,exp(k)) > 0) c = DIGIT } if (c == DIGIT) { tok = ctonum(exp, k, radix) kind = OPND  OP switch(c) { case TILDE: if (cn == EQUALS) { tok = OPNE k = k + 1 } else tok = OPNOT case LESS: if (cn == EQUALS) { tok = OPLE k = k + 1 } else tok    = OPLT case GREATER: if (cn == EQUALS) { tok = OPGE k = k + 1 } else tok = OPGT  tok = OPEXP k = k + 1 } else tok = OPMUL case SLASH: tok = OPDIV case PERCENT: tok = OPMOD case Lturn(NO) if (tok != OPDONE) k = k + 1 return(YES) } end #-t- exptok 29_97 ascii 08/30/83 12:30:00 #-h- movnam 3_6 ascii 08/30/83 12:30:00 ## movnam - move in(i) to out(j) until non-alphanumeric f function ctonum(buf,i,dradix) character buf(ARB), tmp(MAXLINE) integer ctoi integer i, j, c, n, val, radix, dradix, m string digits "0123456789abcdefABCDEF" # while (buf(i) == BLANK | buf(i) == TAB) # i = i + 1 # skip blanks if dix val = 0 for (j=1; j<=n; j = j+1) { c = tmp(j) if (c >= radix) call remark("number error") val = val * radix + c } return ( m*val ) end #-t- ctonum 8_10 ascii 08/ } until (intval == 0 | i >= size) if (int < 0 & i < size) { # then sign i = i+1 str(i) = MINUS } numtoc = i - 1 for (j = 1; j < i; j = j+1) { # reverse digits k = str(i)  case EQUALS: if (cn == EQUALS) { tok = OPEQ k = k + 1 } else tok = OPERR PAREN: { kind = SEP tok = OPLP } case RPAREN: { kind = SEP tok = OPRP ound subroutine movnam (in, i, out, j) character in(ARB), out(ARB) integer i, j, k1, k2 character type character c k1 = i k2 = j for(c=type(in(k1)); c == LETTER | c == DIGIT; c=type(in(k1))) { out(k2) = in(k1) (buf(i) == MINUS) { i = i + 1 m = -1 } else m = 1 for (n=0;;i=i+1) { #collect digits c = index(digits,buf(i)) if (c==0) break if (c > 16) c = c-6 # convert to lower case 30/83 12:30:00 #-h- numtoc 6_2 ascii 08/30/83 12:30:00 ## numtoc - convert integer int to char string in str integer function numtoc(int, str, size, radix) integer mod integer radix integer d, i, int, intval, j, k, size chstr(i) = str(j) str(j) = k i = i-1 } return end #-t- numtoc 6_2 ascii 08/30/83 12:30:00 #-h- stackx 2_82 ascii 08/30/83 12:30:00 ## stackx - put next expression on arith evaluation case BAR: tok = OPOR case AMPER: tok = OPAND case PLUS: tok = OPADD case MINUS: tok = OPSUB case STAR: if (cn == STAR) {  } case EOS: { kind = SEP tok = OPDONE } default: tok = OPERR } if (tok == OPERR) rek1 = k1 + 1 k2 = k2 + 1 } out(k2) = EOS return end #-t- movnam 3_6 ascii 08/30/83 12:30:00 #-h- ctonum 8_10 ascii 08/30/83 12:30:00 # ctonum - string to number with radix control integer n = n+1 tmp(n) = c-1 # save digit value } if (buf(i) == UNDERLINE) { # get new radix, default radix is 10. radix = 0 i = i+1 radix = ctoi(buf,i) } else radix = draaracter str(ARB) string digits "0123456789ABCDEF" intval = abs(int) str(1) = EOS i = 1 repeat { # generate digits i = i+1 d = mod(intval,radix) str(i) = digits(d+1) intval = intval / radix  stack integer function stackx(tok, kind) integer tok, kind include cexp if (top >= MAXSTACK) { call remark ("arith evaluation stack overflow.") return (ERR) } top = top + 1 tokst(top) = tok kindst(to   p) = kind return(OK) end #-t- stackx 2_82 ascii 08/30/83 12:30:00 #-t- dc.rat 135_126 ascii 08/30/83 12:30:00 #-t- dc.ar 142_70 ascii 09/02/83 09:15:00 #-h- detab.ar 29_12 ascll settab(tabs) # set initial tab stops int = ERR for (i=1; getarg(i, buf, MAXLINE) != EOF; i=i+1) { if (buf(1) == PLUS | alldig(buf) == YES) #ignore flags next if (buf(1) == MINUS & buf(2)  return YES if str is all digits integer function alldig (str) integer i character type character str(ARB) alldig = NO if (str(1) == EOS) return for (i=1; str(i) != EOS; i=i+1) if (type(str(i)) != DIGIT) f (tabpos(col, tabs) == YES) break } else if (c == NEWLINE) { call putc(NEWLINE) col = 1 } else { call putc(c) col = col + 1 } return  next l = ctoi(n,k) if (l<=0 | l>MAXLINE) next if (n(1)!=PLUS) { p = l tabs(p) = YES } else { if (p==0) p = l + 1 pos = tabs(col) return end #-t- tabpos 1_97 ascii 08/30/83 12:30:00 #-t- detab.rat 27_9 ascii 08/30/83 12:30:00 #-t- detab.ar 29_12 ascii 09/02/83 09:15:00 #-h- diff.ar 20ii 09/02/83 09:15:00 #-h- list 0_11 ascii 08/30/83 12:30:00 detab.rat #-t- list 0_11 ascii 08/30/83 12:30:00 #-h- detab.rat 27_9 ascii 08/30/83 12:30:00 #-h- detab 6_95 == EOS) #read from standard input int = STDIN else int = open(buf, READ) if (int == ERR) call cant(buf) call dotab (tabs, int) if (int != STDIN) call return alldig = YES return end #-t- alldig 2_51 ascii 08/30/83 12:30:00 #-h- dotab 4_99 ascii 08/30/83 12:30:00 ## dotab - convert tabs to equivalent number of blanks subroutine dotab (tabs, int) inte end #-t- dotab 4_99 ascii 08/30/83 12:30:00 #-h- settab 6_71 ascii 08/30/83 12:30:00 # settab - set initial tab stops subroutine settab(tabs) integer alldig integer tabs(MAXLINE), m, p, k, i, j,  for (m=p; m<=MAXLINE; m=m+l) tabs(m) = YES } } if (p==0) { for (i=9; i<=MAXLINE; i=i+8) tabs(i) = YES } return end #-t- settab 6_71 ascii 08/30/83 12:7_98 ascii 09/02/83 09:15:00 #-h- list 0_17 ascii 08/30/83 12:30:00 cdiff diff.rat #-t- list 0_17 ascii 08/30/83 12:30:00 #-h- cdiff 8_111 ascii 08/30/83 12:30:00 sym_pointer _ ascii 08/30/83 12:30:00 ## detab - driver for detab tool DRIVER character buf(MAXLINE) integer open, getarg, length, alldig integer tabs(MAXLINE), int, i, k, l call query ("usage: detab [ etc] [+] [files].") ca close(int) } if (int == ERR) #no files read call dotab(tabs, STDIN) return end #-t- detab 6_95 ascii 08/30/83 12:30:00 #-h- alldig 2_51 ascii 08/30/83 12:30:00 ## alldig -ger int character getch character c integer tabs(ARB) integer tabpos integer col col = 1 while (getch(c, int) != EOF) if (c == TAB) repeat { call putc(BLANK) col = col + 1 il integer getarg, ctoi character n(4) p = 0 for (i=1; i<=MAXLINE; i=i+1) tabs(i) = NO for (j=1; getarg(j,n,4)!=EOF; j=j+1) { k=1 if (n(1) == PLUS) k = k + 1 if (alldig(n(k)) == NO) 30:00 #-h- tabpos 1_97 ascii 08/30/83 12:30:00 # tabpos - return YES if col is a tab stop integer function tabpos(col, tabs) integer col, i, tabs(MAXLINE) if (col > MAXLINE) tabpos = YES else tab Old_count (MAX_FILE_SIZE), New_count (MAX_FILE_SIZE), Old_xref (MAX_FILE_SIZE), New_xref (MAX_FILE_SIZE), Old_lno (MAX_UNIQUE_LINES), Bucket (HASH_TABLE_SIZE), Sym_store (MAX_UNIQUE_LINES2) file_mark _    Text_loc (2, MAX_UNIQUE_LINES) common /c1/ Old_count # separate common because of size limitations common /c2/ New_count # on some machines... common /c3/ Old_xref common /c4/ New_xref common /c5/ Old_lno common /c6/ Bucld_copy, New_copy, Option, Verbos, Text_file_name, Old_copy_name, New_copy_name #-t- cdiff 8_111 ascii 08/30/83 12:30:00 #-h- diff.rat 195_110 ascii 08/30/83 12:30:00 #-h- defns 13_125 ascii 0 enough to index HASH_TABLE_SIZE define (file_mark,integer) # large enough to hold a file position define (DIFFERENCES,1) # -d => list differences define (REVISION,2) # -r => revision bar requests for 'fmt' define (SCRIPTe(Next_sym,nsym) define(Next_inx,ninx) define(New_size,nsize) define(Old_size,osize) define(Old_file,ofile) define(New_file,nfile) define(Text_file,tfile) define(Old_copy,ocopy) define(New_copy,ncopy) define(Text_file_name,tfname) define(Old_copylse { call load call pair call grow call label call report call cleanup } DRETURN end #-t- diff 2_7 ascii 07/06/83 17:00:00 #-t- diff 2_69 ascii 08/30 end #-t- clean 3_60 ascii 07/06/83 17:00:00 #-t- clean 3_122 ascii 08/30/83 12:30:00 #-h- enter 11_59 ascii 08/30/83 12:30:00 # enter --- enter a line in the symbol table, return its indexket common /c7/ Sym_store common /c8/ Text_loc sym_pointer _ Next_sym, Next_inx, New_size, Old_size filedes _ Old_file, New_file, Text_file, Old_copy, New_copy integer _ 8/30/83 12:30:00 # diff --- isolate differences between two files define (MAX_UNIQUE_LINES,500 ) # no. of unique lines in all files define (MAX_UNIQUE_LINES2,arith(MAX_UNIQUE_LINES,*,2)) define (NULL_POINTER,0) #define (HASH_TABLE_SIZE,6073) # ,3) # -s => update script for 'ed' define (COMPARISON,4) # -c => simple line-by-line compare define (ON,) define (OFF,#) define (DEBUG,OFF) # turn debugging output on/off define (TUNING,OFF) # tur_name,ocname) define(New_copy_name,ncname) define(cleanup,clean) define(gen_listing,glist) define(gen_revision,grevis) define(gen_script,gscrip) define(initialize,init) define(simple_compare,scompr) #-t- defns 13_63 ascii 07/0/83 12:30:00 #-h- clean 3_122 ascii 08/30/83 12:30:00 # cleanup --- close input files, remove temporaries, and shut down subroutine cleanup include cdiff call close (Old_file) if (New_file ~= STDIN) call sym_pointer function enter (line) character line (ARB) include cdiff hash_index h hash_index hash sym_pointer i, p character text (MAXLINE) integer junk integer equal, getlin h = hash (line) p = Bu Option, Verbos character _ Text_file_name (FILENAMESIZE), Old_copy_name (FILENAMESIZE), New_copy_name (FILENAMESIZE) common /difcom/ Next_sym, Next_inx, Old_file, New_file, Text_file, New_size, Old_size, Omust be prime, as large as possible define(HASH_TABLE_SIZE,101) define (MAX_FILE_SIZE,500 ) # no. of lines in largest input file define (sym_pointer,integer) # large enough to index MAX_UNIQUE_LINES2 define (hash_index,integer) # largen algorithm tuning output on/off # definitions for long variable names define(Old_count,ocount) define(New_count,ncount) define(Old_xref,oxref) define(New_xref,nxref) define(Old_lno,oldlno) define(Sym_store,sstore) define(Text_loc,tloc) defin6/83 17:00:00 #-t- defns 13_125 ascii 08/30/83 12:30:00 #-h- diff 2_69 ascii 08/30/83 12:30:00 DRIVER(diff) include cdiff call initialize if (Option == COMPARISON) call simple_compare e close (New_file) ifnotdef(CPM,call close (Old_copy)) call remove (Old_copy_name) ifnotdef(CPM,call close (New_copy)) call remove (New_copy_name) ifnotdef(CPM,call close (Text_file)) call remove (Text_file_name) return cket (h) while (p ~= NULL_POINTER) { i = Sym_store (p + 1) # grab index field of entry structure call seek (Text_loc (1, i), Text_file) junk = getlin (text, Text_file) if (equal (line, text) == YES) return (   i) # we got it; return its useful index p = Sym_store (p) # try next item in the chain DEBUG call remark ("probing in lookup:.") DEBUG call remark ("ptr =.") DEBUG call putint (p, 0, ERROUT) DEBUG cae) call putlin (line, Text_file) return (i) end #-t- enter 10_125 ascii 07/06/83 17:00:00 #-t- enter 11_59 ascii 08/30/83 12:30:00 #-h- glist 27_114 ascii 08/30/83 12:30:00 # gen_lVerbos == YES) call putch (NEWLINE, STDOUT) while (Old_count (oi) == 0 & New_count (ni) == 0) { junk = getlin (line, Old_copy) if (Verbos == YES) { call putint (oi - 1, 7, STDOUT) ll putint (ni - 1, 5, STDOUT) call putch (BAR, STDOUT) } else { call putlin (bib, STDOUT) call putint (ni - 1, 4, STDOUT) call putlin (nbar, STDOUT) kd, STDOUT) call putint (oi - 1, 5, STDOUT) call putlin (obar, STDOUT) } call putlin (line, STDOUT) } } else if (Old_count (oi) == 1 & New_count (ni) == 1) { line, STDOUT) } call putch (NEWLINE, STDOUT) for (; New_count (ni) == 1; ni = ni + 1) { junk = getlin (line, New_copy) if (Verbos == YES) { call putlin (ci5, STDOUT) ll putch (NEWLINE, ERROUT) DEBUG call remark ("line =.") DEBUG call putlin (line, ERROUT) } if (Next_inx >= MAX_UNIQUE_LINES) call error ("too many unique lines; symbol table overflow.") i = Next_inx Next_inx = Nexisting --- generate a full listing of changes to a file subroutine gen_listing include cdiff sym_pointer oi, ni integer junk integer getlin character line (MAXLINE) string nbar "n|" string ci1 "ci " string ci call putint (ni - 1, 5, STDOUT) call putlin (line, STDOUT) } junk = getlin (line, New_copy) oi = oi + 1 ni = ni + 1 } } else if (Old_count (oi) ~= 1 } call putlin (line, STDOUT) } } else if (Old_count (oi) == 1 & New_count (ni) ~= 1) { call putch (NEWLINE, STDOUT) for (; Old_count (oi) == 1; oi = oi + 1) { junk = getlin (li call putch (NEWLINE, STDOUT) for (; Old_count (oi) == 1; oi = oi + 1) { junk = getlin (line, Old_copy) if (Verbos == YES) { call putlin (cd, STDOUT) call putint (oi - 1, 5, STDOUT)  call putint (ni - 1, 5, STDOUT) call putch (BAR, STDOUT) } else { call putlin (ci1, STDOUT) call putint (ni - 1, 4, STDOUT) call putlin (nbar, STDOUT) t_inx + 1 h = hash (line) Sym_store (Next_sym) = Bucket (h) # link in new entry Sym_store (Next_sym + 1) = i Bucket (h) = Next_sym Next_sym = Next_sym + 2 call seek (END_OF_FILE, Text_file) call note (Text_loc (1, i), Text_fil5 "ci " string obar "o|" string cd "cd" string b5bar " |" string blankd " d" string bib " i " string bi5 " i " oi = 2 ni = 2 repeat if (Old_count (oi) == 0 & New_count (ni) == 0) { if ( & New_count (ni) == 1) { call putch (NEWLINE, STDOUT) for (; New_count (ni) == 1; ni = ni + 1) { junk = getlin (line, New_copy) if (Verbos == YES) { call putlin (bi5, STDOUT) cane, Old_copy) if (Verbos == YES) { call putlin (blankd, STDOUT) call putint (oi - 1, 5, STDOUT) call putlin (b5bar, STDOUT) } else { call putlin (blan call putlin (b5bar, STDOUT) } else { call putlin (cd, STDOUT) call putint (oi - 1, 5, STDOUT) call putlin (obar, STDOUT) } call putlin ( } call putlin (line, STDOUT) } } else if (Old_count (oi) == 2 & New_count (ni) == 2) break return end #-t- glist 27_52 ascii 07/06/83 17:00:00 #-t- glist     27_114 ascii 08/30/83 12:30:00 #-h- grevis 15_18 ascii 08/30/83 12:30:00 # gen_revision --- generate 'fmt' input text with revision bar requests subroutine gen_revision include cdiff sym_pointer oi, ni  if (Old_count (oi) ~= 1 & New_count (ni) == 1) { call putlin (srbar, STDOUT) call putch (NEWLINE, STDOUT) for (; New_count (ni) == 1; ni = ni + 1) { junk = getlin (line, New_copy) call putlin (line,  = oi + 1) ; call putlin (srbar, STDOUT) call putch (NEWLINE, STDOUT) for (; New_count (ni) == 1; ni = ni + 1) { junk = getlin (line, New_copy) call putlin (line, STDOUT) } i, offset, length integer junk integer getlin character line (MAXLINE) oi = 2 ni = 2 offset = 0 repeat if (Old_count (oi) == 0 & New_count (ni) == 0) { oi = oi + 1 ni = ni + 1 junk  offset = offset + length } else if (Old_count (oi) == 1 & New_count (ni) ~= 1) { length = 0 for (; Old_count (oi) == 1; oi = oi + 1) length = length + 1 call putint (oi - 1 - length + oft (oi - 2 + offset, 0, STDOUT) call putch (LETC, STDOUT) call putch (NEWLINE, STDOUT) offset = offset - length length = 0 for (; New_count (ni) == 1; ni = ni + 1) { length = length + 1 integer junk integer getlin character line (MAXLINE) # start_revision_bar string srbar ".mc 2 |" # stop_revision_bar string stbar ".mc" #start_deletion_star string sdstar ".mc 2 *" # stop_deletion_star string STDOUT) } call putlin (stbar, STDOUT) call putch (NEWLINE, STDOUT) } else if (Old_count (oi) == 1 & New_count (ni) ~= 1) { call putlin (sdstar, STDOUT) call putch (NEWLINE, STDOUT)  call putlin (stbar, STDOUT) call putch (NEWLINE, STDOUT) } else if (Old_count (oi) == 2 & New_count (ni) == 2) break return end #-t- grevis 14_84 ascii 07/06/83 17:00:00 #-t- gr= getlin (line, New_copy) } else if (Old_count (oi) ~= 1 & New_count (ni) == 1) { call putint (oi - 2 + offset, 0, STDOUT) call putch (LETA, STDOUT) call putch (NEWLINE, STDOUT) length = 0 fset, 0, STDOUT) call putch (COMMA, STDOUT) call putint (oi - 2 + offset, 0, STDOUT) call putch (LETD, STDOUT) call putch (NEWLINE, STDOUT) offset = offset - length } else if (Old_count ( junk = getlin (line, New_copy) call putlin (line, STDOUT) } call putch (PERIOD, STDOUT) call putch (NEWLINE, STDOUT) offset = offset + length } else if (Old_count (oi) == 2 & Nststar ".mc" oi = 2 ni = 2 repeat if (Old_count (oi) == 0 & New_count (ni) == 0) { oi = oi + 1 ni = ni + 1 junk = getlin (line, New_copy) call putlin (line, STDOUT) } else call putlin (ststar, STDOUT) call putch (NEWLINE, STDOUT) for (; Old_count (oi) == 1; oi = oi + 1) ; } else if (Old_count (oi) == 1 & New_count (ni) == 1) { for (; Old_count (oi) == 1; oievis 15_18 ascii 08/30/83 12:30:00 #-h- gscrip 19_9 ascii 08/30/83 12:30:00 # gen_script --- produce editor script to convert old file into new subroutine gen_script include cdiff sym_pointer oi, n for (; New_count (ni) == 1; ni = ni + 1) { length = length + 1 junk = getlin (line, New_copy) call putlin (line, STDOUT) } call putch (PERIOD, STDOUT) call putch (NEWLINE, STDOUT) oi) == 1 & New_count (ni) == 1) { length = 0 for (; Old_count (oi) == 1; oi = oi + 1) length = length + 1 call putint (oi - 1 - length + offset, 0, STDOUT) call putch (COMMA, STDOUT) call putinew_count (ni) == 2) break call putch (LETW, STDOUT) call putch (NEWLINE, STDOUT) # DON'T output a 'q' command -- prevents concatentation of scripts return end #-t- gscrip 18_75 ascii 07/06/83 17:00:00 #-    t- gscrip 19_9 ascii 08/30/83 12:30:00 #-h- grow 6_75 ascii 08/30/83 12:30:00 # grow --- grow unchanged blocks around unique line pairs subroutine grow include cdiff sym_pointer i, nx for nx - 1)) { Old_xref (nx - 1) = i - 1 New_xref (i - 1) = nx - 1 } } return end #-t- grow 6_13 ascii 07/06/83 17:00:00 #-t- grow 6_75 ascii 08/30/83 12:30:0 08/30/83 12:30:00 # initialize --- set up everything needed for a file comparison subroutine initialize include cdiff filedes open, create integer argno, i integer equal, getarg character arg (FILENAMESIZE) string ion = COMPARISON else if (arg (i) == LETD) Option = DIFFERENCES else if (arg (i) == LETR) Option = REVISION else if (arg (i) == LETS) Option = SCRIPT else if (arg (i) == LETV)  # STDIN1, to be precise else { New_file = open (arg, READ) if (New_file == ERR) call cant (arg) argno = argno + 1 } } if (getarg (argno, arg, FILENAMESIZE) ~= EOF) call usage ary file.") return end #-t- init 18_14 ascii 07/06/83 17:00:00 #-t- init 18_76 ascii 08/30/83 12:30:00 #-h- label 15_103 ascii 08/30/83 12:30:00 # label --- label lines as "inserted(i = 1; i < New_size; i = i + 1) { nx = New_xref (i) if (nx > 0) # is this line paired with an old line? if (New_xref (i + 1) < 0 & New_xref (i + 1) == Old_xref (nx + 1)) { Old_xref (nx + 1) = i + 1 0 #-h- hash 2_87 ascii 08/30/83 12:30:00 # hash --- hash a line into a hash_index hash_index function hash (line) character line (ARB) integer i hash = 0 for (i = 1; line (i) ~= EOS; i = i + 1) hash tf1 "df1" # text of unique lines string tf2 "df2" # copy of "old" file string tf3 "df3" # copy of "new" file call query ("usage: diff [-{c|d|r|s|v}] old_file [new_file].") Option = DIFFERENCES # the default Verbo Verbos = YES else call usage argno = 2 } if (getarg (argno, arg, FILENAMESIZE) == EOF) { # no files, use STDIN # Old_file = STDIN1 # New_file = STDIN2 call usage # GT impleme Next_inx = 1 Next_sym = 1 call mkuniq (tf1, Text_file_name) Text_file = create (Text_file_name, READWRITE) if (Text_file == ERR) call error ("can't open temporary file.") call mkuniq (tf2, Old_copy_name) Old_copy = cr," "deleted," or "unchanged" subroutine label include cdiff sym_pointer oi, ni, ox, nx DEBUG call remark ("input new xref:.") DEBUG do ni = 1, New_size; { DEBUG call putch (BLANK, ERROUT) DEBUG call putint (New_xref (ni), 0, E New_xref (i + 1) = nx + 1 } } for (i = New_size; i > 1; i = i - 1) { nx = New_xref (i) if (nx > 0) # is this line paired? if (New_xref (i - 1) < 0 & New_xref (i - 1) == Old_xref (= hash + line (i) hash = mod (iabs (hash), HASH_TABLE_SIZE) + 1 return end #-t- hash 2_25 ascii 07/06/83 17:00:00 #-t- hash 2_87 ascii 08/30/83 12:30:00 #-h- init 18_76 asciis = NO argno = 1 # where we expect to find file names if (getarg (1, arg, FILENAMESIZE) ~= EOF) if (arg (1) == MINUS) { call lower (arg) for (i = 2; arg (i) ~= EOS; i = i + 1) if (arg (i) == LETC) Optntation has multiple standard ports... } else { Old_file = open (arg, READ) if (Old_file == ERR) call cant (arg) argno = argno + 1 if (getarg (argno, arg, FILENAMESIZE) == EOF) New_file = STDIN eate (Old_copy_name, READWRITE) if (Old_copy == ERR) call error ("can't open temporary file.") call mkuniq (tf3, New_copy_name) New_copy = create (New_copy_name, READWRITE) if (New_copy == ERR) call error ("can't open temporRROUT) DEBUG } DEBUG call putch (NEWLINE, ERROUT) DEBUG call remark ("input old xref:.") DEBUG do oi = 1, Old_size; { DEBUG call putch (BLANK, ERROUT) DEBUG call putint (Old_xref (oi), 0, ERROUT) DEBUG } DEBUG call putch (NEWLINE, ERROU    T) oi = 2 ni = 2 repeat { ox = Old_xref (oi) nx = New_xref (ni) if (oi >= Old_size & ni >= New_size) break else if (oi < Old_size & ox < 0) { # deletion from old file Old_count (oi) = 1 nt (oi) = 1 oi = oi + 1 New_count (ox) = 1 } else { call remark ("oi, ox, ni, nx:.") call putint (oi, 10, ERROUT) call putint (ox, 10, ERROUT) call putint (ni, 10, ERROUT)  #-h- load 17_45 ascii 08/30/83 12:30:00 # load --- load symbol table, set up cross-reference structures subroutine load include cdiff sym_pointer lno, i sym_pointer enter hash_index h character line  i = enter (line) Old_count (i) = Old_count (i) + 1 Old_lno (i) = lno Old_xref (lno) = -i } Old_size = lno # includes null line at end # Load the "new" file: for (lno = 2; getlin (line, New_file) ~= EOF; lno =ain_len = MAX_UNIQUE_LINES TUNING do h = 1, HASH_TABLE_SIZE; { TUNING p = Bucket (h) TUNING if (p ~= NULL_POINTER) TUNING used += 1 TUNING chain_len = 0 TUNING while (p ~= NULL_POINTER) { TUNING chain_len += 1 TUNING p 17_45 ascii 08/30/83 12:30:00 #-h- pair 4_110 ascii 08/30/83 12:30:00 # pair --- pair up unique lines in both files subroutine pair include cdiff sym_pointer i, j, k for (i = 2; i < New_size; i = i  oi = oi + 1 } else if (ni < New_size & nx < 0) { # insertion in new file New_count (ni) = 1 ni = ni + 1 } else if (ox == ni & nx == oi) { # unchanged line Old_count (oi) = 0  call putint (nx, 10, ERROUT) call putch (NEWLINE, ERROUT) call error ("in label: can't happen.") } } Old_count (1) = 2 # mark the null lines specially, Old_count (Old_size) = 2 # so(MAXLINE) integer getlin, length TUNING sym_pointer p TUNING integer used, chain_len, max_chain_len, min_chain_len do h = 1, HASH_TABLE_SIZE Bucket (h) = NULL_POINTER do lno = 1, MAX_UNIQUE_LINES; { Old_count (lno) = 0  lno + 1) { if (lno > MAX_FILE_SIZE) call error ("new file too large to handle.") call putlin (line, New_copy) i = enter (line) New_count (i) = New_count (i) + 1 New_xref (lno) = -i } New_size = lno  = Sym_store (p) TUNING } TUNING max_chain_len = max0 (chain_len, max_chain_len) TUNING min_chain_len = min0 (chain_len, min_chain_len) TUNING } TUNING call print (STDOUT2, "chain lengths: min = *i, avg = *i, max = *i*n"s, TUNING m+ 1) { j = -New_xref (i) if (Old_count (j) == 1 & New_count (j) == 1) { # unique pair New_xref (i) = Old_lno (j) k = Old_lno (j) Old_xref (k) = i } } New_xref (1) = 1 # matc oi = oi + 1 New_count (ni) = 0 ni = ni + 1 } else if (oi <= Old_size & ni <= New_size) { # out-of-order block New_count (ni) = 1 ni = ni + 1 Old_count (nx) = 1 Old_cou people won't have to deal New_count (1) = 2 # with file sizes New_count (New_size) = 2 return end #-t- label 15_41 ascii 07/06/83 17:00:00 #-t- label 15_103 ascii 08/30/83 12:30:00  New_count (lno) = 0 } # Load the "old" file: for (lno = 2; getlin (line, Old_file) ~= EOF; lno = lno + 1) { if (lno > MAX_FILE_SIZE) call error ("old file too large to handle.") call putlin (line, Old_copy)  # also allows for null line at end TUNING call print (STDOUT2, "Old_size = *i, New_size = *i*n"s, TUNING Old_size, New_size) TUNING call print (STDOUT2, "*i unique lines*n"s, Next_inx - 1) TUNING used = 0 TUNING max_chain_len = 0 TUNING min_chin_chain_len, (Next_inx - 1) / used, max_chain_len) TUNING call print (STDOUT2, "hash buckets *i% full*n"s, TUNING (100 * used) / HASH_TABLE_SIZE) return end #-t- load 16_111 ascii 07/06/83 17:00:00 #-t- load h null lines at BOF Old_xref (1) = 1 New_xref (New_size) = Old_size # ... and at EOF Old_xref (Old_size) = New_size return end #-t- pair 4_48 ascii 07/06/83 17:00:00 #-t- pair 4_110 ascii     08/30/83 12:30:00 #-h- report 6_47 ascii 08/30/83 12:30:00 # report --- report differences between files in desired format subroutine report include cdiff DEBUG sym_pointer i DEBUG call print (ERROUT, "New mark: "s) call error ("in report: can't happen.") return end #-t- report 5_113 ascii 07/06/83 17:00:00 #-t- report 6_47 ascii 08/30/83 12:30:00 #-h- scompr 12_59 ascii 08/30/83 12:30:00 # s2 == EOF) break lineno = lineno + 1 if (equal (line1, line2) == NO) if (Verbos == YES) { call putch (NEWLINE, STDOUT) call putint (lineno, 5, STDOUT) call putch (NEWLINE, STDOUT) == EOF) if (Verbos == YES) { call putlin (neweof, STDOUT) call putch (NEWLINE, STDOUT) } else { call putlin (diff, STDOUT) call putch (NEWLINE, STDOUT) } return end #-t- s#-t- diff.ar 207_98 ascii 09/02/83 09:15:00 00 #-t- usage 1_80 ascii 08/30/83 12:30:00 #-t- diff.rat 195_110 ascii 08/30/83 12:30:00 å DEBUG do i = 1, New_size DEBUG call print (ERROUT, " *i"s, New_count (i)) DEBUG call print (ERROUT, "*nOld mark: "s) DEBUG do i = 1, Old_size DEBUG call print (ERROUT, " *i"s, Old_count (i)) DEBUG call putch (NEWLINE, ERROUT) call seekimple_compare --- do a line-by-line comparison of the input files subroutine simple_compare include cdiff character line1 (MAXLINE), line2 (MAXLINE) integer lineno, m1, m2 integer equal, getlin # different string diff  call putlin (line1, STDOUT) call putlin (line2, STDOUT) } else { call putlin (diff, STDOUT) call putch (NEWLINE, STDOUT) return } } if (m1 == EOF compr 11_125 ascii 07/06/83 17:00:00 #-t- scompr 12_59 ascii 08/30/83 12:30:00 #-h- usage 1_80 ascii 08/30/83 12:30:00 # usage --- print usage message, then die subroutine usage call å#-h- echo.ar 7_77 ascii 09/02/83 09:15:00 #-h- list 0_10 ascii 08/30/83 12:30:00 echo.rat #-t- list 0_10 ascii 08/30/83 12:30:00 #-h- echo.rat 5_75 ascii 08/30/83 12:30:00 (BEGINNING_OF_FILE, Old_copy) call seek (BEGINNING_OF_FILE, New_copy) if (Option == DIFFERENCES) call gen_listing else if (Option == REVISION) call gen_revision else if (Option == SCRIPT) call gen_script else "different" # eof_on_old_file string oldeof "eof on old file" # eof_on_new_file string neweof "eof on new file" lineno = 0 repeat { m1 = getlin (line1, Old_file) m2 = getlin (line2, New_file) if (m1 == EOF | m& m2 ~= EOF) if (Verbos == YES) { call putlin (oldeof, STDOUT) call putch (NEWLINE, STDOUT) } else { call putlin (diff, STDOUT) call putch (NEWLINE, STDOUT) } if (m1 ~= EOF & m2 error ("usage: diff [-{c|d|r|s|v}] old_file [new_file].") end #-t- usage 1_18 ascii 07/06/83 17:00:00 #-t- usage 1_80 ascii 08/30/83 12:30:00 #-t- diff.rat 195_110 ascii 08/30/83 12:30:00 å #-h- defns 0_57 ascii 08/30/83 12:30:00 # include symbol definitions # include ratdef #-t- defns 0_57 ascii 08/30/83 12:30:00 #-h- echo 3_26 ascii 08/30/83 12:30:00 ## echo -     echo command line arguments DRIVER integer getarg, i character buf(MAXLINE) integer ii for (i=1; getarg(i, buf, MAXLINE) != EOF; i=i+1) { if (buf(1) == QMARK & buf(2) == EOS) call error ("usage: echo [args].") if (i /83 12:30:00 #-h- entab.rat 31_127 ascii 08/30/83 12:30:00 #-h- defns 8_21 ascii 08/30/83 12:30:00 ## entab - replace blanks by tabs and blanks DRIVER character getch integer nxtfil character c integer tabp } } for (;col < newcol; col = col + 1) call putc(BLANK) if(c == EOF) { if (int != STDIN) call close(int) break  # flag for one time through int = STDIN for ( ; ; argct = argct + 1) { nxtfil = getarg(argct,abuf,FILENAMESIZE) if (nxtfil == EOF) break if (abuf(1) == PLUS | alldig(abuf) == YES) return end #-t- nxtfil 7_115 ascii 08/30/83 12:30:00 #-h- alldig 2_53 ascii 08/30/83 12:30:00 ## alldig - return YES if str is all digits integer function alldig (str) integer i character type charactor (i=1; i<=MAXLINE; i=i+1) tabs(i) = NO for (j=1; getarg(j,n,4)!=EOF; j=j+1) { k=1 if (n(1) == PLUS) k = k + 1 if (alldig(n(k)) == NO) next l = ctoi(n,k) if (l!= 1) call putch(BLANK, STDOUT) call putlin (buf, STDOUT) } if (i != 1) call putch (NEWLINE, STDOUT) DRETURN end #-t- echo 3_26 ascii 08/30/83 12:30:00 #-t- echo.rat 5_75 ascii 08/30/83os, int, argct integer col, i, newcol, tabs(MAXLINE) call query ("usage: entab [tab-stops] [+n] [file].") call settab(tabs) col = 1 argct = 1 while (nxtfil(argct,int) != EOF) { repeat { newcol = col whil } call putc(c) if(c == NEWLINE) col = 1 else col = col + 1 } } DRETURN end #-t- defns 8_21 ascii 08/30/83 12:30:00 #-h- nxtfil 7_11 next flag = flag + 1 if (abuf(1) == MINUS & abuf(2) == EOS) { int = STDIN break } else { int = open(abuf,READ) er str(ARB) alldig = NO if (str(1) == EOS) return for (i=1; str(i) != EOS; i=i+1) if (type(str(i)) != DIGIT) return alldig = YES return end #-t- alldig 2_53 ascii 08/30/83 12:30:00 #-h<=0 | l>MAXLINE) next if (n(1)!=PLUS) { p = l tabs(p) = YES } else { if (p==0) p = l + 1 for (m=p; m<=MAXLINE; m=m+l)  12:30:00 #-t- echo.ar 7_77 ascii 09/02/83 09:15:00 #-h- entab.ar 34_2 ascii 09/02/83 09:15:00 #-h- list 0_11 ascii 08/30/83 12:30:00 entab.rat #-t- list 0_11 ascii 08/30e (getch(c,int) == BLANK) { newcol = newcol + 1 if(tabpos(newcol,tabs) == YES) { call putc(TAB) col = newcol 5 ascii 08/30/83 12:30:00 ## nxtfil - get next file from argument list integer function nxtfil(argct,int) integer getarg, open, alldig integer argct, int integer flag #own character abuf(FILENAMESIZE) data flag /0/  if (int != ERR) break else call cant(abuf) } } if (flag == 0) { flag = 1 nxtfil = EOS } argct = argct + 1 - settab 6_106 ascii 08/30/83 12:30:00 # settab - set initial tab stops subroutine settab(tabs) integer alldig integer tabs(MAXLINE), m, p, k, i, j, l integer getarg, ctoi character n(4) p = 0 f tabs(m) = YES } } if (p==0) { for (i=9; i<=MAXLINE; i=i+8) tabs(i) = YES } return end #-t- settab 6_106 ascii 08/30/83 12:30:00 #-h- tabpos      1_108 ascii 08/30/83 12:30:00 # tabpos - return YES if col is a tab stop integer function tabpos(col, tabs) integer col, i, tabs(MAXLINE) if (col > MAXLINE) tabpos = YES else tabpos = tabs(col) return2:30:00 # ratdef for compress and expand tools #must have RCODE > MAXCHUNK or RCODE = 0 define(MAXCHUNK,92) define(BASECOUNT,32) define(RCODE,125) define(THRESH,4) #-t- defns 1_44 ascii 08/30/83 12:30:00 #-h- expand uf) } call xpd (int) if (int != STDIN) call close(int) } if (i == 1) call xpd(STDIN) DRETURN end #-t- expand 5_0 ascii 08/30/83 12:30:00 #-h- xpd  } else { code = code - BASECOUNT for (; code > 0; code = code - 1) { if (getch(c,int) == EOF) break #-h- list 1_9 ascii 08/29/83 18:57:00 emakear.sub elist.1 elist.2 elist.3 elist.4 cbuf cfile clines cpat cscrat ctbufs ctxt e.rat e1.rat e2.rat e3.rat e4.rat #-t- list 1_9 ascii 08/29/83 18:5700 docmd doglob doprnt doread dowrit getb getfn getind getlst getnum #-t- elist.2 0_76 ascii 08/29/83 18:57:00 #-h- elist.3 0_94 ascii 08/29/83 18:57:00 getone getrhs gettxt inject lmove maklin maksu end #-t- tabpos 1_108 ascii 08/30/83 12:30:00 #-t- entab.rat 31_127 ascii 08/30/83 12:30:00 #-t- entab.ar 34_2 ascii 09/02/83 09:15:00 #-h- expand.ar 18_14 ascii 09/02/83 09:15 5_0 ascii 08/30/83 12:30:00 # include ratdef ## expand - uncompress input files DRIVER(expand) character buf(MAXLINE) integer getarg, open integer i call query ("usage: expand [files].") for (i=1; getarg(i, 6_106 ascii 08/30/83 12:30:00 ## xpd - uncompress file -int- subroutine xpd (int) character getch character c, code while(getch(code,int) != EOF) if (code == RCODE) #expand repetition {  call putc(c) } if (c == EOF) break } return end #-t- xpd 6_106 ascii 08/30/83 12:30:00 #-t- expand.rat 16_10 ascii :00 #-h- emakear.sub 1_2 ascii 08/29/83 18:57:00 a:ar uv e1.rat - 0; code = code - 1) call putc(c) 08/30/83 12:30:00 #-t- expand.ar 18_14 ascii 09/02/83 09:15:00  } return end #-t- xpd 6_106 ascii 08/30/83 12:30:00 #-t- expand.rat 16_10 ascii 0 #-h- elist.1 0_71 ascii 08/29/83 18:57:00 defns ed append catsub ckglob ckp clrbuf conct defalt lindel #-t- elist.1 0_71 ascii 08/29/83 18:57:00 #-h- elist.2 0_76 ascii 08/29/83 18:57:-t- elist.4 0_89 ascii 08/29/83 18:57:00 #-h- cbuf 7_19 ascii 08/29/83 18:57:00 # /cbuf/ common block # put on a file called 'cbuf' # Used only by the editor common /cbuf/ buf(MAXBUF), lastbf, free #NOTB    KY integer buf, lastbf, free #NOTBKY #buf(k+0) PREV previous line #buf(k+1) NEXT next line #buf(k+2) MARK mark for global commands #buf(k+3) SEEDADR where line is on scratch file #---------------------------broutine ed. #-t- cbuf 7_19 ascii 08/29/83 18:57:00 #-h- cfile 1_47 ascii 08/29/83 18:57:00 ## cfile common block - for editor # put on a file named 'cfile' # Used only by the editor common /cfile/ sber of line numbers specified integer curln # current line: value of dot integer lastln # last line: value of $ integer print # flag to cause/suppress printing of line count integer cursav # value of current line before new command er pat # pattern #-t- cpat 1_34 ascii 08/29/83 18:57:00 #-h- cscrat 3_124 ascii 08/29/83 18:57:00 # /cscrat/ - common block for editor; holds scratch file info # put on a file called 'cscrat' # Used on3 18:57:00 ## common block used to hold temporary buffers for editor # put on a file called "ctbufs" # used only by the editor common / ctbufs / edtbuf(FILENAMESIZE, MAXTBUFS), bufid(3, MAXTBUFS) character edtbuf # name 18:57:00 #-h- e.rat 0_64 ascii 08/29/83 18:57:00 include e1.rat include e2.rat include e3.rat include e4.rat #-t- e.rat 0_64 ascii 08/29/83 18:57:00 #-h- e1.rat 72_104 ascii 08/29/83 18:57---------------------------------- #Special version for BKY #BKY common /cbuf/ buf(MAXBUF, lastbf, #BKY descr(NTYPS), locb(NTYPS), mskb(NTYPS) #BKY integer buf, lastb, descr, locb, mskb #BKY # structure of line pointers for all lineavfil(MAXLINE) character savfil #remembered file name #-t- cfile 1_47 ascii 08/29/83 18:57:00 #-h- clines 6_69 ascii 08/29/83 18:57:00 # /clines/ - common block for editor; holds line flags # put on a file c integer oldlin # last line number used by getind integer oldndx # last index returned by getind integer ifmod # if buffer has been modified since last write integer notify # if user has been notified of no write since last change #-t- cly by the editor common /cscrat/ scr, wscr, scrend(2), scrfil(FILENAMESIZE) integer scr # scratch file id integer wscr # scratch file id for WRITE access (if file # needs to be opened twice cause READWRITE  of scratch files for temp buffs character bufid # buffer name associated with each buff # (e.g. $1, $2, etc.) #-t- ctbufs 3_7 ascii 08/29/83 18:57:00 #-h- ctxt 1_62 ascii 08/2:00 #-h- defns 13_10 ascii 08/29/83 18:57:00 # include ratdef # # definitions for editor # # If you haven't implemented READWRITE access (but are able to # open the same file at READ and at WRITE access, set the s #BKY # MARK (LENG) SEEKADR PREV NEXT #BKY # 3 -- 18 15 15 #BKY #Variables in the arrays 'descr', 'locb', and 'mskb' describe #BKY #the line pointer structures. They are all initialized in #BKY #sualled 'clines' # Used only by the editor common /clines/ line1, line2, nlines, curln, lastln, print, cursav, oldlin, oldndx, ifmod, notify integer line1 # first line number integer line2 # second line number integer nlines # numlines 6_69 ascii 08/29/83 18:57:00 #-h- cpat 1_34 ascii 08/29/83 18:57:00 # /cpat/ - common block for editor # put on a file named 'cpat' # Used only by the editor common /cpat/ pat(MAXPAT) charact # hasn't been implemented integer scrend # end of info on scratch file character scrfil # name of scratch file #-t- cscrat 3_124 ascii 08/29/83 18:57:00 #-h- ctbufs 3_7 ascii 08/29/89/83 18:57:00 # /ctxt/ - common block for editor # put on a file called 'ctxt' # Used only by the editor common /ctxt/ txt(MAXLINE) character txt # text line for matching and output #-t- ctxt 1_62 ascii 08/29/83 # following definition: # # define(NO_READWRITE,) ifdef(BKY, define(NO_READWRITE,)) # If you have implemented "spawn", set the following definition: # define(SPAWN_OK,) ifdef(VAX_VMS, define(SPAWN_OK,)) ifdef(RSX_    11M, define(SPAWN_OK,)) define(DITTO,11111) ifdef(NEGDEF, define(DITTO,(-3)) ) define(GLOBAL,LETG) define(PRINT,LETP) define(MARKED,LETY) define(NOMARK,LETN) define(EXCLUDE,LETX) define(APPENDCOM,LETA) define(CHANGE,LETC) #size of line pointer array # (includes line 0 and line $) #(each line needs 4 words) ifdef(VAX_VMS, define(MAXBUF,20008) ) define(SEEKADR,3) define(BUFENT,4) define(BROWSE, status, clrbuf include cfile include clines include cpat include cbuf string edpmt ": " #Initialize flag for printing/suppression of line counts data print /YES/ # Initialize variables and buffers call inited cal = prompt (edpmt, lin, STDIN) if (status == EOF) # MUST clear buffer on EOF of input file { status = clrbuf(EOF) break } else if (status != ERR) { i = 1 l return ERR if changes since last w break # else OK, loop } call ended DRETURN end #-t- ed 14_49 ascii 08/29/83 18:57:00 #-h- append 4_38 ascii 08/29/83 18:57:00 ## appen } return end #-t- append 4_38 ascii 08/29/83 18:57:00 #-h- catsub 3_114 ascii 08/29/83 18:57:00 ## catsub - add replacement text to end of new. subroutine catsub(lin, from, to, sub, new, k, ma define(DELCOM,LETD) define(ENTER,LETE) define(PRINTFIL,LETF) define(READCOM,LETR) define(WRITECOM,LETW) define(INSERT,LETI) define(PRINTCUR,EQUALS) define(MOVECOM,LETM) define(QUIT,LETQ) define(SUBSTITUTE,LETS) deLETB) define(SCREENSIZE,22) define(KOPYCOM,LETK) define(SPAWNCOM,ATSIGN) define(COMMENT,SHARP) define(FORWARD,PLUS) define(CENTER,PERIOD) define(BACKWARD,MINUS) define(MAXTBUFS,4) #-t- defns 13_10 ascii 08/29/83l setbuf pat(1) = EOS savfil(1) = EOS #Pick up file name and possible flag(s) for (i=1; getarg(i, arg, MAXLINE) != EOF; i=i+1) { if (arg(1) == QMARK & arg(2) == EOS) call error ("usage: ed [-] file.") if (arg(1) cursav = curln if (getlst(lin, i, status) == OK) { if (ckglob(lin, i, status) == OK) status = doglob(lin, i, cursav, status) else if (status != ERR) status = docmd - append lines after 'line' integer function append(line, glob) character lin(MAXLINE) integer getlin, inject integer line, glob include clines if (glob == YES) append = ERR else { curln = line for (xnew) integer addset integer from, i, j, junk, k, maxnew, to character lin(MAXLINE), new(maxnew), sub(MAXPAT) for (i = 1; sub(i) != EOS; i = i + 1) if (sub(i) == DITTO) for (j = from; j < to; j = j + 1) fine(CURLINE,PERIOD) define(LASTLINE,DOLLAR) define(SCAN,SLASH) define(BACKSCAN,BACKSLASH) define(NOSTATUS,1) define(LINE0,1) define(PREV,0) define(NEXT,1) define(MARK,2) define(TEXT,3) define(MAXBUF,4008)  18:57:00 #-h- ed 14_49 ascii 08/29/83 18:57:00 ## ed - driver subroutine for editor DRIVER character lin(MAXLINE) character arg (MAXLINE) integer ckglob, docmd, doglob, doread, getarg, prompt, getlst integer i, == DASH & arg(2) == EOS) print = NO else { call scopy (arg, 1, savfil, 1) if (doread (0, savfil, ENTER) == ERR) call remark ('?.') } } repeat { statusd(lin, i, NO, status) # else error, do nothing } } if (status == ERR) { call remark('?.') curln = cursav } else if (status == EOF) if (clrbuf(QUIT) == OK) # wilappend = NOSTATUS; append == NOSTATUS; ) if (getlin(lin, STDIN) == EOF) append = EOF else if (lin(1) == PERIOD & lin(2) == NEWLINE) append = OK else if (inject(lin) == ERR) append = ERR  junk = addset(lin(j), new, k, maxnew) else junk = addset(sub(i), new, k, maxnew) return end #-t- catsub 3_114 ascii 08/29/83 18:57:00 #-h- ckglob 8_109 ascii 08/29/83 18:5    7:00 ## ckglob - if global prefix, mark lines to be affected integer function ckglob(lin, i, status) character lin(MAXLINE) integer defalt, getind, gettxt, match, nextln, optpat integer gflag, i, k, line, status character clower ch(txt, pat) == gflag) call setb (k, MARK, YES) else call setb (k, MARK, NO) } for (line=nextln(line2); line!=line1; line=nextln(line)) { k = getind(line) call seelse pflag = NO if (lin(j) == NEWLINE) status = OK else status = ERR ckp = status return end #-t- ckp 3_24 ascii 08/29/83 18:57:00 #-h- clrbuf 4_27 ascii 08/29/83 18:57:0 } return end #-t- clrbuf 4_27 ascii 08/29/83 18:57:00 #-h- conct 4_10 ascii 08/29/83 18:57:00 ## conct - concat line to next line if necessary integer function conct (nbr, lin) integer nbr 2_85 ascii 08/29/83 18:57:00 ## defalt - set defaulted line numbers integer function defalt(def1, def2, status) integer def1, def2, status include clines if (nlines == 0) { line1 = def1 line2 = def2 } if (prevln(from)) k2 = getind(nextln(to)) start = getind(from) stop = getind(to) lastln = lastln - (to - from + 1) curln = prevln(from) call relink(k1, k2, k1, k2) call ptfndx(start, stop) status = OK  include cbuf include clines include cpat include ctxt if (clower(lin(i)) != GLOBAL & clower(lin(i)) != EXCLUDE) status = EOF else { if (clower(lin(i)) == GLOBAL) gflag = YES else gflag = NO tb (k, MARK, NO) } status = OK } } ckglob = status return end #-t- ckglob 8_109 ascii 08/29/83 18:57:00 #-h- ckp 3_24 ascii 08/29/83 18:57:00 ## ckp - check 0 ## clrbuf - dispose of editor scratch file integer function clrbuf(comand) character comand include cscrat include clines if (comand == QUIT & ifmod == YES & notify == NO) # no w since last change { , i, gettxt, junk character lin(ARB) include clines include ctxt conct = OK for (i=1; lin(i)!=EOS; i=i+1) #check for lack of NEWLINE if (lin(i) == NEWLINE) return if (nbr+1 > lastln) #no next line (line1 > line2 | line1 <= 0) status = ERR else status = OK defalt = status return end #-t- defalt 2_85 ascii 08/29/83 18:57:00 #-h- lindel 4_62 ascii 08/29/83 18:57:00 ## lindel - d } lindel = status return end #-t- lindel 4_62 ascii 08/29/83 18:57:00 #-t- e1.rat 72_104 ascii 08/29/83 18:57:00 #-h- e2.rat 101_119 ascii 08/29/83 18:57:00 #-h- docmd  i = i + 1 if (optpat(lin, i) == ERR | defalt(1, lastln, status) == ERR) status = ERR else { i = i + 1 for (line = line1; line <= line2; line = line + 1) { k = gettxt(line) if (matfor 'p' after command integer function ckp(lin, i, pflag, status) character lin(MAXLINE) integer i, j, pflag, status character clower j = i if (clower(lin(j)) == PRINT) { j = j + 1 pflag = YES }  notify = YES call remark("NO WRITE SINCE LAST CHANGE.") clrbuf = ERR } else { ifnotdef(CPM, call close(scr) ) ifdef(NO_READWRITE, call close(wscr) ) call remove(scrfil) clrbuf = OK  { conct = ERR return } junk = gettxt (nbr+1) call scopy (txt, 1, lin, i) call lindel (nbr+1, nbr+1, junk) return end #-t- conct 4_10 ascii 08/29/83 18:57:00 #-h- defalt elete lines 'from' through 'to' integer function lindel(from, to, status) integer getind, nextln, prevln integer from, k1, k2, status, to, start, stop include clines if (from <= 0) status = ERR else { k1 = getind 33_63 ascii 08/29/83 18:57:00 ## docmd - handle all editor commands except globals integer function docmd(lin, i, glob, status) character file(MAXLINE), lin(MAXLINE), sub(MAXPAT) integer append, lindel, doprnt, doread, dowrit, lmo    ve, substt integer ckp, defalt, getfn, getone, getrhs, nextln, optpat, prevln character clower, comand integer gflag, glob, i, line3, pflag, status, kopy, dospwn, brows integer clrbuf include cfile include clines include cpat  if (ckp(lin, i + 1, pflag, status) == OK) andif (defalt(curln, curln, status) == OK) andif (lindel(line1, line2, status) == OK) andif (nextln(curln) != 0) curln = nextln(curln) } else if (comand == INSERT) { status = lmove(line3) } else if (comand == KOPYCOM) { i = i + 1 if (getone(lin, i, line3, status) == EOF) status = ERR if (status == OK) andif (ckp(lin, i, pflag, status) == O status = dospwn(lin, i) # } # ) else if (comand == ENTER) { if (nlines == 0) andif (getfn(lin, i, file) == OK) if (clrbuf(QUIT) == OK) { call scopy(file, doread(line2, file, READCOM) } else if (comand == WRITECOM) { if (getfn(lin, i, file) == OK) andif (defalt(1, lastln, status) == OK) status = dowrit(line1, line2, file) } else if (comand == PRINT) { i if (lin(i + 1) == NEWLINE & nlines == 0 & glob == NO) status = EOF } # else status is ERR if (status == OK & pflag == YES) status = doprnt(curln, curln) docmd = status return end #-t- docmd  pflag = NO # may be set by d, m, s status = ERR comand = clower(lin(i)) # make sure comparing with lower case if (comand == APPENDCOM) { if (lin(i + 1) == NEWLINE) status = append(line2, glob) } else i if (lin(i + 1) == NEWLINE) status = append(prevln(line2), glob) } else if (comand == PRINTCUR) { if (ckp(lin, i + 1, pflag, status) == OK) { call putdec(line2, 1) call putc(NEWLINE) } K) andif (defalt(curln, curln, status) == OK) status = kopy(line3) } else if (comand == SUBSTITUTE) { i = i + 1 if (optpat(lin, i) == OK) andif (getrhs(lin, i, sub, gflag) == OK) an 1, savfil, 1) call setbuf status = doread(0, file, ENTER) } else status = OK } else if (comand == PRINTFIL) { if (nlines == 0) andif (getfn(lin, i, f (lin(i + 1) == NEWLINE) andif (defalt(curln, curln, status) == OK) status = doprnt(line1, line2) } else if (comand == BROWSE) { i = i + 1 if (defalt(curln, curln, status) == OK) status 33_63 ascii 08/29/83 18:57:00 #-h- doglob 10_17 ascii 08/29/83 18:57:00 ## doglob - do command at lin(i) on all marked lines integer function doglob(lin, i, status) character lin(MAXLINE) integer docmd, getind, gef (comand == CHANGE) { if (lin(i + 1) == NEWLINE) andif (defalt(curln, curln, status) == OK) andif (lindel(line1, line2, status) == OK) status = append(prevln(line1), glob) } else if (comand == DELCOM) {  } else if (comand == MOVECOM) { i = i + 1 if (getone(lin, i, line3, status) == EOF) status = ERR if (status == OK) andif (ckp(lin, i, pflag, status) == OK) andif (defalt(curln, curln, status) == OK) dif (ckp(lin, i + 1, pflag, status) == OK) andif (defalt(curln, curln, status) == OK) status = substt(sub, gflag) } # ifdef(SPAWN_OK, # else if (comand == SPAWNCOM) # { # i = i + 1 # file) == OK) { call scopy(file, 1, savfil, 1) call putlin(savfil, STDOUT) call putc(NEWLINE) status = OK } } else if (comand == READCOM) { if (getfn(lin, i, file) == OK) status = = brows(line2, lin, i) } else if (comand == COMMENT) status = OK else if (lin(i) == NEWLINE) { if (nlines == 0) line2 = nextln(curln) status = doprnt(line2, line2) } else if (comand == QUIT) { tlst, nextln integer getlin integer value(2) integer count, i, istart, k, line, status, last include cbuf include clines for (last = length(lin); lin(last - 1) == ATSIGN; last = length(lin)) { lin(last - 1) = NE    WLINE junk = getlin(lin(last),STDIN) } status = OK count = 0 line = line1 istart = i repeat { k = getind(line) call getb(k, MARK, value) if (value(1) == YES) { call setb(k, MARK, NO) unt = count + 1 } } until (count > lastln | status != OK) doglob = status return end #-t- doglob 10_17 ascii 08/29/83 18:57:00 #-h- doprnt 3_16 ascii 08/29/83 18:57:00 ## doprnt - pridoread - read 'file' into scratch after 'line' integer function doread(line, file, comand) character file(MAXLINE), lin(MAXLINE), comand integer getlin, inject, open, access #BKY integer equal, gettyp integer count, fd, line intn) if (doread == ERR) break } call close(fd) if (print == YES) { call putdec (count, 1) call putc (NEWLINE) } if (comand == ENTER) lude clines include cfile if (look4(file, lin) != YES) call scopy(file, 1, lin, 1) fd = create(lin, WRITE) if (fd == ERR) dowrit = ERR else { for (line = from; line <= to; line = line + 1) { k = gettxtne getb (index, type, value) integer index, type integer value(2) include cbuf # one word holds PREV and MARK if(type == PREV) #this word also holds MARK (in the sign bit) value(1) = abs(buf(index cursav = line i = istart repeat { curln = line if (getlst(lin, i, status) == OK) andif (docmd(lin, i, YES, status) == OK) count = 0 nt lines 'from' through 'to' integer function doprnt(from, to) integer gettxt integer from, i, j, to include clines include ctxt if (from <= 0) doprnt = ERR else { for (i = from; i <= to; i = i + 1) { eger look4 include clines include cfile access = READ ifdef(VAX_VMS, if (comand == ENTER) # enter new file - open at READWRITE access = READWRITE ) if (look4(file, lin) != YES) call scopy(file, 1, lin, # reset changes since last write switches { ifmod = NO notify = NO } } return end #-t- doread 9_15 ascii 08/29/83 18:57:00 #-h- dowrit 6_57 ascii 08/29/83 18:5(line) call putlin(txt, fd) } call close(fd) if (print == YES) { call putdec (to-from+1, 1) call putc (NEWLINE) } dowrit = OK ifmod = NO # reset changes sinc)) else if (type == NEXT) value(1) = buf(index+1) else if (type == MARK) { if (buf(index) < 0) value(1) = YES else value(1) = NO } else if (type == SEEKADR) {  while(lin(i) != NEWLINE) i = i + 1 i = i + 1 if (lin(i) == EOS) break } } else { line = nextln(line) coj = gettxt(i) call putlin(txt, STDOUT) } curln = to doprnt = OK } return end #-t- doprnt 3_16 ascii 08/29/83 18:57:00 #-h- doread 9_15 ascii 08/29/83 18:57:00 ##  1) fd = open(lin, access) if (fd == ERR) doread = ERR else { curln = line doread = OK for (count = 0; getlin(lin, fd) != EOF; count = count + 1) { doread = inject(li7:00 ## dowrit - write 'from' through 'to' into file integer function dowrit(from, to, file) character file(MAXLINE), lin(FILENAMESIZE) integer create, gettxt integer fd, from, k, line, to integer look4 include ctxt ince last w flags notify = NO } return end #-t- dowrit 6_57 ascii 08/29/83 18:57:00 #-h- getb 5_39 ascii 08/29/83 18:57:00 ## getb - retrieve 'value' of 'type' in buf(index) subrouti value(1) = buf(index+2) value(2) = buf(index+3) } return end #-t- getb 5_39 ascii 08/29/83 18:57:00 #-h- getfn 5_99 ascii 08/29/83 18:57:00 ## getfn - get file name from li   n(i) integer function getfn(lin, i, file) character lin(MAXLINE), file(MAXLINE) integer i, j, k include cfile getfn = ERR if (lin(i + 1) == BLANK) { j = i + 2 # get new file name call skipbl(lin, j) -h- getind 6_55 ascii 08/29/83 18:57:00 ## getind - locate line index in buffer integer function getind(line) integer line, k, j integer nextln, prevln include clines data oldndx /ERR/ data oldlin /-2/ if (ol call getb(k, PREV, k) } oldlin = line oldndx = k getind = k return end #-t- getind 6_55 ascii 08/29/83 18:57:00 #-h- getlst 5_36 ascii 08/29/83 18:57:00 ## getlst - co0) line2 = curln if (nlines <= 1) line1 = line2 if (status != ERR) status = OK getlst = status return end #-t- getlst 5_36 ascii 08/29/83 18:57:00 #-h- getnum 7_18 ascii 08/ pnum = lastln else if (c == SCAN | c == BACKSCAN) { if (optpat(lin, i) == ERR) # build the pattern getnum = ERR else if (c == SCAN) getnum = ptscan(FORWARD, pnum) else getnum = ptscan(BACKWARD, pnum character lin(MAXLINE) integer getnum, ctoi integer i, istart, mul, num, pnum, status character type include clines istart = i num = 0 call skipbl(lin, i) if (lin(i) == PLUS | lin(i) == MINUS) { status = OK num  for (k = 1; lin(j) != NEWLINE; k = k + 1) { file(k) = lin(j) j = j + 1 } file(k) = EOS if (k > 1) getfn = OK } else if (lin(i + 1) == NEWLINE & savfil(1) != EOS) { call scopy(savfil, dndx != ERR & line == nextln(oldlin)) call getb(oldndx, NEXT, k) else if (oldndx != ERR & line == oldlin) k = oldndx else if (oldndx != ERR & line == prevln(oldlin)) call getb(oldndx, PREV, k) else llect line numbers at lin(i), increment i integer function getlst(lin, i, status) character lin(MAXLINE) integer getone integer i, num, status include clines line2 = 0 for (nlines = 0; getone(lin, i, num, status) == OK; ) {29/83 18:57:00 ## getnum - convert one term to line number integer function getnum(lin, i, pnum, status) character lin(MAXLINE) integer ctoi, optpat, ptscan integer i, pnum, status character c character type include cline) } else getnum = EOF if (getnum == OK) i = i + 1 # point at next character to be examined status = getnum return end #-t- getnum 7_18 ascii 08/29/83 18:57:00 #-t- e2.rat 101= curln } else status = getnum(lin, i, num, status) if (status == OK) repeat { # + or - terms call skipbl(lin, i) if (lin(i) != PLUS & lin(i) != MINUS) { status = EOF break 1, file, 1) # or old name getfn = OK } # else error if (getfn == OK & savfil(1) == EOS) call scopy(file, 1, savfil, 1) # save if no old one return end #-t- getfn 5_99 ascii 08/29/83 18:57:00 # { k = LINE0 if (line < lastln/2) for (j=0; j=line; j=j-1) #search backwards  line1 = line2 line2 = num nlines = nlines + 1 if (lin(i) != COMMA & lin(i) != SEMICOL) break if (lin(i) == SEMICOL) curln = num i = i + 1 } nlines = min(nlines, 2) if (nlines == s include cpat c = lin(i) getnum = OK if (type(c) == DIGIT) { pnum = ctoi(lin, i) i = i - 1 # move back; to be advanced at the end } else if (c == CURLINE) pnum = curln else if (c == LASTLINE) _119 ascii 08/29/83 18:57:00 #-h- e3.rat 68_94 ascii 08/29/83 18:57:00 #-h- getone 9_51 ascii 08/29/83 18:57:00 ## getone - evaluate one line number expression integer function getone(lin, i, num, status)  } if (lin(i) == PLUS) mul = +1 else mul = -1 i = i + 1 call skipbl(lin, i) if (type(lin(i)) != DIGIT) { num = num + mul status = EOF break } else    num = num + mul * ctoi(lin,i) if (status == EOF) status = ERR } until (status != OK) if (num < 0 | num > lastln) status = ERR if (status == ERR) getone = ERR else if (i <= istart) getone  maksub(lin, i + 1, lin(i), sub) if (i == ERR) return if (clower(lin(i+1)) == GLOBAL) { i = i + 1 gflag = YES } else gflag = NO getrhs = OK return end #-t- getrhs 4_17 a} else call scopy(null, 1, txt, 1) gettxt = k return end #-t- gettxt 4_1 ascii 08/29/83 18:57:00 #-h- inject 4_77 ascii 08/29/83 18:57:00 ## inject - insert lin after curln, write s } return end #-t- inject 4_77 ascii 08/29/83 18:57:00 #-h- lmove 6_79 ascii 08/29/83 18:57:00 ## lmove - move line1 through line2 after line 3 integer function lmove(line3) integer  curln = line3 + delta k4 = getind(line3) k5 = getind(nextln(line3)) call relink(k4, k1, k2, k5) call relink(k2, k5, k4, k1) lastln = lastln + delta lmove = OK } return end #-t- lmove call remark ('File size exceeded.') return } txtend = 1 for (j = i; lin(j) != EOS; ) { junk = addset(lin(j), txt, txtend, MAXLINE) j = j + 1 if (lin(j - 1) == NEWLINE) break } if (ad= EOF else getone = OK status = getone return end #-t- getone 9_51 ascii 08/29/83 18:57:00 #-h- getrhs 4_17 ascii 08/29/83 18:57:00 ## getrhs - get substitution string for 's' command scii 08/29/83 18:57:00 #-h- gettxt 4_1 ascii 08/29/83 18:57:00 ## gettxt - locate text for line, copy to txt integer function gettxt(line) character null(1) integer getind integer line, len, j, k integercratch integer function inject(lin) character lin(MAXLINE) integer getind, maklin, nextln integer i, k1, k2, k3 include clines for (i = 1; lin(i) != EOS; ) { i = maklin(lin, i, k3) if (i == ERR) { getind, nextln, prevln integer k0, k1, k2, k3, k4, k5, line3, delta include clines if (line1 <= 0 | (line1 <= line3 & line3 <= line2)) lmove = ERR else { k0 = getind(prevln(line1)) k3 = getind(nextln(line2)) k 6_79 ascii 08/29/83 18:57:00 #-h- maklin 8_121 ascii 08/29/83 18:57:00 ## maklin - make new line entry, copy text to scratch integer function maklin(lin, i, newind) character lin(MAXLINE) integer addsetdset(EOS, txt, txtend, MAXLINE) == NO) { call ptfndx(newind, newind) # return free index block return } call setb (newind, SEEKADR, scrend) call seek (scrend, scr) ifnotdef(NO_READWRITE, call p integer function getrhs(lin, i, sub, gflag) character lin(MAXLINE), sub(MAXPAT) integer maksub integer gflag, i character clower getrhs = ERR if (lin(i) == EOS) return if (lin(i + 1) == EOS) return i = loc(2) include cbuf include cscrat include ctxt data null/EOS/ k = getind(line) if (line != 0) { call getb (k, SEEKADR, loc) call seek (loc, scr) call fread (txt, dummy, scr)  inject = ERR break } k1 = getind(curln) k2 = getind(nextln(curln)) call relink(k1, k3, k3, k2) call relink(k3, k2, k1, k3) curln = curln + 1 lastln = lastln + 1 inject = OK 1 = getind(line1) k2 = getind(line2) call relink(k0, k3, k0, k3) delta = line2 - line1 + 1 lastln = lastln - delta if (line3 > line1) { curln = line3 line3 = line3 - delta } else , gtfndx integer i, j, junk, newind, txtend include cbuf include cscrat include ctxt include clines maklin = ERR oldndx = ERR if (gtfndx(newind) == ERR) { # no room for new line entry utlin(txt, scr) ) ifdef(NO_READWRITE, call putlin(txt, wscr) ) call note(scrend,scr) call setb (newind, MARK, NO) maklin = j # next character to be examined in lin return end #-t- maklin 8   _121 ascii 08/29/83 18:57:00 #-h- maksub 5_16 ascii 08/29/83 18:57:00 ## maksub - make substitution string in sub integer function maksub(arg, from, delim, sub) character esc character arg(MAXARG), delim, sub(MAXPAT 5_16 ascii 08/29/83 18:57:00 #-h- nextln 1_71 ascii 08/29/83 18:57:00 ## nextln - get line after 'line' integer function nextln(line) integer line include clines nextln = line + 1 if (nextln >ave existing pattern alone else i = makpat(lin, i + 1, lin(i), pat) if (pat(1) == EOS) i = ERR if (i == ERR) { pat(1) = EOS optpat = ERR } else optpat = OK return end #-t- optpat um) integer gettxt, match, nextln, prevln integer k, num, way include clines include cpat include ctxt num = curln repeat { if (way == FORWARD) num = nextln(num) else num = prevln(num)  if necessary integer nchar, fd, getlin, junk character buffer(ARB) junk = getlin (buffer, fd) return end #-t- fread 2_84 ascii 08/29/83 18:57:00 #-t- e3.rat 68_94 ascii 08/29/83 18:57:00 #-h- e4. 'value' subroutine setb (index, type, value) integer index, type integer value(2) include cbuf if (type == PREV) #the leftmost bit of this word holds MARK { if (buf(index) < 0) buf(index) integer addset integer from, i, j, junk j = 1 for (i = from; arg(i) != delim & arg(i) != EOS; i = i + 1) if (arg(i) == AND) junk = addset(DITTO, sub, j, MAXPAT) else junk = addset(esc( lastln) nextln = 0 return end #-t- nextln 1_71 ascii 08/29/83 18:57:00 #-h- optpat 4_63 ascii 08/29/83 18:57:00 ## optpat - make pattern if specified at lin(i) integer function optpat(lin, 4_63 ascii 08/29/83 18:57:00 #-h- prevln 1_71 ascii 08/29/83 18:57:00 ## prevln - get line before 'line' integer function prevln(line) integer line include clines prevln = line - 1 if (prevln < 0 k = gettxt(num) if (match(txt, pat) == YES) { ptscan = OK return } } until (num == curln) ptscan = ERR return end #-t- ptscan 4_3 ascii 08/29/83 18:57:00 #-h- fread rat 71_44 ascii 08/29/83 18:57:00 #-h- relink 1_105 ascii 08/29/83 18:57:00 ## relink - rewrite two half line links subroutine relink(a, x, y, b) integer a, b, x, y include clines oldndx = E) = -value(1) else buf(index) = value(1) } else if (type == NEXT) buf(index+1) = value(1) else if (type == MARK) { if (value(1) == YES) buf(index) = -abs(buf(index)) elsarg, i), sub, j, MAXPAT) if (arg(i) != delim) # missing delimiter maksub = ERR else if (addset(EOS, sub, j, MAXPAT) == NO) # no room maksub = ERR else maksub = i return end #-t- maksub  i) character lin(MAXLINE) integer makpat integer i include cpat if (lin(i) == EOS) i = ERR else if (lin(i + 1) == EOS) i = ERR else if (lin(i + 1) == lin(i)) # repeated delimiter i = i + 1 # le) prevln = lastln return end #-t- prevln 1_71 ascii 08/29/83 18:57:00 #-h- ptscan 4_3 ascii 08/29/83 18:57:00 ## ptscan - scan for next occurrence of pattern integer function ptscan(way, n 2_84 ascii 08/29/83 18:57:00 ## fread - read line from file (random access) subroutine fread (buffer, nchar, fd) #note--in this implementation, a call to getlin is made rather #than reading a specified number of characters #ChangeRR call setb (x, PREV, a) call setb (y, NEXT, b) ifmod = YES return end #-t- relink 1_105 ascii 08/29/83 18:57:00 #-h- setb 5_88 ascii 08/29/83 18:57:00 ## setb - Set 'type' in buf(index) toe buf(index) = abs(buf(index)) } else if (type == SEEKADR) { buf(index+2) = value(1) buf(index+3) = value(2) } return end #-t- setb 5_88 ascii 08/29/83 18:57:00 #-h- setbuf     8_82 ascii 08/29/83 18:57:00 ## setbuf - create scratch file, set up line 0 subroutine setbuf integer create, open integer k, j include cbuf include clines include cscrat string null '' string fil "e the beginning) call note(scrend,scr) lastbf = LINE0 free = 0 # initialize free list call maklin(null, 1, k) # create empty line 0 call relink(k, k, k, k) # establish initial linked list curln = 0 lastde clines include cpat include ctxt substt = ERR if (line1 <= 0) return for (line = line1; line <= line2; line = line + 1) { j = 1 subbed = NO junk = gettxt(line) lastm = 0 for (k = 1; txt(k) k = m } if (subbed == YES) { if (addset(EOS, new, j, MAXLINE) == NO) { substt = ERR break } substt = conct(line, new) #check for conctenation if (substt == line2)) kopy = ERR else { kopy = OK curln = line3 for (nline = line1; nline <= line2; nline = nline + 1) { junk = gettxt(nline) kopy = inject(txt) if (kopy == ERR) break , # if (init == YES) # { # call usrbin(proces) # j = length(proces) + 1 # call scopy(sh, 1, proces, j) # k = 1 # ) # ifdef(SPAWN_OK, # for (j=1; j <= MAXTBUFS; j=j+1) # { # call stcopy(edtbuf(1,j), 1, args, k) # ds" call mkuniq(fil, scrfil) #get unique name for scratch file ifnotdef(NO_READWRITE, scr = create(scrfil, READWRITE) ) ifdef(NO_READWRITE, scr = create(scrfile, READ) wscr = create(scrfile,ln = 0 cursav = 0 ifmod = NO # initialize changes since last w variables notify = NO return end #-t- setbuf 8_82 ascii 08/29/83 18:57:00 #-h- substt 11_108 ascii 08/29/83 18:57:00 ##  != EOS; ) { if (gflag == YES | subbed == NO) m = amatch(txt, k, pat) else m = 0 if (m > 0 & lastm != m) { # replace matched text subbed = YES call catsub(txt, k, m, sub, n= ERR) break call lindel(line, line, status) # remembers dot substt = inject(new) if (substt == ERR) break substt = OK } } return end #-t- substt  } } return end #-t- kopy 3_57 ascii 08/29/83 18:57:00 #-h- dospwn 9_75 ascii 08/29/83 18:57:00 # spawns a shell command from within the editor # # ifdef(SPAWN_OK, # integer function dospwn(l args(k) = BLANK # k = k + 1 # } # args(k) = EOS # init = NO # } # ) # ifdef(SPAWN_OK, # call skipbl(lin, i) # extra blanks not necessary # if (lin(i) == NEWLINE | lin(i) == EOS) # no shell comman WRITE) if (wscr == ERR) call cant(scrfil) ) if (scr == ERR) call cant(scrfil) #pick up current location of file # (better be atsubstt - substitute "sub" for occurrences of pattern integer function substt(sub, gflag) character new(MAXLINE), sub(MAXPAT) integer addset, amatch, gettxt, inject, conct integer gflag, j, junk, k, lastm, line, m, status, subbed incluew, j, MAXLINE) lastm = m } if (m == 0 | m == k) { # no match or null match junk = addset(txt(k), new, j, MAXLINE) k = k + 1 } else # skip matched text  11_108 ascii 08/29/83 18:57:00 #-h- kopy 3_57 ascii 08/29/83 18:57:00 integer function kopy(line3) integer line3, nline, junk, gettxt, inject include clines include ctxt if (line1 <= 0 | (line1 <= line3 & line3 <in, i) # # character lin(ARB), proces(FILENAMESIZE), args(ARGBUFSIZE), sh(3), # desc(PIDSIZE) # integer i, length, j, spawn, init, k, int, create # # include ctbufs # # data init/YES/ # data sh/LETS, LETH, EOS/ # ) # # ifdef(SPAWN_OKd # dospwn = spawn(proces, EOS, desc, WAIT) # else # { # int = create(edtbuf(1,1), WRITE) # if (int == ERR) # dospwn = ERR # ) # ifdef(SPAWN_OK, # else # { # call putlin(lin(i), int) # call close(int   ) # dospwn = spawn(proces, args, desc, WAIT) # } # } # # return # end # ) #-t- dospwn 9_75 ascii 08/29/83 18:57:00 #-h- brows 6_74 ascii 08/29/83 18:57:00 integer function brows(line, linr else curscr = screen } if (direc == FORWARD) lin1 = line else if (direc == CENTER) lin1 = line - (screen / 2) else lin1 = line - screen lin2 = lin1 + screen lin1 = max(1, lin1) lin2 = min(lin2, lastln) browk = itoc(i, num, 2) edt(3) = num(1) call mkuniq(edt, edtbuf(1,j)) defn(2) = num(1) call scopy(defn, 1, bufid(1,j), 1) } return end #-t- inited 3_126 ascii 08/29/83 18:57:00 #-h- ended <= MAXBUF) { newind = lastbf lastbf = lastbf + BUFENT } else newind = ERR gtfndx = newind return end #-t- gtfndx 2_103 ascii 08/29/83 18:57:00 #-h- ptfndx 1_10 ascii 08/29/83 18:57,i)) == YES) { call scopy(edtbuf(1,i), 1, name, 1) return(YES) } } return(NO) end #-t- look4 3_25 ascii 08/29/83 18:57:00 #-t- e4.rat å, i) character lin(ARB), direc integer line, i, screen, curscr, ctoi, lin1, lin2 integer doprnt include clines data screen, curscr/SCREENSIZE, SCREENSIZE/ if (lin(i) == NEWLINE) { direc = FORWARD screen = curscr } s = doprnt(lin1, lin2) return end #-t- brows 6_74 ascii 08/29/83 18:57:00 #-h- inited 3_126 ascii 08/29/83 18:57:00 ## inited - set up temporary buffers (for $1, $2, etc.) subroutine inited character  1_7 ascii 08/29/83 18:57:00 subroutine ended integer i include ctbufs for (i=1; i <= MAXTBUFS; i=i+1) call remove(edtbuf(1,i)) return end #-t- ended 1_7 ascii 08/29/83 18:57:00 #-h- gtfndx :00 subroutine ptfndx(start, stop) integer start, stop include cbuf call setb(stop, NEXT, free) free = start return end #-t- ptfndx 1_10 ascii 08/29/83 18:57:00 #-h- look4 3_25 ascii 08/29/83 71_44 ascii 08/29/83 18:57:00  } } return(NO) end #-t- look4 3_25 ascii 08/29/83 18:57:00 #-t- e4.rat #-h- fb.ar 114_108 ascii 09/02/83 09:15:00 #-h- list 0_22 ascii 08/30/83 12:30:00 fbcom fbbuf fb.rat #-t- list 0_22 ascii 08/30/83 12:30:00 #-h- fbcom 10_34 ascii 08/30else { if (lin(i) == FORWARD | lin(i) == CENTER | lin(i) == BACKWARD) { direc = lin(i) i = i + 1 } else direc = FORWARD screen = ctoi(lin, i) - 1 if (screen <= 0) screen = curscnum(2), edt(4), defn(3) integer i, j, junk, itoc include ctbufs data edt(1), edt(2), edt(3), edt(4) /LETE, LETD, LETT, EOS/ data defn(1), defn(2), defn(3) /DOLLAR, BLANK, EOS/ for (j=1; j <= MAXTBUFS; j=j+1) { i = j - 1 jun 2_103 ascii 08/29/83 18:57:00 integer function gtfndx(newind) include cbuf if (free != 0) # something in free list { newind = free call getb(free, NEXT, free) # relink free list } else if (lastbf + BUFENT  18:57:00 ## look4 - look for filename associated with buffer id integer function look4 (id, name) character id(ARB), name(ARB) integer i integer equal include ctbufs for (i=1; i<=MAXTBUFS; i=i+1) { if (equal (id, bufid(1å/83 12:30:00 #-h- fbcom 1238 asc 18-jul-80 21:30:16 ## /fbcom/ - common block for 'bf' tool # Put on a file called 'fbcom' # Used only by 'fb', but very similar to variables used in 'find' common /fbcom/ andpat, count, except, elevel   , pat(MAXPAT, NEXPR), atend, atbeg, seps(MAXPAT,2), nbrsep, skping, prting, locatd(MAXARG), mcount, seploc, bklth, lcount integer andpat #flag for locating blocks which contain all args integer count #t of number of matches integer skping #flag indicating lines should not be examined character locatd #flag indicating which patterns have been located integer bklth #max size of block to output # init = HUGE integb #file ID of scratch file; init=ERR #-t- fbbuf 2_123 ascii 08/30/83 12:30:00 #-h- fb.rat 97_73 ascii 08/30/83 12:30:00 #-h- defns 4_62 ascii 08/30/83 12:30:00 # include ratdef pressions allowed on cmd line #-t- defns 4_62 ascii 08/30/83 12:30:00 #-h- fbs 2_80 ascii 08/30/83 12:30:00 DRIVER ## fb - find block of lines include fbcom call fbargs #set initial vai=1; i<=elevel; i=i+1) if (match(line, pat(1,i)) == YES) locatd(i) = YES #mark arg that was matched return end #-t- bmatch 2_47 ascii 08/30/83 12:30:00 #-h- checkl 2_13 ascii 0 integer stackl include fbcom call initbk #clear stacks lcount = 0 if (nbrsep > 1 | seploc == BEFORE) { call bmatch(line) if (stackl(line) == ERR) call error ("Block buffer overflow.") flag for counting occurrences only integer except #flag for locating blocks without indicated patterns integer elevel #number of patterns to locate character pat #patterns to locate integer atend #flag for indicating end of block reached inteer lcount #running line count of block #-t- fbcom 10_34 ascii 08/30/83 12:30:00 #-h- fbbuf 2_123 ascii 08/30/83 12:30:00 #-h- fbbuf 321 asc 18-jul-80 21:30:17 ## fbbuf - common block for 'fb'  #note--the following 3 symbols should be defined the same as # those in the pattern-matching library routines define(BOL,PERCENT) #beginning of line define(CLOSURE,STAR) #flag for closure define(EOL,DOLLAR) lues; parse args call dobk (STDIN) #search blocks for patterns if (count == YES) #print final count { call putdec(mcount, 1) call putc(NEWLINE) } DRETURN end #-t- fbs 8/30/83 12:30:00 ## checkl - check line for block separator subroutine checkl (line) character line(ARB) integer match include fbcom atbeg = match(line, seps(1,1)) if (nbrsep == 1) atend = atbeg else atend = match(li } skping = NO prting = NO return end #-t- dobeg 3_28 ascii 08/30/83 12:30:00 #-h- dobk 8_29 ascii 08/30/83 12:30:00 ## dobk - find patterns in block of text subroutine dobk (fd) integerger atbeg #flag indicating beginning of block reached character seps #block separator(s) (1=start,2=ending) integer nbrsep #number of separators (1 or 2) integer seploc #location of separator (BEFORE or AFTER block) integer mcount #coun block buffer common /fbbuf/ fbbuf(MAXBUFLENGTH), endstk, fname(FILENAMESIZE), fb character fbbuf #buffer which holds lines integer endstk #pointer to end of stack; init=0 character fname #holds name of scratch file integer f #end of line define(MAXBUFLENGTH,5000) #length of block buffer (characters) define(BEFORE,1) #separator at beginning of block define(AFTER,0) #separator at end of block define(NEXPR,10) #nbr ex 2_80 ascii 08/30/83 12:30:00 #-h- bmatch 2_47 ascii 08/30/83 12:30:00 ## bmatch - locate patterns which appear in line of block subroutine bmatch (line) character line(ARB) integer match include fbcom for (ne, seps(1,2)) return end #-t- checkl 2_13 ascii 08/30/83 12:30:00 #-h- dobeg 3_28 ascii 08/30/83 12:30:00 ## dobeg - process beginning of block (fb tool) subroutine dobeg (line) character line(ARB) getlin integer fd, prt, first character line(MAXLINE) include fbcom include fbbuf call initbk #clear stacks first = YES while(getlin(line, fd) != EOF) { call checkl (line) #check line for block    separator #check if sep really at start of block if (first == YES & atend == YES & nbrsep == 1) seploc = BEFORE first = NO if (atend == YES) call doend(line) if/83 12:30:00 #-h- doend 8_82 ascii 08/30/83 12:30:00 ## doend - process end of block (fb tool) subroutine doend (line) character line(ARB) integer stackl integer prt include fbcom if (prting == YES) {  overflow.") } call tally (prt) if (prt == YES) { call printb if (bklth != HUGE) for (lcount=lcount+1; lcount<=bklth; unt == NO) call outlin(line) } else #check line for match { call bmatch (line) if (stackl(line) == ERR) call error ("Block buffer overflow.") call tally(prt)ol subroutine fbargs character arg(MAXLINE), dsep(5) integer getarg, itoc, getpat, status, index, ctoi integer i, j include fbbuf include fbcom string ilpat "illegal pattern: " string maxexp "max nbr expressions allowed: " data exceEOF; i=i+1) { if (arg(1) == MINUS & (arg(2) == LETS | arg(2) == BIGS)) { nbrsep = nbrsep + 1 if (nbrsep > 2) call error ("only start and ending separators allowed.") if (getpat(arg(3), seps(1,  (atbeg == YES) { call dobeg(line) next } if (skping == YES) next else call dolin (line) } #EOF reached if (skping if ( (nbrsep > 1 | seploc == AFTER) & count == NO) call outlin(line) if (bklth != HUGE) #finish off rest of block for(lcount=lcount+1; lcount<=bklth; lcount=lcount+1) call put lcount=lcount+1) call putch(NEWLINE,STDOUT) } } skping = YES prting = NO return end #-t- doend 8_82 ascii 08/30/83 12:30:00 #-h- dolin 6_63 #block may definitely be printed if (prt == YES & except == NO) { call printb prting = YES } #block may definitely be skipped else ifpt/NO/ data andpat/NO/ data count /NO/ data mcount /0/ data elevel/0/ data skping /NO/ data nbrsep /0/ data seploc /AFTER/ data endstk /0/ data fb /ERR/ data bklth /HUGE/ data lcount /0/ #default separator (% *$) nbrsep)) == ERR) { call putlin(ilpat, ERROUT) call error (arg(3)) } } else if (arg(1) == MINUS) { call fold(arg) if (index(arg, LETA) > 0)  == NO) call doend(line) if (fb != ERR) #make sure scratch file is removed { call close(fb) call remove(fname) fb = ERR } return end #-t- dobk 8_29 ascii 08/30ch(NEWLINE, STDOUT) } else if (skping == NO) { if (nbrsep > 1 | seploc == AFTER) { call bmatch (line) if (stackl(line) ==ERR) call error ("Block buffer ascii 08/30/83 12:30:00 ## dolin - process line for 'fb' tool subroutine dolin (line) character line(ARB) integer prt integer stackl include fbcom if (skping == YES) return if (prting == YES) { if (co (prt == NO & except == YES) skping = YES } return end #-t- dolin 6_63 ascii 08/30/83 12:30:00 #-h- fbargs 19_60 ascii 08/30/83 12:30:00 ## fbargs - parse arguments for 'fb' todata dsep(1), dsep(2), dsep(3), dsep(4), dsep(5) /BOL, BLANK, CLOSURE, EOL, EOS/ call query ("usage: fb [-axc] [-ln] [-spat] [-spat] pats.") #loop thru args, picking up flags and patterns for (i=1; getarg(i, arg, MAXARG) !=  andpat = YES if (index(arg, LETC) > 0) count = YES if (index(arg, LETX) > 0) except = YES j = index(arg, LETL) if (j > 0) #setting block length {     j = j + 1 bklth = ctoi(arg, j) if (bklth <= 0) call fberr } } else if (elevel < NEXPR) { elevel = elevel + 1 if (getpat(arg(1), pat(1,eparator.") nbrsep = 1 } if (nbrsep > 1) #skip till beginning of first block skping = YES return end #-t- fbargs 19_60 ascii 08/30/83 12:30:00 #-h- fberr 1_10 ascii 08/30/remove(fname) fb = ERR } return end #-t- initbk 2_40 ascii 08/30/83 12:30:00 #-h- outlin 1_96 ascii 08/30/83 12:30:00 ## outlin - output line from block, if user wants to see it subroutine if (count == YES) { mcount = mcount + 1 return } if (fb != ERR) #copy scratch file to output { call close(fb) fb = open(fname, READ) #start at beginning if (fb == ERR) ion stackl (line) character line(MAXLINE) integer length, create integer len include fbbuf include fbcom string fbtemp "fbt" stackl = OK if (count == YES) #no need to stack if just counting return lcount = lcount +} } for (i=1; i<=endstk; i=i+1) call putch(fbbuf(i), fb) call putlin(line, fb) endstk = 0 return } call scopy(line, 1, fbbuf, endstk+1) endstk = endstk + len return endelevel)) == ERR) { call putlin(ilpat, ERROUT) call error (arg) } } else { call putlin(maxexp, ERROUT) status = itoc(NEXPR, arg, MAXARG) ca83 12:30:00 ## fberr - report error in fb' tool subroutine fberr call error ('usage: fb [-axc] [-ln] [-spat] [-spat] pats.') return end #-t- fberr 1_10 ascii 08/30/83 12:30:00 #-h- initbk 2_40 ascii  outlin(line) character line(ARB) include fbcom lcount = lcount + 1 if (lcount <= bklth) call putlin(line, STDOUT) return end #-t- outlin 1_96 ascii 08/30/83 12:30:00 #-h- printb 6_28 ascii  call error ('problems reopening scratch file.') while(getch(c, fb) != EOF) call putch(c, STDOUT) call close(fb) call remove (fname) fb = ERR } for (i=1; i<=endstk; i=i+1)  1 if (lcount > bklth) #user doesn't want to see this much return len = length(line) if ( (len+endstk+1) > MAXBUFLENGTH) #store buffer on scratch file { if (fb == ERR) { call mkuniq(f #-t- stackl 8_87 ascii 08/30/83 12:30:00 #-h- tally 5_48 ascii 08/30/83 12:30:00 ## tally - tally results of block search subroutine tally (prt) integer prt #returned as YES if block should be printed; ell error(arg) } } #check for errors if (elevel == 0) call fberr if (nbrsep == 0) #set default separator { if (getpat(dsep, seps(1,1)) == ERR) call error ("illegal default s08/30/83 12:30:00 ## initbk - initialize buffers for 'fb' tool subroutine initbk include fbcom include fbbuf for (i=1; i<=elevel; i=i+1) locatd(i) = NO endstk = 0 if (fb != ERR) { call close(fb) call 08/30/83 12:30:00 ## printb - print (or count) block of lines subroutine printb integer i character c character getch integer open include fbbuf include fbcom if (endstk == 0 & fb == ERR) #nothing on stack return  call putch(fbbuf(i), STDOUT) return end #-t- printb 6_28 ascii 08/30/83 12:30:00 #-h- stackl 8_87 ascii 08/30/83 12:30:00 ## stackl - put line on bottom of stack (if user wants to see it) integer functbtemp, fname) fb = create(fname, WRITE) if (fb == ERR) { call remark ('problems opening scratch file.') call cant (fname) lse NO include fbcom prt = andpat for (i=1; i<=elevel; i=i+1) { if (andpat == NO & locatd(i) == YES) { prt = YES break } else if (andpat == YES & loc   atd(i) == NO) { prt = NO break } } if (except == YES) #opposite for exceptions { if (prt == NO) prt = YES else  0_92 ascii 08/30/83 12:30:00 # include ratdef define(MAXFIELDS,10) define(ARGFLAG,-1) # or define(ARGFLAG,255) #-t- defns 0_92 ascii 08/30/83 12:30:00 #-h- field 16_75 ascii 08/30/83 12:30:00 specified? if (buf(1) == MINUS & (buf(2) == LETT | buf(2) == BIGT) ) { if (buf(3) ^= EOS) tabc = buf(3) i = 2 } else if (buf(1) >= DIG0 & buf(1) <= DIG9) { # fields are specified nflds = doflds(buf, from, to, ad from STDIN } else if (buf(1) == MINUS & buf(2) == EOS) fd = STDIN else fd = open(buf, READ) files = YES if (fd == ERR) call cant(buf) len = getlin(buf, fd) while (len ^=  if (fd ^= STDIN) call close(fd) } DRETURN end #-t- field 16_75 ascii 08/30/83 12:30:00 #-h- doflds 8_41 ascii 08/30/83 12:30:00 # doflds - get field specifications from buf into from a } else if (buf(i) == PLUS) { # form is n+m i = i + 1 to(n) = from(n) + ctoi(buf, i) - 1 call skipbl(buf, i) } if (from(n) < 1 | from(n) > to(n) | (buf(i) ^= COMMA &  prt = NO } return end #-t- tally 5_48 ascii 08/30/83 12:30:00 #-t- fb.rat 97_73 ascii 08/30/83 12:30:00 #-t- fb.ar 114_108 ascii 09/02/83 09:15:00 #-h- field.ar  # field - rearrange fields in a file DRIVER character buf(MAXLINE), tabc integer from(MAXFIELDS), to(MAXFIELDS) character ofmt(MAXLINE) integer i, j, k, n, nflds, len, fd, tflag, files integer getarg, getlin, open, doflds, getfmt MAXFIELDS) if (nflds == ERR) call error ("illegal field specification.") tflag = NO i = 2 } if (getarg(i, buf, MAXLINE) == EOF) call usage #error, no output format specified junk = EOF) { if (tflag == YES) call dotabs(buf, tabc, from, to, nflds) for (j = 1; ofmt(j) ^= EOS; j = j + 1) if (ofmt(j) == ARGFLAG) { n = ofmt(j+1) for (k = from(n); k <= to(n) & k <nd to integer function doflds(buf, from, to, maxsiz) character buf(ARB) integer from(ARB), to(ARB), maxsiz integer i, n integer ctoi n = 1 from(1) = 1 to(1) = HUGE for (i = 1; buf(i) ^= EOS; ) { n = n + 1 buf(i) ^= EOS)) return(ERR) if (buf(i) == COMMA) i = i + 1 } for (i = n + 1; i <= maxsiz; i = i + 1) { # clear other fields from(i) = HUGE to(i) = HUGE } return(n) end #-t- doflds  44_44 ascii 09/02/83 09:15:00 #-h- list 0_11 ascii 08/30/83 12:30:00 field.rat #-t- list 0_11 ascii 08/30/83 12:30:00 #-h- field.rat 42_41 ascii 08/30/83 12:30:00 #-h- defns  data tabc /TAB/, tflag /YES/, nflds /MAXFIELDS/ i = 1 # assume no field specification is given if (getarg(1, buf, MAXLINE) == EOF) call usage else if (buf(1) == QMARK & buf(2) == EOS) call usage # tab fields are getfmt(buf, ofmt) files = NO for (i=i+1; ; i=i+1) { if (getarg(i, buf, MAXLINE) == EOF) #done? { if (files == YES) #yes, done break fd = STDIN #not done, re len; k = k + 1) call putch(buf(k), STDOUT) j = j + 1 } else call putch(ofmt(j), STDOUT) call putch(NEWLINE, STDOUT) len = getlin(buf, fd) }  if (n > maxsiz) return(ERR) from(n) = ctoi(buf, i) to(n) = from(n) call skipbl(buf, i) if (buf(i) == MINUS) { # form is n-m i = i + 1 to(n) = ctoi(buf, i) call skipbl(buf, i)  8_41 ascii 08/30/83 12:30:00 #-h- dotabs 5_31 ascii 08/30/83 12:30:00 # dotabs - break buf into fields defined by tab character c subroutine dotabs(buf, c, from, to, maxsiz) character buf(ARB), c integer f   rom(ARB), to(ARB), maxsiz integer i, j, n n = 1 from(n) = 1 to(n) = HUGE j = 1 for (i = 1; buf(i) ^= EOS & n < maxsiz; i = i + 1) if (buf(i) == c) { n = n + 1 from(n) = j to(n) = i - 1  character fmt(ARB) integer i, j character esc integer addset j = 1 for (i = 1; buf(i) ^= EOS; i = i + 1) { if (buf(i) == DOLLAR & buf(i+1) >= DIG0 & buf(i+1) <= DIG9) { junk = addset(ARGFLAG, fmt, j, MAXLINE) 08/30/83 12:30:00 #-t- field.rat 42_41 ascii 08/30/83 12:30:00 #-t- field.ar 44_44 ascii 09/02/83 09:15:00 #-h- find.ar 24_9 ascii 09/02/83 09:15:00 #-h- list 0_10 ascii 08/30/8 arg(MAXARG) integer i, getarg, except, andpat, count, elevel, itoc, getpat, mcount, getlin, matchd, status, gmatch, index string illpat "illegal pattern: " string maxexp "max nbr expressions allowed is: " data except/NO/ data a= elevel + 1 call scopy(arg, 1, exp(1, elevel), 1) } else { call putlin(maxexp, ERROUT) status = itoc(NEXPR, arg, MAXARG) call error(arg) } if (elevel == 0) call finerr for (i=1;  1) call putc(NEWLINE) } DRETURN end #-t- find 13_41 ascii 08/30/83 12:30:00 #-h- gmatch 3_72 ascii 08/30/83 12:30:00 integer function gmatch(lin, pat, elevel, andpat) integer elevel, andpat, j = i + 1 } if (n < maxsiz) { n = n + 1 from(n) = j to(n) = HUGE } for ( ; n < maxsiz; n = n + 1) { # clear other fields from(n+1) = HUGE to(n+1) = HUGE } retu junk = addset(buf(i+1) - DIG0 + 1, fmt, j, MAXLINE) i = i + 1 } else junk = addset(esc(buf,i), fmt, j, MAXLINE) } fmt(j) = EOS return end #-t- getfmt 4_62 ascii 08/30/83 12:30:3 12:30:00 find.rat #-t- list 0_10 ascii 08/30/83 12:30:00 #-h- find.rat 22_7 ascii 08/30/83 12:30:00 #-h- defns 0_65 ascii 08/30/83 12:30:00 define(NEXPR,10) # max nbr expressions allondpat/NO/ data count /NO/ data elevel/0/ for (i=1; getarg(i, arg, MAXARG) != EOF; i=i+1) if (arg(1) == QMARK & arg(2) == EOS) call finerr else if (arg(1) == MINUS) { call scopy(arg, 1, lin, 1) call foldi <= elevel; i=i+1) if (getpat(exp(1,i), pat(1,i)) == ERR) { call putlin(illpat, ERROUT) call error(exp(1,i)) } mcount = 0 while (getlin(lin, STDIN) != EOF) { matchd = gmatch(lin, pat, elevel, andpat)  match, i, status character lin(ARB), pat(MAXPAT, NEXPR) gmatch = andpat for (i=1; i <= elevel; i=i+1) { status = match(lin, pat(1,i)) if (andpat == NO & status == YES) { gmatch = YES break } rn end #-t- dotabs 5_31 ascii 08/30/83 12:30:00 #-h- getfmt 4_62 ascii 08/30/83 12:30:00 # getfmt - convert output format in buf to internal form in fmt subroutine getfmt(buf, fmt) character buf(ARB) 00 #-h- usage 1_20 ascii 08/30/83 12:30:00 # usage - print usage message and die subroutine usage call error ("usage: field [-t[c] | fieldslist] outputformat [files].") return end #-t- usage 1_20 asciiwed on cmd line #-t- defns 0_65 ascii 08/30/83 12:30:00 #-h- find 13_41 ascii 08/30/83 12:30:00 DRIVER ## find -- main program character exp(MAXARG,NEXPR), pat(MAXPAT,NEXPR), lin(MAXLINE), (lin) if (index(lin, LETA) > 0) andpat = YES if (index(lin, LETC) > 0) count = YES if (index(lin, LETX) > 0) except = YES } else if (elevel < NEXPR) { elevel  if ( (matchd == YES & except == NO) | (matchd == NO & except == YES) ) if (count == YES) mcount = mcount + 1 else call putlin(lin, STDOUT) } if (count == YES) { call putdec(mcount,else if (andpat == YES & status == NO) { gmatch = NO break } } return end #-t- gmatch 3_72 ascii 08/30/83 12:30:00 #-h- finerr 0_101 ascii 08/30/83 12:30:00 subroutin   e finerr call error("usage: find [-acx] expression [expression ].") return end #-t- finerr 0_101 ascii 08/30/83 12:30:00 #-t- find.rat 22_7 ascii 08/30/83 12:30:00 #-t- find.ar 24_9 asci #init = LESS character char2 #character to terminate prompt; #init = GREATER integer ftb #pointer to symbol table holding responses #-t- cform 3_19 ascii 08/30/83 12:30:00 #-h- cdef#number files allowed on command line define(MAXREPLY,3000) #maximum characters available in user's response # define(MEM_SIZE,3000) # size of dynamic storage in words define(ESCAPE,MINUS) #-t- defns 1_93 ascii 08/30/83 12:30:0NUS & line(2) != EOS) char1 = line(2) else if (line(1) == PLUS) char2 = line(2) else { nfiles = nfiles + 1 if (nfiles > MAXFILES)  9_46 ascii 08/30/83 12:30:00 #-h- forml 8_51 ascii 08/30/83 12:30:00 ##forml - replace prompts with user input on file 'int' subroutine forml(int) integer int, tog integer ftok, guser integer lookup charaeak # call tbinst(token, defn) call enter (token, defn, ftb) } call putlin(defn, STDOUT) next } else if (token(1) == char1) { i 09/02/83 09:15:00 #-h- form.ar 55_75 ascii 09/02/83 09:15:00 #-h- list 0_25 ascii 08/30/83 12:30:00 cform cdefio form.rat #-t- list 0_25 ascii 08/30/83 12:30:00 #-h- cform io 1_121 ascii 08/30/83 12:30:00 ## /cdefio/ - holds pushed-back characters # kludgey version - only works for one file define(BUFSIZE,MAXLINE) integer bp #next available character; init = 0 character buf # pushed-back char0 #-h- main 9_46 ascii 08/30/83 12:30:00 ## form - replace all instances of '<...>' in file with input from user DRIVER(form) character line(MAXLINE) integer getarg, open, mktabl integer i, nfiles character fnames(FILE call error ('too many file names.') call scopy(line, 1, fnames(1, nfiles), 1) } } for (i=1; i<=nfiles; i=i+1) #loop through all files { int = open(fnames(1,i), READ) cter token(MAXLINE), defn(MAXREPLY) include cform tog = NO while (ftok(token, int, tog) != EOF) { if (tog == YES) #inside prompt { if (token(1) == char2)  tog = YES next } call putlin(token, STDOUT) #output normal text } return end #-t- forml 8_51 ascii 08/30/83 12:30:00 #-h- ftok 6_97 3_19 ascii 08/30/83 12:30:00 ## cform common block for formletter tool # put on a file named 'cform' # Used only by form common /cform/ char1, char2, ftb character char1 #character to indicate beginning of prompt; acters common /cdefio/ bp, buf(BUFSIZE) #-t- cdefio 1_121 ascii 08/30/83 12:30:00 #-h- form.rat 46_54 ascii 08/30/83 12:30:00 #-h- defns 1_93 ascii 08/30/83 12:30:00 define(MAXFILES,10) NAMESIZE, MAXFILES) include cform data char1 /LESS/ data char2 /GREATER/ call query ("usage: form file.") ftb = mktabl (CHAR_DEFN) nfiles = 0 for (i=1; getarg(i, line, MAXLINE) != EOF; i=i+1) { if (line(1) == MIif (int == ERR) call cant(fnames(1,i)) call forml(int) call close(int) } if (i == 1) #no input file call error ("usage: form file.") DRETURN end #-t- main  { tog = NO next } if (lookup(token, defn, ftb) == NO) { if (guser(token, defn) == EOF) br ascii 08/30/83 12:30:00 ## ftok - pick up token for form letter integer function ftok(token, int, prflag) character token(ARB) integer int, prflag character ngetch include cform for (i=1; i< MAXREPLY; i=i+1) { ftok    = ngetch(token(i), int) if (ftok == EOF | (prflag == NO & ftok == NEWLINE) | (i == 1 & ftok == char1) | (i == 1 & ftok == char2) ) break if (ftok == char1 | ftok == char2) #b- get form letter replacement text from user integer function guser(pstr, repl) character repl(ARB), pstr(ARB) integer getlin, prompt integer lth lth = 0 repeat { if (lth == 0) i = prompt(pstr, repl(lth+1), he escape #and continue } if (repl(lth) == NEWLINE) #remove last NEWLINE lth = lth - 1 repl(lth+1) = EOS if (i == EOF) guser = EOF else rn end #-t- ngetch 2_114 ascii 08/30/83 12:30:00 #-h- putbak 2_28 ascii 08/30/83 12:30:00 ## putbak - push character back onto input # kludgey version - fd better always be the same subroutine putbak (c, fd) 0_11 ascii 08/30/83 12:30:00 #-h- fsort.rat 48_76 ascii 08/30/83 12:30:00 #-h- defns 2_15 ascii 08/30/83 12:30:00 define(HEAD,1) define(END,2) define(BODY,3) define(PROG,4) define(TYPE,5) define(COMN,6) defi = STDIN else fd = open(buf, READ) if (fd == ERR) call cant (buf) call fsort (fd, STDOUT) if (fd != STDIN) call close (fd) } if (i == 1) # no files given call fsort (STDIN, STDOUT) DRETURN end #-t- main 3_5eginning of next token { call putbak(ftok, int) if (ftok == char2 & prflag == YES) token(i) = BLANK else i = i - 1 break STDIN) else i = getlin(repl(lth+1), STDIN) if (i == EOF) break lth = lth + i if (lth >= MAXREPLY) #oops--too long { call remark ('truncatguser = lth return end #-t- guser 8_37 ascii 08/30/83 12:30:00 #-h- ngetch 2_114 ascii 08/30/83 12:30:00 ## ngetch - get a (possibly pushed-back) character from 'fd' # kludgy version - fd better always be  character c integer fd include cdefio bp = bp + 1 if (bp > BUFSIZE) call error ("too many characters pushed back.") buf(bp) = c return end #-t- putbak 2_28 ascii 08/30/83 12:30:00 #-t- form.rat 4ne(EQUI,7) define(DAT,8) define(DOUBLE,9) define(BLOCK,10) define(PRECISION,11) define(WRONG,12) define(MAXNAMES,10) define(MAXBUF,10000) define(MAXSAVE,1000) #-t- defns 2_15 ascii 08/30/83 12:30:00 #-h- main 3 ascii 08/30/83 12:30:00 #-h- fsort 8_15 ascii 08/30/83 12:30:00 subroutine fsort(ifd,ofd) integer ifd,ofd integer len, i byte kind character line(MAXLINE), word(MAXLINE), code(2) integer getlin, getwrd, lookup, mktabl byte gc } } if (i >=MAXREPLY) call error ("token too long.") token(i+1) = EOS return end #-t- ftok 6_97 ascii 08/30/83 12:30:00 #-h- guser 8_37 ascii 08/30/83 12:30:00 ##guser ing response.') break } if (repl(lth) == NEWLINE & repl(lth-1) != ESCAPE) break #no more lth = lth - 1 repl(lth) = NEWLINE #remove tthe same character function ngetch (c, fd) character c character getch integer fd include cdefio data bp /0/ if (bp > 0) c = buf(bp) else { bp = 1 buf(bp) = getch(c, fd) } if (c != EOF) bp = bp - 1 ngetch = c retu6_54 ascii 08/30/83 12:30:00 #-t- form.ar 55_75 ascii 09/02/83 09:15:00 #-h- fsort.ar 50_79 ascii 09/02/83 09:15:00 #-h- list 0_11 ascii 08/30/83 12:30:00 fsort.rat #-t- list  3_53 ascii 08/30/83 12:30:00 DRIVER integer getarg, open integer i, fd character buf(FILENAMESIZE) call query ("usage: fsort [files].") for (i=1; getarg(i, buf, FILENAMESIZE) != EOF; i=i+1) { if (buf(1) == MINUS & buf(2) == EOS) fdode #common for fsort character ord # sorted order of kind character buf # line hold buffer integer ptr # index of starts of lines byte type # kind of each line integer nextp # next line pos pointer integer stb # symbol table pointer common /fsor   tc/ buf(MAXBUF),ptr(MAXSAVE),type(MAXSAVE), ord(MAXNAMES),nextp, stb data ord/PROG,TYPE,COMN,EQUI,DAT,BODY,END,EOS/ nextp = 1 ptr(nextp) = 1 kind = WRONG stb = mktabl (CHAR_DEFN) call initfs (stb) for(len=getlin(line,ifd);len!=EOF;len=getlin(liger tb # symbol table pointer character code(2) string send "end" string sprog "program" string ssub "subroutine" string sblck "block" string sdata "data" string sint "integer" string sint1 "integer*1" string sint2 "integer*2" string sreal "realcall enter(sint,code, tb) call enter(sint2,code, tb) call enter(sint1,code, tb) call enter(sreal,code, tb) call enter(sreal4,code, tb) call enter(sreal8,code, tb) call enter(slog,code, tb) call enter(slog1,code, tb) call enter(slog2,code, tb) calline(ARB), word(ARB), code(2) integer i, len integer lookup, getwrd byte tmp #common for fsort character ord # sorted order of kind character buf # line hold buffer integer ptr # index of starts of lines byte type # kind of each line integer nextp turn(code(1)) return(BODY) # no path here but supress message end #-t- gcode 6_116 ascii 08/30/83 12:30:00 #-h- sflush 4_92 ascii 08/30/83 12:30:00 subroutine sflush(fd) integer fd,j,p byte i,kind #common f),fd) } } return end #-t- sflush 4_92 ascii 08/30/83 12:30:00 #-h- keepln 5_82 ascii 08/30/83 12:30:00 subroutine keepln(line,kind) character line(ARB) integer length integer i,j byte kind #common fone,ifd)) { i = 1 if(getwrd(line,i,word) == 0) # line is blank next; if (len>6 & line(6)!=BLANK & line(6)!=DIG0 & line(6)!=TAB) { # continuation line # kind = kind } else kind = gcode(line,i,word) call keepln(line,kind) if (kin" string sreal4 "real*4" string sreal8 "real*8" string sdoubl "double" string sprec "precision" string slog "logical" string slog1 "logical*1" string slog2 "logical*2" string sbyte "byte" string sext "external" string sdim "dimension" string sim enter(sbyte,code, tb) call enter(sdim,code, tb) call enter(sext,code, tb) call enter(simpl,code, tb) code(1) = EQUI call enter(sequ,code, tb) code(1) = DAT call enter(sdata,code, tb) code(1) = DOUBLE call enter(sdoubl,code, tb) code(1) = PRECISI# next line pos pointer integer stb # symbol table pointer common /fsortc/ buf(MAXBUF),ptr(MAXSAVE),type(MAXSAVE), ord(MAXNAMES),nextp, stb if (lookup(word,code, stb) == NO) return(BODY) if (code(1)==BLOCK | code(1)==DOUBLE) { tmp = code(1) or fsort character ord # sorted order of kind character buf # line hold buffer integer ptr # index of starts of lines byte type # kind of each line integer nextp # next line pos pointer integer stb # symbol table pointer common /fsortc/ buf(MAXBUFr fsort character ord # sorted order of kind character buf # line hold buffer integer ptr # index of starts of lines byte type # kind of each line integer nextp # next line pos pointer integer stb # symbol table pointer common /fsortc/ buf(MAXBUF)d==END) { call sflush (ofd) nextp = 1 ptr(nextp) = 1 kind = WRONG } } return end #-t- fsort 8_15 ascii 08/30/83 12:30:00 #-h- initfs 10_115 ascii 08/30/83 12:30:00 subroutine initfs (tb) intepl "implicit" string scom "common" string sequ "equivalence" code(2) = EOS code(1) = PROG call enter(sprog,code, tb) call enter(ssub,code, tb) code(1) = BLOCK call enter(sblck,code, tb) code(1) = COMN call enter(scom,code, tb) code(1) = TYPE ON call enter(sprec,code, tb) code(1) = END call enter(send,code, tb) return end #-t- initfs 10_115 ascii 08/30/83 12:30:00 #-h- gcode 6_116 ascii 08/30/83 12:30:00 byte function gcode(line,i,word) character l i = 1 len = getwrd(line,i,word) len = getwrd(line,i,word) if (lookup(word,code, stb) == NO) return(BODY) if (tmp==BLOCK & code(1)==DAT) return(PROG) else if(tmp==DOUBLE & code(1)==PRECISION) return(TYPE) else return(BODY) } else re),ptr(MAXSAVE),type(MAXSAVE), ord(MAXNAMES),nextp, stb for (i=1; ord(i) != EOS; i=i+1) # step thru kinds { kind = ord(i) for (p=1; p= MAXBUF) call    error("too many decl chars.") call scopy(line,1,buf,i) nextp = nextp + 1 ptr(nextp) = i+j+1 return end #-t- keepln 5_82 ascii 08/30/83 12:30:00 #-t- fsort.rat 48_76 ascii 08/30/83 12:30:00 #-t- fsort.ar å#-h- list 0_87 ascii 08/30/83 12:30:00 cdefio cfiles cnr cout cpage cparam ctemp format.rat croff defns format.lst #-t- list 0_87 ascii 08/30/83 12:30:00 #-h- cdefio 2_7 ascii 08f common /cfiles/ infile(NFILES), level integer infile # stack of file descriptors integer level # current file is infile(level) #-t- cfiles 1_123 ascii 08/30/83 12:30:00 #-h- cnr 1_61 ascii 08/30/83integer outp # last char position in outbuf; init = 0 integer outw # width of text currently in outbuf; init = 0 integer outwds # number of words in outbuf; init = 0 character outbuf # lines to be filled collect here tpg, print, offset integer curpag # current output page number; init = 0 integer newpag # next output page number; init = 1 integer lineno # next line to be printed; init = 0 integer plval # page length in lines; init = PAG 50_79 ascii 09/02/83 09:15:00  5_82 ascii 08/30/83 12:30:00 #-t- fsort.rat 48_76 ascii 08/30/83 12:30:00 #-t- fsort.ar å/30/83 12:30:00 ## common block to hold pushed-back input characters # put on a file called 'cdefio' # used by ratfor, macro, roff common /cdefio/ bp, buf(BUFSIZE) integer bp # next available character; init = 0 character buf #  12:30:00 ## common block holding number registers for format tool # put on a file called "cnr" # used only by the format tool common /cnr/ nr(26) integer nr # number registers a..z #-t- cnr 1_61 ascii 08/30/83 12:3 # word in outbuf; init=0 #-t- cout 3_104 ascii 08/30/83 12:30:00 #-h- cpage 14_21 ascii 08/30/83 12:30:00 ## common block holding misc. page info for format tool # put on a file called "cpagELEN = 66 integer m1val # margin before and including header integer m2val # margin after header integer m3val # margin after last text line integer m4val # bottom margin, including footer integer bottom # last lååpushed-back characters #-t- cdefio 2_7 ascii 08/30/83 12:30:00 #-h- cfiles 1_123 ascii 08/30/83 12:30:00 ## common block used to hold list of input files # put on a file called 'cfiles' # used by macro, rof0:00 #-h- cout 3_104 ascii 08/30/83 12:30:00 ## common block holding output lines and info for format tool # put on a file called "cout" # used only by the format tool common /cout/ outp, outw, outwds, outbuf(MAXOUT) e" # (used only by format tool) common /cpage/ curpag,newpag,lineno,plval,m1val,m2val,m3val,m4val, bottom, ehead(MAXLINE), ohead(MAXLINE), ehlim(2), ohlim(2), efoot(MAXLINE), ofoot(MAXLINE), eflim(2), oflim(2), stopx, frstpg, lasive line on page, = plval-m3val-m4val character ehead # top of page title for even pages;init=NEWLINE character ohead # top of page title for odd pages;init=NEWLINE integer ehlim # left,right margins for even header;init=inval,rm   val integer ohlim # left,right margins for odd header;init=inval,rmval character efoot # bot of page title for even pages;init=NEWLINE character ofoot # bot of page title for odd pages;init=NEWLINE integer eflim # leftcparam 10_43 ascii 08/30/83 12:30:00 ## common block holding misc. line info for format tool # put on a file called "cparam" # (used ony by format tool) common /cparam/ fill, lsval, inval, rmval, mfval, tival, ceval, ulval,  integer ulval # number of lines to underline; init = 0 integer boval # number of lines to boldface; init = 0 character cchar # line control character; init = PERIOD character mfstng # margin string; init EOS integer tjustry buffers for format tool # put on a file called "ctemp" # (used only by format tool) common /ctemp/ tbuf1(MAXLINE), tbuf2(MAXLINE), ttl(MAXLINE) character tbuf1 # scratch arrays for use by puttl and tabs character tbuf2 # char (i = 1; getarg(i, arg, MAXLINE) ^= EOF; i = i + 1) if (arg(1) == QMARK & arg(2) == EOS) call error ("usage: format [-s] [+n] [-n] [-pon] [files].") else if (arg(1) == MINUS & (arg(2) == LETS | arg(2) == BIGS)) stopx = 1  fd = open(arg, READ) if (fd == ERR) call cant (arg) call doroff(fd) nf = nf + 1 if (fd ^= STDIN) call close(fd) } if (nf == 0) # no files, do STDIN call doroff(S,right margins for even footer;init=inval,rmval integer oflim # left,right margins for odd footer;init=inval,rmval integer stopx # flag for pausing between pages integer frstpg # first page to begin printing with integer boval, cchar, mfstng(21), tjust(3), bsval, rjust, cuval, tabs(INSIZE) integer fill # fill if YES; init = YES integer lsval # current line spacing; init = 1 integer inval # current indent; >= 0; in # justification types for heads and foots; # init = LEFT, CENTER, RIGHT integer bsval # number of lines to blank suppress; init=0 integer rjust # right justify filled lines if YES; init=YES integer cuval # numracter ttl # #-t- ctemp 2_51 ascii 08/30/83 12:30:00 #-h- format.rat 277_88 ascii 08/30/83 12:30:00 #-h- format 12_73 ascii 08/30/83 12:30:00 include defns ## format - text formatter DRIVER  else if (arg(1) == MINUS & (arg(2) == LETP | arg(2) == BIGP) & (arg(3) == LETO | arg(3) == BIGO)) { j = 4 call set(offset, ctoi(arg, j), arg(4), 0, 0, rmval-1) } else if (arg(1) == PLUS) { TDIN) call brk if (plval <= 100 & (lineno > 0 | outp > 0)) call space(HUGE) # flush last output ifdef(PAGECONTROL, call putc(PAGEJECT) call putc(NEWLINE) ) ifdef(DEC10, blanks = cntrl(STDOUT, 15, blanks) lastpg # last page to be printed integer print # flag to indicate whether page should be printed integer offset # number of blanks to offset page by; init = 0 #-t- cpage 14_21 ascii 08/30/83 12:30:00 #-h- it = 0 integer rmval # current right margin; init = PAGEWIDTH = 60 integer mfval # current margin flag offset; init = 0 (off) integer tival # current temporary indent; init = 0 integer ceval # number of lines to center; init = 0ber lines to continuously underline; init = 0 integer tabs # tab stops; init every 8 spaces #-t- cparam 10_43 ascii 08/30/83 12:30:00 #-h- ctemp 2_51 ascii 08/30/83 12:30:00 ## common block holding tempora character arg(MAXLINE) integer getarg, open, ctoi ifdef(DEC10, integer cntrl, blanks) integer i, fd, nf include cpage include cparam include cout call init ifdef(DEC10, blanks = cntrl(STDOUT, 15, 0)) nf = 0 fo j = 2 frstpg = ctoi(arg, j) } else if (arg(1) == MINUS & arg(2) ^= EOS) { j = 2 lastpg = ctoi(arg, j) } else { if (arg(1) == MINUS) fd = STDIN else  ) DRETURN end #-t- format 12_73 ascii 08/30/83 12:30:00 #-h- bold 5_45 ascii 08/30/83 12:30:00 # bold - bold-face or overstrike a line subroutine bold(buf, tbuf, size) integer i, j, size charac   ter buf(ARB), tbuf(ARB) j = 1 # expand into tbuf for (i = 1; buf(i) ^= NEWLINE & j < size-1; i = i + 1) { tbuf(j) = buf(i) j = j + 1 if (buf(i) ^= BLANK & buf(i) ^= TAB & buf(i) ^= BACKSPACE & buf(i) ^= S if (outp > 0) { outbuf(outp) = NEWLINE outbuf(outp+1) = EOS call put(outbuf) } outp = 0 outw = 0 outwds = 0 return end #-t- brk 1_118 ascii 08/30/83 12:30:00 #-h- center val, getwrd, open, length integer ctoc integer argtyp, ct, spval, val, i, j include cpage include cparam include cfiles include cnr ct = comtyp(buf, defn) if (ct == UNKNOWN) # ignore unknown commands return  call brk call set(ceval, val, argtyp, 1, 0, HUGE) } else if (ct == UL) { cuval = 0 call set(ulval, val, argtyp, 0, 1, HUGE) } else if (ct == BD) call set(boval, val, argtyp, 0, 1, HUGE) e call space(spval) } else if (ct == IN) { call brk call set(inval, val, argtyp, 0, 0, rmval-1) tival = inval } else if (ct == RM) call set(rmval, val, argtyp, PAGEWIDTH, tival+1, HUGE) els plval-m1val-m3val-m4val-1) else if (ct == M3) { call set(m3val, val, argtyp, 2, 0, plval-m1val-m2val-m4val-1) bottom = plval - m3val - m4val } else if (ct == M4) { call set(m4val, val, argtyp, 3,TARTU & buf(i) ^= STOPU) { tbuf(j) = BACKSPACE tbuf(j+1) = tbuf(j-1) tbuf(j+2) = BACKSPACE tbuf(j+3) = tbuf(j+1) j = j + 4 } } tbuf(j) = NEWLINE tbuf(j+1) = EOS call scop 1_71 ascii 08/30/83 12:30:00 # center - center a line by setting tival subroutine center(buf) character buf(ARB) integer width include cparam tival = max((rmval+tival-width(buf))/2, 0) return end #-t- center call doesc(buf, name, MAXLINE) i = 1 # skip command name while (buf(i) ^= BLANK & buf(i) ^= TAB & buf(i) ^= NEWLINE) i = i + 1 val = getval(buf, i, argtyp) if (ct == DEFINED) call eval(buf, defn) else if (ct == FIlse if (ct == HE) { call gettl(buf, ehead, ehlim) call gettl(buf, ohead, ohlim) } else if (ct == FO) { call gettl(buf, efoot, eflim) call gettl(buf, ofoot, oflim) } else if (ct == BP) { call be if (ct == TI) { call brk call set(tival, val, argtyp, 0, 0, rmval) } else if (ct == PL) { call set(plval, val, argtyp, PAGELEN, m1val+m2val+m3val+m4val+1, HUGE) bottom = plval - m3val - m4val  0, plval-m1val-m2val-m3val-1) bottom = plval - m3val - m4val } else if (ct == MC) { # margin flag call brk call set (mfval, val, argtyp, 0, 0, MAXLINE-rmval) call skipbl (buf, i) j = ctoc (buf(i), mfstng, 21) iy(tbuf, 1, buf, 1) # copy it back to buf return end #-t- bold 5_45 ascii 08/30/83 12:30:00 #-h- brk 1_118 ascii 08/30/83 12:30:00 # brk - end current filled line subroutine brk include cout  1_71 ascii 08/30/83 12:30:00 #-h- comand 37_68 ascii 08/30/83 12:30:00 # comand - perform formatting command subroutine comand(buf) character buf(MAXLINE), name(MAXLINE), defn(MAXDEF) integer comtyp, get) { call brk fill = YES } else if (ct == NF) { call brk fill = NO } else if (ct == BR) call brk else if (ct == LS) call set(lsval, val, argtyp, 1, 1, HUGE) else if (ct == CE) {rk # perform break explicitly if (lineno > 0) call space(HUGE) call set(curpag, val, argtyp, curpag+1, -HUGE, HUGE) newpag = curpag } else if (ct == SP) { call set(spval, val, argtyp, 1, 0, HUGE) } else if (ct == PO) call set(offset, val, argtyp, 0, 0, rmval-1) else if (ct == M1) call set(m1val, val, argtyp, 3, 0, plval-m2val-m3val-m4val-1) else if (ct == M2) call set(m2val, val, argtyp, 2, 0, f (mfstng(j) == NEWLINE) mfstng(j) = EOS } else if (ct == EH) call gettl(buf, ehead, ehlim) else if (ct == OH) call gettl(buf, ohead, ohlim) else if (ct == EF) call gettl(buf, efoot, eflim) else if (ct == OF)     call gettl(buf, ofoot, oflim) else if (ct == CC) { cchar = argtyp if (cchar == EOS | cchar == NEWLINE) cchar = PERIOD } else if (ct == NE) { if ((lineno + val) > bottom & lineno <= bottom) {  else if (ct == CU) { ulval = 0 call set(cuval, val, argtyp, 0, 1, HUGE) } else if (ct == DE) call dodef(buf, infile(level)) else if (ct == NR) { if (getwrd(buf, i, name) == 0) return call space(spval - lineno) } return end #-t- comand 37_68 ascii 08/30/83 12:30:00 #-h- comtyp 21_76 ascii 08/30/83 12:30:00 # comtyp - decode command type integer function comtyp(buf, defn) characcomtyp = LS else if (buf(2) == LETB & buf(3) == LETP) comtyp = BP else if (buf(2) == LETS & buf(3) == LETP) comtyp = SP else if (buf(2) == LETI & buf(3) == LETN) comtyp = IN else if (buf(2) == LETR & buf(3) == LETM) buf(3) == LETD) comtyp = BD else if (buf(2) == LETM & buf(3) == DIG1) comtyp = M1 else if (buf(2) == LETM & buf(3) == DIG2) comtyp = M2 else if (buf(2) == LETM & buf(3) == DIG3) comtyp = M3 else if (buf(2) ==(buf(2) == LETB & buf(3) == LETS) comtyp = BS else if (buf(2) == LETJ & buf(3) == LETU) comtyp = JU else if (buf(2) == LETN & buf(3) == LETJ) comtyp = NJ else if (buf(2) == LETS & buf(3) == LETO) comtyp = SO  call space(val) lineno = 0 } } else if (ct == BS) call set(bsval, val, argtyp, 1, 0, HUGE) else if (ct == JU) rjust = YES else if (ct == NJ) rjust = NO else if (ct == SO) { iffold(name) if (name(1) < LETA | name(1) > LETZ) call error("invalid number register name.") val = getval(buf, i, argtyp) itmp = name(1) - LETA+1 call set(nr(itmp), val, argtyp, 0, -HUGE, HUGE) } else if (ct ter buf(MAXLINE), defn(MAXDEF) character name(MAXNAME) integer i integer lookup, getwrd include croff i = 2 i = getwrd(buf, i, name) if (i > 2) name(3) = EOS if (lookup(name, defn, st) == YES) comtyp = DEFI comtyp = RM else if (buf(2) == LETT & buf(3) == LETI) comtyp = TI else if (buf(2) == LETC & buf(3) == LETE) comtyp = CE else if (buf(2) == LETU & buf(3) == LETL) comtyp = UL else if (buf(2) == LETH & buf(3) = LETM & buf(3) == DIG4) comtyp = M4 else if (buf(2) == LETM & buf(3) == LETC) comtyp = MC else if (buf(2) == LETE & buf(3) == LETH) comtyp = EH else if (buf(2) == LETO & buf(3) == LETH) comtyp = OH else if (buf(2) else if (buf(2) == LETC & buf(3) == LETU) comtyp = CU else if (buf(2) == LETD & buf(3) == LETE) comtyp = DE else if (buf(2) == LETE & buf(3) == LETN) comtyp = EN else if (buf(2) == LETN & buf(3) == LETR) comtyp = (getwrd(buf, i, name) == 0) return if (level + 1 > NFILES) call error("so commands nested too deeply.") infile(level+1) = open(name, READ) if (infile(level+1) ^= ERR) level = level + 1 } == ST) { if (argtyp == MINUS) spval = plval else spval = 0 call set(spval, val, argtyp, 0, 1, bottom) if (spval > lineno & lineno == 0) call phead if (spval > lineno) call NED else if (buf(2) == LETF & buf(3) == LETI) comtyp = FI else if (buf(2) == LETN & buf(3) == LETF) comtyp = NF else if (buf(2) == LETB & buf(3) == LETR) comtyp = BR else if (buf(2) == LETL & buf(3) == LETS) = LETE) comtyp = HE else if (buf(2) == LETF & buf(3) == LETO) comtyp = FO else if (buf(2) == LETP & buf(3) == LETL) comtyp = PL else if (buf(2) == LETP & buf(3) == LETO) comtyp = PO else if (buf(2) == LETB & == LETE & buf(3) == LETF) comtyp = EF else if (buf(2) == LETO & buf(3) == LETF) comtyp = OF else if (buf(2) == LETC & buf(3) == LETC) comtyp = CC else if (buf(2) == LETN & buf(3) == LETE) comtyp = NE else if  NR else if (buf(2) == LETS & buf(3) == LETT) comtyp = ST else comtyp = UNKNOWN return end #-t- comtyp 21_76 ascii 08/30/83 12:30:00 #-h- dodef 6_19 ascii 08/30/83 12:30:00 # dodef    - define a command; .de xx is in buf subroutine dodef(buf, fd) character buf(MAXLINE) integer fd character name(MAXNAME), defn(MAXDEF) integer i, junk integer getwrd, addstr, addset, ngetln include cparam include croff n end #-t- dodef 6_19 ascii 08/30/83 12:30:00 #-h- doesc 6_31 ascii 08/30/83 12:30:00 # doesc - expand escapes in buf subroutine doesc(buf, tbuf, size) character buf(ARB), tbuf(ARB) integer size  i = i + 2 } else { tbuf(j) = buf(i) j = j + 1 } tbuf(j) = EOS call scopy(tbuf, 1, buf, 1) return end #-t- doesc 6_31 ascii 08/30/83 12:30:00 #-h- doroff vel) >= 0) call close(infile(level)) } return end #-t- doroff 4_44 ascii 08/30/83 12:30:00 #-h- dotabs 4_63 ascii 08/30/83 12:30:00 # dotabs - expand tabs in buf subroutine dotabs(bu end #-t- dotabs 4_63 ascii 08/30/83 12:30:00 #-h- eval 8_59 ascii 08/30/83 12:30:00 # eval - evaluate defined command; push back definition subroutine eval(buf, defn) character buf(MAXLINE), defn(MAX(defn); k > 1; k = k - 1) if (defn(k-1) ^= ARGFLAG) call putbak(defn(k)) else { if (defn(k) < DIG0 | defn(k) > DIG9) call putbak(defn(k)) else { i = defn(k) - DIG0 + 1 i = a i = 1 junk = getwrd(buf, i, name) i = getwrd(buf, i, name) # get name if (i == 0) call error("missing name in command definition.") if (i > 2) name(3) = EOS # truncate to xx i = 1 while (ngetln(buf, fd) ^= EOF) {  integer i, j integer itoc include cnr j = 1 # expand into tbuf for (i = 1; buf(i) ^= EOS & j < size; i = i + 1) if (buf(i) ^= ESCAPE) { tbuf(j) = buf(i) j = j + 1 } else if (buf(i+1) == ES 4_44 ascii 08/30/83 12:30:00 # doroff - format text in file fd subroutine doroff(fd) integer fd character inbuf(INSIZE) integer ngetln include cfiles include cparam infile(1) = fd for (level = 1; level > 0; level = lf, tbuf, size) character buf(ARB), tbuf(ARB) integer size integer i, j include cparam j = 1 # expand into tbuf for (i = 1; buf(i) ^= EOS & j < size; i = i + 1) if (buf(i) == TAB) while (j < size) { DEF) integer i, j, k, argptr(10) integer length for (j = 1; j <= 10; j = j + 1) # initialize arguments to null argptr(j) = 1 buf(1) = EOS i = 2 for (j = 1; j <= 10; j = j + 1) { call skipbl(buf, i) if (buf(irgptr(i) call pbstr(buf(i)) k = k - 1 # skip over $ } } if (k > 0) # do last character call putbak(defn(k)) return end #-t- eval 8_59 ascii 08/30/83 12:30:00 #- if (buf(1) == cchar & buf(2) == LETE & buf(3) == LETN) break junk = addstr(buf, defn, i, MAXDEF) } if (addset(EOS, defn, i, MAXDEF) == NO) call error("definition too long.") call enter(name, defn, st) returCAPE) { tbuf(j) = ESCAPE j = j + 1 i = i + 1 } else if (buf(i+1) == LETN & (buf(i+2) >= LETA & buf(i+2) <= LETZ)) { itmp = buf(i+2) - LETA+1 j = j + itoc(nr(itmp), tbuf(j), size - j - 1) evel - 1) { while (ngetln(inbuf, infile(level)) ^= EOF) if (inbuf(1) == cchar) # it's a command call comand(inbuf) else # it's text call text(inbuf) if (level > 1 & infile(letbuf(j) = BLANK j = j + 1 if (tabs(j) == YES | j > INSIZE) break } else { tbuf(j) = buf(i) j = j + 1 } tbuf(j) = EOS call scopy(tbuf, 1, buf, 1) return ) == NEWLINE | buf(i) == EOS) break argptr(j) = i while (buf(i) ^= BLANK & buf(i) ^= TAB & buf(i) ^= NEWLINE & buf(i) ^= EOS) i = i + 1 buf(i) = EOS i = i + 1 } for (k = lengthh- ngetln 3_47 ascii 08/30/83 12:30:00 # ngetln - get next line from f into line integer function ngetln(line, f) character line(MAXLINE), c, ngetch integer f for (ngetln = 0; ngetch(c, f) ^= EOF; ) { if (ngetl   n < MAXLINE - 1) { ngetln = ngetln + 1 line(ngetln) = c } if (c == NEWLINE) break } line(ngetln+1) = EOS if (ngetln == 0 & c == EOF) ngetln = EOF return end #-t- ngetln  # set limits lim(2) = rmval return end #-t- gettl 3_81 ascii 08/30/83 12:30:00 #-h- getval 2_87 ascii 08/30/83 12:30:00 # getval - evaluate optional numeric argument; increment i integer functB) integer i, j j = 1 while (in(i) ^= EOS & in(i) ^= BLANK & in(i) ^= TAB & in(i) ^= NEWLINE) { out(j) = in(i) i = i + 1 j = j + 1 } while (in(i) == BLANK) { # include trailing blanks out(j) = B& buf(i) ^= NEWLINE & j <= n) { temp(j) = buf(i) j = j + 1 i = i + 1 } } temp(j) = EOS gfield = j - 1 # set to number of characters copied while (buf(i) ^= delim & b fill = YES ceval = 0 ulval = 0 boval = 0 cchar = PERIOD mfstng(1) = EOS tjust(1) = LEFT tjust(2) = CENTER tjust(3) = RIGHT bsval = 0 rjust = YES cuval = 0 for (i = 1; i <= INSIZE; i = i + 1) if (mod(eflim(1) = inval eflim(2) = rmval oflim(1) = inval oflim(2) = rmval stopx = 0 frstpg = 0 lastpg = HUGE print = YES offset = 0 outp = 0 # initialize cout outw = 0 outwds = 0 st = mktabl(CHAR_DEFN)  3_47 ascii 08/30/83 12:30:00 #-h- gettl 3_81 ascii 08/30/83 12:30:00 # gettl - copy title from buf to ttl subroutine gettl(buf, ttl, lim) character buf(MAXLINE), ttl(MAXLINE) integer i, lim(2) include cparaion getval(buf, i, argtyp) character buf(MAXLINE) integer i, argtyp integer ctoi call skipbl(buf, i) # find argument argtyp = buf(i) if (argtyp == PLUS | argtyp == MINUS) i = i + 1 getval = ctoi(buf, i) returLANK i = i + 1 j = j + 1 } out(j) = EOS getwrb = j - 1 return end #-t- getwrb 3_100 ascii 08/30/83 12:30:00 #-h- gfield 4_97 ascii 08/30/83 12:30:00 # gfield - get next tab ouf(i) ^= EOS & buf(i) ^= NEWLINE) i = i + 1 return end #-t- gfield 4_97 ascii 08/30/83 12:30:00 #-h- init 11_90 ascii 08/30/83 12:30:00 # init - set parameters to default values subroutine inii, 8) == 1) tabs(i) = YES else tabs(i) = NO lineno = 0 # initialize cpage curpag = 0 newpag = 1 plval = PAGELEN m1val = 3 m2val = 2 m3val = 2 m4val = 3 bottom = plval - m3val - m4val # init hash table bp = 0 # initialize cdefio for (i = 1; i <= 26; i = i + 1) # initialize cnr nr(i) = 0 return end #-t- init 11_90 ascii 08/30/83 12:30:00 #-h- jcopy 2_30m i = 1 # skip command name while (buf(i) ^= BLANK & buf(i) ^= TAB & buf(i) ^= NEWLINE) i = i + 1 call skipbl(buf, i) # find argument call scopy(buf, i, ttl, 1) # copy titles to ttl lim(1) = inval n end #-t- getval 2_87 ascii 08/30/83 12:30:00 #-h- getwrb 3_100 ascii 08/30/83 12:30:00 # getwrb - get a word; hangs onto trailing blanks integer function getwrb(in, i, out) character in(ARB), out(ARr title field integer function gfield(buf, i, n, temp, delim) character buf(ARB), temp(ARB), delim integer i, j, n j = 1 if (n > 0) { if (buf(i) == delim) i = i + 1 while (buf(i) ^= delim & buf(i) ^= EOS t integer i integer mktabl include cparam include cpage include cout include cdefio include cnr include croff inval = 0 # initialize cparam rmval = PAGEWIDTH mfval = 0 tival = 0 lsval = 1  ehead(1) = NEWLINE ehead(2) = EOS ohead(1) = NEWLINE ohead(2) = EOS efoot(1) = NEWLINE efoot(2) = EOS ofoot(1) = NEWLINE ofoot(2) = EOS ehlim(1) = inval ehlim(2) = rmval ohlim(1) = inval ohlim(2) = rmval  ascii 08/30/83 12:30:00 # jcopy - scopy without copying EOS subroutine jcopy(from, i, to, j) character from(ARB), to(ARB) integer i, j, k1, k2 k1 = i k2 = j while (from(k1) ^= EOS) { to(k2) = from(k1) k1 = k1    + 1 k2 = k2 + 1 } return end #-t- jcopy 2_30 ascii 08/30/83 12:30:00 #-h- justify 3_47 ascii 08/30/83 12:30:00 # justfy - justifies string in its tab column subroutine justfy(in, left set tival subroutine leadbl(buf) character buf(MAXLINE) integer i, j include cparam call brk for (i = 1; buf(i) == BLANK; i = i + 1) # find 1st non-blank ; if (buf(i) ^= NEWLINE) tival = tival + i - 1 f else c = getch(c, fd) ngetch = c return end #-t- ngetch 2_50 ascii 08/30/83 12:30:00 #-h- pbstr 1_86 ascii 08/30/83 12:30:00 # pbstr - push string back onto input subroutine pbstr(in) , curpag) ifnotdef(PAGECONTROL, call skip(m4val-1) ) } return end #-t- pfoot 2_74 ascii 08/30/83 12:30:00 #-h- phead 5_17 ascii 08/30/83 12:30:00 # phead - put out page header subrou(ohead, ohlim, curpag) } call skip(m2val) lineno = m1val + m2val + 1 return end #-t- phead 5_17 ascii 08/30/83 12:30:00 #-h- prmpt 5_27 ascii 08/30/83 12:30:00 # prmpt - pause for paper irn junk = getlin(line, tin) call close(tin) if (i == 1) call close(tout) i = i + 1 return end #-t- prmpt 5_27 ascii 08/30/83 12:30:00 #-h- put 13_39 ascii 08/30/83 12:30:00 # pu, right, type, out) character in(ARB), out(ARB) integer left, right, type, j, n, width n = width(in) if (type == RIGHT) call jcopy(in, 1, out, right-n) else if (type == CENTER) { j = max((right+left-n)/2, left) or (j = 1; buf(i) ^= EOS; j = j + 1) { # move line to left buf(j) = buf(i) i = i + 1 } buf(j) = EOS return end #-t- leadbl 3_55 ascii 08/30/83 12:30:00 #-h- ngetch 2_50 ascii 0 character in(MAXLINE) integer length integer i for (i = length(in); i > 0; i = i - 1) call putbak(in(i)) return end #-t- pbstr 1_86 ascii 08/30/83 12:30:00 #-h- pfoot 2_74 ascii 0tine phead include cpage integer c(MAXLINE) curpag = newpag if (curpag >= frstpg & curpag <= lastpg) print = YES else print = NO if(stopx > 0 & print == YES) call prmpt(stopx) newpag = newpag + 1 ifdef(PAGEnsertion; prompt if i == 1; increment i subroutine prmpt(i) integer i integer open, getlin integer tin, tout, junk character line(MAXLINE) string tell "Type return to begin a page" string trmin TERMINAL_IN string trmout TERMt - put out line with proper spacing and indenting subroutine put(buf) character buf(MAXLINE) integer width integer i, j, k, w, c, cuflg include cpage include cparam data cuflg /NO/ if (lineno == 0 | lineno > bottom)  call jcopy(in, 1, out, j) } else call jcopy(in, 1, out, left) return end #-t- justify 3_47 ascii 08/30/83 12:30:00 #-h- leadbl 3_55 ascii 08/30/83 12:30:00 # leadbl - delete leading blanks,8/30/83 12:30:00 # ngetch - get a (possibly pushed back) character from file fd character function ngetch(c, fd) character c integer fd character getch include cdefio if (bp > 0) { c = buf(bp) bp = bp - 1 } 8/30/83 12:30:00 # pfoot - put out page footer subroutine pfoot include cpage call skip(m3val) if (m4val > 0) { if (mod(curpag, 2) == 1) call puttl(efoot, eflim, curpag) else call puttl(ofoot, oflimCONTROL, if (stopx == 0 & print == YES) call putc(PAGEJECT) ) if (m1val > 0) { call skip(m1val-1) if (mod(curpag, 2) == 0) call puttl(ehead, ehlim, curpag) else call puttlINAL_OUT if (i == 1) { tout = open(trmout, WRITE) if (tout == ERR) return call putlin(tell, tout) call flush(tout) } tin = open(trmin, READ) if (tin == ERR) retu call phead if (print == YES) { for (i = 1; i <= offset; i = i + 1) # page offset call putc(BLANK) for (i = 1; i <= tival; i = i + 1) # indenting call putc(BLANK) for (i = 1; buf(i) ^= EOS & bu   f(i) ^= NEWLINE; i = i + 1) if (buf(i) == STARTU) cuflg = YES else if (buf(i) == STOPU) cuflg = NO else if (cuflg == YES) { # underlining for (j = i; buf(i) ^= STOPU & buf else call putch(buf(i), STDOUT) if (mfval > 0) { k = rmval + (mfval-1) - width(buf) - tival for (; k > 0; k = k - 1) call putch (BLANK, STDOUT) call putlin (mfstng, STDOUT) } call putch(NEWLINE, STDOUT)  end #-t- putbak 1_105 ascii 08/30/83 12:30:00 #-h- puttl 9_81 ascii 08/30/83 12:30:00 # puttl - put out title line with optional page number & date subroutine puttl(buf, lim, pageno) character buf(MAXLI # update title counter if (gfield(buf, i, right-left, tbuf1, delim) > 0) { call subst(tbuf1, PAGENUM, tbuf2, chars, nc) call subst(tbuf2, CURRENTDATE, tbuf1, cdate, ncd) call justfy(tbuf1, left, right, tjusn justification subroutine putwrd(wrdbuf) character wrdbuf(INSIZE) integer length, width integer last, llval, nextra, w include cout include cparam w = width(wrdbuf) last = length(wrdbuf) + outp # new end of outbu # flush previous line } call scopy(wrdbuf, 1, outbuf, outp+1) outp = last outw = outw + w outwds = outwds + 1 return end #-t- putwrd 7_79 ascii 08/30/83 12:30:00 #-h- set 3_1(i) ^= NEWLINE & buf(i) ^= EOS; i = i + 1) ; c = buf(i) buf(i) = EOS w = width(buf(j)) for (k = 1; k <= w; k = k + 1) call putch(UNDERLINE, } tival = inval call skip(min(lsval-1, bottom-lineno)) lineno = lineno + lsval if (lineno > bottom) call pfoot return end #-t- put 13_39 ascii 08/30/83 12:30:00 #-h- putbak NE), chars(MAXCHARS), delim, cdate(20) integer pageno, lim(2) integer nc, itoc, i, j, n, left, right, gfield, ncd integer length include cpage include cparam include ctemp if (print == NO) return left = lim(1) + 1t(n), ttl) } } until (buf(i) == EOS | buf(i) == NEWLINE | n == 3) while (ttl(right-1) == BLANK) # trim blanks right = right - 1 ttl(right) = NEWLINE ttl(right+1) = EOS for (i = 1; i <= offset; i = i + 1)f llval = rmval - tival if (outw + w > llval | last >= MAXOUT) { # too big last = last - outp nextra = llval - outw for (outp = outp + 1; outp > 1; outp = outp - 1) if (outbuf(outp-1) == BLANK) 26 ascii 08/30/83 12:30:00 # set - set parameter and check range subroutine set(param, val, argtyp, defval, minval, maxval) integer argtyp, defval, maxval, minval, param, val if (argtyp == NEWLINE) # defaulted param = defval  STDOUT) for (k = 1; k <= w; k = k + 1) call putch(BACKSPACE, STDOUT) for (; j < i; j = j + 1) call putch(buf(j), STDOUT) buf(i) = c i = i - 1 } 1_105 ascii 08/30/83 12:30:00 # putbak - push character back onto input subroutine putbak(c) character c include cdefio bp = bp + 1 if (bp > BUFSIZE) call error("too many characters pushed back.") buf(bp) = c return  right = lim(2) + 1 nc = itoc(pageno, chars, MAXCHARS) call gdate (cdate, tbuf1) ncd = length(cdate) i = 1 delim = buf(i) for (j = 1; j < right; j = j + 1) ttl(j) = BLANK n = 0 repeat { n = n + 1  call putc(BLANK) # offset call putlin(ttl, STDOUT) return end #-t- puttl 9_81 ascii 08/30/83 12:30:00 #-h- putwrd 7_79 ascii 08/30/83 12:30:00 # putwrd - put a word in outbuf; includes margi nextra = nextra + 1 else break if (rjust == YES) { call spread(outbuf, outp, nextra, outwds) if (nextra > 0 & outwds > 1) outp = outp + nextra } call brk  else if (argtyp == PLUS) # relative + param = param + val else if (argtyp == MINUS) # relative - param = param - val else # absolute param = val param = min(param, maxval) param = max(param, mi   nval) return end #-t- set 3_126 ascii 08/30/83 12:30:00 #-h- skip 1_76 ascii 08/30/83 12:30:00 # skip - output n blank lines subroutine skip(n) integer i, n include cpage if (print call pfoot return end #-t- space 2_70 ascii 08/30/83 12:30:00 #-h- spread 7_58 ascii 08/30/83 12:30:00 # spread - spread words to justify right margin subroutine spread(buf, outp, nextra, outwds) if (dir == 0) nb = (ne-1) / nholes + 1 else nb = ne / nholes ne = ne - nb nholes = nholes - 1 for ( ; nb > 0; nb = nb - 1) { j = j - 1 buf(j) = BLANK + 1) { out(j) = subara(k) j = j + 1 } else { out(j) = in(i) j = j + 1 } out(j) = EOS return end #-t- subst 3_122 ascii 08/30) { # word underlining call underl(inbuf, wrdbuf, INSIZE) ulval = ulval - 1 } if (cuval > 0) { # continuous underlining if (cuflg == NO) { call scopy(inbuf, 1 0) { # centering call center(inbuf) call put(inbuf) ceval = ceval - 1 } else if (inbuf(1) == NEWLINE) # all blank line call put(inbuf) else if (fill == NO) #  == YES) for (i = 1; i <= n; i = i + 1) call putc(NEWLINE) return end #-t- skip 1_76 ascii 08/30/83 12:30:00 #-h- space 2_70 ascii 08/30/83 12:30:00 # space - space n lines or to bo character buf(MAXOUT) include cparam integer dir, i, j, nb, ne, nextra, nholes, outp, outwds data dir /0/ if (nextra <= 0 | outwds <= 1) return dir = 1 - dir # reverse previous direction ne = nextra nholes = ou } } i = i - 1 j = j - 1 } return end #-t- spread 7_58 ascii 08/30/83 12:30:00 #-h- subst 3_122 ascii 08/30/83 12:30:00 # subst - substitutes a string for a speci/83 12:30:00 #-h- text 14_55 ascii 08/30/83 12:30:00 # text - process text lines subroutine text(inbuf) character inbuf(INSIZE), wrdbuf(INSIZE) integer getwrb, length integer i, cuflg include cparam data cuflg, wrdbuf, 1) inbuf(1) = STARTU call scopy(wrdbuf, 1, inbuf, 2) cuflg = YES } cuval = cuval - 1 if (cuflg == YES & cuval == 0) { i = length(inbuf) inbuf(i) = STOPU unfilled text call put(inbuf) else { # filled text i = length(inbuf) inbuf(i) = BLANK if (inbuf(i-1) == PERIOD) { i = i + 1 inbuf(i) = BLANK } ttom of page subroutine space(n) integer n include cpage call brk if (lineno > bottom) return if (lineno == 0) call phead call skip(min(n, bottom+1-lineno)) lineno = lineno + n if (lineno > bottom) twds - 1 if (tival ^= inval & nholes > 1) nholes = nholes - 1 i = outp - 1 j = min(MAXOUT-2, i+ne) # leave room for NEWLINE, EOS while (i < j) { buf(j) = buf(i) if (buf(i) == BLANK & buf(i-1) ^= BLANK) { fied character subroutine subst(in, char, out, subara, n) character in(ARB), char, out(ARB), subara(ARB) integer i, j, k, n j = 1 for (i = 1; in(i) ^= EOS; i = i + 1) if (in(i) == char) for (k = 1; k <= n; k = k  /NO/ call doesc(inbuf, wrdbuf, INSIZE) # expand escapes call dotabs(inbuf, wrdbuf, INSIZE) # expand tabs if (inbuf(1) == BLANK | inbuf(1) == NEWLINE) call leadbl(inbuf) # move left, set tival if (ulval > 0 inbuf(i+1) = NEWLINE inbuf(i+2) = EOS cuflg = NO } } if (boval > 0) { # boldfacing call bold(inbuf, wrdbuf, INSIZE) boval = boval - 1 } if (ceval > inbuf(i+1) = EOS for (i = 1; getwrb(inbuf, i, wrdbuf) > 0; ) call putwrd(wrdbuf) } return end #-t- text 14_55 ascii 08/30/83 12:30:00 #-h- underl 6_91 ascii 08/30/83 12:30:00 #    underl - underline words in a line subroutine underl(buf, tbuf, size) integer i, j, size, t character buf(ARB), tbuf(ARB), type j = 1 # expand into tbuf i = 1 while (j < size - 1) { for (t = type(buf(i)); t ^= LETTERuf(j+1) = EOS call scopy(tbuf, 1, buf, 1) # copy it back to buf return end #-t- underl 6_91 ascii 08/30/83 12:30:00 #-h- width 2_83 ascii 08/30/83 12:30:00 # width - compute width of character strinsymbol table pointer common /croff/ st pointer st #-t- croff 0_82 ascii 08/30/83 12:30:00 #-h- defns 11_39 ascii 08/30/83 12:30:00 # include ratdef # define the following if you want format to outputWN,0) define(DEFINED,-1) define(LEFT,1) define(CENTER,2) define(RIGHT,3) define(STARTU,200) # start underscoring ifdef(NEGDEF, define(STARTU,-10)) define(STOPU,201) # stop underscoring ifdef(NEGDEF, define(STOPU,-11)) defCU,31) define(DE,32) define(EN,33) define(NR,34) define(ST,35) define(MC,36) #-t- defns 11_39 ascii 08/30/83 12:30:00 #-h- format.lst 2_10 ascii 08/30/83 12:30:00 format bold brk center comand comtyp då & t ^= DIGIT & t ^= NEWLINE & t ^= EOS; t = type(buf(i))) { tbuf(j) = buf(i) i = i + 1 j = j + 1 } if (buf(i) == EOS | buf(i) == NEWLINE) break tbuf(j) = STARTU j = j + 1 g integer function width(buf) character buf(MAXLINE) integer i width = 0 for (i = 1; buf(i) ^= EOS; i = i + 1) if (buf(i) == BACKSPACE) width = width - 1 else if (buf(i) >= BLANK & buf(i) <= TILDE)  a # page eject character (CNTRL-L) rather than count lines # to finish off a page # define(PAGECONTROL,) ifdef(VAX_VMS, define(PAGECONTROL,) ) define(ARGFLAG,DOLLAR) define(INSIZE,400) define(MAXOUT,400) deine(FI,1) define(NF,2) define(BR,3) define(LS,4) define(BP,5) define(SP,6) define(IN,7) define(RM,8) define(TI,9) define(CE,10) define(UL,11) define(HE,12) define(FO,13) define(PL,14) define(PO,15) defiodef doesc doroff dotabs eval ngetln gettl getval getwrb gfield init jcopy justify leadbl ngetch pbstr pfoot phead prmpt put putbak puttl putwrd set skip space spread subst text underl width #-t- format.lst 2_å for (t = type(buf(i)); t == LETTER | t == DIGIT | t == MINUS; t = type(buf(i))) { tbuf(j) = buf(i) i = i + 1 j = j + 1 } tbuf(j) = STOPU j = j + 1 } tbuf(j) = NEWLINE tb width = width + 1 return end #-t- width 2_83 ascii 08/30/83 12:30:00 #-t- format.rat 277_88 ascii 08/30/83 12:30:00 #-h- croff 0_82 ascii 08/30/83 12:30:00 # croff - used only in roff, fine(MAXDEF,200) define(NFILES,incr(MAXOFILES,-,4)) define(PAGENUM,SHARP) define(CURRENTDATE,PERCENT) define(PAGEJECT,12) #CNTRL-L define(PAGEWIDTH,65) define(PAGELEN,66) define(BUFSIZE,400) # push back buffer define(UNKNOne(BD,16) define(M1,17) define(M2,18) define(M3,19) define(M4,20) define(EH,21) define(OH,22) define(EF,23) define(OF,24) define(CC,25) define(NE,26) define(BS,27) define(JU,28) define(NJ,29) define(SO,30) define(10 ascii 08/30/83 12:30:00 ead prmpt put putbak puttl putwrd set skip space spread subst text underl width #-t- format.lst 2_å   å00 #-h- defns 1_34 ascii 08/30/83 12:30:00 # include ratdef define(NFILES,arith(MAXOFILES,-,4)) #(should be set to max nbr opened files # allowed - 4) #-t- defns  next } f = open(name, READ) if (f == ERR) call cant(name) else { call incl(f) call close(f) } } if (i == 1) # read from STDIN call incl(STDIN) DRETURN end #-in(line, infile(level)) ^= EOF) { loc = 1 len = getwrd(line, loc, str) if ((equal(str, incld) == NO) & (equal(str, bincld) == NO)) call putlin(line, STDOUT) else { level = leve101 ascii 08/30/83 12:30:00 #-h- getqw 5_46 ascii 08/30/83 12:30:00 ## getqw - get word or quoted word from in(i) into out; increment i integer function getqw (in, i, out) character in(ARB), out(ARB) integer i, j character qn end #-t- getqw 5_46 ascii 08/30/83 12:30:00 #-t- includ.rat 24_67 ascii 08/30/83 12:30:00 #-t- includ.ar 26_71 ascii 09/02/83 09:15:00 #-h- isam.ar 33_16 ascii 09/02/83 09:15:00 å 1_34 ascii 08/30/83 12:30:00 #-h- includ 5_30 ascii 08/30/83 12:30:00 # includ-concatenate args and replace include file by contents of file DRIVER character name(MAXLINE) integer i, f integer getarg, open, equal t- includ 5_30 ascii 08/30/83 12:30:00 #-h- incl 8_101 ascii 08/30/83 12:30:00 # incl - copy f to STDOUT, replacing include file by contents of file subroutine incl(f) integer f character line(MAXLINEl + 1 if (level > NFILES) call error("includes nested too deeply.") len = getqw(line, loc, str) infile(level) = open(str, READ) if (infile(level) == ERR) { call putlin(str,m integer getwrd while (in(i) == BLANK | in(i) == TAB) i = i + 1 if (in(i) == SQUOTE | in(i) == DQUOTE) { qm = in(i) j = 1 for (i=i+1; in(i) != qm & in(i) != EOS; i=i+1) {  #-h- list 0_17 ascii 08/30/83 12:30:00 cisam isam.rat #-t- list 0_17 ascii 08/30/83 12:30:00 #-h- cisam 2_92 ascii 08/30/83 12:30:00 common / cisam / dif, width, justfy, addr, oldadr #-h- includ.ar 26_71 ascii 09/02/83 09:15:00 #-h- list 0_12 ascii 08/30/83 12:30:00 includ.rat #-t- list 0_12 ascii 08/30/83 12:30:00 #-h- includ.rat 24_67 ascii 08/30/83 12:30: string dash "-" for (i = 1; getarg(i, name, MAXLINE) ^= EOF; i = i + 1) { if (name(1) == QMARK & name(2) == EOS) call error ("usage: includ [file].") if (equal(name, dash) == YES) { call incl(STDIN) ), str(MAXLINE) integer equal, getlin, getqw, open, getwrd integer infile(NFILES), len, level, loc, i string incld "include" string bincld "INCLUDE" infile(1) = f for (level = 1; level > 0; level = level - 1) { while (getl ERROUT) call remark(": can't include.") level = level - 1 } } } if (level > 1) call close(infile(level)) } return end #-t- incl 8_ out(j) = in(i) j = j + 1 } out(j) = EOS getqw = j - 1 if (in(i) != EOS) i = i + 1 #skip past ending quote } else getqw = getwrd(in, i, out) retur integer dif # number of CP/M blocks between isam'ed records integer width # width of key field in index integer justfy # type of justification desired on key; init = LEFT integer oldadr(2) # previous record address in   teger addr(2) # current record address #-t- cisam 2_92 ascii 08/30/83 12:30:00 #-h- isam.rat 27_47 ascii 08/30/83 12:30:00 #-h- isam.r 26_51 ascii 08/30/83 12:30:00 define(DEFAULT_WIDTH,25) de = getlin(buf, STDIN) if (status != EOF) { n = n + 1 i = 1 junk = getwrd(buf, i, word) if (doline(n) == YES) call outlin(word, addr) call ctoc(word, oldwrd, MAXLINE) call ptrcfor (i=1; getarg(i, arg, FILENAMESIZE) != EOF; i=i+1) { call fold(arg) if (arg(1) == MINUS) if (arg(2) == LETD) { j = 3 dif = ctoi(arg, j) if (dif <= 0)  call badarg(arg) else call badarg(arg) } return end subroutine outlin(word, addrs) character word(ARB) # linepointer addrs integer addrs(2) include cisam if (justfy == RIGHT) call putstr(word, wicupy 2 integer words integer addrs(2), fd include cisam integer iw if (width == 1) iw = 0 else iw = 6 call putint (addrs(1), iw, fd) call putch (BLANK, fd) call putint (addrs(2), iw, fd) return end # ptreq - compare pointers åfine(DEFAULT_DIF,8) define(LEFT,0) define(RIGHT,1) define(DEFAULT_JUSTFY,LEFT) define(NULLPOINTER,-1) #???? DRIVER(isam) integer n, status, i, junk integer getlin, getwrd, doline, ptreq character oldwrd(MAXLINE), buf(MAXLINE), word(MAXLIpy(addr, oldadr) } } until (status == EOF) if (doline(n) == NO & ptreq(oldadr, NULLPOINTER) == NO) call outlin(oldwrd, oldadr) DRETURN end integer function doline(n) integer n integer b include cisam b = addr(2) i dif = DEFAULT_DIF } else if (arg(2) == LETW) { j = 3 width = ctoi(arg, j) if (width <= 0) width = DEFAULT_WIDTH dth, STDOUT) else call putstr(word, -width, STDOUT) call putc(BLANK) call putptr(addrs, STDOUT) call putc(NEWLINE) return end ## ptrcpy - copy pointer subroutine ptrcpy (in, out) integer in(2), out(2) # Assume pointers occupy 2 iinteger function ptreq (a,b) integer a(2), b(2) if (a(1) == b(1) & a(2) == b(2)) return(YES) return(NO) end # badarg - complain and quit of arg error subroutine badarg(arg) character arg(ARB) call putlin(arg,STDERR) call error(" illegal ar#-h- lam.ar 22_39 ascii 09/02/83 09:15:00 #-h- list 0_9 ascii 08/30/83 12:30:00 lam.rat #-t- list 0_9 ascii 08/30/83 12:30:00 #-h- lam.rat 20_38 ascii 08/30/83 12:30:00 NE) include cisam call query("usage: isam [-d] [-w] [-j].") call getcmd # crack command line oldwrd(1) = EOS call ptrcpy(NULLPOINTER, oldadr) n = 0 repeat { call note(addr, STDIN) statusf (b != oldadr(2) & mod(b,dif) == 0) return(YES) return(NO) end subroutine getcmd character arg(FILENAMESIZE) integer getarg, ctoi integer i, j include cisam dif = DEFAULT_DIF width = DEFAULT_WIDTH justfy = DEFAULT_JUSTFY  } else if (arg(2) == LETJ) { if (arg(3) == LETL) justfy = LEFT else if (arg(3) == LETR) justfy = RIGHT } else nteger words if (in(1) == NULLPOINTER) { out(1) = NULLPOINTER out(2) = NULLPOINTER } else { out(1) = in(1) out(2) = in(2) } return end ## putptr - print pointer on output subroutine putptr (addrs, fd) # Assume pointers ocg.") return end #-t- isam.r 26_51 ascii 08/30/83 12:30:00 #-t- isam.rat 27_47 ascii 08/30/83 12:30:00 #-t- isam.ar 33_16 ascii 09/02/83 09:15:00  #-h- defns 1_43 ascii 08/30/83 12:30:00 # include ratdef define(MAXARGS,12) # max nbr args (files and strings) allowed define(MAXBUF,200) # buffer to hold strings define(MAXOBUF,500) # output buffer #-t- defns     1_43 ascii 08/30/83 12:30:00 #-h- lam 17_3 ascii 08/30/83 12:30:00 # lam - laminate named files DRIVER character lin(MAXLINE), buf(MAXBUF), obuf(MAXOBUF) integer bp, obp, i, j, junk, nfiles, len, fd(MAXARGS) l error("too many strings.") } else { nfiles = nfiles + 1 if (lin(1) == MINUS) fd(i) = STDIN else fd(i) = open(lin, READ) if (fd(i) == ERR) call cant(lin) ) { len = getlin(lin, fd(i)) if (len == EOF) { nfiles = nfiles - 1 if (fd(i) ^= STDIN) call close(fd(i)) fd(i) = EOF } else  17_3 ascii 08/30/83 12:30:00 #-t- lam.rat 20_38 ascii 08/30/83 12:30:00 #-t- lam.ar 22_39 ascii 09/02/83 09:15:00 #-h- ll.ar 15_36 ascii 09/02/83 09:15:00 #-h- list NE) integer open, getarg integer fd, i for (i = 1; getarg(i, arg, MAXNAME) ^= EOF; i = i + 1) { if (arg(1) == QMARK & arg(2) == EOS) call error ('usage: ll [file].') if (arg(1) == MINUS & arg(2) == EOS) ortest lines in fd subroutine doll(fd) integer fd character getch character c integer len, minl, maxl minl = HUGE maxl = 0 len = 0 while (getch(c, fd) ^= EOF) if (c == NEWLINE) { if (len > maxl)  integer open, getarg, getlin, addset character esc call query ("usage: lam [file | -sstring].") bp = 1 nfiles = 0 for (i = 1; getarg(i, lin, MAXLINE) ^= EOF; i = i + 1) { if (i > MAXARGS) call error("too many argume } } if (nfiles == 0) { nfiles = 1 fd(i) = STDIN } else i = i - 1 n = i for (obp = 1; nfiles > 0; obp = 1) { for (i = 1; i <= n; i = i + 1) { if (fd(i) < 0 ) # do stri { for (j = 1; j < len; j = j + 1) { if ( addset(lin(j), obuf, obp, MAXOBUF) == NO) call error ('output buffer exceeded.') } } } } # en 0_8 ascii 08/30/83 12:30:00 ll.rat #-t- list 0_8 ascii 08/30/83 12:30:00 #-h- ll.rat 13_36 ascii 08/30/83 12:30:00 #-h- defns 0_80 ascii 08/30/83 12:30:00 # include ratdef define(HUGE, fd = STDIN else fd = open(arg, READ) if (fd == ERR) call cant(arg) else { call doll(fd) if (fd != STDIN) { call putc(BLANK) call putlin(arg, maxl = len if (len < minl) minl = len len = 0 } else len = len + 1 if (minl == HUGE) minl = 0 call putdec(minl, 5) call putc(BLANK) call putdec(maxl, 5) DRETURN nts.") if (lin(1) == MINUS & lin(2) ^= EOS) { # -string fd(i) = -bp for (j = 2; lin(j) ^= EOS; j = j + 1) junk = addset(esc(lin, j), buf, bp, MAXBUF) if (addset(EOS, buf, bp, MAXBUF) == NO) calng { for (j = -fd(i); buf(j) ^= EOS; j = j + 1) { if ( addset(buf(j), obuf, obp, MAXOBUF) == NO) call error ('output buffer exceeded.') } } else if (fd(i) ^= EOFd of second 'for' loop if (nfiles > 0) { for (j = 1; j < obp; j = j + 1) call putch(obuf(j), STDOUT) call putch(NEWLINE, STDOUT) } } # end of main 'for' loop. DRETURN end #-t- lam 10000) # bigger than longest possible line #-t- defns 0_80 ascii 08/30/83 12:30:00 #-h- ll 10_92 ascii 08/30/83 12:30:00 # ll - prints length of shortest and longest lines DRIVER character arg(MAXLI STDOUT) call close(fd) } call putc(NEWLINE) } } if (i == 1) { # no args, do STDIN call doll(STDIN) call putc(NEWLINE) } end # doll - determine longest and sh end #-t- ll 10_92 ascii 08/30/83 12:30:00 #-t- ll.rat 13_36 ascii 08/30/83 12:30:00 #-t- ll.ar 15_36 ascii 09/02/83 09:15:00 #-h- logout.ar 5_99 ascii 09/02/83 09:15:00     #-h- list 0_12 ascii 08/30/83 12:30:00 logout.rat #-t- list 0_12 ascii 08/30/83 12:30:00 #-h- logout.rat 3_95 ascii 08/30/83 12:30:00 #-h- logout.r 2_99 ascii 08/30/83 12:30 5_99 ascii 09/02/83 09:15:00 #-h- ls.ar 92_108 ascii 09/02/83 09:15:00 #-h- list 0_13 ascii 08/30/83 12:30:00 cls ls.rat #-t- list 0_13 ascii 08/30/83 12:30:00 #-h- cls l #count of patterns integer linp #pointer (into Mem) for line pointers integer bufp #pointer (into Mem) for filename buffer integer maxptr #max number of filenames allowed integer maxtxt #max size of filename buffer integer nlines #number _79 ascii 08/30/83 12:30:00 define(MAXPAT,25) #max size of a pattern/expression define(MAX_POINTERS,50) #max filenames allowed define(NEXPR,15) #max command line expressions define(LOGPTR,20) #Smallest integer at least as big #as log(2) of max nbr f(CPM, integer getnde, dsget) DS_DECL(Mem, 1) include cls call initls (dir) if (dir(1) == EOS) call gwdir (dir, LOCAL) if (opendr (dir, fd) == ERR) call cant (dir) #Get space for names (CPM only) ifdef(CPM, maxptr = getnde(dir)  7_10 ascii 08/30/83 12:30:00 #-h- initls 12_31 ascii 08/30/83 12:30:00 ## initls - initialize and parse command line for ls subroutine initls (dir) character dir (ARB) integer getarg, index, isatty integer fnt:00 ## logout - clean up shell files and return to local system DRIVER(logout) include config integer flag flag = NO if (atend(1) != EOS) { flag = YES atend(1) = EOS } if (list == 1) { flag = YES list = 0 } if (vbose == 1) { f 8_60 ascii 08/30/83 12:30:00 ## cls - common block for ls integer verbos #flag for verbose listing (-v) integer sortit #flag for sorted listing (-s) integer packit #flag for columnated listing integer except #flag for locating all pof lines being used in buffer integer nextl #next place in buffer to use integer col #current output character column integer fd #file descriptor for directory common /cls/ verbos, sortit, packit, except, andpat, system, lspath, lines to be sorted define(LINESIZE,13) #output name width define(COLUMNS,5) #nbr output columns define(GUTTER,2) #white space between names define(CASE_INDEP,) #set if case (upper/lower) is to be ignored define(SORTBYDEFAULT,YES) #-t- defns  maxtxt = FILENAMESIZE * maxptr linp = dsget (maxptr) bufp = dsget (maxtxt/2) ) repeat { len = gdrprm (fd, file) if (len == EOF) break file(len+1) = NEWLINE #necessary for pattern matching file(len+2) = EOS ifdef(CASE_INDEP, call foldype integer i character buf(MAXLINE) string defpat "%" #use if no patterns given include cls DS_DECL(Mem,1) call query ("usage: ls [-ahpsxv] [directory] [patterns].") system = NO lspath = NO verbos = NO except = NO andpat = NO lag = YES vbose = 0 } if (flag == YES) call setenv call remove (shcmd) call exit return end #-t- logout.r 2_99 ascii 08/30/83 12:30:00 #-t- logout.rat 3_95 ascii 08/30/83 12:30:00 #-t- logout.ar atterns #except those noted (-x) integer andpat #flag for matching all patterns (-a) integer system #flag for listing "hidden" files (-h) integer lspath #flag for listing full path of files (-p) character pat #holds patterns integer eleve pat(MAXPAT, NEXPR), elevel, linp, bufp, maxptr, maxtxt, nlines, nextl, col, fd #-t- cls 8_60 ascii 08/30/83 12:30:00 #-h- ls.rat 81_47 ascii 08/30/83 12:30:00 #-h- defns 3 3_79 ascii 08/30/83 12:30:00 #-h- ls 7_10 ascii 08/30/83 12:30:00 ## ls - list contents of directory DRIVER(ls) character dir(FILENAMESIZE) character file(FILENAMESIZE) integer fmatch, gdrprm, opendr ifde(file)) if (fmatch(file) == YES) { file(len+1) = EOS #get rid of NEWLINE call holdf (file) } } call closdr (fd) if (sortit == YES) call quick (Mem(linp), nlines, Mem(bufp) ) #quicksort call outls(dir) DRETURN end #-t- ls  packit = isatty (STDOUT) sortit = SORTBYDEFAULT elevel = 0 dir(1) = EOS for (i=1; getarg(i, buf, MAXLINE) != EOF; i=i+1) { if (buf(1) == MINUS) #it's a flag { call fold (buf) if (index(buf, LETV) > 0) { verbos = YES; packit = NO }    if (index(buf, LETH) > 0) system = YES if (index(buf, LETP) > 0) lspath = YES if (index(buf, LETS) > 0) sortit = YES if (index(buf, LETX) > 0) except = YES if (index(buf, LETA) > 0) andpat = YES } else if (elevel==0 = 1 ifnotdef(CPM, maxptr = MAX_POINTERS maxtxt = FILENAMESIZE*maxptr linp = dsget(maxptr) bufp = dsget(maxtxt) ) return end #-t- initls 12_31 ascii 08/30/83 12:30:00 #-h- fntype 2_26 ascii 08/30/83 1B) integer gmatch, matchd include cls matchd = gmatch (file, pat, elevel, andpat) if ( (matchd == YES & except == NO) | (matchd == NO & except == YES) ) return (YES) else return (NO) end #-t- fmatch 2_56 asci 3_15 ascii 08/30/83 12:30:00 #-h- holdf 3_29 ascii 08/30/83 12:30:00 ## holdf - save filename for later output subroutine holdf (file) character file(ARB) integer length, len integer i include cls DS_DECL(Mem,1) learacter file(FILENAMESIZE) character dirpth(FILENAMESIZE) character info(MAXLINE) ifdef(CPM, character date(1)) ifnotdef(CPM, character date(MAXLINE)) include cls DS_DECL(Mem, 1) if (nlines <= 0) return call mkpath(dir,dirpth) call lowefo, date) call putlin (info, STDOUT) } call putch (NEWLINE, STDOUT) } } else { pagsiz = nlines/COLUMNS if (mod(nlines, COLUMNS) != 0) pagsiz = pagsiz + 1 call outbuf(pagsiz, LINESIZE, GUTTER) } return  & fntype(buf) == DIRECTORY) call scopy (buf, 1, dir, 1) else #it's a pattern { elevel = elevel + 1 ifdef(CASE_INDEP, call fold(buf) ) if (getpat (buf, pat(1, elevel)) == ERR) call error ("illegal pattern.") } } if (elevel ==2:30:00 ## fntype - find file name type, directory or file # CPM version integer function fntype(fn) character fn(FILENAMESIZE) byte packnm character tmp(16) if (packnm(fn,tmp) == ERR) return(ERR) if (tmp(2) == BLANK & tmp(10) == BLANK) return(i 08/30/83 12:30:00 #-h- gmatch 3_15 ascii 08/30/83 12:30:00 ## gmatch - check for match of all patterns integer function gmatch (lin, pat, elevel, andpat) integer elevel, andpat, match, i, status character lin(ARB), pat(MAXPATn = length(file) + 1 nlines = nlines + 1 if (len > (maxtxt-nextl) | nlines > maxptr) call error ("out of buffer space.") call scopy (file, 1, Mem(bufp), nextl) i = linp + nlines - 1 Mem(i) = nextl nextl = nextl + len return end #-t- r(dirpth) i = length(dirpth) if (dirpth(i) != SLASH) { dirpth(i+1) = SLASH dirpth(i+2) = EOS } if (packit == NO | lspath == YES) { for (i=1; i<= nlines; i=i+1) { k = linp + i - 1 j = Mem(k) call scopy (Mem(bufp), j, file, 1) end #-t- outls 9_14 ascii 08/30/83 12:30:00 #-h- quick 10_112 ascii 08/30/83 12:30:00 ## quick - quicksort for character lines subroutine quick(linptr, nlines, linbuf) character linbuf(ARB) inte 0) { elevel = 1 if (getpat (defpat, pat(1,elevel)) == ERR) call error ("illegal default pattern.") } # get space for the filenames # (NOTE: CPM needs the directory name, # so its space will be retrieved late nlines = 0 nextlDIRECTORY) return(FILENAME) end #-t- fntype 2_26 ascii 08/30/83 12:30:00 #-h- fmatch 2_56 ascii 08/30/83 12:30:00 ## fmatch - see if filename matches patterns integer function fmatch (file) character file(AR, NEXPR) gmatch = andpat for (i=1; i <= elevel; i=i+1) { status = match (lin, pat(1,i)) if (andpat == NO & status == YES) return (YES) else if (andpat == YES & status == NO) return (NO) } return end #-t- gmatch holdf 3_29 ascii 08/30/83 12:30:00 #-h- outls 9_14 ascii 08/30/83 12:30:00 ## outls - output filenames for ls subroutine outls(dir) integer i, j, k, pagsiz integer length character dir(FILENAMESIZE) ch if (lspath == YES) call putlin (dirpth, STDOUT) call putlin (file, STDOUT) if (verbos == YES) #print auxilliary info { n = LINESIZE - length(file) for (m=1; m <= n; m=m+1) call putch(BLANK, STDOUT) call gdraux (fd, file, inger compar integer i, j, linptr(ARB), lv(LOGPTR), nlines, p, pivlin, uv(LOGPTR) lv(1) = 1 uv(1) = nlines p = 1 while (p > 0) if (lv(p) >= uv(p)) # only one element in this subset p = p - 1 #    pop stack else { i = lv(p) - 1 j = uv(p) pivlin = linptr(j) # pivot line while (i < j) { for (i=i+1; compar(linptr(i), pivlin, linbuf) < 0; i=i+1) ; ) = i + 1 } else { lv(p+1) = i + 1 uv(p+1) = uv(p) uv(p) = i - 1 } p = p + 1 # push onto stack } return end #-t- quick lp2, linbuf) character linbuf(ARB) integer k, lp1, lp2 k = lp1 lp1 = lp2 lp2 = k return end #-t- exchan 1_92 ascii 08/30/83 12:30:00 #-h- outbuf 5_27 ascii 08/30/83 12ll outtab (l) l = Mem(k) call outlin (Mem(bufp), l) Mem(k) = 0 #zero line pointer } call outch(NEWLINE) } return end #-t- outbuf 5_27 ascii 08/30/83 12:30:00 #-h- outch  call outch(str(i)) return end #-t- outlin 1_73 ascii 08/30/83 12:30:00 #-h- outtab 1_40 ascii 08/30/83 12:30:00 ## outtab - tab to column n on formatted page subroutine outtab(n) integer n åfor (j = j - 1; j > i; j = j - 1) if (compar(linptr(j), pivlin, linbuf) <= 0) break if (i < j) # out of order pair call exchan(linptr(i), linptr(j), linbuf) }  10_112 ascii 08/30/83 12:30:00 #-h- compar 1_71 ascii 08/30/83 12:30:00 ## compar - compare linbuf(lp1) with linbuf(lp2) integer function compar (lp1, lp2, linbuf) character linbuf(ARB) integer strcmp compar :30:00 ## outbuf - dump buffer to formatted page subroutine outbuf(pagsiz, linsiz, gutsiz) integer pagsiz, linsiz, gutsiz integer i, j, k, l include cls DS_DECL(Mem, 1) col = 0 for (i=1; i<=nlines; i=i+1) { k = linp + i - 1_72 ascii 08/30/83 12:30:00 ## outch - output c to formatted page subroutine outch(c) character c include cls call putc(c) if (c == NEWLINE) col = 0 else col = col + 1 return end #-t- outch  include cls while (col < n) call outch(BLANK) return end #-t- outtab 1_40 ascii 08/30/83 12:30:00 #-t- ls.rat 81_47 ascii 08/30/83 12:30:00 #-t- ls.ar 92_108 ascii 09/02/83 Disk 2 of 3 for the Carousel MicroTools Builder ToolBook (V2.0) Files on this diskette are copyrighted (c) 1983 by Carousel MicroTools, Inc., and may be used only in accordance with a duly executed software license from Carousel MicroTools, Inc.  j = uv(p) # move pivot to position i call exchan(linptr(i), linptr(j), linbuf) if (i-lv(p) < uv(p)-i) { # stack so shorter done first lv(p+1) = lv(p) uv(p+1) = i - 1 lv(p= strcmp (linbuf(lp1), linbuf(lp2)) return end #-t- compar 1_71 ascii 08/30/83 12:30:00 #-h- exchan 1_92 ascii 08/30/83 12:30:00 ## exchan - exchange linbuf(lp1) with linbuf(lp2) subroutine exchan(lp1,  1 if (Mem(k) == 0) break l = Mem(k) call outlin (Mem(bufp), l) Mem(k) = 0 #zero-out line pointer for (j=i+pagsiz; j<=nlines; j=j+pagsiz) { k = linp + j - 1 if (Mem(k) == 0) break l = (linsiz + gutsiz) * max( (j-1)/pagsiz, 1) ca 1_72 ascii 08/30/83 12:30:00 #-h- outlin 1_73 ascii 08/30/83 12:30:00 ## outlin - output str to formatted page subroutine outlin(str, l) character str(ARB) integer i, l for (i = l; str(i) ^= EOS; i = i + 1) 09:15:00 /83 12:30:00 #-t- ls.rat 81_47 ascii 08/30/83 12:30:00 #-t- ls.ar 92_108 ascii 09/02/83 å   åååååååååååååååååå   åååååååååååååååååå   åååååååååååååååååå   åååååååååååååååååå   åååååååååååååååååå   åååååååååååååååååå   åååååååååååååååååå    åååååååååååååååååå    åååååååååååååååååå!   åååååååååååååååååå!   åååååååååååååååååå"   åååååååååååååååååå"   åååååååååååååååååå#   åååååååååååååååååå#   åååååååååååååååååå$   åååååååååååååååååå$   åååååååååååååååååå%   åååååååååååååååååå%   åååååååååååååååååå&   åååååååååååååååååå&   åååååååååååååååååå'   åååååååååååååååååå'   åååååååååååååååååå