%%s 0/0/0
%%d D 1.1 25-Mar-82 12:08:25 v1.1 1 0
%%c Version 1.1 is the Spring 1982 Distribution of the LBL/Hughes release
%%c of the Software Tools Virtual Operating System software and documentation.
%%T
%%I 1
#-h- cmacro           286  asc  25-mar-82 08:06:41  v1.1 (sw-tools v1.1)
 
 # -cmacro- common block
 # put on a file called 'cmacro'
 # Used only by the macro tool
 
 common /cmacro/ cp, ep, evalst(EVALSIZE)
    integer cp         # current call stack pointer
    integer ep         # next free position in evalst
    character evalst      # evaluation stack
#-h- macro.r        11955  asc  25-mar-82 08:06:44  v1.1 (sw-tools v1.1)
#-h- defns            527  asc  25-mar-82 08:06:14  v1.1 (sw-tools v1.1)
  ## /macsym/ - definitions for macro processor
  # put on a file named 'macsym'
  # Used only by the macro tool
 
 
 define(CALLSIZE,130)
 define(ARGSIZE,100)
 
 define(ARGFLAG,'$')
 
 define(MAXDEF,200)
 define(MAXTOK,100)
 define(DEFTYPE,-4)
 define(IFTYPE,-11)
 define(INCTYPE,-12)
 define(SUBTYPE,-13)
 define(ARITHTYPE,-14)
 
 define(EVALSIZE,500)

ifdef(LARGE_ADDRESS_SPACE)
  define(MEM_SIZE,20000)
elsedef
  define(MEM_SIZE,5000)	# size of dynamic storage region
enddef
 define(PB_SIZE,512)	# size of push back buffer
