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/ratlibr | |
| download | iraf-osx-40e5a5811c6ffce9b0974e93cdd927cbcf60c157.tar.gz | |
Repatch (from linux) of OSX IRAF
Diffstat (limited to 'unix/boot/spp/rpp/ratlibr')
74 files changed, 2245 insertions, 0 deletions
diff --git a/unix/boot/spp/rpp/ratlibr/Makefile b/unix/boot/spp/rpp/ratlibr/Makefile new file mode 100644 index 00000000..7c4d42b4 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/Makefile @@ -0,0 +1,33 @@ +# Ratfor source for the ratfor library. A TOOLS compatible ratfor compiler +# is required to compile this. The original UNIX ratfor compiler may not do +# the job. + +.r.f: + /usr/local/bin/ratfor $*.r > $*.f + +SRCS= addset.r addstr.r amatch.r catsub.r clower.r concat.r ctoc.r\ + ctoi.r ctomn.r cupper.r delete.r docant.r dodash.r dsdbiu.r\ + dsdump.r dsfree.r dsget.r dsinit.r enter.r equal.r error.r\ + errsub.r esc.r fcopy.r filset.r fmtdat.r fold.r gctoi.r getc.r\ + getccl.r getpat.r getwrd.r gfnarg.r index.r insub.r\ + itoc.r length.r locate.r lookup.r lower.r makpat.r maksub.r\ + match.r mktabl.r mntoc.r omatch.r outsub.r patsiz.r prompt.r\ + putc.r putdec.r putint.r putstr.r query.r rmtabl.r scopy.r\ + sctabl.r sdrop.r skipbl.r slstr.r stake.r stclos.r stcopy.r\ + stlu.r strcmp.r strim.r termin.r trmout.r type.r upper.r wkday.r + +FORT= addset.f addstr.f amatch.f catsub.f clower.f concat.f ctoc.f\ + ctoi.f ctomn.f cupper.f delete.f docant.f dodash.f dsdbiu.f\ + dsdump.f dsfree.f dsget.f dsinit.f enter.f equal.f error.f\ + errsub.f esc.f fcopy.f filset.f fmtdat.f fold.f gctoi.f getc.f\ + getccl.f getpat.f getwrd.f gfnarg.f index.f insub.f\ + itoc.f length.f locate.f lookup.f lower.f makpat.f maksub.f\ + match.f mktabl.f mntoc.f omatch.f outsub.f patsiz.f prompt.f\ + putc.f putdec.f putint.f putstr.f query.f rmtabl.f scopy.f\ + sctabl.f sdrop.f skipbl.f slstr.f stake.f stclos.f stcopy.f\ + stlu.f strcmp.f strim.f termin.f trmout.f type.f upper.f wkday.f + +fort: $(SRCS) defs + make fsrc; mv *.f ../ratlibf; touch fort + +fsrc: $(FORT) diff --git a/unix/boot/spp/rpp/ratlibr/addset.r b/unix/boot/spp/rpp/ratlibr/addset.r new file mode 100644 index 00000000..06f9f578 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/addset.r @@ -0,0 +1,18 @@ +include defs + +# addset - put c in string (j) if it fits, increment j + + integer function addset (c, str, j, maxsiz) + integer j, maxsiz + character c, str (maxsiz) + + if (j > maxsiz) + addset = NO + else { + str(j) = c + j = j + 1 + addset = YES + } + + return + end diff --git a/unix/boot/spp/rpp/ratlibr/addstr.r b/unix/boot/spp/rpp/ratlibr/addstr.r new file mode 100644 index 00000000..2f88c74c --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/addstr.r @@ -0,0 +1,19 @@ +include defs + +# addstr - add s to str(j) if it fits, increment j + + integer function addstr (s, str, j, maxsiz) + integer j, maxsiz + character s (ARB), str (maxsiz) + + integer i, addset + + for (i = 1; s (i) != EOS; i = i + 1) + if (addset (s (i), str, j, maxsiz) == NO) { + addstr = NO + return + } + addstr = YES + + return + end diff --git a/unix/boot/spp/rpp/ratlibr/amatch.r b/unix/boot/spp/rpp/ratlibr/amatch.r new file mode 100644 index 00000000..54a2904b --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/amatch.r @@ -0,0 +1,55 @@ +include defs + +# amatch --- (non-recursive) look for match starting at lin (from) + + integer function amatch (lin, from, pat, tagbeg, tagend) + character lin (MAXLINE), pat (MAXPAT) + integer from, tagbeg (10), tagend (10) + + integer i, j, offset, stack + integer omatch, patsiz + + for (i = 1; i <= 10; i = i + 1) { + tagbeg (i) = 0 + tagend (i) = 0 + } + tagbeg (1) = from + stack = 0 + offset = from # next unexamined input character + for (j = 1; pat (j) != EOS; j = j + patsiz (pat, j)) + if (pat (j) == CLOSURE) { # a closure entry + stack = j + j = j + CLOSIZE # step over CLOSURE + for (i = offset; lin (i) != EOS; ) # match as many as + if (omatch (lin, i, pat, j) == NO) # possible + break + pat (stack + COUNT) = i - offset + pat (stack + START) = offset + offset = i # character that made us fail + } + else if (pat (j) == START_TAG) { + i = pat (j + 1) + tagbeg (i + 1) = offset + } + else if (pat (j) == STOP_TAG) { + i = pat (j + 1) + tagend (i + 1) = offset + } + else if (omatch (lin, offset, pat, j) == NO) { # non-closure + for ( ; stack > 0; stack = pat (stack + PREVCL)) + if (pat (stack + COUNT) > 0) + break + if (stack <= 0) { # stack is empty + amatch = 0 # return failure + return + } + pat (stack + COUNT) = pat (stack + COUNT) - 1 + j = stack + CLOSIZE + offset = pat (stack + START) + pat (stack + COUNT) + } + # else omatch succeeded + + amatch = offset + tagend (1) = offset + return # success + end diff --git a/unix/boot/spp/rpp/ratlibr/catsub.r b/unix/boot/spp/rpp/ratlibr/catsub.r new file mode 100644 index 00000000..627e998f --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/catsub.r @@ -0,0 +1,27 @@ +include defs + +# catsub --- add replacement text to end of new + + subroutine catsub (lin, from, to, sub, new, k, maxnew) + + character lin(MAXLINE) + integer from(10), to(10) + integer maxnew + character sub(maxnew), new(MAXPAT) + integer k + + integer i, j, junk, ri + integer addset + + for (i = 1; sub (i) != EOS; i = i + 1) + if (sub (i) == DITTO) { + i = i + 1 + ri = sub (i) + 1 + for (j = from (ri); j < to (ri); j = j + 1) + junk = addset (lin (j), new, k, maxnew) + } + else + junk = addset (sub (i), new, k, maxnew) + + return + end diff --git a/unix/boot/spp/rpp/ratlibr/clower.r b/unix/boot/spp/rpp/ratlibr/clower.r new file mode 100644 index 00000000..0f629ea3 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/clower.r @@ -0,0 +1,18 @@ +include defs + +# clower - change letter to lower case + + character function clower(c) + character c + + character k + + if (c >= BIGA & c <= BIGZ) { + k = LETA - BIGA # avoid integer overflow in byte machines + clower = c + k + } + else + clower = c + + return + end diff --git a/unix/boot/spp/rpp/ratlibr/concat.r b/unix/boot/spp/rpp/ratlibr/concat.r new file mode 100644 index 00000000..abe55156 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/concat.r @@ -0,0 +1,15 @@ +include defs + +# concat - concatenate two strings together + + subroutine concat (buf1, buf2, outstr) + character buf1(ARB), buf2(ARB), outstr(ARB) + + 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/ratlibr/ctoc.r b/unix/boot/spp/rpp/ratlibr/ctoc.r new file mode 100644 index 00000000..3b9a22ba --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/ctoc.r @@ -0,0 +1,18 @@ +include defs + +# ctoc --- convert EOS-terminated string to EOS-terminated string + + integer function ctoc (from, to, len) + integer len + character from (ARB), to (len) + + integer i + + for (i = 1; i < len & from (i) != EOS; i = i + 1) + to (i) = from (i) + + to (i) = EOS + + return (i - 1) + + end diff --git a/unix/boot/spp/rpp/ratlibr/ctoi.r b/unix/boot/spp/rpp/ratlibr/ctoi.r new file mode 100644 index 00000000..54a5769b --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/ctoi.r @@ -0,0 +1,37 @@ +include defs + +# ctoi - convert string at in(i) to integer, increment i + + integer function ctoi(in, i) + character in (ARB) + integer i + + integer d + external index + integer index + + # string digits "0123456789" + character digits(11) + data digits (1) /DIG0/, + digits (2) /DIG1/, + digits (3) /DIG2/, + digits (4) /DIG3/, + digits (5) /DIG4/, + digits (6) /DIG5/, + digits (7) /DIG6/, + digits (8) /DIG7/, + digits (9) /DIG8/, + digits (10) /DIG9/, + digits (11) /EOS/ + + while (in (i) == BLANK | in (i) == TAB) + i = i + 1 + for (ctoi = 0; in (i) != EOS; i = i + 1) { + d = index (digits, in (i)) + if (d == 0) # non-digit + break + ctoi = 10 * ctoi + d - 1 + } + + return + end diff --git a/unix/boot/spp/rpp/ratlibr/ctomn.r b/unix/boot/spp/rpp/ratlibr/ctomn.r new file mode 100644 index 00000000..ef59e51a --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/ctomn.r @@ -0,0 +1,59 @@ +include defs + +# ctomn --- translate ASCII control character to mnemonic string + + integer function ctomn (c, rep) + character c, rep (4) + + integer i + integer length + + character mntext (136) # 4 chars/mnemonic; 32 control chars + SP + DEL + data mntext / _ + BIGN, BIGU, BIGL, EOS, + BIGS, BIGO, BIGH, EOS, + BIGS, BIGT, BIGX, EOS, + BIGE, BIGT, BIGX, EOS, + BIGE, BIGO, BIGT, EOS, + BIGE, BIGN, BIGQ, EOS, + BIGA, BIGC, BIGK, EOS, + BIGB, BIGE, BIGL, EOS, + BIGB, BIGS, EOS, EOS, + BIGH, BIGT, EOS, EOS, + BIGL, BIGF, EOS, EOS, + BIGV, BIGT, EOS, EOS, + BIGF, BIGF, EOS, EOS, + BIGC, BIGR, EOS, EOS, + BIGS, BIGO, EOS, EOS, + BIGS, BIGI, EOS, EOS, + BIGD, BIGL, BIGE, EOS, + BIGD, BIGC, DIG1, EOS, + BIGD, BIGC, DIG2, EOS, + BIGD, BIGC, DIG3, EOS, + BIGD, BIGC, DIG4, EOS, + BIGN, BIGA, BIGK, EOS, + BIGS, BIGY, BIGN, EOS, + BIGE, BIGT, BIGB, EOS, + BIGC, BIGA, BIGN, EOS, + BIGE, BIGM, EOS, EOS, + BIGS, BIGU, BIGB, EOS, + BIGE, BIGS, BIGC, EOS, + BIGF, BIGS, EOS, EOS, + BIGG, BIGS, EOS, EOS, + BIGR, BIGS, EOS, EOS, + BIGU, BIGS, EOS, EOS, + BIGS, BIGP, EOS, EOS, + BIGD, BIGE, BIGL, EOS/ + + i = mod (max(c,0), 128) + if (0 <= i & i <= 32) # non-printing character or space + call scopy (mntext, 4 * i + 1, rep, 1) + elif (i == 127) # rubout (DEL) + call scopy (mntext, 133, rep, 1) + else { # printing character + rep (1) = c + rep (2) = EOS + } + + return (length (rep)) + end diff --git a/unix/boot/spp/rpp/ratlibr/cupper.r b/unix/boot/spp/rpp/ratlibr/cupper.r new file mode 100644 index 00000000..9a39cf21 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/cupper.r @@ -0,0 +1,14 @@ +include defs + +# cupper - change letter to upper case + + character function cupper (c) + character c + + if (c >= LETA & c <= LETZ) + cupper = c + (BIGA - LETA) + else + cupper = c + + return + end diff --git a/unix/boot/spp/rpp/ratlibr/defs b/unix/boot/spp/rpp/ratlibr/defs new file mode 100644 index 00000000..bf040c55 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/defs @@ -0,0 +1,138 @@ +# common definitions for all routines comprising the ratfor preprocessor +#--------------------------------------------------------------- +# The definition STDEFNS defines the file which contains the +# standard definitions to be used when preprocessing a file. +# It is opened and read automatically by the ratfor preprocessor. +# Set STDEFNS to the name of the file in which the standard +# definitions reside. If you don't want the preprocessor to +# automatically open this file, set STDENFS to "". +# +#--------------------------------------------------------------- +# If you want the preprocessor to output upper case only, +# set the following definition: +# +# define (UPPERC,) +# +#--------------------------------------------------------------- +# Some of the buffer sizes and other symbols might have to be +# changed. Especially check the following: +# +# MAXDEF (number of characters in a definition) +# SBUFSIZE (nbr string declarations allowed per module) +# MAXSTRTBL (size of table to buffer string declarations) +# MAXSWITCH (max stack for switch statement) +# +#----------------------------------------------------------------- + + +define (STDEFNS, string defns "") # standard defns file +#define (UPPERC,) # define if Fortran compiler wants upper case +#define (IMPNONE,) # output IMPLICIT NONE in procedures +define (NULL,0) +define (INDENT,3) # number of spaces of indentation +define (MAX_INDENT,30) # maximum column for indentation +define (FIRST_LABEL,100) # first statement label +define (SZ_SPOOLBUF,8) # for breaking continuation cards + +define (RADIX,PERCENT) # % indicates alternate radix +define (TOGGLE,PERCENT) # toggle for literal lines +define (ARGFLAG,DOLLAR) +define (CUTOFF,3) # min nbr of cases to generate branch table + # (for switch statement) +define (DENSITY,2) # reciprocal of density necessary for + # branch table +define (FILLCHAR,DIG0) # used in long-name uniquing +define (MAXIDLENGTH,6) # for Fortran 66 and 77 +define (SZ_SMEM,240) # memory common declarations string + + +# Lexical items (codes are negative to avoid conflict with character values) + +define (LEXBEGIN,-83) +define (LEXBREAK,-79) +define (LEXCASE,-91) +define (LEXDEFAULT,-90) +define (LEXDIGITS,-89) +define (LEXDO,-96) +define (LEXELSE,-87) +define (LEXEND,-82) +define (LEXERRCHK,-84) +define (LEXERROR,-73) +define (LEXFOR,-94) +define (LEXIF,-99) +define (LEXIFELSE,-72) +define (LEXIFERR,-98) +define (LEXIFNOERR,-97) +define (LEXLITERAL,-85) +define (LEXNEXT,-78) +define (LEXOTHER,-80) +define (LEXPOINTER,-88) +define (LEXRBRACE,-74) +define (LEXREPEAT,-93) +define (LEXRETURN,-77) +define (LEXGOTO,-76) +define (LEXSTOP,-71) +define (LEXSTRING,-75) +define (LEXSWITCH,-92) +define (LEXTHEN,-86) +define (LEXUNTIL,-70) +define (LEXWHILE,-95) +define (LSTRIPC,-69) +define (RSTRIPC,-68) +define (LEXDECL,-67) + +define (XPP_DIRECTIVE, -166) + +# Built-in macro functions: + +define (DEFTYPE,-4) +define (MACTYPE,-10) +define (IFTYPE,-11) +define (INCTYPE,-12) +define (SUBTYPE,-13) +define (ARITHTYPE,-14) +define (IFDEFTYPE,-15) +define (IFNOTDEFTYPE,-16) +define (PRAGMATYPE,-17) + + +# Size-limiting definitions: + +define (MEMSIZE,60000) # space allotted to symbol tables and macro text +define (BUFSIZE,4096) # pushback buffer for ngetch and putbak +define (PBPOINT,3192) # point in buffer where pushback begins +define (SBUFSIZE,2048) # buffer for string statements +define (MAXDEF,2048) # max chars in a defn +define (MAXFORSTK,200) # max space for for reinit clauses +define (MAXERRSTK,30) # max nesting of iferr statements +define (MAXFNAMES, arith(NFILES,*,FILENAMESIZE)) +define (MAXSTACK,100) # max stack depth for parser +define (MAXSWITCH,1000) # max stack for switch statement +define (MAXSWNEST,10) # max nesting of switches in a procedure +define (MAXTOK,100) # max chars in a token +define (NFILES,5) # max number of include file nesting +define (MAXNBRSTR,20) #max nbr string declarations per module +define (CALLSIZE,50) +define (ARGSIZE,100) +define (EVALSIZE,500) + + +# Where to find the common blocks: + +define(COMMON_BLOCKS,"common") + +# Data types, Dynamic Memory common: + +define (XPOINTER,"integer ") + + +# The following external names are redefined to avoid name collisions with +# standard library procedures on some systems. + +define open rfopen +define close rfclos +define flush rfflus +define note rfnote +define seek rfseek +define remove rfrmov +define exit rexit diff --git a/unix/boot/spp/rpp/ratlibr/delete.r b/unix/boot/spp/rpp/ratlibr/delete.r new file mode 100644 index 00000000..f4cadeb2 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/delete.r @@ -0,0 +1,21 @@ +include defs + +# delete --- remove a symbol from the symbol table + + subroutine delete (symbol, st) + character symbol (ARB) + pointer st + + DS_DECL(Mem, 1) + + integer stlu + + pointer node, pred + + if (stlu (symbol, node, pred, st) == YES) { + Mem (pred + ST_LINK) = Mem (node + ST_LINK) + call dsfree (node) + } + + return + end diff --git a/unix/boot/spp/rpp/ratlibr/docant.r b/unix/boot/spp/rpp/ratlibr/docant.r new file mode 100644 index 00000000..efa14ccc --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/docant.r @@ -0,0 +1,25 @@ +include defs + +# docant +# +# Similar to cant(name), however precede the messge with the name +# of the program that was running when the file could not be +# opened. Helpful in a pipeline to verify which program was not +# able to open a file. +# + subroutine docant(name) + + character name(ARB), prog(FILENAMESIZE) + integer length + integer getarg + + length = getarg(0, prog, FILENAMESIZE) + if (length != EOF) { + call putlin(prog, STDERR) + call putch(COLON, STDERR) + call putch(BLANK, STDERR) + } + call cant(name) + + return + end diff --git a/unix/boot/spp/rpp/ratlibr/dodash.r b/unix/boot/spp/rpp/ratlibr/dodash.r new file mode 100644 index 00000000..83c4f2bc --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/dodash.r @@ -0,0 +1,22 @@ +include defs + +# dodash --- expand array (i-1)-array (i+1) into set (j)... from valid + + subroutine dodash (valid, array, i, set, j, maxset) + integer i, j, maxset + character valid (ARB), array (ARB), set (maxset) + + character esc + + integer junk, k, limit + external index + integer addset, index + + i = i + 1 + j = j - 1 + limit = index (valid, esc (array, i)) + for (k = index (valid, set (j)); k <= limit; k = k + 1) + junk = addset (valid (k), set, j, maxset) + + return + end diff --git a/unix/boot/spp/rpp/ratlibr/dsdbiu.r b/unix/boot/spp/rpp/ratlibr/dsdbiu.r new file mode 100644 index 00000000..99c2acc0 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/dsdbiu.r @@ -0,0 +1,45 @@ +include defs + +# dsdbiu --- dump contents of block-in-use + + subroutine dsdbiu (b, form) + pointer b + character form + + DS_DECL(Mem, 1) + + integer l, s, lmax + + string blanks " " + + call putint (b, 5, ERROUT) + call putch (BLANK, ERROUT) + call putint (Mem (b + DS_SIZE), 0, ERROUT) + call remark (" words in use.") + + l = 0 + s = b + Mem (b + DS_SIZE) + if (form == DIGIT) + lmax = 5 + else + lmax = 50 + + for (b = b + DS_OHEAD; b < s; b = b + 1) { + if (l == 0) + call putlin (blanks, ERROUT) + if (form == DIGIT) + call putint (Mem (b), 10, ERROUT) + elif (form == LETTER) + call putch (Mem (b), ERROUT) + l = l + 1 + if (l >= lmax) { + l = 0 + call putch (NEWLINE, ERROUT) + } + } + + if (l != 0) + call putch (NEWLINE, ERROUT) + + return + end diff --git a/unix/boot/spp/rpp/ratlibr/dsdump.r b/unix/boot/spp/rpp/ratlibr/dsdump.r new file mode 100644 index 00000000..276290db --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/dsdump.r @@ -0,0 +1,34 @@ +include defs + +# dsdump --- produce semi-readable dump of storage + + subroutine dsdump (form) + character form + + DS_DECL(Mem, 1) + + pointer p, t, q + + t = DS_AVAIL + + call remark ("** DYNAMIC STORAGE DUMP **.") + call putint (1, 5, ERROUT) + call putch (BLANK, ERROUT) + call putint (DS_OHEAD + 1, 0, ERROUT) + call remark (" words in use.") + + p = Mem (t + DS_LINK) + while (p != LAMBDA) { + call putint (p, 5, ERROUT) + call putch (BLANK, ERROUT) + call putint (Mem (p + DS_SIZE), 0, ERROUT) + call remark (" words available.") + q = p + Mem (p + DS_SIZE) + while (q != Mem (p + DS_LINK) & q < Mem (DS_MEMEND)) + call dsdbiu (q, form) + p = Mem (p + DS_LINK) + } + + call remark ("** END DUMP **.") + return + end diff --git a/unix/boot/spp/rpp/ratlibr/dsfree.r b/unix/boot/spp/rpp/ratlibr/dsfree.r new file mode 100644 index 00000000..34cd7e55 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/dsfree.r @@ -0,0 +1,53 @@ +include defs + +# dsfree --- return a block of storage to the available space list + + subroutine dsfree (block) + pointer block + + DS_DECL(Mem, 1) + + pointer p0, p, q + + integer n, junk + + character con (10) + + p0 = block - DS_OHEAD + n = Mem (p0 + DS_SIZE) + q = DS_AVAIL + + repeat { + p = Mem (q + DS_LINK) + if (p == LAMBDA | p > p0) + break + q = p + } + + if (q + Mem (q + DS_SIZE) > p0) { + call remark ("in dsfree: attempt to free unallocated block.") + call remark ("type 'c' to continue.") + junk = getlin (con, STDIN) + if (con (1) != LETC & con (1) != BIGC) + call endst + return # do not attempt to free the block + } + + if (p0 + n == p & p != LAMBDA) { + n = n + Mem (p + DS_SIZE) + Mem (p0 + DS_LINK) = Mem (p + DS_LINK) + } + else + Mem (p0 + DS_LINK) = p + + if (q + Mem (q + DS_SIZE) == p0) { + Mem (q + DS_SIZE) = Mem (q + DS_SIZE) + n + Mem (q + DS_LINK) = Mem (p0 + DS_LINK) + } + else { + Mem (q + DS_LINK) = p0 + Mem (p0 + DS_SIZE) = n + } + + return + end diff --git a/unix/boot/spp/rpp/ratlibr/dsget.r b/unix/boot/spp/rpp/ratlibr/dsget.r new file mode 100644 index 00000000..4c62ce62 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/dsget.r @@ -0,0 +1,50 @@ +include defs + +# dsget --- get pointer to block of at least w available words + + pointer function dsget (w) + integer w + + DS_DECL(Mem, 1) + + pointer p, q, l + + integer n, k, junk + integer getlin + + character c (10) + + n = w + DS_OHEAD + q = DS_AVAIL + + repeat { + p = Mem (q + DS_LINK) + if (p == LAMBDA) { + call remark ("in dsget: out of storage space.") + call remark ("type 'c' or 'i' for char or integer dump.") + junk = getlin (c, STDIN) + if (c (1) == LETC | c (1) == BIGC) + call dsdump (LETTER) + else if (c (1) == LETI | c (1) == BIGI) + call dsdump (DIGIT) + call error ("program terminated.") + } + if (Mem (p + DS_SIZE) >= n) + break + q = p + } + + k = Mem (p + DS_SIZE) - n + if (k >= DS_CLOSE) { + Mem (p + DS_SIZE) = k + l = p + k + Mem (l + DS_SIZE) = n + } + else { + Mem (q + DS_LINK) = Mem (p + DS_LINK) + l = p + } + + return (l + DS_OHEAD) + + end diff --git a/unix/boot/spp/rpp/ratlibr/dsinit.r b/unix/boot/spp/rpp/ratlibr/dsinit.r new file mode 100644 index 00000000..926390b3 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/dsinit.r @@ -0,0 +1,29 @@ +include defs + +# dsinit --- initialize dynamic storage space to w words + + subroutine dsinit (w) + integer w + + DS_DECL(Mem, 1) + + pointer t + + if (w < 2 * DS_OHEAD + 2) + call error ("in dsinit: unreasonably small memory size.") + + # set up avail list: + t = DS_AVAIL + Mem (t + DS_SIZE) = 0 + Mem (t + DS_LINK) = DS_AVAIL + DS_OHEAD + + # set up first block of space: + t = DS_AVAIL + DS_OHEAD + Mem (t + DS_SIZE) = w - DS_OHEAD - 1 # -1 for MEMEND + Mem (t + DS_LINK) = LAMBDA + + # record end of memory: + Mem (DS_MEMEND) = w + + return + end diff --git a/unix/boot/spp/rpp/ratlibr/enter.r b/unix/boot/spp/rpp/ratlibr/enter.r new file mode 100644 index 00000000..56a3d46b --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/enter.r @@ -0,0 +1,40 @@ +include defs + +# enter --- place a symbol in the symbol table, updating if already present + + subroutine enter (symbol, info, st) + character symbol (ARB) + integer info (ARB) + pointer st + + DS_DECL(Mem, 1) + + integer i, nodsiz, j + integer stlu, length + + pointer node, pred + pointer dsget + + nodsiz = Mem (st) + + if (stlu (symbol, node, pred, st) == NO) { + node = dsget (1 + nodsiz + length (symbol) + 1) + Mem (node + ST_LINK) = LAMBDA + Mem (pred + ST_LINK) = node + i = 1 + j = node + ST_DATA + nodsiz + while (symbol (i) != EOS) { + Mem (j) = symbol (i) + i = i + 1 + j = j + 1 + } + Mem (j) = EOS + } + + for (i = 1; i <= nodsiz; i = i + 1) { + j = node + ST_DATA + i - 1 + Mem (j) = info (i) + } + + return + end diff --git a/unix/boot/spp/rpp/ratlibr/equal.r b/unix/boot/spp/rpp/ratlibr/equal.r new file mode 100644 index 00000000..0aa24c4c --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/equal.r @@ -0,0 +1,15 @@ +include defs + +# equal - compare str1 to str2; return YES if equal, NO if not + + integer function equal (str1, str2) + character str1(ARB), str2(ARB) + + integer i + + for (i = 1; str1 (i) == str2 (i); i = i + 1) + if (str1 (i) == EOS) + return (YES) + + return (NO) + end diff --git a/unix/boot/spp/rpp/ratlibr/error.r b/unix/boot/spp/rpp/ratlibr/error.r new file mode 100644 index 00000000..326a8823 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/error.r @@ -0,0 +1,10 @@ +include defs + +# error - print message and terminate execution + + subroutine error (line) + character line (ARB) + + call remark (line) + call endst + end diff --git a/unix/boot/spp/rpp/ratlibr/errsub.r b/unix/boot/spp/rpp/ratlibr/errsub.r new file mode 100644 index 00000000..6e34195a --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/errsub.r @@ -0,0 +1,26 @@ +include defs + +# errsub - see if argument is ERROUT substitution + + integer function errsub (arg, file, access) + + character arg (ARB), file (ARB) + integer access + + if (arg (1) == QMARK & arg (2) != QMARK & arg (2) != EOS) { + errsub = YES + access = WRITE + call scopy (arg, 2, file, 1) + } + + else if (arg (1) == QMARK & arg (2) == QMARK & arg (3) != EOS) { + errsub = YES + access = APPEND + call scopy (arg, 3, file, 1) + } + + else + errsub = NO + + return + end diff --git a/unix/boot/spp/rpp/ratlibr/esc.r b/unix/boot/spp/rpp/ratlibr/esc.r new file mode 100644 index 00000000..bcb0d3a7 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/esc.r @@ -0,0 +1,24 @@ +include defs + +# esc - map array (i) into escaped character if appropriate + + character function esc (array, i) + character array (ARB) + integer i + + if (array (i) != ESCAPE) + esc = array (i) + else if (array (i+1) == EOS) # @ not special at end + esc = ESCAPE + else { + i = i + 1 + if (array (i) == LETN | array (i) == BIGN) + esc = NEWLINE + else if (array (i) == LETT | array (i) == BIGT) + esc = TAB + else + esc = array (i) + } + + return + end diff --git a/unix/boot/spp/rpp/ratlibr/fcopy.r b/unix/boot/spp/rpp/ratlibr/fcopy.r new file mode 100644 index 00000000..755f9ad7 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/fcopy.r @@ -0,0 +1,16 @@ +include defs + +# fcopy - copy file in to file out + + subroutine fcopy (in, out) + filedes in, out + + character line (MAXLINE) + + integer getlin + + while (getlin (line, in) != EOF) + call putlin (line, out) + + return + end diff --git a/unix/boot/spp/rpp/ratlibr/filset.r b/unix/boot/spp/rpp/ratlibr/filset.r new file mode 100644 index 00000000..eba728b9 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/filset.r @@ -0,0 +1,35 @@ +include defs + +# filset --- expand set at array (i) into set (j), stop at delim + + subroutine filset (delim, array, i, set, j, maxset) + integer i, j, maxset + character array (ARB), delim, set (maxset) + + character esc + + integer junk + external index + integer addset, index + + string digits "0123456789" + string lowalf "abcdefghijklmnopqrstuvwxyz" + string upalf "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + + for ( ; array (i) != delim & array (i) != EOS; i = i + 1) + if (array (i) == ESCAPE) + junk = addset (esc (array, i), set, j, maxset) + else if (array (i) != DASH) + junk = addset (array (i), set, j, maxset) + else if (j <= 1 | array (i + 1) == EOS) # literal - + junk = addset (DASH, set, j, maxset) + else if (index (digits, set (j - 1)) > 0) + call dodash (digits, array, i, set, j, maxset) + else if (index (lowalf, set (j - 1)) > 0) + call dodash (lowalf, array, i, set, j, maxset) + else if (index (upalf, set (j - 1)) > 0) + call dodash (upalf, array, i, set, j, maxset) + else + junk = addset (DASH, set, j, maxset) + return + end diff --git a/unix/boot/spp/rpp/ratlibr/fmtdat.r b/unix/boot/spp/rpp/ratlibr/fmtdat.r new file mode 100644 index 00000000..652b6769 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/fmtdat.r @@ -0,0 +1,34 @@ +include defs + +# fmtdat - format date and time information + + subroutine fmtdat(date, time, now, form) + character date(ARB), time(ARB) + integer now(7), form + + # at present, simply return mm/dd/yy and hh:mm:ss + # 'form' is reserved for selecting different formats + # when those have been chosen. + + date(1) = now(2) / 10 + DIG0 + date(2) = mod(now(2), 10) + DIG0 + date(3) = SLASH + date(4) = now(3) / 10 + DIG0 + date(5) = mod(now(3), 10) + DIG0 + date(6) = SLASH + date(7) = mod(now(1), 100) / 10 + DIG0 + date(8) = mod(now(1), 10) + DIG0 + date(9) = EOS + + time(1) = now(4) / 10 + DIG0 + time(2) = mod(now(4), 10) + DIG0 + time(3) = COLON + time(4) = now(5) / 10 + DIG0 + time(5) = mod(now(5), 10) + DIG0 + time(6) = COLON + time(7) = now(6) / 10 + DIG0 + time(8) = mod(now(6), 10) + DIG0 + time(9) = EOS + + return + end diff --git a/unix/boot/spp/rpp/ratlibr/fold.r b/unix/boot/spp/rpp/ratlibr/fold.r new file mode 100644 index 00000000..d6530e90 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/fold.r @@ -0,0 +1,16 @@ +include defs + +# fold - fold all letters in a string to lower case + + subroutine fold (token) + character token (ARB) + + character clower + + integer i + + for (i = 1; token (i) != EOS; i = i + 1) + token (i) = clower (token (i)) + + return + end diff --git a/unix/boot/spp/rpp/ratlibr/fort b/unix/boot/spp/rpp/ratlibr/fort new file mode 100644 index 00000000..e69de29b --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/fort diff --git a/unix/boot/spp/rpp/ratlibr/gctoi.r b/unix/boot/spp/rpp/ratlibr/gctoi.r new file mode 100644 index 00000000..8efabe4f --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/gctoi.r @@ -0,0 +1,58 @@ +include defs + +# gctoi --- convert any radix string to single precision integer + + integer function gctoi (str, i, radix) + character str (ARB) + integer i, radix + + integer base, v, d, j + external index + integer index + + character clower + + logical neg + + string digits "0123456789abcdef" + + v = 0 + base = radix + + while (str (i) == BLANK | str (i) == TAB) + i = i + 1 + + neg = (str (i) == MINUS) + if (str (i) == PLUS | str (i) == MINUS) + i = i + 1 + + if (str (i + 2) == LETR & str (i) == DIG1 & IS_DIGIT(str (i + 1)) + | str (i + 1) == LETR & IS_DIGIT(str (i))) { + base = str (i) - DIG0 + j = i + if (str (i + 1) != LETR) { + j = j + 1 + base = base * 10 + (str (j) - DIG0) + } + if (base < 2 | base > 16) + base = radix + else + i = j + 2 + } + + for (; str (i) != EOS; i = i + 1) { + if (IS_DIGIT(str (i))) + d = str (i) - DIG0 + else + d = index (digits, clower (str (i))) - 1 + if (d < 0 | d >= base) + break + v = v * base + d + } + + if (neg) + return (-v) + else + return (+v) + + end diff --git a/unix/boot/spp/rpp/ratlibr/getc.r b/unix/boot/spp/rpp/ratlibr/getc.r new file mode 100644 index 00000000..afd0fc81 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/getc.r @@ -0,0 +1,13 @@ +include defs + +# getc - get character from STDIN + + character function getc (c) + character c + + character getch + + getc = getch (c, STDIN) + + return + end diff --git a/unix/boot/spp/rpp/ratlibr/getccl.r b/unix/boot/spp/rpp/ratlibr/getccl.r new file mode 100644 index 00000000..727cc7d6 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/getccl.r @@ -0,0 +1,29 @@ +include defs + +# getccl --- expand char class at arg (i) into pat (j) + + integer function getccl (arg, i, pat, j) + character arg (MAXARG), pat (MAXPAT) + integer i, j + + integer jstart, junk + integer addset + + i = i + 1 # skip over [ + if (arg (i) == NOT) { + junk = addset (NCCL, pat, j, MAXPAT) + i = i + 1 + } + else + junk = addset (CCL, pat, j, MAXPAT) + jstart = j + junk = addset (0, pat, j, MAXPAT) # leave room for count + call filset (CCLEND, arg, i, pat, j, MAXPAT) + pat (jstart) = j - jstart - 1 + if (arg (i) == CCLEND) + getccl = OK + else + getccl = ERR + + return + end diff --git a/unix/boot/spp/rpp/ratlibr/getpat.r b/unix/boot/spp/rpp/ratlibr/getpat.r new file mode 100644 index 00000000..ef1dc4a2 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/getpat.r @@ -0,0 +1,12 @@ +include defs + +# getpat - convert str into pattern + + integer function getpat (str, pat) + character str (ARB), pat (ARB) + + integer makpat + + return (makpat (str, 1, EOS, pat)) + + end diff --git a/unix/boot/spp/rpp/ratlibr/getwrd.r b/unix/boot/spp/rpp/ratlibr/getwrd.r new file mode 100644 index 00000000..ec324af0 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/getwrd.r @@ -0,0 +1,25 @@ +include defs + +# getwrd - get non-blank word from in (i) into out, increment i + + integer function getwrd (in, i, out) + character in (ARB), out (ARB) + integer i + + integer j + + while (in (i) == BLANK | in (i) == TAB) + i = i + 1 + + 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 + } + out (j) = EOS + + getwrd = j - 1 + return + end diff --git a/unix/boot/spp/rpp/ratlibr/gfnarg.r b/unix/boot/spp/rpp/ratlibr/gfnarg.r new file mode 100644 index 00000000..39409592 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/gfnarg.r @@ -0,0 +1,115 @@ +include defs + +# gfnarg --- get the next file name from the argument list + + integer function gfnarg (name, state) + character name (ARB) + integer state (4) + + integer l + integer getarg, getlin + + filedes fd + filedes open + + string in1 "/dev/stdin1" + string in2 "/dev/stdin2" + string in3 "/dev/stdin3" + + repeat { + + if (state (1) == 1) { + state (1) = 2 # new state + state (2) = 1 # next argument + state (3) = ERR # current input file + state (4) = 0 # input file count + } + + else if (state (1) == 2) { + if (getarg (state (2), name, MAXARG) != EOF) { + state (1) = 2 # stay in same state + state (2) = state (2) + 1 # bump argument count + if (name (1) != MINUS) { + state (4) = state (4) + 1 # bump input file count + return (OK) + } + else if (name (2) == EOS) { + call scopy (in1, 1, name, 1) + state (4) = state (4) + 1 # bump input file count + return (OK) + } + else if (name (2) == DIG1 & name (3) == EOS) { + call scopy (in1, 1, name, 1) + state (4) = state (4) + 1 # bump input file count + return (OK) + } + else if (name (2) == DIG2 & name (3) == EOS) { + call scopy (in2, 1, name, 1) + state (4) = state (4) + 1 # bump input file count + return (OK) + } + else if (name (2) == DIG3 & name (3) == EOS) { + call scopy (in3, 1, name, 1) + state (4) = state (4) + 1 # bump input file count + return (OK) + } + + else if (name (2) == LETN | name (2) == BIGN) { + state (1) = 3 # new state + if (name (3) == EOS) + state (3) = STDIN + else if (name (3) == DIG1 & name (4) == EOS) + state (3) = STDIN1 + else if (name (3) == DIG2 & name (4) == EOS) + state (3) = STDIN2 + else if (name (3) == DIG3 & name (4) == EOS) + state (3) = STDIN3 + else { + state (3) = open (name (3), READ) + if (state (3) == ERR) { + call putlin (name, ERROUT) + call remark (": can't open.") + state (1) = 2 + } + } + } + else + return (ERR) + } + + else + state (1) = 4 # EOF state + } + + else if (state (1) == 3) { + l = getlin (name, state (3)) + if (l != EOF) { + name (l) = EOS + state (4) = state (4) + 1 # bump input file count + return (OK) + } + if (fd != ERR & fd != STDIN) + call close (state (3)) + state (1) = 2 + } + + else if (state (1) == 4) { + state (1) = 5 + if (state (4) == 0) {# no input files + call scopy (in1, 1, name, 1) + return (OK) + } + break + } + + else if (state (1) == 5) + break + + else + call error ("in gfnarg: bad state (1) value.") + + } # end of infinite repeat + + name (1) = EOS + return (EOF) + end diff --git a/unix/boot/spp/rpp/ratlibr/index.r b/unix/boot/spp/rpp/ratlibr/index.r new file mode 100644 index 00000000..f0693f02 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/index.r @@ -0,0 +1,14 @@ +include defs + +# index - find character c in string str + + integer function index (str, c) + character str (ARB), c + + for (index = 1; str (index) != EOS; index = index + 1) + if (str (index) == c) + return + + index = 0 + return + end diff --git a/unix/boot/spp/rpp/ratlibr/insub.r b/unix/boot/spp/rpp/ratlibr/insub.r new file mode 100644 index 00000000..7d71b95f --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/insub.r @@ -0,0 +1,16 @@ +include defs + +# insub - determine if argument is STDIN substitution + + integer function insub (arg, file) + character arg (ARB), file (ARB) + + if (arg (1) == LESS & arg (2) != EOS) { + insub = YES + call scopy (arg, 2, file, 1) + } + else + insub = NO + + return + end diff --git a/unix/boot/spp/rpp/ratlibr/itoc.r b/unix/boot/spp/rpp/ratlibr/itoc.r new file mode 100644 index 00000000..18d8f4bd --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/itoc.r @@ -0,0 +1,50 @@ +include defs + +# itoc - convert integer int to char string in str + + integer function itoc (int, str, size) + integer int, size + character str (ARB) + + integer mod + integer d, i, intval, j, k + + # string digits "0123456789" + character digits (11) + data digits (1) /DIG0/, + digits (2) /DIG1/, + digits (3) /DIG2/, + digits (4) /DIG3/, + digits (5) /DIG4/, + digits (6) /DIG5/, + digits (7) /DIG6/, + digits (8) /DIG7/, + digits (9) /DIG8/, + digits (10) /DIG9/, + digits (11) /EOS/ + + intval = iabs (int) + str (1) = EOS + i = 1 + repeat { # generate digits + i = i + 1 + d = mod (intval, 10) + str (i) = digits (d+1) + intval = intval / 10 + } until (intval == 0 | i >= size) + + if (int < 0 & i < size) { # then sign + i = i + 1 + str (i) = MINUS + } + itoc = i - 1 + + for (j = 1; j < i; j = j + 1) { # then reverse + k = str (i) + str (i) = str (j) + str (j) = k + i = i - 1 + } + + return + end diff --git a/unix/boot/spp/rpp/ratlibr/length.r b/unix/boot/spp/rpp/ratlibr/length.r new file mode 100644 index 00000000..3abb3a81 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/length.r @@ -0,0 +1,12 @@ +include defs + +# length - compute length of string + + integer function length (str) + character str (ARB) + + for (length = 0; str (length+1) != EOS; length = length + 1) + ; + + return + end diff --git a/unix/boot/spp/rpp/ratlibr/locate.r b/unix/boot/spp/rpp/ratlibr/locate.r new file mode 100644 index 00000000..c8d1365b --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/locate.r @@ -0,0 +1,17 @@ +include defs + +# locate --- look for c in char class at pat (offset) + + integer function locate (c, pat, offset) + character c, pat (MAXPAT) + integer offset + + integer i + + # size of class is at pat (offset), characters follow + for (i = offset + pat (offset); i > offset; i = i - 1) + if (c == pat (i)) + return (YES) + + return (NO) + end diff --git a/unix/boot/spp/rpp/ratlibr/lookup.r b/unix/boot/spp/rpp/ratlibr/lookup.r new file mode 100644 index 00000000..6cda8f08 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/lookup.r @@ -0,0 +1,30 @@ +include defs + +# lookup --- find a symbol in the symbol table, return its data + + integer function lookup (symbol, info, st) + character symbol (ARB) + integer info (ARB) + pointer st + + DS_DECL(Mem, 1) + + integer i, nodsiz, kluge + integer stlu + + pointer node, pred + + if (stlu (symbol, node, pred, st) == NO) { + lookup = NO + return + } + + nodsiz = Mem (st) + for (i = 1; i <= nodsiz; i = i + 1) { + kluge = node + ST_DATA - 1 + i + info (i) = Mem (kluge) + } + lookup = YES + + return + end diff --git a/unix/boot/spp/rpp/ratlibr/lower.r b/unix/boot/spp/rpp/ratlibr/lower.r new file mode 100644 index 00000000..91161578 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/lower.r @@ -0,0 +1,11 @@ +include defs + +# lower - fold all letters to lower case + + subroutine lower (token) + character token (ARB) + + call fold (token) + + return + end diff --git a/unix/boot/spp/rpp/ratlibr/makpat.r b/unix/boot/spp/rpp/ratlibr/makpat.r new file mode 100644 index 00000000..a310ada7 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/makpat.r @@ -0,0 +1,70 @@ +include defs + +# makpat --- make pattern from arg (from), terminate at delim + + integer function makpat (arg, from, delim, pat) + character arg (MAXARG), delim, pat (MAXPAT) + integer from + + character esc + + integer i, j, junk, lastcl, lastj, lj, + tagnst, tagnum, tagstk (9) + integer addset, getccl, stclos + + j = 1 # pat index + lastj = 1 + lastcl = 0 + tagnum = 0 + tagnst = 0 + for (i = from; arg (i) != delim & arg (i) != EOS; i = i + 1) { + lj = j + if (arg (i) == ANY) + junk = addset (ANY, pat, j, MAXPAT) + else if (arg (i) == BOL & i == from) + junk = addset (BOL, pat, j, MAXPAT) + else if (arg (i) == EOL & arg (i + 1) == delim) + junk = addset (EOL, pat, j, MAXPAT) + else if (arg (i) == CCL) { + if (getccl (arg, i, pat, j) == ERR) { + makpat = ERR + return + } + } + else if (arg (i) == CLOSURE & i > from) { + lj = lastj + if (pat (lj) == BOL | pat (lj) == EOL | pat (lj) == CLOSURE | + pat (lj) == START_TAG | pat (lj) == STOP_TAG) + break + lastcl = stclos (pat, j, lastj, lastcl) + } + else if (arg (i) == START_TAG) { + if (tagnum >= 9) # too many tagged sub-patterns + break + tagnum = tagnum + 1 + tagnst = tagnst + 1 + tagstk (tagnst) = tagnum + junk = addset (START_TAG, pat, j, MAXPAT) + junk = addset (tagnum, pat, j, MAXPAT) + } + else if (arg (i) == STOP_TAG & tagnst > 0) { + junk = addset (STOP_TAG, pat, j, MAXPAT) + junk = addset (tagstk (tagnst), pat, j, MAXPAT) + tagnst = tagnst - 1 + } + else { + junk = addset (CHAR, pat, j, MAXPAT) + junk = addset (esc (arg, i), pat, j, MAXPAT) + } + lastj = lj + } + if (arg (i) != delim) # terminated early + makpat = ERR + else if (addset (EOS, pat, j, MAXPAT) == NO) # no room + makpat = ERR + else if (tagnst != 0) + makpat = ERR + else + makpat = i + return + end diff --git a/unix/boot/spp/rpp/ratlibr/maksub.r b/unix/boot/spp/rpp/ratlibr/maksub.r new file mode 100644 index 00000000..6dd5e049 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/maksub.r @@ -0,0 +1,34 @@ +include defs + +# maksub --- make substitution string in sub + + integer function maksub (arg, from, delim, sub) + character arg (MAXARG), delim, sub (MAXPAT) + integer from + + character esc, type + + integer i, j, junk + integer addset + + j = 1 + for (i = from; arg (i) != delim & arg (i) != EOS; i = i + 1) + if (arg (i) == AND) { + junk = addset (DITTO, sub, j, MAXPAT) + junk = addset (0, sub, j, MAXPAT) + } + else if (arg (i) == ESCAPE & type (arg (i + 1)) == DIGIT) { + i = i + 1 + junk = addset (DITTO, sub, j, MAXPAT) + junk = addset (arg (i) - DIG0, 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) # no room + maksub = ERR + else + maksub = i + return + end diff --git a/unix/boot/spp/rpp/ratlibr/match.r b/unix/boot/spp/rpp/ratlibr/match.r new file mode 100644 index 00000000..c708f4cd --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/match.r @@ -0,0 +1,18 @@ +include defs + +# match --- find match anywhere on line + + integer function match (lin, pat) + character lin (MAXLINE), pat (MAXPAT) + + integer i, junk (9) + integer amatch + + for (i = 1; lin (i) != EOS; i = i + 1) + if (amatch (lin, i, pat, junk, junk) > 0) { + match = YES + return + } + match = NO + return + end diff --git a/unix/boot/spp/rpp/ratlibr/mktabl.r b/unix/boot/spp/rpp/ratlibr/mktabl.r new file mode 100644 index 00000000..9269b18c --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/mktabl.r @@ -0,0 +1,24 @@ +include defs + +# mktabl --- make a new (empty) symbol table + + pointer function mktabl (nodsiz) + integer nodsiz + + DS_DECL(Mem, 1) + + pointer st + pointer dsget + + integer i + + st = dsget (ST_HTABSIZE + 1) # +1 for record of nodsiz + Mem (st) = nodsiz + mktabl = st + do i = 1, ST_HTABSIZE; { + st = st + 1 + Mem (st) = LAMBDA # null link + } + + return + end diff --git a/unix/boot/spp/rpp/ratlibr/mntoc.r b/unix/boot/spp/rpp/ratlibr/mntoc.r new file mode 100644 index 00000000..55d3fedd --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/mntoc.r @@ -0,0 +1,74 @@ +include defs + +# mntoc --- translate ASCII mnemonic into a character + + character function mntoc (buf, p, defalt) + character buf (ARB), defalt + integer p + + integer i, tp + integer equal + + character c, tmp (MAXLINE) + + character text (170) + data text / _ + ACK, LETA, LETC, LETK, EOS, + BEL, LETB, LETE, LETL, EOS, + BS, LETB, LETS, EOS, EOS, + CAN, LETC, LETA, LETN, EOS, + CR, LETC, LETR, EOS, EOS, + DC1, LETD, LETC, DIG1, EOS, + DC2, LETD, LETC, DIG2, EOS, + DC3, LETD, LETC, DIG3, EOS, + DC4, LETD, LETC, DIG4, EOS, + DEL, LETD, LETE, LETL, EOS, + DLE, LETD, LETL, LETE, EOS, + EM, LETE, LETM, EOS, EOS, + ENQ, LETE, LETN, LETQ, EOS, + EOT, LETE, LETO, LETT, EOS, + ESC, LETE, LETS, LETC, EOS, + ETB, LETE, LETT, LETB, EOS, + ETX, LETE, LETT, LETX, EOS, + FF, LETF, LETF, EOS, EOS, + FS, LETF, LETS, EOS, EOS, + GS, LETG, LETS, EOS, EOS, + HT, LETH, LETT, EOS, EOS, + LF, LETL, LETF, EOS, EOS, + NAK, LETN, LETA, LETK, EOS, + NUL, LETN, LETU, LETL, EOS, + RS, LETR, LETS, EOS, EOS, + SI, LETS, LETI, EOS, EOS, + SO, LETS, LETO, EOS, EOS, + SOH, LETS, LETO, LETH, EOS, + SP, LETS, LETP, EOS, EOS, + STX, LETS, LETT, LETX, EOS, + SUB, LETS, LETU, LETB, EOS, + SYN, LETS, LETY, LETN, EOS, + US, LETU, LETS, EOS, EOS, + VT, LETV, LETT, EOS, EOS/ + + tp = 1 + repeat { + tmp (tp) = buf (p) + tp = tp + 1 + p = p + 1 + } until (! (IS_LETTER(buf (p)) | IS_DIGIT(buf (p))) + | tp >= MAXLINE) + tmp (tp) = EOS + + if (tp == 2) + c = tmp (1) + else { + call lower (tmp) + for (i = 1; i < 170; i = i + 5) # should use binary search here + if (equal (tmp, text (i + 1)) == YES) + break + if (i < 170) + c = text (i) + else + c = defalt + } + + return (c) + end diff --git a/unix/boot/spp/rpp/ratlibr/omatch.r b/unix/boot/spp/rpp/ratlibr/omatch.r new file mode 100644 index 00000000..598a4e24 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/omatch.r @@ -0,0 +1,48 @@ +include defs + +# omatch --- try to match a single pattern at pat (j) + + integer function omatch (lin, i, pat, j) + character lin (MAXLINE), pat (MAXPAT) + integer i, j + + integer bump + integer locate + + omatch = NO + if (lin (i) == EOS) + return + bump = -1 + if (pat (j) == CHAR) { + if (lin (i) == pat (j + 1)) + bump = 1 + } + else if (pat (j) == BOL) { + if (i == 1) + bump = 0 + } + else if (pat (j) == ANY) { + if (lin (i) != NEWLINE) + bump = 1 + } + else if (pat (j) == EOL) { + if (lin (i) == NEWLINE) + bump = 0 + } + else if (pat (j) == CCL) { + if (locate (lin (i), pat, j + 1) == YES) + bump = 1 + } + else if (pat (j) == NCCL) { + if (lin (i) != NEWLINE & locate (lin (i), pat, j + 1) == NO) + bump = 1 + } + else + call error ("in omatch: can't happen.") + if (bump >= 0) { + i = i + bump + omatch = YES + } + + return + end diff --git a/unix/boot/spp/rpp/ratlibr/outsub.r b/unix/boot/spp/rpp/ratlibr/outsub.r new file mode 100644 index 00000000..ac657efe --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/outsub.r @@ -0,0 +1,25 @@ +include defs + +# outsub - determine if argument is STDOUT substitution + + integer function outsub (arg, file, access) + character arg (ARB), file (ARB) + integer access + + if (arg (1) == GREATER & arg (2) != GREATER & arg (2) != EOS) { + outsub = YES + access = WRITE + call scopy (arg, 2, file, 1) + } + + else if (arg (1) == GREATER & arg (2) == GREATER & arg (3) != EOS) { + access = APPEND + outsub = YES + call scopy (arg, 3, file, 1) + } + + else + outsub = NO + + return + end diff --git a/unix/boot/spp/rpp/ratlibr/patsiz.r b/unix/boot/spp/rpp/ratlibr/patsiz.r new file mode 100644 index 00000000..54265b64 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/patsiz.r @@ -0,0 +1,21 @@ +include defs + +# patsiz --- returns size of pattern entry at pat (n) + + integer function patsiz (pat, n) + character pat (MAXPAT) + integer n + + if (pat (n) == CHAR | pat (n) == START_TAG | pat (n) == STOP_TAG) + patsiz = 2 + else if (pat (n) == BOL | pat (n) == EOL | pat (n) == ANY) + patsiz = 1 + else if (pat (n) == CCL | pat (n) == NCCL) + patsiz = pat (n + 1) + 2 + else if (pat (n) == CLOSURE) # optional + patsiz = CLOSIZE + else + call error ("in patsiz: can't happen.") + + return + end diff --git a/unix/boot/spp/rpp/ratlibr/prompt.r b/unix/boot/spp/rpp/ratlibr/prompt.r new file mode 100644 index 00000000..2648993c --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/prompt.r @@ -0,0 +1,19 @@ +include defs + +# prompt - write to/read from teletype + + subroutine prompt (str, buf, fd) + character str(ARB), buf(ARB) + filedes fd + + integer isatty + + if (isatty(fd) == YES) + { + call putlin (str, fd) + call flush (fd) + } + call getlin (buf, fd) + + return + end diff --git a/unix/boot/spp/rpp/ratlibr/putc.r b/unix/boot/spp/rpp/ratlibr/putc.r new file mode 100644 index 00000000..3ba16c13 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/putc.r @@ -0,0 +1,11 @@ +include defs + +# putc - put character onto STDOUT + + subroutine putc (c) + character c + + call putch (c, STDOUT) + + return + end diff --git a/unix/boot/spp/rpp/ratlibr/putdec.r b/unix/boot/spp/rpp/ratlibr/putdec.r new file mode 100644 index 00000000..6f7bb195 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/putdec.r @@ -0,0 +1,20 @@ +include defs + +# putdec - put decimal integer n in field width >= w + + subroutine putdec(n,w) + integer n, w + + character chars (MAXCHARS) + + integer i, nd + integer itoc + + nd = itoc (n, chars, MAXCHARS) + for (i = nd + 1; i <= w; i = i + 1) + call putc (BLANK) + for (i = 1; i <= nd; i = i + 1) + call putc (chars (i)) + + return + end diff --git a/unix/boot/spp/rpp/ratlibr/putint.r b/unix/boot/spp/rpp/ratlibr/putint.r new file mode 100644 index 00000000..0fed044b --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/putint.r @@ -0,0 +1,18 @@ +include defs + +# putint - output integer in specified field + + subroutine putint (n, w, fd) + integer n, w + filedes fd + + character chars (MAXCHARS) + + integer junk + integer itoc + + junk = itoc (n, chars, MAXCHARS) + call putstr (chars, w, fd) + + return + end diff --git a/unix/boot/spp/rpp/ratlibr/putstr.r b/unix/boot/spp/rpp/ratlibr/putstr.r new file mode 100644 index 00000000..497e34d9 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/putstr.r @@ -0,0 +1,23 @@ +include defs + +# putstr - output character string in specified field + + subroutine putstr (str, w, fd) + character str (ARB) + integer w + filedes fd + + character length + + integer i, len + + len = length (str) + for (i = len + 1; i <= w; i = i + 1) + call putch (BLANK, fd) + for (i = 1; i <= len; i = i + 1) + call putch (str (i), fd) + for (i = (-w) - len; i > 0; i = i - 1) + call putch (BLANK, fd) + + return + end diff --git a/unix/boot/spp/rpp/ratlibr/query.r b/unix/boot/spp/rpp/ratlibr/query.r new file mode 100644 index 00000000..80e049be --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/query.r @@ -0,0 +1,17 @@ +include defs + +# query - print usage message if user has requested one + + subroutine query (mesg) + character mesg (ARB) + + integer getarg + + character arg1 (3), arg2 (1) + + if (getarg (1, arg1, 3) != EOF & getarg (2, arg2, 1) == EOF) + if (arg1 (1) == QMARK & arg1 (2) == EOS) + call error (mesg) + + return + end diff --git a/unix/boot/spp/rpp/ratlibr/rmtabl.r b/unix/boot/spp/rpp/ratlibr/rmtabl.r new file mode 100644 index 00000000..16a5d3d5 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/rmtabl.r @@ -0,0 +1,27 @@ +include defs + +# rmtabl --- remove a symbol table, deleting all entries + + subroutine rmtabl (st) + pointer st + + DS_DECL(Mem, 1) + + integer i + + pointer walker, bucket, node + + bucket = st + do i = 1, ST_HTABSIZE; { + bucket = bucket + 1 + walker = Mem (bucket) + while (walker != LAMBDA) { + node = walker + walker = Mem (node + ST_LINK) + call dsfree (node) + } + } + + call dsfree (st) + return + end diff --git a/unix/boot/spp/rpp/ratlibr/scopy.r b/unix/boot/spp/rpp/ratlibr/scopy.r new file mode 100644 index 00000000..0878f45a --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/scopy.r @@ -0,0 +1,19 @@ +include defs + +# scopy - copy string at from (i) to to (j) + + subroutine scopy (from, i, to, j) + character from (ARB), to (ARB) + integer i, j + + integer k1, k2 + + k2 = j + for (k1 = i; from (k1) != EOS; k1 = k1 + 1) { + to (k2) = from (k1) + k2 = k2 + 1 + } + to (k2) = EOS + + return + end diff --git a/unix/boot/spp/rpp/ratlibr/sctabl.r b/unix/boot/spp/rpp/ratlibr/sctabl.r new file mode 100644 index 00000000..73b0b308 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/sctabl.r @@ -0,0 +1,59 @@ +include defs + +# sctabl --- scan symbol table, returning next entry or EOF + + integer function sctabl (table, sym, info, posn) + pointer table, posn + character sym (ARB) + integer info (ARB) + + DS_DECL(Mem, 1) + + pointer bucket, walker + pointer dsget + + integer nodsiz, i, j + + if (posn == 0) { # just starting scan? + posn = dsget (2) # get space for position info + Mem (posn) = 1 # get index of first bucket + Mem (posn + 1) = Mem (table + 1) # get pointer to first chain + } + + bucket = Mem (posn) # recover previous position + walker = Mem (posn + 1) + nodsiz = Mem (table) + + repeat { # until the next symbol, or none are left + if (walker != LAMBDA) { # symbol available? + i = walker + ST_DATA + nodsiz + j = 1 + while (Mem (i) != EOS) { + sym (j) = Mem (i) + i = i + 1 + j = j + 1 + } + sym (j) = EOS + for (i = 1; i <= nodsiz; i = i + 1) { + j = walker + ST_DATA + i - 1 + info (i) = Mem (j) + } + Mem (posn) = bucket # save position of next symbol + Mem (posn + 1) = Mem (walker + ST_LINK) + sctabl = 1 # not EOF + return + } + else { + bucket = bucket + 1 + if (bucket > ST_HTABSIZE) + break + j = table + bucket + walker = Mem (j) + } + } + + call dsfree (posn) # throw away position information + posn = 0 + sctabl = EOF + return + end diff --git a/unix/boot/spp/rpp/ratlibr/sdrop.r b/unix/boot/spp/rpp/ratlibr/sdrop.r new file mode 100644 index 00000000..fb3169cd --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/sdrop.r @@ -0,0 +1,20 @@ +include defs + +# sdrop --- drop characters from a string APL-style + + integer function sdrop (from, to, chars) + character from (ARB), to (ARB) + integer chars + + integer len, start + integer ctoc, length, min0 + + len = length (from) + if (chars < 0) + return (ctoc (from, to, len + chars + 1)) + else { + start = min0 (chars, len) + return (ctoc (from (start + 1), to, len + 1)) + } + + end diff --git a/unix/boot/spp/rpp/ratlibr/skipbl.r b/unix/boot/spp/rpp/ratlibr/skipbl.r new file mode 100644 index 00000000..9058d09b --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/skipbl.r @@ -0,0 +1,13 @@ +include defs + +# skipbl - skip blanks and tabs at lin(i) + + subroutine skipbl(lin, i) + character lin(ARB) + integer i + + while (lin (i) == BLANK | lin (i) == TAB) + i = i + 1 + + return + end diff --git a/unix/boot/spp/rpp/ratlibr/slstr.r b/unix/boot/spp/rpp/ratlibr/slstr.r new file mode 100644 index 00000000..92d82123 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/slstr.r @@ -0,0 +1,36 @@ +include defs + +# slstr --- slice a substring from a string + + integer function slstr (from, to, first, chars) + character from (ARB), to (ARB) + integer first, chars + + integer len, i, j, k + integer length + + len = length (from) + + i = first + if (i < 1) + i = i + len + 1 + + if (chars < 0) { + i = i + chars + 1 + chars = - chars + } + + j = i + chars - 1 + if (i < 1) + i = 1 + if (j > len) + j = len + + for (k = 0; i <= j; k = k + 1) { + to (k + 1) = from (i) + i = i + 1 + } + to (k + 1) = EOS + + return (k) + end diff --git a/unix/boot/spp/rpp/ratlibr/stake.r b/unix/boot/spp/rpp/ratlibr/stake.r new file mode 100644 index 00000000..52a9a096 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/stake.r @@ -0,0 +1,20 @@ +include defs + +# stake --- take characters from a string APL-style + + integer function stake (from, to, chars) + character from (ARB), to (ARB) + integer chars + + integer len, start + integer length, ctoc, max0 + + len = length (from) + if (chars < 0) { + start = max0 (len + chars, 0) + return (ctoc (from (start + 1), to, len + 1)) + } + else + return (ctoc (from, to, chars + 1)) + + end diff --git a/unix/boot/spp/rpp/ratlibr/stclos.r b/unix/boot/spp/rpp/ratlibr/stclos.r new file mode 100644 index 00000000..37cac0c5 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/stclos.r @@ -0,0 +1,24 @@ +include defs + +# stclos --- insert closure entry at pat (j) + + integer function stclos (pat, j, lastj, lastcl) + character pat (MAXPAT) + integer j, lastj, lastcl + + integer addset + integer jp, jt, junk + + for (jp = j - 1; jp >= lastj; jp = jp - 1) { # make a hole + jt = jp + CLOSIZE + junk = addset (pat (jp), pat, jt, MAXPAT) + } + j = j + CLOSIZE + stclos = lastj + junk = addset (CLOSURE, pat, lastj, MAXPAT) # put closure in it + junk = addset (0, pat, lastj, MAXPAT) # COUNT + junk = addset (lastcl, pat, lastj, MAXPAT) # PREVCL + junk = addset (0, pat, lastj, MAXPAT) # START + + return + end diff --git a/unix/boot/spp/rpp/ratlibr/stcopy.r b/unix/boot/spp/rpp/ratlibr/stcopy.r new file mode 100644 index 00000000..5c5b2396 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/stcopy.r @@ -0,0 +1,17 @@ +include defs + +# stcopy - copy string from in (i) to out (j), updating j, excluding EOS + + subroutine stcopy (in, i, out, j) + character in (ARB), out (ARB) + integer i, j + + integer k + + for (k = i; in (k) != EOS; k = k + 1) { + out (j) = in (k) + j = j + 1 + } + out(j) = EOS + return + end diff --git a/unix/boot/spp/rpp/ratlibr/stlu.r b/unix/boot/spp/rpp/ratlibr/stlu.r new file mode 100644 index 00000000..2f173b1c --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/stlu.r @@ -0,0 +1,36 @@ +include defs + +# stlu --- symbol table lookup primitive + + integer function stlu (symbol, node, pred, st) + character symbol (ARB) + pointer node, pred, st + + DS_DECL(Mem, 1) + + integer hash, i, j, nodsiz + + nodsiz = Mem (st) + + hash = 0 + for (i = 1; symbol (i) != EOS; i = i + 1) + hash = hash + symbol (i) + hash = mod (hash, ST_HTABSIZE) + 1 + + pred = st + hash + node = Mem (pred) + while (node != LAMBDA) { + i = 1 + j = node + ST_DATA + nodsiz + while (symbol (i) == Mem (j)) { + if (symbol (i) == EOS) + return (YES) + i = i + 1 + j = j + 1 + } + pred = node + node = Mem (pred + ST_LINK) + } + + return (NO) + end diff --git a/unix/boot/spp/rpp/ratlibr/strcmp.r b/unix/boot/spp/rpp/ratlibr/strcmp.r new file mode 100644 index 00000000..9bc12c6a --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/strcmp.r @@ -0,0 +1,24 @@ +include defs + +# strcmp - compare 2 strings; return -1 if <, 0 if =, +1 if > + + integer function strcmp (str1, str2) + character str1 (ARB), str2 (ARB) + + integer i + + for (i = 1; str1 (i) == str2 (i); i = i + 1) + if (str1 (i) == EOS) + return (0) + + if (str1 (i) == EOS) + strcmp = -1 + else if (str2 (i) == EOS) + strcmp = + 1 + else if (str1 (i) < str2 (i)) + strcmp = -1 + else + strcmp = +1 + + return + end diff --git a/unix/boot/spp/rpp/ratlibr/strim.r b/unix/boot/spp/rpp/ratlibr/strim.r new file mode 100644 index 00000000..ed082ef2 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/strim.r @@ -0,0 +1,18 @@ +include defs + +# strim --- trim trailing blanks and tabs from a string + + integer function strim (str) + character str (ARB) + + integer lnb, i + + lnb = 0 + for (i = 1; str (i) != EOS; i = i + 1) + if (str (i) != BLANK & str (i) != TAB) + lnb = i + + str (lnb + 1) = EOS + return (lnb) + + end diff --git a/unix/boot/spp/rpp/ratlibr/termin.r b/unix/boot/spp/rpp/ratlibr/termin.r new file mode 100644 index 00000000..0eb0c78b --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/termin.r @@ -0,0 +1,12 @@ +include defs + +# termin - pick up name of input channel to users teletype + + subroutine termin (name) + character name (ARB) + + string tname TERMINAL_IN + + call scopy (tname, 1, name, 1) + return + end diff --git a/unix/boot/spp/rpp/ratlibr/trmout.r b/unix/boot/spp/rpp/ratlibr/trmout.r new file mode 100644 index 00000000..672bc0fe --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/trmout.r @@ -0,0 +1,12 @@ +include defs + +# trmout - pick up name of output channel to users teletype + + subroutine trmout (name) + character name (ARB) + + string tname TERMINAL_OUT + + call scopy (tname, 1, name, 1) + return + end diff --git a/unix/boot/spp/rpp/ratlibr/type.r b/unix/boot/spp/rpp/ratlibr/type.r new file mode 100644 index 00000000..c98c9655 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/type.r @@ -0,0 +1,99 @@ +include defs + +# type - determine type of character + + character function type (c) + + character c + + if ((LETA <= c & c <= LETZ) | (BIGA <= c & c <= BIGZ)) + type = LETTER + else if (DIG0 <= c & c <= DIG9) + type = DIGIT + else + type = c + + # The original version used a table look-up; you'll have to + # use that method if you have subverted the convention to + # use ASCII characters internally: + # integer index + # character digits(11), lowalf(27), upalf(27) + # data digits(1) /DIG0/ + # data digits(2) /DIG1/ + # data digits(3) /DIG2/ + # data digits(4) /DIG3/ + # data digits(5) /DIG4/ + # data digits(6) /DIG5/ + # data digits(7) /DIG6/ + # data digits(8) /DIG7/ + # data digits(9) /DIG8/ + # data digits(10) /DIG9/ + # data digits(11) /EOS/ + # + # data lowalf(1) /LETA/ + # data lowalf(2) /LETB/ + # data lowalf(3) /LETC/ + # data lowalf(4) /LETD/ + # data lowalf(5) /LETE/ + # data lowalf(6) /LETF/ + # data lowalf(7) /LETG/ + # data lowalf(8) /LETH/ + # data lowalf(9) /LETI/ + # data lowalf(10) /LETJ/ + # data lowalf(11) /LETK/ + # data lowalf(12) /LETL/ + # data lowalf(13) /LETM/ + # data lowalf(14) /LETN/ + # data lowalf(15) /LETO/ + # data lowalf(16) /LETP/ + # data lowalf(17) /LETQ/ + # data lowalf(18) /LETR/ + # data lowalf(19) /LETS/ + # data lowalf(20) /LETT/ + # data lowalf(21) /LETU/ + # data lowalf(22) /LETV/ + # data lowalf(23) /LETW/ + # data lowalf(24) /LETX/ + # data lowalf(25) /LETY/ + # data lowalf(26) /LETZ/ + # data lowalf(27) /EOS/ + # + # data upalf(1) /BIGA/ + # data upalf(2) /BIGB/ + # data upalf(3) /BIGC/ + # data upalf(4) /BIGD/ + # data upalf(5) /BIGE/ + # data upalf(6) /BIGF/ + # data upalf(7) /BIGG/ + # data upalf(8) /BIGH/ + # data upalf(9) /BIGI/ + # data upalf(10) /BIGJ/ + # data upalf(11) /BIGK/ + # data upalf(12) /BIGL/ + # data upalf(13) /BIGM/ + # data upalf(14) /BIGN/ + # data upalf(15) /BIGO/ + # data upalf(16) /BIGP/ + # data upalf(17) /BIGQ/ + # data upalf(18) /BIGR/ + # data upalf(19) /BIGS/ + # data upalf(20) /BIGT/ + # data upalf(21) /BIGU/ + # data upalf(23) /BIGW/ + # data upalf(24) /BIGX/ + # data upalf(25) /BIGY/ + # data upalf(26) /BIGZ/ + # data upalf(27) /EOS/ + # + # if (index(lowalf, c) > 0) + # type = LETTER + # else if (index(upalf,c) >0) + # type = LETTER + # else if (index(digits,c) > 0) + # type = DIGIT + # else + # type = c + + + return + end diff --git a/unix/boot/spp/rpp/ratlibr/upper.r b/unix/boot/spp/rpp/ratlibr/upper.r new file mode 100644 index 00000000..0fc337bb --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/upper.r @@ -0,0 +1,16 @@ +include defs + +# upper - fold all alphas to upper case + + subroutine upper (token) + character token (ARB) + + character cupper + + integer i + + for (i = 1; token (i) != EOS; i = i + 1) + token (i) = cupper (token (i)) + + return + end diff --git a/unix/boot/spp/rpp/ratlibr/wkday.r b/unix/boot/spp/rpp/ratlibr/wkday.r new file mode 100644 index 00000000..027d14a2 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibr/wkday.r @@ -0,0 +1,23 @@ +include defs + +# wkday --- get day-of-week corresponding to month,day,year + + integer function wkday (month, day, year) + integer month, day, year + + integer lmonth, lday, lyear + + lmonth = month - 2 + lday = day + lyear = year + + if (lmonth <= 0) { + lmonth = lmonth + 12 + lyear = lyear - 1 + } + + wkday = mod (lday + (26 * lmonth - 2) / 10 + lyear + lyear / 4 - 34, + 7) + 1 + + return + end |