diff options
| author | Joe Hunkeler <jhunkeler@gmail.com> | 2015-08-11 16:51:37 -0400 |
|---|---|---|
| committer | Joe Hunkeler <jhunkeler@gmail.com> | 2015-08-11 16:51:37 -0400 |
| commit | 40e5a5811c6ffce9b0974e93cdd927cbcf60c157 (patch) | |
| tree | 4464880c571602d54f6ae114729bf62a89518057 /unix/boot/spp/rpp/ratlibf | |
| download | iraf-osx-40e5a5811c6ffce9b0974e93cdd927cbcf60c157.tar.gz | |
Repatch (from linux) of OSX IRAF
Diffstat (limited to 'unix/boot/spp/rpp/ratlibf')
73 files changed, 1798 insertions, 0 deletions
diff --git a/unix/boot/spp/rpp/ratlibf/README b/unix/boot/spp/rpp/ratlibf/README new file mode 100644 index 00000000..52be57b2 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/README @@ -0,0 +1 @@ +RPP/RATLIBF -- Fortran source for the library utilities used by the RPP program. diff --git a/unix/boot/spp/rpp/ratlibf/addset.f b/unix/boot/spp/rpp/ratlibf/addset.f new file mode 100644 index 00000000..629b4b91 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/addset.f @@ -0,0 +1,13 @@ + integer function addset (c, str, j, maxsiz) + integer j, maxsiz + integer c, str (maxsiz) + if (.not.(j .gt. maxsiz))goto 23000 + addset = 0 + goto 23001 +23000 continue + str(j) = c + j = j + 1 + addset = 1 +23001 continue + return + end diff --git a/unix/boot/spp/rpp/ratlibf/addstr.f b/unix/boot/spp/rpp/ratlibf/addstr.f new file mode 100644 index 00000000..eedc7cf3 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/addstr.f @@ -0,0 +1,16 @@ + integer function addstr (s, str, j, maxsiz) + integer j, maxsiz + integer s (100), str (maxsiz) + integer i, addset + i = 1 +23000 if (.not.(s (i) .ne. -2))goto 23002 + if (.not.(addset (s (i), str, j, maxsiz) .eq. 0))goto 23003 + addstr = 0 + return +23003 continue +23001 i = i + 1 + goto 23000 +23002 continue + addstr = 1 + return + end diff --git a/unix/boot/spp/rpp/ratlibf/amatch.f b/unix/boot/spp/rpp/ratlibf/amatch.f new file mode 100644 index 00000000..fe23fb53 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/amatch.f @@ -0,0 +1,68 @@ + integer function amatch (lin, from, pat, tagbeg, tagend) + integer lin (128), pat (128) + integer from, tagbeg (10), tagend (10) + integer i, j, offset, stack + integer omatch, patsiz + i = 1 +23000 if (.not.(i .le. 10))goto 23002 + tagbeg (i) = 0 + tagend (i) = 0 +23001 i = i + 1 + goto 23000 +23002 continue + tagbeg (1) = from + stack = 0 + offset = from + j = 1 +23003 if (.not.(pat (j) .ne. -2))goto 23005 + if (.not.(pat (j) .eq. 42))goto 23006 + stack = j + j = j + 4 + i = offset +23008 if (.not.(lin (i) .ne. -2))goto 23010 + if (.not.(omatch (lin, i, pat, j) .eq. 0))goto 23011 + goto 23010 +23011 continue +23009 goto 23008 +23010 continue + pat (stack + 1) = i - offset + pat (stack + 3) = offset + offset = i + goto 23007 +23006 continue + if (.not.(pat (j) .eq. 123))goto 23013 + i = pat (j + 1) + tagbeg (i + 1) = offset + goto 23014 +23013 continue + if (.not.(pat (j) .eq. 125))goto 23015 + i = pat (j + 1) + tagend (i + 1) = offset + goto 23016 +23015 continue + if (.not.(omatch (lin, offset, pat, j) .eq. 0))goto 23017 +23019 if (.not.(stack .gt. 0))goto 23021 + if (.not.(pat (stack + 1) .gt. 0))goto 23022 + goto 23021 +23022 continue +23020 stack = pat (stack + 2) + goto 23019 +23021 continue + if (.not.(stack .le. 0))goto 23024 + amatch = 0 + return +23024 continue + pat (stack + 1) = pat (stack + 1) - 1 + j = stack + 4 + offset = pat (stack + 3) + pat (stack + 1) +23017 continue +23016 continue +23014 continue +23007 continue +23004 j = j + patsiz (pat, j) + goto 23003 +23005 continue + amatch = offset + tagend (1) = offset + return + end diff --git a/unix/boot/spp/rpp/ratlibf/catsub.f b/unix/boot/spp/rpp/ratlibf/catsub.f new file mode 100644 index 00000000..a7dbc318 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/catsub.f @@ -0,0 +1,28 @@ + subroutine catsub (lin, from, to, sub, new, k, maxnew) + integer lin(128) + integer from(10), to(10) + integer maxnew + integer sub(maxnew), new(128) + integer k + integer i, j, junk, ri + integer addset + i = 1 +23000 if (.not.(sub (i) .ne. -2))goto 23002 + if (.not.(sub (i) .eq. -3))goto 23003 + i = i + 1 + ri = sub (i) + 1 + j = from (ri) +23005 if (.not.(j .lt. to (ri)))goto 23007 + junk = addset (lin (j), new, k, maxnew) +23006 j = j + 1 + goto 23005 +23007 continue + goto 23004 +23003 continue + junk = addset (sub (i), new, k, maxnew) +23004 continue +23001 i = i + 1 + goto 23000 +23002 continue + return + end diff --git a/unix/boot/spp/rpp/ratlibf/clower.f b/unix/boot/spp/rpp/ratlibf/clower.f new file mode 100644 index 00000000..e001f4fd --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/clower.f @@ -0,0 +1,12 @@ + integer function clower(c) + integer c + integer k + if (.not.(c .ge. 65 .and. c .le. 90))goto 23000 + k = 97 - 65 + clower = c + k + goto 23001 +23000 continue + clower = c +23001 continue + return + end diff --git a/unix/boot/spp/rpp/ratlibf/concat.f b/unix/boot/spp/rpp/ratlibf/concat.f new file mode 100644 index 00000000..9385f2d1 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/concat.f @@ -0,0 +1,8 @@ + subroutine concat (buf1, buf2, outstr) + integer buf1(100), buf2(100), outstr(100) + integer i + i = 1 + call stcopy (buf1, 1, outstr, i) + call scopy (buf2, 1, outstr, i) + return + end diff --git a/unix/boot/spp/rpp/ratlibf/ctoc.f b/unix/boot/spp/rpp/ratlibf/ctoc.f new file mode 100644 index 00000000..a5d3d4b3 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/ctoc.f @@ -0,0 +1,14 @@ + integer function ctoc (from, to, len) + integer len + integer from (100), to (len) + integer i + i = 1 +23000 if (.not.(i .lt. len .and. from (i) .ne. -2))goto 23002 + to (i) = from (i) +23001 i = i + 1 + goto 23000 +23002 continue + to (i) = -2 + ctoc=(i - 1) + return + end diff --git a/unix/boot/spp/rpp/ratlibf/ctoi.f b/unix/boot/spp/rpp/ratlibf/ctoi.f new file mode 100644 index 00000000..8aa92061 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/ctoi.f @@ -0,0 +1,26 @@ + integer function ctoi(in, i) + integer in (100) + integer i + integer d + external index + integer index + integer digits(11) + data digits (1) /48/, digits (2) /49/, digits (3) /50/, digits (4) + * /51/, digits (5) /52/, digits (6) /53/, digits (7) /54/, digits ( + *8) /55/, digits (9) /56/, digits (10) /57/, digits (11) /-2/ +23000 if (.not.(in (i) .eq. 32 .or. in (i) .eq. 9))goto 23001 + i = i + 1 + goto 23000 +23001 continue + ctoi = 0 +23002 if (.not.(in (i) .ne. -2))goto 23004 + d = index (digits, in (i)) + if (.not.(d .eq. 0))goto 23005 + goto 23004 +23005 continue + ctoi = 10 * ctoi + d - 1 +23003 i = i + 1 + goto 23002 +23004 continue + return + end diff --git a/unix/boot/spp/rpp/ratlibf/ctomn.f b/unix/boot/spp/rpp/ratlibf/ctomn.f new file mode 100644 index 00000000..a2e0294e --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/ctomn.f @@ -0,0 +1,30 @@ + integer function ctomn (c, rep) + integer c, rep (4) + integer i + integer length + integer mntext (136) + data mntext / 78, 85, 76, -2, 83, 79, 72, -2, 83, 84, 88, -2, 69, + * 84, 88, -2, 69, 79, 84, -2, 69, 78, 81, -2, 65, 67, 75, -2, 66, 6 + *9, 76, -2, 66, 83, -2, -2, 72, 84, -2, -2, 76, 70, -2, -2, 86, 84, + * -2, -2, 70, 70, -2, -2, 67, 82, -2, -2, 83, 79, -2, -2, 83, 73, - + *2, -2, 68, 76, 69, -2, 68, 67, 49, -2, 68, 67, 50, -2, 68, 67, 51, + * -2, 68, 67, 52, -2, 78, 65, 75, -2, 83, 89, 78, -2, 69, 84, 66, - + *2, 67, 65, 78, -2, 69, 77, -2, -2, 83, 85, 66, -2, 69, 83, 67, -2, + * 70, 83, -2, -2, 71, 83, -2, -2, 82, 83, -2, -2, 85, 83, -2, -2, 8 + *3, 80, -2, -2, 68, 69, 76, -2/ + i = mod (max0(c,0), 128) + if (.not.(0 .le. i .and. i .le. 32))goto 23000 + call scopy (mntext, 4 * i + 1, rep, 1) + goto 23001 +23000 continue + if (.not.(i .eq. 127))goto 23002 + call scopy (mntext, 133, rep, 1) + goto 23003 +23002 continue + rep (1) = c + rep (2) = -2 +23003 continue +23001 continue + ctomn=(length (rep)) + return + end diff --git a/unix/boot/spp/rpp/ratlibf/cupper.f b/unix/boot/spp/rpp/ratlibf/cupper.f new file mode 100644 index 00000000..549ee9df --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/cupper.f @@ -0,0 +1,10 @@ + integer function cupper (c) + integer c + if (.not.(c .ge. 97 .and. c .le. 122))goto 23000 + cupper = c + (65 - 97) + goto 23001 +23000 continue + cupper = c +23001 continue + return + end diff --git a/unix/boot/spp/rpp/ratlibf/delete.f b/unix/boot/spp/rpp/ratlibf/delete.f new file mode 100644 index 00000000..92d5fb37 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/delete.f @@ -0,0 +1,13 @@ + subroutine delete (symbol, st) + integer symbol (100) + integer st + integer mem( 1) + common/cdsmem/mem + integer stlu + integer node, pred + if (.not.(stlu (symbol, node, pred, st) .eq. 1))goto 23000 + mem (pred + 0) = mem (node + 0) + call dsfree (node) +23000 continue + return + end diff --git a/unix/boot/spp/rpp/ratlibf/docant.f b/unix/boot/spp/rpp/ratlibf/docant.f new file mode 100644 index 00000000..0bcdd7ca --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/docant.f @@ -0,0 +1,13 @@ + subroutine docant(name) + integer name(100), prog(30) + integer length + integer getarg + length = getarg(0, prog, 30) + if (.not.(length .ne. -1))goto 23000 + call putlin(prog, 2) + call putch(58, 2) + call putch(32, 2) +23000 continue + call cant(name) + return + end diff --git a/unix/boot/spp/rpp/ratlibf/dodash.f b/unix/boot/spp/rpp/ratlibf/dodash.f new file mode 100644 index 00000000..63dd7e48 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/dodash.f @@ -0,0 +1,18 @@ + subroutine dodash (valid, array, i, set, j, maxset) + integer i, j, maxset + integer valid (100), array (100), set (maxset) + integer esc + integer junk, k, limit + external index + integer addset, index + i = i + 1 + j = j - 1 + limit = index (valid, esc (array, i)) + k = index (valid, set (j)) +23000 if (.not.(k .le. limit))goto 23002 + junk = addset (valid (k), set, j, maxset) +23001 k = k + 1 + goto 23000 +23002 continue + return + end diff --git a/unix/boot/spp/rpp/ratlibf/dsdbiu.f b/unix/boot/spp/rpp/ratlibf/dsdbiu.f new file mode 100644 index 00000000..62efd56e --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/dsdbiu.f @@ -0,0 +1,47 @@ + subroutine dsdbiu (b, form) + integer b + integer form + integer mem( 1) + common/cdsmem/mem + integer l, s, lmax + integer blanks(6) + data blanks(1)/9/,blanks(2)/32/,blanks(3)/32/,blanks(4)/32/,blanks + *(5)/32/,blanks(6)/-2/ + call putint (b, 5, 2) + call putch (32, 2) + call putint (mem (b + 0), 0, 2) + call remark (14H words in use.) + l = 0 + s = b + mem (b + 0) + if (.not.(form .eq. 48))goto 23000 + lmax = 5 + goto 23001 +23000 continue + lmax = 50 +23001 continue + b = b + 2 +23002 if (.not.(b .lt. s))goto 23004 + if (.not.(l .eq. 0))goto 23005 + call putlin (blanks, 2) +23005 continue + if (.not.(form .eq. 48))goto 23007 + call putint (mem (b), 10, 2) + goto 23008 +23007 continue + if (.not.(form .eq. 97))goto 23009 + call putch (mem (b), 2) +23009 continue +23008 continue + l = l + 1 + if (.not.(l .ge. lmax))goto 23011 + l = 0 + call putch (10, 2) +23011 continue +23003 b = b + 1 + goto 23002 +23004 continue + if (.not.(l .ne. 0))goto 23013 + call putch (10, 2) +23013 continue + return + end diff --git a/unix/boot/spp/rpp/ratlibf/dsdump.f b/unix/boot/spp/rpp/ratlibf/dsdump.f new file mode 100644 index 00000000..366bd5c4 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/dsdump.f @@ -0,0 +1,28 @@ + subroutine dsdump (form) + integer form + integer mem( 1) + common/cdsmem/mem + integer p, t, q + t = 2 + call remark (27H** DYNAMIC STORAGE DUMP **.) + call putint (1, 5, 2) + call putch (32, 2) + call putint (2 + 1, 0, 2) + call remark (14H words in use.) + p = mem (t + 1) +23000 if (.not.(p .ne. 0))goto 23001 + call putint (p, 5, 2) + call putch (32, 2) + call putint (mem (p + 0), 0, 2) + call remark (17H words available.) + q = p + mem (p + 0) +23002 if (.not.(q .ne. mem (p + 1) .and. q .lt. mem (1)))goto 23003 + call dsdbiu (q, form) + goto 23002 +23003 continue + p = mem (p + 1) + goto 23000 +23001 continue + call remark (15H** END DUMP **.) + return + end diff --git a/unix/boot/spp/rpp/ratlibf/dsfree.f b/unix/boot/spp/rpp/ratlibf/dsfree.f new file mode 100644 index 00000000..8ab2f2a0 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/dsfree.f @@ -0,0 +1,44 @@ + subroutine dsfree (block) + integer block + integer mem( 1) + common/cdsmem/mem + integer p0, p, q + integer n, junk + integer con (10) + p0 = block - 2 + n = mem (p0 + 0) + q = 2 +23000 continue + p = mem (q + 1) + if (.not.(p .eq. 0 .or. p .gt. p0))goto 23003 + goto 23002 +23003 continue + q = p +23001 goto 23000 +23002 continue + if (.not.(q + mem (q + 0) .gt. p0))goto 23005 + call remark (45Hin dsfree: attempt to free unallocated block.) + call remark (21Htype 'c' to continue.) + junk = getlin (con, 0) + if (.not.(con (1) .ne. 99 .and. con (1) .ne. 67))goto 23007 + call endst +23007 continue + return +23005 continue + if (.not.(p0 + n .eq. p .and. p .ne. 0))goto 23009 + n = n + mem (p + 0) + mem (p0 + 1) = mem (p + 1) + goto 23010 +23009 continue + mem (p0 + 1) = p +23010 continue + if (.not.(q + mem (q + 0) .eq. p0))goto 23011 + mem (q + 0) = mem (q + 0) + n + mem (q + 1) = mem (p0 + 1) + goto 23012 +23011 continue + mem (q + 1) = p0 + mem (p0 + 0) = n +23012 continue + return + end diff --git a/unix/boot/spp/rpp/ratlibf/dsget.f b/unix/boot/spp/rpp/ratlibf/dsget.f new file mode 100644 index 00000000..ef4fbcfe --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/dsget.f @@ -0,0 +1,45 @@ + integer function dsget (w) + integer w + integer mem( 1) + common/cdsmem/mem + integer p, q, l + integer n, k, junk + integer getlin + integer c (10) + n = w + 2 + q = 2 +23000 continue + p = mem (q + 1) + if (.not.(p .eq. 0))goto 23003 + call remark (31Hin dsget: out of storage space.) + call remark (41Htype 'c' or 'i' for char or integer dump.) + junk = getlin (c, 0) + if (.not.(c (1) .eq. 99 .or. c (1) .eq. 67))goto 23005 + call dsdump (97) + goto 23006 +23005 continue + if (.not.(c (1) .eq. 105 .or. c (1) .eq. 73))goto 23007 + call dsdump (48) +23007 continue +23006 continue + call error (19Hprogram terminated.) +23003 continue + if (.not.(mem (p + 0) .ge. n))goto 23009 + goto 23002 +23009 continue + q = p +23001 goto 23000 +23002 continue + k = mem (p + 0) - n + if (.not.(k .ge. 8))goto 23011 + mem (p + 0) = k + l = p + k + mem (l + 0) = n + goto 23012 +23011 continue + mem (q + 1) = mem (p + 1) + l = p +23012 continue + dsget=(l + 2) + return + end diff --git a/unix/boot/spp/rpp/ratlibf/dsinit.f b/unix/boot/spp/rpp/ratlibf/dsinit.f new file mode 100644 index 00000000..9eb0ebad --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/dsinit.f @@ -0,0 +1,17 @@ + subroutine dsinit (w) + integer w + integer mem( 1) + common/cdsmem/mem + integer t + if (.not.(w .lt. 2 * 2 + 2))goto 23000 + call error (42Hin dsinit: unreasonably small memory size.) +23000 continue + t = 2 + mem (t + 0) = 0 + mem (t + 1) = 2 + 2 + t = 2 + 2 + mem (t + 0) = w - 2 - 1 + mem (t + 1) = 0 + mem (1) = w + return + end diff --git a/unix/boot/spp/rpp/ratlibf/enter.f b/unix/boot/spp/rpp/ratlibf/enter.f new file mode 100644 index 00000000..6711c57d --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/enter.f @@ -0,0 +1,34 @@ + subroutine enter (symbol, info, st) + integer symbol (100) + integer info (100) + integer st + integer mem( 1) + common/cdsmem/mem + integer i, nodsiz, j + integer stlu, length + integer node, pred + integer dsget + nodsiz = mem (st) + if (.not.(stlu (symbol, node, pred, st) .eq. 0))goto 23000 + node = dsget (1 + nodsiz + length (symbol) + 1) + mem (node + 0) = 0 + mem (pred + 0) = node + i = 1 + j = node + 1 + nodsiz +23002 if (.not.(symbol (i) .ne. -2))goto 23003 + mem (j) = symbol (i) + i = i + 1 + j = j + 1 + goto 23002 +23003 continue + mem (j) = -2 +23000 continue + i = 1 +23004 if (.not.(i .le. nodsiz))goto 23006 + j = node + 1 + i - 1 + mem (j) = info (i) +23005 i = i + 1 + goto 23004 +23006 continue + return + end diff --git a/unix/boot/spp/rpp/ratlibf/equal.f b/unix/boot/spp/rpp/ratlibf/equal.f new file mode 100644 index 00000000..1148779c --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/equal.f @@ -0,0 +1,15 @@ + integer function equal (str1, str2) + integer str1(100), str2(100) + integer i + i = 1 +23000 if (.not.(str1 (i) .eq. str2 (i)))goto 23002 + if (.not.(str1 (i) .eq. -2))goto 23003 + equal=(1) + return +23003 continue +23001 i = i + 1 + goto 23000 +23002 continue + equal=(0) + return + end diff --git a/unix/boot/spp/rpp/ratlibf/error.f b/unix/boot/spp/rpp/ratlibf/error.f new file mode 100644 index 00000000..f4e15821 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/error.f @@ -0,0 +1,5 @@ + subroutine error (line) + integer line (100) + call remark (line) + call endst + end diff --git a/unix/boot/spp/rpp/ratlibf/errsub.f b/unix/boot/spp/rpp/ratlibf/errsub.f new file mode 100644 index 00000000..63aa3c0e --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/errsub.f @@ -0,0 +1,22 @@ + integer function errsub (arg, file, access) + integer arg (100), file (100) + integer access + if (.not.(arg (1) .eq. 63 .and. arg (2) .ne. 63 .and. arg (2) .ne. + * -2))goto 23000 + errsub = 1 + access = 2 + call scopy (arg, 2, file, 1) + goto 23001 +23000 continue + if (.not.(arg (1) .eq. 63 .and. arg (2) .eq. 63 .and. arg (3) .ne. + * -2))goto 23002 + errsub = 1 + access = 4 + call scopy (arg, 3, file, 1) + goto 23003 +23002 continue + errsub = 0 +23003 continue +23001 continue + return + end diff --git a/unix/boot/spp/rpp/ratlibf/esc.f b/unix/boot/spp/rpp/ratlibf/esc.f new file mode 100644 index 00000000..fd3ce7fe --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/esc.f @@ -0,0 +1,27 @@ + integer function esc (array, i) + integer array (100) + integer i + if (.not.(array (i) .ne. 64))goto 23000 + esc = array (i) + goto 23001 +23000 continue + if (.not.(array (i+1) .eq. -2))goto 23002 + esc = 64 + goto 23003 +23002 continue + i = i + 1 + if (.not.(array (i) .eq. 110 .or. array (i) .eq. 78))goto 23004 + esc = 10 + goto 23005 +23004 continue + if (.not.(array (i) .eq. 116 .or. array (i) .eq. 84))goto 23006 + esc = 9 + goto 23007 +23006 continue + esc = array (i) +23007 continue +23005 continue +23003 continue +23001 continue + return + end diff --git a/unix/boot/spp/rpp/ratlibf/fcopy.f b/unix/boot/spp/rpp/ratlibf/fcopy.f new file mode 100644 index 00000000..6c63dad8 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/fcopy.f @@ -0,0 +1,10 @@ + subroutine fcopy (in, out) + integer in, out + integer line (128) + integer getlin +23000 if (.not.(getlin (line, in) .ne. -1))goto 23001 + call putlin (line, out) + goto 23000 +23001 continue + return + end diff --git a/unix/boot/spp/rpp/ratlibf/filset.f b/unix/boot/spp/rpp/ratlibf/filset.f new file mode 100644 index 00000000..d5ada767 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/filset.f @@ -0,0 +1,63 @@ + subroutine filset (delim, array, i, set, j, maxset) + integer i, j, maxset + integer array (100), delim, set (maxset) + integer esc + integer junk + external index + integer addset, index + integer digits(11) + integer lowalf(27) + integer upalf(27) + data digits(1)/48/,digits(2)/49/,digits(3)/50/,digits(4)/51/,digit + *s(5)/52/,digits(6)/53/,digits(7)/54/,digits(8)/55/,digits(9)/56/,d + *igits(10)/57/,digits(11)/-2/ + data lowalf(1)/97/,lowalf(2)/98/,lowalf(3)/99/,lowalf(4)/100/,lowa + *lf(5)/101/,lowalf(6)/102/,lowalf(7)/103/,lowalf(8)/104/,lowalf(9)/ + *105/,lowalf(10)/106/,lowalf(11)/107/,lowalf(12)/108/,lowalf(13)/10 + *9/,lowalf(14)/110/,lowalf(15)/111/,lowalf(16)/112/,lowalf(17)/113/ + *,lowalf(18)/114/,lowalf(19)/115/,lowalf(20)/116/,lowalf(21)/117/,l + *owalf(22)/118/,lowalf(23)/119/,lowalf(24)/120/,lowalf(25)/121/,low + *alf(26)/122/,lowalf(27)/-2/ + data upalf(1)/65/,upalf(2)/66/,upalf(3)/67/,upalf(4)/68/,upalf(5)/ + *69/,upalf(6)/70/,upalf(7)/71/,upalf(8)/72/,upalf(9)/73/,upalf(10)/ + *74/,upalf(11)/75/,upalf(12)/76/,upalf(13)/77/,upalf(14)/78/,upalf( + *15)/79/,upalf(16)/80/,upalf(17)/81/,upalf(18)/82/,upalf(19)/83/,up + *alf(20)/84/,upalf(21)/85/,upalf(22)/86/,upalf(23)/87/,upalf(24)/88 + */,upalf(25)/89/,upalf(26)/90/,upalf(27)/-2/ +23000 if (.not.(array (i) .ne. delim .and. array (i) .ne. -2))goto 23002 + if (.not.(array (i) .eq. 64))goto 23003 + junk = addset (esc (array, i), set, j, maxset) + goto 23004 +23003 continue + if (.not.(array (i) .ne. 45))goto 23005 + junk = addset (array (i), set, j, maxset) + goto 23006 +23005 continue + if (.not.(j .le. 1 .or. array (i + 1) .eq. -2))goto 23007 + junk = addset (45, set, j, maxset) + goto 23008 +23007 continue + if (.not.(index (digits, set (j - 1)) .gt. 0))goto 23009 + call dodash (digits, array, i, set, j, maxset) + goto 23010 +23009 continue + if (.not.(index (lowalf, set (j - 1)) .gt. 0))goto 23011 + call dodash (lowalf, array, i, set, j, maxset) + goto 23012 +23011 continue + if (.not.(index (upalf, set (j - 1)) .gt. 0))goto 23013 + call dodash (upalf, array, i, set, j, maxset) + goto 23014 +23013 continue + junk = addset (45, set, j, maxset) +23014 continue +23012 continue +23010 continue +23008 continue +23006 continue +23004 continue +23001 i = i + 1 + goto 23000 +23002 continue + return + end diff --git a/unix/boot/spp/rpp/ratlibf/fmtdat.f b/unix/boot/spp/rpp/ratlibf/fmtdat.f new file mode 100644 index 00000000..7a81c9c8 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/fmtdat.f @@ -0,0 +1,23 @@ + subroutine fmtdat(date, time, now, form) + integer date(100), time(100) + integer now(7), form + date(1) = now(2) / 10 + 48 + date(2) = mod(now(2), 10) + 48 + date(3) = 47 + date(4) = now(3) / 10 + 48 + date(5) = mod(now(3), 10) + 48 + date(6) = 47 + date(7) = mod(now(1), 100) / 10 + 48 + date(8) = mod(now(1), 10) + 48 + date(9) = -2 + time(1) = now(4) / 10 + 48 + time(2) = mod(now(4), 10) + 48 + time(3) = 58 + time(4) = now(5) / 10 + 48 + time(5) = mod(now(5), 10) + 48 + time(6) = 58 + time(7) = now(6) / 10 + 48 + time(8) = mod(now(6), 10) + 48 + time(9) = -2 + return + end diff --git a/unix/boot/spp/rpp/ratlibf/fold.f b/unix/boot/spp/rpp/ratlibf/fold.f new file mode 100644 index 00000000..187bb721 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/fold.f @@ -0,0 +1,12 @@ + subroutine fold (token) + integer token (100) + integer clower + integer i + i = 1 +23000 if (.not.(token (i) .ne. -2))goto 23002 + token (i) = clower (token (i)) +23001 i = i + 1 + goto 23000 +23002 continue + return + end diff --git a/unix/boot/spp/rpp/ratlibf/gctoi.f b/unix/boot/spp/rpp/ratlibf/gctoi.f new file mode 100644 index 00000000..93ac3b6d --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/gctoi.f @@ -0,0 +1,61 @@ + integer function gctoi (str, i, radix) + integer str (100) + integer i, radix + integer base, v, d, j + external index + integer index + integer clower + logical neg + integer digits(17) + data digits(1)/48/,digits(2)/49/,digits(3)/50/,digits(4)/51/,digit + *s(5)/52/,digits(6)/53/,digits(7)/54/,digits(8)/55/,digits(9)/56/,d + *igits(10)/57/,digits(11)/97/,digits(12)/98/,digits(13)/99/,digits( + *14)/100/,digits(15)/101/,digits(16)/102/,digits(17)/-2/ + v = 0 + base = radix +23000 if (.not.(str (i) .eq. 32 .or. str (i) .eq. 9))goto 23001 + i = i + 1 + goto 23000 +23001 continue + neg = (str (i) .eq. 45) + if (.not.(str (i) .eq. 43 .or. str (i) .eq. 45))goto 23002 + i = i + 1 +23002 continue + if (.not.(str (i + 2) .eq. 114 .and. str (i) .eq. 49 .and. (48.le. + *str (i + 1).and.str (i + 1).le.57) .or. str (i + 1) .eq. 114 .and. + * (48.le.str (i).and.str (i).le.57)))goto 23004 + base = str (i) - 48 + j = i + if (.not.(str (i + 1) .ne. 114))goto 23006 + j = j + 1 + base = base * 10 + (str (j) - 48) +23006 continue + if (.not.(base .lt. 2 .or. base .gt. 16))goto 23008 + base = radix + goto 23009 +23008 continue + i = j + 2 +23009 continue +23004 continue +23010 if (.not.(str (i) .ne. -2))goto 23012 + if (.not.((48.le.str (i).and.str (i).le.57)))goto 23013 + d = str (i) - 48 + goto 23014 +23013 continue + d = index (digits, clower (str (i))) - 1 +23014 continue + if (.not.(d .lt. 0 .or. d .ge. base))goto 23015 + goto 23012 +23015 continue + v = v * base + d +23011 i = i + 1 + goto 23010 +23012 continue + if (.not.(neg))goto 23017 + gctoi=(-v) + return +23017 continue + gctoi=(+v) + return +23018 continue + end diff --git a/unix/boot/spp/rpp/ratlibf/getc.f b/unix/boot/spp/rpp/ratlibf/getc.f new file mode 100644 index 00000000..1dfabd93 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/getc.f @@ -0,0 +1,6 @@ + integer function getc (c) + integer c + integer getch + getc = getch (c, 0) + return + end diff --git a/unix/boot/spp/rpp/ratlibf/getccl.f b/unix/boot/spp/rpp/ratlibf/getccl.f new file mode 100644 index 00000000..67ac73fa --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/getccl.f @@ -0,0 +1,25 @@ + integer function getccl (arg, i, pat, j) + integer arg (128), pat (128) + integer i, j + integer jstart, junk + integer addset + i = i + 1 + if (.not.(arg (i) .eq. 126))goto 23000 + junk = addset (110, pat, j, 128) + i = i + 1 + goto 23001 +23000 continue + junk = addset (91, pat, j, 128) +23001 continue + jstart = j + junk = addset (0, pat, j, 128) + call filset (93, arg, i, pat, j, 128) + pat (jstart) = j - jstart - 1 + if (.not.(arg (i) .eq. 93))goto 23002 + getccl = -2 + goto 23003 +23002 continue + getccl = -3 +23003 continue + return + end diff --git a/unix/boot/spp/rpp/ratlibf/getpat.f b/unix/boot/spp/rpp/ratlibf/getpat.f new file mode 100644 index 00000000..02d00ace --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/getpat.f @@ -0,0 +1,6 @@ + integer function getpat (str, pat) + integer str (100), pat (100) + integer makpat + getpat=(makpat (str, 1, -2, pat)) + return + end diff --git a/unix/boot/spp/rpp/ratlibf/getwrd.f b/unix/boot/spp/rpp/ratlibf/getwrd.f new file mode 100644 index 00000000..f1c0f8d7 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/getwrd.f @@ -0,0 +1,20 @@ + integer function getwrd (in, i, out) + integer in (100), out (100) + integer i + integer j +23000 if (.not.(in (i) .eq. 32 .or. in (i) .eq. 9))goto 23001 + i = i + 1 + goto 23000 +23001 continue + j = 1 +23002 if (.not.(in (i) .ne. -2 .and. in (i) .ne. 32 .and. in (i) .ne. 9 + *.and. in (i) .ne. 10))goto 23003 + out (j) = in (i) + i = i + 1 + j = j + 1 + goto 23002 +23003 continue + out (j) = -2 + getwrd = j - 1 + return + end diff --git a/unix/boot/spp/rpp/ratlibf/gfnarg.f b/unix/boot/spp/rpp/ratlibf/gfnarg.f new file mode 100644 index 00000000..19d4655d --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/gfnarg.f @@ -0,0 +1,142 @@ + integer function gfnarg (name, state) + integer name (100) + integer state (4) + integer l + integer getarg, getlin + integer fd + integer rfopen + integer in1(12) + integer in2(12) + integer in3(12) + data in1(1)/47/,in1(2)/100/,in1(3)/101/,in1(4)/118/,in1(5)/47/,in1 + *(6)/115/,in1(7)/116/,in1(8)/100/,in1(9)/105/,in1(10)/110/,in1(11)/ + *49/,in1(12)/-2/ + data in2(1)/47/,in2(2)/100/,in2(3)/101/,in2(4)/118/,in2(5)/47/,in2 + *(6)/115/,in2(7)/116/,in2(8)/100/,in2(9)/105/,in2(10)/110/,in2(11)/ + *50/,in2(12)/-2/ + data in3(1)/47/,in3(2)/100/,in3(3)/101/,in3(4)/118/,in3(5)/47/,in3 + *(6)/115/,in3(7)/116/,in3(8)/100/,in3(9)/105/,in3(10)/110/,in3(11)/ + *51/,in3(12)/-2/ +23000 continue + if (.not.(state (1) .eq. 1))goto 23003 + state (1) = 2 + state (2) = 1 + state (3) = -3 + state (4) = 0 + goto 23004 +23003 continue + if (.not.(state (1) .eq. 2))goto 23005 + if (.not.(getarg (state (2), name, 128) .ne. -1))goto 23007 + state (1) = 2 + state (2) = state (2) + 1 + if (.not.(name (1) .ne. 45))goto 23009 + state (4) = state (4) + 1 + gfnarg=(-2) + return +23009 continue + if (.not.(name (2) .eq. -2))goto 23011 + call scopy (in1, 1, name, 1) + state (4) = state (4) + 1 + gfnarg=(-2) + return +23011 continue + if (.not.(name (2) .eq. 49 .and. name (3) .eq. -2))goto 23013 + call scopy (in1, 1, name, 1) + state (4) = state (4) + 1 + gfnarg=(-2) + return +23013 continue + if (.not.(name (2) .eq. 50 .and. name (3) .eq. -2))goto 23015 + call scopy (in2, 1, name, 1) + state (4) = state (4) + 1 + gfnarg=(-2) + return +23015 continue + if (.not.(name (2) .eq. 51 .and. name (3) .eq. -2))goto 23017 + call scopy (in3, 1, name, 1) + state (4) = state (4) + 1 + gfnarg=(-2) + return +23017 continue + if (.not.(name (2) .eq. 110 .or. name (2) .eq. 78))goto 23019 + state (1) = 3 + if (.not.(name (3) .eq. -2))goto 23021 + state (3) = 0 + goto 23022 +23021 continue + if (.not.(name (3) .eq. 49 .and. name (4) .eq. -2))goto 23023 + state (3) = stdin1 + goto 23024 +23023 continue + if (.not.(name (3) .eq. 50 .and. name (4) .eq. -2))goto 23025 + state (3) = stdin2 + goto 23026 +23025 continue + if (.not.(name (3) .eq. 51 .and. name (4) .eq. -2))goto 23027 + state (3) = stdin3 + goto 23028 +23027 continue + state (3) = rfopen(name (3), 1) + if (.not.(state (3) .eq. -3))goto 23029 + call putlin (name, 2) + call remark (14H: can't open.) + state (1) = 2 +23029 continue +23028 continue +23026 continue +23024 continue +23022 continue + goto 23020 +23019 continue + gfnarg=(-3) + return +23020 continue +23018 continue +23016 continue +23014 continue +23012 continue +23010 continue + goto 23008 +23007 continue + state (1) = 4 +23008 continue + goto 23006 +23005 continue + if (.not.(state (1) .eq. 3))goto 23031 + l = getlin (name, state (3)) + if (.not.(l .ne. -1))goto 23033 + name (l) = -2 + state (4) = state (4) + 1 + gfnarg=(-2) + return +23033 continue + if (.not.(fd .ne. -3 .and. fd .ne. 0))goto 23035 + call rfclos(state (3)) +23035 continue + state (1) = 2 + goto 23032 +23031 continue + if (.not.(state (1) .eq. 4))goto 23037 + state (1) = 5 + if (.not.(state (4) .eq. 0))goto 23039 + call scopy (in1, 1, name, 1) + gfnarg=(-2) + return +23039 continue + goto 23002 +23037 continue + if (.not.(state (1) .eq. 5))goto 23041 + goto 23002 +23041 continue + call error (32Hin gfnarg: bad state (1) value.) +23042 continue +23038 continue +23032 continue +23006 continue +23004 continue +23001 goto 23000 +23002 continue + name (1) = -2 + gfnarg=(-1) + return + end diff --git a/unix/boot/spp/rpp/ratlibf/index.f b/unix/boot/spp/rpp/ratlibf/index.f new file mode 100644 index 00000000..d5978954 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/index.f @@ -0,0 +1,13 @@ + integer function index (str, c) + integer str (100), c + index = 1 +23000 if (.not.(str (index) .ne. -2))goto 23002 + if (.not.(str (index) .eq. c))goto 23003 + return +23003 continue +23001 index = index + 1 + goto 23000 +23002 continue + index = 0 + return + end diff --git a/unix/boot/spp/rpp/ratlibf/insub.f b/unix/boot/spp/rpp/ratlibf/insub.f new file mode 100644 index 00000000..72e50ff1 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/insub.f @@ -0,0 +1,11 @@ + integer function insub (arg, file) + integer arg (100), file (100) + if (.not.(arg (1) .eq. 60 .and. arg (2) .ne. -2))goto 23000 + insub = 1 + call scopy (arg, 2, file, 1) + goto 23001 +23000 continue + insub = 0 +23001 continue + return + end diff --git a/unix/boot/spp/rpp/ratlibf/itoc.f b/unix/boot/spp/rpp/ratlibf/itoc.f new file mode 100644 index 00000000..3ceea6a7 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/itoc.f @@ -0,0 +1,35 @@ + integer function itoc (int, str, size) + integer int, size + integer str (100) + integer mod + integer d, i, intval, j, k + integer digits (11) + data digits (1) /48/, digits (2) /49/, digits (3) /50/, digits (4) + * /51/, digits (5) /52/, digits (6) /53/, digits (7) /54/, digits ( + *8) /55/, digits (9) /56/, digits (10) /57/, digits (11) /-2/ + intval = iabs (int) + str (1) = -2 + i = 1 +23000 continue + i = i + 1 + d = mod (intval, 10) + str (i) = digits (d+1) + intval = intval / 10 +23001 if (.not.(intval .eq. 0 .or. i .ge. size))goto 23000 +23002 continue + if (.not.(int .lt. 0 .and. i .lt. size))goto 23003 + i = i + 1 + str (i) = 45 +23003 continue + itoc = i - 1 + j = 1 +23005 if (.not.(j .lt. i))goto 23007 + k = str (i) + str (i) = str (j) + str (j) = k + i = i - 1 +23006 j = j + 1 + goto 23005 +23007 continue + return + end diff --git a/unix/boot/spp/rpp/ratlibf/length.f b/unix/boot/spp/rpp/ratlibf/length.f new file mode 100644 index 00000000..4bf20e40 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/length.f @@ -0,0 +1,9 @@ + integer function length (str) + integer str (100) + length = 0 +23000 if (.not.(str (length+1) .ne. -2))goto 23002 +23001 length = length + 1 + goto 23000 +23002 continue + return + end diff --git a/unix/boot/spp/rpp/ratlibf/locate.f b/unix/boot/spp/rpp/ratlibf/locate.f new file mode 100644 index 00000000..6db95e25 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/locate.f @@ -0,0 +1,16 @@ + integer function locate (c, pat, offset) + integer c, pat (128) + integer offset + integer i + i = offset + pat (offset) +23000 if (.not.(i .gt. offset))goto 23002 + if (.not.(c .eq. pat (i)))goto 23003 + locate=(1) + return +23003 continue +23001 i = i - 1 + goto 23000 +23002 continue + locate=(0) + return + end diff --git a/unix/boot/spp/rpp/ratlibf/lookup.f b/unix/boot/spp/rpp/ratlibf/lookup.f new file mode 100644 index 00000000..f70e9842 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/lookup.f @@ -0,0 +1,24 @@ + integer function lookup (symbol, info, st) + integer symbol (100) + integer info (100) + integer st + integer mem( 1) + common/cdsmem/mem + integer i, nodsiz, kluge + integer stlu + integer node, pred + if (.not.(stlu (symbol, node, pred, st) .eq. 0))goto 23000 + lookup = 0 + return +23000 continue + nodsiz = mem (st) + i = 1 +23002 if (.not.(i .le. nodsiz))goto 23004 + kluge = node + 1 - 1 + i + info (i) = mem (kluge) +23003 i = i + 1 + goto 23002 +23004 continue + lookup = 1 + return + end diff --git a/unix/boot/spp/rpp/ratlibf/lower.f b/unix/boot/spp/rpp/ratlibf/lower.f new file mode 100644 index 00000000..b3550701 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/lower.f @@ -0,0 +1,5 @@ + subroutine lower (token) + integer token (100) + call fold (token) + return + end diff --git a/unix/boot/spp/rpp/ratlibf/makpat.f b/unix/boot/spp/rpp/ratlibf/makpat.f new file mode 100644 index 00000000..27744665 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/makpat.f @@ -0,0 +1,90 @@ + integer function makpat (arg, from, delim, pat) + integer arg (128), delim, pat (128) + integer from + integer esc + integer i, j, junk, lastcl, lastj, lj, tagnst, tagnum, tagstk (9) + integer addset, getccl, stclos + j = 1 + lastj = 1 + lastcl = 0 + tagnum = 0 + tagnst = 0 + i = from +23000 if (.not.(arg (i) .ne. delim .and. arg (i) .ne. -2))goto 23002 + lj = j + if (.not.(arg (i) .eq. 63))goto 23003 + junk = addset (63, pat, j, 128) + goto 23004 +23003 continue + if (.not.(arg (i) .eq. 37 .and. i .eq. from))goto 23005 + junk = addset (37, pat, j, 128) + goto 23006 +23005 continue + if (.not.(arg (i) .eq. 36 .and. arg (i + 1) .eq. delim))goto 23007 + junk = addset (36, pat, j, 128) + goto 23008 +23007 continue + if (.not.(arg (i) .eq. 91))goto 23009 + if (.not.(getccl (arg, i, pat, j) .eq. -3))goto 23011 + makpat = -3 + return +23011 continue + goto 23010 +23009 continue + if (.not.(arg (i) .eq. 42 .and. i .gt. from))goto 23013 + lj = lastj + if (.not.(pat (lj) .eq. 37 .or. pat (lj) .eq. 36 .or. pat (lj) .eq + *. 42 .or. pat (lj) .eq. 123 .or. pat (lj) .eq. 125))goto 23015 + goto 23002 +23015 continue + lastcl = stclos (pat, j, lastj, lastcl) + goto 23014 +23013 continue + if (.not.(arg (i) .eq. 123))goto 23017 + if (.not.(tagnum .ge. 9))goto 23019 + goto 23002 +23019 continue + tagnum = tagnum + 1 + tagnst = tagnst + 1 + tagstk (tagnst) = tagnum + junk = addset (123, pat, j, 128) + junk = addset (tagnum, pat, j, 128) + goto 23018 +23017 continue + if (.not.(arg (i) .eq. 125 .and. tagnst .gt. 0))goto 23021 + junk = addset (125, pat, j, 128) + junk = addset (tagstk (tagnst), pat, j, 128) + tagnst = tagnst - 1 + goto 23022 +23021 continue + junk = addset (97, pat, j, 128) + junk = addset (esc (arg, i), pat, j, 128) +23022 continue +23018 continue +23014 continue +23010 continue +23008 continue +23006 continue +23004 continue + lastj = lj +23001 i = i + 1 + goto 23000 +23002 continue + if (.not.(arg (i) .ne. delim))goto 23023 + makpat = -3 + goto 23024 +23023 continue + if (.not.(addset (-2, pat, j, 128) .eq. 0))goto 23025 + makpat = -3 + goto 23026 +23025 continue + if (.not.(tagnst .ne. 0))goto 23027 + makpat = -3 + goto 23028 +23027 continue + makpat = i +23028 continue +23026 continue +23024 continue + return + end diff --git a/unix/boot/spp/rpp/ratlibf/maksub.f b/unix/boot/spp/rpp/ratlibf/maksub.f new file mode 100644 index 00000000..176c5321 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/maksub.f @@ -0,0 +1,40 @@ + integer function maksub (arg, from, delim, sub) + integer arg (128), delim, sub (128) + integer from + integer esc, type + integer i, j, junk + integer addset + j = 1 + i = from +23000 if (.not.(arg (i) .ne. delim .and. arg (i) .ne. -2))goto 23002 + if (.not.(arg (i) .eq. 38))goto 23003 + junk = addset (-3, sub, j, 128) + junk = addset (0, sub, j, 128) + goto 23004 +23003 continue + if (.not.(arg (i) .eq. 64 .and. type (arg (i + 1)) .eq. 48))goto 2 + *3005 + i = i + 1 + junk = addset (-3, sub, j, 128) + junk = addset (arg (i) - 48, sub, j, 128) + goto 23006 +23005 continue + junk = addset (esc (arg, i), sub, j, 128) +23006 continue +23004 continue +23001 i = i + 1 + goto 23000 +23002 continue + if (.not.(arg (i) .ne. delim))goto 23007 + maksub = -3 + goto 23008 +23007 continue + if (.not.(addset (-2, sub, j, 128) .eq. 0))goto 23009 + maksub = -3 + goto 23010 +23009 continue + maksub = i +23010 continue +23008 continue + return + end diff --git a/unix/boot/spp/rpp/ratlibf/match.f b/unix/boot/spp/rpp/ratlibf/match.f new file mode 100644 index 00000000..de4e3638 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/match.f @@ -0,0 +1,16 @@ + integer function match (lin, pat) + integer lin (128), pat (128) + integer i, junk (9) + integer amatch + i = 1 +23000 if (.not.(lin (i) .ne. -2))goto 23002 + if (.not.(amatch (lin, i, pat, junk, junk) .gt. 0))goto 23003 + match = 1 + return +23003 continue +23001 i = i + 1 + goto 23000 +23002 continue + match = 0 + return + end diff --git a/unix/boot/spp/rpp/ratlibf/mkpkg.sh b/unix/boot/spp/rpp/ratlibf/mkpkg.sh new file mode 100644 index 00000000..e9cb8822 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/mkpkg.sh @@ -0,0 +1,18 @@ +# Utility library subroutines for RPP. + +$F77 -c $HSI_FF addset.f addstr.f amatch.f catsub.f clower.f concat.f +$F77 -c $HSI_FF ctoc.f ctoi.f ctomn.f cupper.f delete.f docant.f dodash.f +$F77 -c $HSI_FF dsdbiu.f dsdump.f dsfree.f dsget.f dsinit.f enter.f equal.f +$F77 -c $HSI_FF error.f errsub.f esc.f fcopy.f filset.f fmtdat.f fold.f +$F77 -c $HSI_FF gctoi.f getc.f getccl.f getpat.f getwrd.f gfnarg.f index.f +$F77 -c $HSI_FF insub.f itoc.f length.f locate.f lookup.f lower.f makpat.f +$F77 -c $HSI_FF maksub.f match.f mktabl.f mntoc.f omatch.f outsub.f patsiz.f +$F77 -c $HSI_FF prompt.f putc.f putdec.f putint.f putstr.f query.f rmtabl.f +$F77 -c $HSI_FF scopy.f sctabl.f sdrop.f skipbl.f slstr.f stake.f stclos.f +$F77 -c $HSI_FF stcopy.f stlu.f strcmp.f strim.f termin.f trmout.f type.f +$F77 -c $HSI_FF upper.f wkday.f + +ar rv libf.a *.o +$RANLIB libf.a +mv -f libf.a .. +rm *.o diff --git a/unix/boot/spp/rpp/ratlibf/mktabl.f b/unix/boot/spp/rpp/ratlibf/mktabl.f new file mode 100644 index 00000000..9c3e7908 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/mktabl.f @@ -0,0 +1,17 @@ + integer function mktabl (nodsiz) + integer nodsiz + integer mem( 1) + common/cdsmem/mem + integer st + integer dsget + integer i + st = dsget (43 + 1) + mem (st) = nodsiz + mktabl = st + do 23000 i = 1, 43 + st = st + 1 + mem (st) = 0 +23000 continue +23001 continue + return + end diff --git a/unix/boot/spp/rpp/ratlibf/mntoc.f b/unix/boot/spp/rpp/ratlibf/mntoc.f new file mode 100644 index 00000000..5a54ec16 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/mntoc.f @@ -0,0 +1,52 @@ + integer function mntoc (buf, p, defalt) + integer buf (100), defalt + integer p + integer i, tp + integer equal + integer c, tmp (128) + integer text (170) + data text / 6, 97, 99, 107, -2, 7, 98, 101, 108, -2, 8, 98, 115, + *-2, -2, 24, 99, 97, 110, -2, 13, 99, 114, -2, -2, 17, 100, 99, 49, + * -2, 18, 100, 99, 50, -2, 19, 100, 99, 51, -2, 20, 100, 99, 52, -2 + *, 127, 100, 101, 108, -2, 16, 100, 108, 101, -2, 25, 101, 109, -2, + * -2, 5, 101, 110, 113, -2, 4, 101, 111, 116, -2, 27, 101, 115, 99, + * -2, 23, 101, 116, 98, -2, 3, 101, 116, 120, -2, 12, 102, 102, -2, + * -2, 28, 102, 115, -2, -2, 29, 103, 115, -2, -2, 9, 104, 116, -2, + *-2, 10, 108, 102, -2, -2, 21, 110, 97, 107, -2, 0, 110, 117, 108, + *-2, 30, 114, 115, -2, -2, 15, 115, 105, -2, -2, 14, 115, 111, -2, + *-2, 1, 115, 111, 104, -2, 32, 115, 112, -2, -2, 2, 115, 116, 120, + *-2, 26, 115, 117, 98, -2, 22, 115, 121, 110, -2, 31, 117, 115, -2, + * -2, 11, 118, 116, -2, -2/ + tp = 1 +23000 continue + tmp (tp) = buf (p) + tp = tp + 1 + p = p + 1 +23001 if (.not.(.not. (((65.le.buf (p).and.buf (p).le.90).or.(97.le.buf + *(p).and.buf (p).le.122)) .or. (48.le.buf (p).and.buf (p).le.57)) . + *or. tp .ge. 128))goto 23000 +23002 continue + tmp (tp) = -2 + if (.not.(tp .eq. 2))goto 23003 + c = tmp (1) + goto 23004 +23003 continue + call lower (tmp) + i = 1 +23005 if (.not.(i .lt. 170))goto 23007 + if (.not.(equal (tmp, text (i + 1)) .eq. 1))goto 23008 + goto 23007 +23008 continue +23006 i = i + 5 + goto 23005 +23007 continue + if (.not.(i .lt. 170))goto 23010 + c = text (i) + goto 23011 +23010 continue + c = defalt +23011 continue +23004 continue + mntoc=(c) + return + end diff --git a/unix/boot/spp/rpp/ratlibf/omatch.f b/unix/boot/spp/rpp/ratlibf/omatch.f new file mode 100644 index 00000000..60d57c83 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/omatch.f @@ -0,0 +1,60 @@ + integer function omatch (lin, i, pat, j) + integer lin (128), pat (128) + integer i, j + integer bump + integer locate + omatch = 0 + if (.not.(lin (i) .eq. -2))goto 23000 + return +23000 continue + bump = -1 + if (.not.(pat (j) .eq. 97))goto 23002 + if (.not.(lin (i) .eq. pat (j + 1)))goto 23004 + bump = 1 +23004 continue + goto 23003 +23002 continue + if (.not.(pat (j) .eq. 37))goto 23006 + if (.not.(i .eq. 1))goto 23008 + bump = 0 +23008 continue + goto 23007 +23006 continue + if (.not.(pat (j) .eq. 63))goto 23010 + if (.not.(lin (i) .ne. 10))goto 23012 + bump = 1 +23012 continue + goto 23011 +23010 continue + if (.not.(pat (j) .eq. 36))goto 23014 + if (.not.(lin (i) .eq. 10))goto 23016 + bump = 0 +23016 continue + goto 23015 +23014 continue + if (.not.(pat (j) .eq. 91))goto 23018 + if (.not.(locate (lin (i), pat, j + 1) .eq. 1))goto 23020 + bump = 1 +23020 continue + goto 23019 +23018 continue + if (.not.(pat (j) .eq. 110))goto 23022 + if (.not.(lin (i) .ne. 10 .and. locate (lin (i), pat, j + 1) .eq. + *0))goto 23024 + bump = 1 +23024 continue + goto 23023 +23022 continue + call error (24Hin omatch: can't happen.) +23023 continue +23019 continue +23015 continue +23011 continue +23007 continue +23003 continue + if (.not.(bump .ge. 0))goto 23026 + i = i + bump + omatch = 1 +23026 continue + return + end diff --git a/unix/boot/spp/rpp/ratlibf/outsub.f b/unix/boot/spp/rpp/ratlibf/outsub.f new file mode 100644 index 00000000..c8da87de --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/outsub.f @@ -0,0 +1,22 @@ + integer function outsub (arg, file, access) + integer arg (100), file (100) + integer access + if (.not.(arg (1) .eq. 62 .and. arg (2) .ne. 62 .and. arg (2) .ne. + * -2))goto 23000 + outsub = 1 + access = 2 + call scopy (arg, 2, file, 1) + goto 23001 +23000 continue + if (.not.(arg (1) .eq. 62 .and. arg (2) .eq. 62 .and. arg (3) .ne. + * -2))goto 23002 + access = 4 + outsub = 1 + call scopy (arg, 3, file, 1) + goto 23003 +23002 continue + outsub = 0 +23003 continue +23001 continue + return + end diff --git a/unix/boot/spp/rpp/ratlibf/patsiz.f b/unix/boot/spp/rpp/ratlibf/patsiz.f new file mode 100644 index 00000000..e15449de --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/patsiz.f @@ -0,0 +1,28 @@ + integer function patsiz (pat, n) + integer pat (128) + integer n + if (.not.(pat (n) .eq. 97 .or. pat (n) .eq. 123 .or. pat (n) .eq. + *125))goto 23000 + patsiz = 2 + goto 23001 +23000 continue + if (.not.(pat (n) .eq. 37 .or. pat (n) .eq. 36 .or. pat (n) .eq. 6 + *3))goto 23002 + patsiz = 1 + goto 23003 +23002 continue + if (.not.(pat (n) .eq. 91 .or. pat (n) .eq. 110))goto 23004 + patsiz = pat (n + 1) + 2 + goto 23005 +23004 continue + if (.not.(pat (n) .eq. 42))goto 23006 + patsiz = 4 + goto 23007 +23006 continue + call error (24Hin patsiz: can't happen.) +23007 continue +23005 continue +23003 continue +23001 continue + return + end diff --git a/unix/boot/spp/rpp/ratlibf/prompt.f b/unix/boot/spp/rpp/ratlibf/prompt.f new file mode 100644 index 00000000..64ab202e --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/prompt.f @@ -0,0 +1,11 @@ + subroutine prompt (str, buf, fd) + integer str(100), buf(100) + integer fd + integer isatty + if (.not.(isatty(fd) .eq. 1))goto 23000 + call putlin (str, fd) + call rfflus(fd) +23000 continue + call getlin (buf, fd) + return + end diff --git a/unix/boot/spp/rpp/ratlibf/putc.f b/unix/boot/spp/rpp/ratlibf/putc.f new file mode 100644 index 00000000..c3eecfde --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/putc.f @@ -0,0 +1,5 @@ + subroutine putc (c) + integer c + call putch (c, 1) + return + end diff --git a/unix/boot/spp/rpp/ratlibf/putdec.f b/unix/boot/spp/rpp/ratlibf/putdec.f new file mode 100644 index 00000000..878febcf --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/putdec.f @@ -0,0 +1,20 @@ + subroutine putdec(n,w) + integer n, w + integer chars (20) + integer i, nd + integer itoc + nd = itoc (n, chars, 20) + i = nd + 1 +23000 if (.not.(i .le. w))goto 23002 + call putc (32) +23001 i = i + 1 + goto 23000 +23002 continue + i = 1 +23003 if (.not.(i .le. nd))goto 23005 + call putc (chars (i)) +23004 i = i + 1 + goto 23003 +23005 continue + return + end diff --git a/unix/boot/spp/rpp/ratlibf/putint.f b/unix/boot/spp/rpp/ratlibf/putint.f new file mode 100644 index 00000000..182e96e2 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/putint.f @@ -0,0 +1,10 @@ + subroutine putint (n, w, fd) + integer n, w + integer fd + integer chars (20) + integer junk + integer itoc + junk = itoc (n, chars, 20) + call putstr (chars, w, fd) + return + end diff --git a/unix/boot/spp/rpp/ratlibf/putstr.f b/unix/boot/spp/rpp/ratlibf/putstr.f new file mode 100644 index 00000000..aaf0f060 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/putstr.f @@ -0,0 +1,27 @@ + subroutine putstr (str, w, fd) + integer str (100) + integer w + integer fd + integer length + integer i, len + len = length (str) + i = len + 1 +23000 if (.not.(i .le. w))goto 23002 + call putch (32, fd) +23001 i = i + 1 + goto 23000 +23002 continue + i = 1 +23003 if (.not.(i .le. len))goto 23005 + call putch (str (i), fd) +23004 i = i + 1 + goto 23003 +23005 continue + i = (-w) - len +23006 if (.not.(i .gt. 0))goto 23008 + call putch (32, fd) +23007 i = i - 1 + goto 23006 +23008 continue + return + end diff --git a/unix/boot/spp/rpp/ratlibf/query.f b/unix/boot/spp/rpp/ratlibf/query.f new file mode 100644 index 00000000..d12c514a --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/query.f @@ -0,0 +1,12 @@ + subroutine query (mesg) + integer mesg (100) + integer getarg + integer arg1 (3), arg2 (1) + if (.not.(getarg (1, arg1, 3) .ne. -1 .and. getarg (2, arg2, 1) .e + *q. -1))goto 23000 + if (.not.(arg1 (1) .eq. 63 .and. arg1 (2) .eq. -2))goto 23002 + call error (mesg) +23002 continue +23000 continue + return + end diff --git a/unix/boot/spp/rpp/ratlibf/rmtabl.f b/unix/boot/spp/rpp/ratlibf/rmtabl.f new file mode 100644 index 00000000..5b552cab --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/rmtabl.f @@ -0,0 +1,21 @@ + subroutine rmtabl (st) + integer st + integer mem( 1) + common/cdsmem/mem + integer i + integer walker, bucket, node + bucket = st + do 23000 i = 1, 43 + bucket = bucket + 1 + walker = mem (bucket) +23002 if (.not.(walker .ne. 0))goto 23003 + node = walker + walker = mem (node + 0) + call dsfree (node) + goto 23002 +23003 continue +23000 continue +23001 continue + call dsfree (st) + return + end diff --git a/unix/boot/spp/rpp/ratlibf/scopy.f b/unix/boot/spp/rpp/ratlibf/scopy.f new file mode 100644 index 00000000..a16bc5ee --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/scopy.f @@ -0,0 +1,15 @@ + subroutine scopy (from, i, to, j) + integer from (100), to (100) + integer i, j + integer k1, k2 + k2 = j + k1 = i +23000 if (.not.(from (k1) .ne. -2))goto 23002 + to (k2) = from (k1) + k2 = k2 + 1 +23001 k1 = k1 + 1 + goto 23000 +23002 continue + to (k2) = -2 + return + end diff --git a/unix/boot/spp/rpp/ratlibf/sctabl.f b/unix/boot/spp/rpp/ratlibf/sctabl.f new file mode 100644 index 00000000..1ba16897 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/sctabl.f @@ -0,0 +1,54 @@ + integer function sctabl (table, sym, info, posn) + integer table, posn + integer sym (100) + integer info (100) + integer mem( 1) + common/cdsmem/mem + integer bucket, walker + integer dsget + integer nodsiz, i, j + if (.not.(posn .eq. 0))goto 23000 + posn = dsget (2) + mem (posn) = 1 + mem (posn + 1) = mem (table + 1) +23000 continue + bucket = mem (posn) + walker = mem (posn + 1) + nodsiz = mem (table) +23002 continue + if (.not.(walker .ne. 0))goto 23005 + i = walker + 1 + nodsiz + j = 1 +23007 if (.not.(mem (i) .ne. -2))goto 23008 + sym (j) = mem (i) + i = i + 1 + j = j + 1 + goto 23007 +23008 continue + sym (j) = -2 + i = 1 +23009 if (.not.(i .le. nodsiz))goto 23011 + j = walker + 1 + i - 1 + info (i) = mem (j) +23010 i = i + 1 + goto 23009 +23011 continue + mem (posn) = bucket + mem (posn + 1) = mem (walker + 0) + sctabl = 1 + return +23005 continue + bucket = bucket + 1 + if (.not.(bucket .gt. 43))goto 23012 + goto 23004 +23012 continue + j = table + bucket + walker = mem (j) +23006 continue +23003 goto 23002 +23004 continue + call dsfree (posn) + posn = 0 + sctabl = -1 + return + end diff --git a/unix/boot/spp/rpp/ratlibf/sdrop.f b/unix/boot/spp/rpp/ratlibf/sdrop.f new file mode 100644 index 00000000..b5334b9f --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/sdrop.f @@ -0,0 +1,15 @@ + integer function sdrop (from, to, chars) + integer from (100), to (100) + integer chars + integer len, start + integer ctoc, length, min0 + len = length (from) + if (.not.(chars .lt. 0))goto 23000 + sdrop=(ctoc (from, to, len + chars + 1)) + return +23000 continue + start = min0 (chars, len) + sdrop=(ctoc (from (start + 1), to, len + 1)) + return +23001 continue + end diff --git a/unix/boot/spp/rpp/ratlibf/skipbl.f b/unix/boot/spp/rpp/ratlibf/skipbl.f new file mode 100644 index 00000000..be60610a --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/skipbl.f @@ -0,0 +1,9 @@ + subroutine skipbl(lin, i) + integer lin(100) + integer i +23000 if (.not.(lin (i) .eq. 32 .or. lin (i) .eq. 9))goto 23001 + i = i + 1 + goto 23000 +23001 continue + return + end diff --git a/unix/boot/spp/rpp/ratlibf/slstr.f b/unix/boot/spp/rpp/ratlibf/slstr.f new file mode 100644 index 00000000..d8d98292 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/slstr.f @@ -0,0 +1,32 @@ + integer function slstr (from, to, first, chars) + integer from (100), to (100) + integer first, chars + integer len, i, j, k + integer length + len = length (from) + i = first + if (.not.(i .lt. 1))goto 23000 + i = i + len + 1 +23000 continue + if (.not.(chars .lt. 0))goto 23002 + i = i + chars + 1 + chars = - chars +23002 continue + j = i + chars - 1 + if (.not.(i .lt. 1))goto 23004 + i = 1 +23004 continue + if (.not.(j .gt. len))goto 23006 + j = len +23006 continue + k = 0 +23008 if (.not.(i .le. j))goto 23010 + to (k + 1) = from (i) + i = i + 1 +23009 k = k + 1 + goto 23008 +23010 continue + to (k + 1) = -2 + slstr=(k) + return + end diff --git a/unix/boot/spp/rpp/ratlibf/stake.f b/unix/boot/spp/rpp/ratlibf/stake.f new file mode 100644 index 00000000..08ba5652 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/stake.f @@ -0,0 +1,15 @@ + integer function stake (from, to, chars) + integer from (100), to (100) + integer chars + integer len, start + integer length, ctoc, max0 + len = length (from) + if (.not.(chars .lt. 0))goto 23000 + start = max0 (len + chars, 0) + stake=(ctoc (from (start + 1), to, len + 1)) + return +23000 continue + stake=(ctoc (from, to, chars + 1)) + return +23001 continue + end diff --git a/unix/boot/spp/rpp/ratlibf/stclos.f b/unix/boot/spp/rpp/ratlibf/stclos.f new file mode 100644 index 00000000..64c041eb --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/stclos.f @@ -0,0 +1,20 @@ + integer function stclos (pat, j, lastj, lastcl) + integer pat (128) + integer j, lastj, lastcl + integer addset + integer jp, jt, junk + jp = j - 1 +23000 if (.not.(jp .ge. lastj))goto 23002 + jt = jp + 4 + junk = addset (pat (jp), pat, jt, 128) +23001 jp = jp - 1 + goto 23000 +23002 continue + j = j + 4 + stclos = lastj + junk = addset (42, pat, lastj, 128) + junk = addset (0, pat, lastj, 128) + junk = addset (lastcl, pat, lastj, 128) + junk = addset (0, pat, lastj, 128) + return + end diff --git a/unix/boot/spp/rpp/ratlibf/stcopy.f b/unix/boot/spp/rpp/ratlibf/stcopy.f new file mode 100644 index 00000000..36ca2ac2 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/stcopy.f @@ -0,0 +1,14 @@ + subroutine stcopy (in, i, out, j) + integer in (100), out (100) + integer i, j + integer k + k = i +23000 if (.not.(in (k) .ne. -2))goto 23002 + out (j) = in (k) + j = j + 1 +23001 k = k + 1 + goto 23000 +23002 continue + out(j) = -2 + return + end diff --git a/unix/boot/spp/rpp/ratlibf/stlu.f b/unix/boot/spp/rpp/ratlibf/stlu.f new file mode 100644 index 00000000..6cfbd0a7 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/stlu.f @@ -0,0 +1,36 @@ + integer function stlu (symbol, node, pred, st) + integer symbol (100) + integer node, pred, st + integer mem( 1) + common/cdsmem/mem + integer hash, i, j, nodsiz + nodsiz = mem (st) + hash = 0 + i = 1 +23000 if (.not.(symbol (i) .ne. -2))goto 23002 + hash = hash + symbol (i) +23001 i = i + 1 + goto 23000 +23002 continue + hash = mod (hash, 43) + 1 + pred = st + hash + node = mem (pred) +23003 if (.not.(node .ne. 0))goto 23004 + i = 1 + j = node + 1 + nodsiz +23005 if (.not.(symbol (i) .eq. mem (j)))goto 23006 + if (.not.(symbol (i) .eq. -2))goto 23007 + stlu=(1) + return +23007 continue + i = i + 1 + j = j + 1 + goto 23005 +23006 continue + pred = node + node = mem (pred + 0) + goto 23003 +23004 continue + stlu=(0) + return + end diff --git a/unix/boot/spp/rpp/ratlibf/strcmp.f b/unix/boot/spp/rpp/ratlibf/strcmp.f new file mode 100644 index 00000000..9d037401 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/strcmp.f @@ -0,0 +1,30 @@ + integer function strcmp (str1, str2) + integer str1 (100), str2 (100) + integer i + i = 1 +23000 if (.not.(str1 (i) .eq. str2 (i)))goto 23002 + if (.not.(str1 (i) .eq. -2))goto 23003 + strcmp=(0) + return +23003 continue +23001 i = i + 1 + goto 23000 +23002 continue + if (.not.(str1 (i) .eq. -2))goto 23005 + strcmp = -1 + goto 23006 +23005 continue + if (.not.(str2 (i) .eq. -2))goto 23007 + strcmp = + 1 + goto 23008 +23007 continue + if (.not.(str1 (i) .lt. str2 (i)))goto 23009 + strcmp = -1 + goto 23010 +23009 continue + strcmp = +1 +23010 continue +23008 continue +23006 continue + return + end diff --git a/unix/boot/spp/rpp/ratlibf/strim.f b/unix/boot/spp/rpp/ratlibf/strim.f new file mode 100644 index 00000000..f9aaa9b4 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/strim.f @@ -0,0 +1,16 @@ + integer function strim (str) + integer str (100) + integer lnb, i + lnb = 0 + i = 1 +23000 if (.not.(str (i) .ne. -2))goto 23002 + if (.not.(str (i) .ne. 32 .and. str (i) .ne. 9))goto 23003 + lnb = i +23003 continue +23001 i = i + 1 + goto 23000 +23002 continue + str (lnb + 1) = -2 + strim=(lnb) + return + end diff --git a/unix/boot/spp/rpp/ratlibf/termin.f b/unix/boot/spp/rpp/ratlibf/termin.f new file mode 100644 index 00000000..2ba3823d --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/termin.f @@ -0,0 +1,8 @@ + subroutine termin (name) + integer name (100) + integer tname(9) + data tname(1)/47/,tname(2)/100/,tname(3)/101/,tname(4)/118/,tname( + *5)/47/,tname(6)/116/,tname(7)/116/,tname(8)/121/,tname(9)/-2/ + call scopy (tname, 1, name, 1) + return + end diff --git a/unix/boot/spp/rpp/ratlibf/trmout.f b/unix/boot/spp/rpp/ratlibf/trmout.f new file mode 100644 index 00000000..398620cd --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/trmout.f @@ -0,0 +1,8 @@ + subroutine trmout (name) + integer name (100) + integer tname(9) + data tname(1)/47/,tname(2)/100/,tname(3)/101/,tname(4)/118/,tname( + *5)/47/,tname(6)/116/,tname(7)/116/,tname(8)/121/,tname(9)/-2/ + call scopy (tname, 1, name, 1) + return + end diff --git a/unix/boot/spp/rpp/ratlibf/type.f b/unix/boot/spp/rpp/ratlibf/type.f new file mode 100644 index 00000000..decd4d15 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/type.f @@ -0,0 +1,16 @@ + integer function type (c) + integer c + if (.not.((97 .le. c .and. c .le. 122) .or. (65 .le. c .and. c .le + *. 90)))goto 23000 + type = 97 + goto 23001 +23000 continue + if (.not.(48 .le. c .and. c .le. 57))goto 23002 + type = 48 + goto 23003 +23002 continue + type = c +23003 continue +23001 continue + return + end diff --git a/unix/boot/spp/rpp/ratlibf/upper.f b/unix/boot/spp/rpp/ratlibf/upper.f new file mode 100644 index 00000000..1cf34941 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/upper.f @@ -0,0 +1,12 @@ + subroutine upper (token) + integer token (100) + integer cupper + integer i + i = 1 +23000 if (.not.(token (i) .ne. -2))goto 23002 + token (i) = cupper (token (i)) +23001 i = i + 1 + goto 23000 +23002 continue + return + end diff --git a/unix/boot/spp/rpp/ratlibf/wkday.f b/unix/boot/spp/rpp/ratlibf/wkday.f new file mode 100644 index 00000000..69d80796 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/wkday.f @@ -0,0 +1,14 @@ + integer function wkday (month, day, year) + integer month, day, year + integer lmonth, lday, lyear + lmonth = month - 2 + lday = day + lyear = year + if (.not.(lmonth .le. 0))goto 23000 + lmonth = lmonth + 12 + lyear = lyear - 1 +23000 continue + wkday = mod (lday + (26 * lmonth - 2) / 10 + lyear + lyear / 4 - 3 + *4, 7) + 1 + return + end |