#-h- main            4753  asc  25-mar-82 08:06:15  v1.1 (sw-tools v1.1)
 ## macro - expand macros with arguments         /*/sor/macror/macros
 
 DRIVER(macro)
 
    character gtoken
    character defn(MAXDEF), t, token(MAXTOK)
    integer tblook, push
    integer ap, argstk(ARGSIZE), callst(CALLSIZE), nlb, plev(CALLSIZE)
    integer int
    include cmacro
 #   string balp '()'
    character balp(3)
 #   string defnam 'define'
    character defnam(7)
 #   string incnam 'incr'
    character incnam(5)
 #   string subnam 'substr'
    character subnam(7)
 #   string ifnam 'ifelse'
    character ifnam(7)
 #   string arnam 'arith'
     character arnam(6)
    integer deftyp(2)
    integer inctyp(2)
    integer subtyp(2)
    integer iftyp(2)
    integer artyp(2)
    integer getarg, i, open
    character file(MAXLINE)

    DS_DECL(Mem,MEM_SIZE)	# dynamic storage region for symbol table
    PB_DECL(PB_SIZE)		# push back buffer for ngetch
 
    # initialize keywords
    data balp(1) /'('/, balp(2) /')'/, balp(3) /EOS/
    data defnam(1) /'d'/, defnam(2) /'e'/, defnam(3) /'f'/
    data defnam(4) /'i'/, defnam(5) /'n'/, defnam(6) /'e'/
    data defnam(7) /EOS/
    data incnam(1)/'i'/,incnam(2)/'n'/,incnam(3)/'c'/,incnam(4)/'r'/
    data incnam(5) /EOS/
    data subnam(1) /'s'/, subnam(2) /'u'/, subnam(3) /'b'/
    data subnam(4) /'s'/, subnam(5) /'t'/, subnam(6) /'r'/
    data subnam(7) /EOS/
    data ifnam(1) /'i'/, ifnam(2) /'f'/, ifnam(3) /'e'/
    data ifnam(4) /'l'/, ifnam(5) /'s'/, ifnam(6) /'e'/
    data ifnam(7) /EOS/
    data deftyp(1) /DEFTYPE/, deftyp(2) /EOS/
    data inctyp(1) /INCTYPE/, inctyp(2) /EOS/
    data subtyp(1) /SUBTYPE/, subtyp(2) /EOS/
    data iftyp(1) /IFTYPE/, iftyp(2) /EOS/
    data artyp(1) /ARITHTYPE/, artyp(2) /EOS/
    data arnam(1) /'a'/, arnam(2) /'r'/, arnam(3) /'i'/, arnam(4) /'t'/,
         arnam(5) /'h'/, arnam(6) /EOS/
 
    call query("usage:  macro [file] ...")
    call tbinit(MEM_SIZE)	# initialize tblook - tbinst block
    call pbinit(PB_SIZE)	# initialize push-back buffer
    call tbinst(defnam, deftyp)
    call tbinst(incnam, inctyp)
    call tbinst(subnam, subtyp)
    call tbinst(ifnam, iftyp)
    call tbinst(arnam, artyp)
 
  for (i=1; ;i=i+1)
    {
    if (getarg(i, file, MAXLINE) == EOF)
         {
         if (i != 1)  break
	 int = STDIN
         }
    else if (file(1) == '-' & file(2) == EOS)
	int = STDIN
    else
	{
	 int = open(file, READ)
	 if (int == ERR)
		call cant (file)
	}
    # initialize pointers, etc.
    bp = 0
    cp = 0
    ap = 1
    ep = 1
    for (t=gtoken(token, MAXTOK, int); t!= EOF;
         t=gtoken(token, MAXTOK, int))
	{
       if (t == ALPHA) {
          if (tblook(token, defn) == NO)
             call puttok(token)
          else {            # defined; put it in eval stack
             cp = cp + 1
             if (cp > CALLSIZE)
                call error("call stack overflow.")
             callst(cp) = ap
             ap = push(ep, argstk, ap)
             call puttok(defn)   # stack definition
             call putchr(EOS)
             ap = push(ep, argstk, ap)
             call puttok(token)   # stack name
             call putchr(EOS)
             ap = push(ep, argstk, ap)
             t = gtoken(token, MAXTOK, int)   # peek at next
             call pbstr(token)
             if (t != '(')   # add ( ) if not present
                call pbstr(balp)
             plev(cp) = 0
             }
          }
       else if (t == '[') {      # strip one level of [ ]
          nlb = 1
          repeat {
             t = gtoken(token, MAXTOK, int)
             if (t == '[')
                nlb = nlb + 1
             else if (t == ']') {
                nlb = nlb - 1
                if (nlb == 0)
                   break
                }
             else if (t == EOF)
                call error("EOF in string.")
             call puttok(token)
             }
          }
       else if (cp == 0)         # not in a macro at all
          call puttok(token)
       else if (t == '(') {
          if (plev(cp) > 0)
             call puttok(token)
          plev(cp) = plev(cp) + 1
          }
       else if (t == ')') {
          plev(cp) = plev(cp) - 1
          if (plev(cp) > 0)
             call puttok(token)
          else {            # end of argument list
             call putchr(EOS)
             call eval(argstk, callst(cp), ap-1)
             ap = callst(cp)   # pop eval stack
             ep = argstk(ap)
             cp = cp - 1
             }
          }
       else if (t == ',' & plev(cp) == 1) {   # new arg
          call putchr(EOS)
          ap = push(ep, argstk, ap)
          }
       else
          call puttok(token)      # just stack it
       }
    if (cp != 0)
       call error("unexpected EOF.")
   if (int != STDIN)
	call close(int)
    }
 
    DRETURN
    end
#-h- doarth           514  asc  25-mar-82 08:06:17  v1.1 (sw-tools v1.1)
 ## doarth - do arithmetic operation
 subroutine doarth(argstk,i,j)
 integer ctoi
 integer argstk(ARGSIZE), i, j, k, l
 character op
 include cmacro
  
 k = argstk(i+2)
 l = argstk(i+4)
 op = evalst(argstk(i+3))
 if (op == '+')
	call pbnum(ctoi(evalst,k)+ctoi(evalst,l))
 else if (op == '-')
	call pbnum(ctoi(evalst,k)-ctoi(evalst,l))
 else if (op ==  '*' )
	call pbnum(ctoi(evalst,k)*ctoi(evalst,l))
 else if (op ==  '/' )
	call pbnum(ctoi(evalst,k)/ctoi(evalst,l))
 else
	call remark("arith error")
 return
 end
#-h- dodef            315  asc  25-mar-82 08:06:17  v1.1 (sw-tools v1.1)
  ## dodef - tbinstl definition in table   /*/sor/macror/dodef
    subroutine dodef(argstk, i, j)
    integer a2, a3, argstk(ARGSIZE), i, j
    include cmacro
 
    if (j - i > 2) {
       a2 = argstk(i+2)
       a3 = argstk(i+3)
       call tbinst(evalst(a2), evalst(a3))   # subarrays
       }
    return
    end
#-h- doif             457  asc  25-mar-82 08:06:18  v1.1 (sw-tools v1.1)
 ## doif - select one of two (macro) arguments    /*/sor/macror/doif
    subroutine doif(argstk, i, j)
    integer equal
    integer a2, a3, a4, a5, argstk(ARGSIZE), i, j
    include cmacro
 
    if (j - i < 5)
       return
    a2 = argstk(i+2)
    a3 = argstk(i+3)
    a4 = argstk(i+4)
    a5 = argstk(i+5)
    if (equal(evalst(a2), evalst(a3)) == YES)   # subarrays
       call pbstr(evalst(a4))
    else
       call pbstr(evalst(a5))
    return
    end
#-h- doincr           252  asc  25-mar-82 08:06:18  v1.1 (sw-tools v1.1)
  ## doincr - increment macro argument by 1    /*/sor/macror/doincr
    subroutine doincr(argstk, i, j)
    integer ctoi
    integer argstk(ARGSIZE), i, j, k
    include cmacro
 
    k = argstk(i+2)
    call pbnum(ctoi(evalst, k)+1)
    return
    end
#-h- dosub            711  asc  25-mar-82 08:06:19  v1.1 (sw-tools v1.1)
  ## dosub - select macro substring   /*/sor/macror/dosub
    subroutine dosub(argstk, i, j)
    integer ctoi, length
    integer ap, argstk(ARGSIZE), fc, i, j, k, nc
    include cmacro
 
    if (j - i < 3)
       return
    if (j - i < 4)
       nc = MAXTOK
    else {
       k = argstk(i+4)
       nc = ctoi(evalst, k)      # number of characters
       }
    k = argstk(i+3)         # origin
    ap = argstk(i+2)         # target string
    fc = ap + ctoi(evalst, k) - 1   # first char of substring
    if (fc >= ap & fc < ap + length(evalst(ap))) {   # subarrays
       k = fc + min(nc, length(evalst(fc))) - 1
       for ( ; k >= fc; k = k - 1)
          call putbak(evalst(k))
       }
    return
    end
#-h- eval            1414  asc  25-mar-82 08:06:20  v1.1 (sw-tools v1.1)
 ## eval - expand args i through j: evaluate builtin or push back defn
    subroutine eval(argstk, i, j)
    integer index, length
    integer argno, argstk(ARGSIZE), i, j, k, m, n, t, td
    include cmacro
 #   string digits '0123456789'
    character digits(11)
    data digits(1) /'0'/
    data digits(2) /'1'/
    data digits(3) /'2'/
    data digits(4) /'3'/
    data digits(5) /'4'/
    data digits(6) /'5'/
    data digits(7) /'6'/
    data digits(8) /'7'/
    data digits(9) /'8'/
    data digits(10) /'9'/
    data digits(11) /EOS/
 
    t = argstk(i)
    td = evalst(t)
    if (td == DEFTYPE)
       call dodef(argstk, i, j)
    else if (td == INCTYPE)
       call doincr(argstk, i, j)
    else if (td == SUBTYPE)
       call dosub(argstk, i, j)
    else if (td == IFTYPE)
       call doif(argstk, i, j)
    else if (td == ARITHTYPE)
        call doarth(argstk, i, j)
    else {
       for (k = t+length(evalst(t))-1; k > t; k = k - 1)
          if (evalst(k-1) != ARGFLAG)
             call putbak(evalst(k))
          else {
             argno = index(digits, evalst(k)) - 1
             if (argno >= 0 & argno < j-i) {
                n = i + argno + 1
                m = argstk(n)
                call pbstr(evalst(m))
                }
             k = k - 1   # skip over $
             }
       if (k == t)         # do last character
          call putbak(evalst(k))
       }
    return
    end
#-h- gtoken           590  asc  25-mar-82 08:06:20  v1.1 (sw-tools v1.1)
  ## gtoken - get alphanumeric string or single non-alph for define
  character function gtoken(token, toksiz, int)
  character ngetc, type
  integer i, toksiz, int
  character token (toksiz)
 
  for (i=1; i<toksiz; i=i+1)
      {
      gtoken = type( ngetch(token(i), int))
      if (gtoken != LETTER & gtoken != DIGIT)
          break
      }
  if (i >= toksiz)
      call error ("token too long.")
  if (i > 1)       # some alpha was seen
      {
      call putbak (token(i))
      i = i - 1
      gtoken = ALPHA
      }
  # else single character token
  token(i+1) = EOS
  return
  end
#-h- pbnum            626  asc  25-mar-82 08:06:21  v1.1 (sw-tools v1.1)
 ## pbnum - convert number to string, push back on input    /*/sor/macror/pbnum
    subroutine pbnum(n)
    integer mod
    integer m, n, num
 #   string digits '0123456789'
    character digits(11)
    data digits(1) /'0'/
    data digits(2) /'1'/
    data digits(3) /'2'/
    data digits(4) /'3'/
    data digits(5) /'4'/
    data digits(6) /'5'/
    data digits(7) /'6'/
    data digits(8) /'7'/
    data digits(9) /'8'/
    data digits(10) /'9'/
    data digits(11) /EOS/
 
    num = n
    repeat {
       m = mod(num, 10)
       call putbak(digits(m+1))
       num = num / 10
       } until (num == 0)
    return
    end
#-h- push             275  asc  25-mar-82 08:06:22  v1.1 (sw-tools v1.1)
 ## push - push ep onto argstk, return new pointer ap   /*/sor/macror/push
    integer function push(ep, argstk, ap)
    integer ap, argstk(ARGSIZE), ep
 
    if (ap > ARGSIZE)
       call error("arg stack overflow.")
    argstk(ap) = ep
    push = ap + 1
    return
    end
#-h- putchr           336  asc  25-mar-82 08:06:22  v1.1 (sw-tools v1.1)
 ## putchr - put single char on output or into eval stack  /*/sor/macror/putchr
    subroutine putchr(c)
    character c
    include cmacro
 
    if (cp == 0)
       call putc(c)
    else {
       if (ep > EVALSIZE)
          call error("evaluation stack overflow.")
       evalst(ep) = c
       ep = ep + 1
       }
    return
    end
#-h- puttok           236  asc  25-mar-82 08:06:23  v1.1 (sw-tools v1.1)
 ## puttok-put token either on output or into eval stack  /*/sor/macror/puttok
    subroutine puttok(str)
    character str(MAXTOK)
    integer i
 
    for (i = 1; str(i) != EOS; i = i + 1)
       call putchr(str(i))
    return
    end
#-h- macro.fmt       6701  asc  25-mar-82 08:06:49  v1.1 (sw-tools v1.1)
.so ~bin/manhdr
.hd Macro (1) 20-May-78
process macro definitions 
.sy
macro [file] ... 
.ds
Macro reads the source file(s) and writes onto the standard output 
a new file with the macro definitions deleted and the macro 
references expanded.  If no file names are specified, the standard 
input is read. 
  
Macros are generally used to extend some underlying language to perform a 
translation from one language to another; that is, a macro 
processor allows one to define symbolic constants so that subsequent 
occurrences of the constant are replaced by the defining 
string of characters. 
The general format is: 
  
.ce 
define(name,replacement text) 
  
All subsequent occurrences of "name" in the file will be replaced 
by "replacement text".  Blanks are significant and may occur only 
inside the replacement text. 
Upper and lower case letters are also significant. 
Nesting of definitions is allowed, as is recursion. 
The definition may be more than one 
line long. 
  
An elementary example of a macro is: 
  
.ce 
define(EOF,-1) 
  
Thereafter, all occurrences of "EOF" in the file would be replaced 
by "-1". 
  
Macros with arguments may also be specified.  Any occurrence in 
the replacement text of "$n", where n is between 1 and 9, 
will be replaced by the nth argument when the macro is actually 
called.  For example, 
  
                define(copen,$3 = open($1,$2) 
                             if ($3 == ERR) 
                                  call cant($1)) 
  
would define a macro which, when called by "copen(name, READ, fd)" 
would expand into: 
  
                fd = open(name,READ) 
                if (fd == ERR) 
                     call cant(name) 
  
If a macro definition asks for an argument that wasn't supplied, 
the "$n" will be ignored. 
  
Macros can be nested, and any macros encountered during argument 
collection are expanded immediately--unless they are surrounded 
by brackets "[]".  That is, any input surrounded by [ and ] is 
left absolutely alone, except that one level of [ and ] is 
stripped off. 
Thus it is possible to write the macro "d" as 
  
.ce 
define(d,[define($1,$2)]) 
  
The replacement text for "d", protected by the brackets is 
literally "define($1,$2)" so one could say 
  
.ce 
d(a,bc) 
  
and be assured that "a" would be defined to be "bc". 
Brackets must also be used when it is desired to redefine an 
identifier: 
  
.ce 
define(x,y) 
.ce 
define(x,z) 
  
would define "y" in the second line, instead of redefining "x". 
To avoid redefining "y", the operation must be expressed as 
  
                                 define(x,y) 
                                 define([x],z) 
  
The macro processor also includes a conditional test, with the 
built-in function "ifelse".  The input 
  
.ce 
ifelse(a,b,c,d) 
  
compares "a" and "b" as character strings.  If they are the same, 
"c" is pushed back onto the input; if they differ, "d" is pushed 
back.  As a simple example, 
  
.ce 
define(compare,[ifelse($1,$2,yes,no)]) 
  
defines "compare" as a two-argument macro returning "yes" if its 
arguments are the same, and "no" if they are not. 
The brackets prevent the "ifelse" from being evaluated too soon. 
  
Another built-in function available is "incr".  "incr(x)" converts 
the string "x" to a number, adds one to it, and returns that as 
its replacement text (as a character string).  "x" had better be 
numeric, or the results may be undesireable.  "incr" can be used 
for tasks like 
  
                   define(MAXCARD,80) 
                   define(MAXLINE,[incr(MAXCARD)]) 
  
which makes two parameters with values 80 and 81. 
  
The third built-in function available in the macro processor 
is a function to take substrings of strings. 
  
.ce 
substr(s, m, n) 
  
produces the substring of "s" which starts at position "m" (with origin 
one), of length "n".  If "n" is omitted or too big, the rest of the 
string is used, while if "m" is out of range the result is a null 
string. 
For example, 
  
.ce 
substr(abc, 2, 1) 
  
results in "b", 
  
.ce 
substr(abc, 2) 
  
results in "bc", and 
  
.ce 
substr(abc,4) 
  
is empty. 
  
  
The last built-in function available in the macro processor is
one to perform simple arithmetic functions:
 
.ce
arith(operand1,op,operand2)
 
where the operation specified by 'op' may be + (add), - (subtract),
* (multiply), or / (divide).
Negative numbers are not handled yet.
Thus,
 
.nf
.in +20
define(add,[arith($1,+,$2)])
add(5,3)
.in -20
.fi
 
would produce the result '8'.
 
As a final example, here is a macro which computes the length 
of a character string: 
  
.ce 
define(len,[ifelse($1,,0,[incr(len(substr($1,2)))])]) 
  
Note the recursion, which is perfectly permissible. 
The outer layer of brackets prevents all evaluation as the 
definition is being copied into an internal table.  The inner 
layer prevents the "incr" construction from being done as the 
arguments of the "ifelse" are collected. 
The value of a macro call "len(abc)" would be 3. 
.fl
none 
.sa
Kernighan and Plauger's "Software Tools", pages 251-283 
.di
arg stack overflow 
.br 
.in +4 
The maximum number of total arguments has been exceeded.  Currently 
this is 100. 
  
.in -4 
call stack overflow 
.br 
.in +4 
The maximum level of nesting of definitions has been exceeded. 
Currently this is 130. 
  
.in -4 
EOF in string 
.br 
.in +4 
An end-of-file has been encountered before a bracketed string has 
been terminated. 
  
.in -4 
evaluation stack overflow 
.br 
.in +4 
The total number of characters for name, definition, and arguments 
has been exceeded.  Currently this is 500. 
  
.in -4 
unexpected EOF 
.br 
.in +4 
An end-of-file was reached before the macro definition was terminated. 
  
.in -4 
filename: cant open 
.br 
.in +4 
For some reason, the file specified could not be opened. 
This is an unlikely error to occur; if it does show up it probably 
indicates a problem with the low-level primitives being used 
by the system. 
.br 
.in -4 
.au
From "Software Tools" by Kernighan and Plauger, with minor 
modifications by Debbie Scherrer. 
.bu
There can be no space between the "define" and the left-parenthesis 
following it. 
  
Keywords (e.g. define, ifelse, etc.) in the input file must be 
surrounded by brackets if they are not part of a macro--otherwise 
they will be stripped out by the processor.  Likewise, if brackets 
are desired anywhere in the input file other than in a macro, they 
must be surrounded by brackets themselves. 
  
The error messages generated by the ratfor compiler when processing 
macros do not seem to show up in this processor.  Examples are 
"definition too long", "missing comma in define", and "non-alphanumeric 
name". 
%%E 1