{PAM: parameter acquisition module}

!Parameter records:
!$IF VAX or APM
%recordformat INFO(%string(255) text,
                   %integer addr,%short size,flags,
                   %record(info)%name link)
!$IF EMAS
{%recordformat INFO(%string(255) text,
{                   %integer addr,%half size,flags,
{                   %record(info)%name link)
%constinteger PAM NEWGROUP=1, PAM NODEFAULT=2, PAM MAJOR=4, PAM KEEPCASE=8,
              PAM INFILE=16, PAM OUTFILE=32
%externalstring(255)%fnspec ITOS(%integer v,p)
%externalinteger%fnspec     STOI(%string(255) s)
!$IF VAX
{%externalstring(127)%fnspec TRANSLATE(%string(127) name)
{!%externalstring(255)%fnspec RTOS(%real v, %integer p,q)
{!%externalreal%fnspec        STOR(%string(255) s)
!$IF APM
!Following removed because of absence of nested includes
!%include "I:UTIL.INC" {for STOI, etc -- also PAM flags}
%recordformat paminfo(%byte GROUPSEP,KEYFLAG, %short allflags,
                      %record(*)%name params)
%external%record(paminfo)%mapspec PAM
%record(*)%map NEW(%integer size)
  aget
  *move a0,size
  %result == record(size)
%end
%routine DISPOSE(%record(*)%name r)
  *lea 256(a0),a0
  *move a0,d6
%end
!$IF EMAS
{%externalroutinespec prompt(%string(15) s)
{%ownrecord(info)%name NIL
{%owninteger free=0
{%ownbyteintegerarray store(0:9999)
{%record(info)%map NEW(%integer size)
{  free = free+size
{  %result == record(addr(store(free-size)))
{%end
{%routine dispose(%record(info)%name v)
{  free = 0
{%end
!$FINISH

%constinteger NEWGROUP=pamnewgroup, NODEFAULT=pamnodefault,
              MAJOR=pammajor,INFILE=paminfile,OUTFILE=pamoutfile,
              KEEPCASE=pamkeepcase
%constinteger NBASIC=newgroup!nodefault!major,
              SBASIC=nbasic!infile!outfile,
              REALY=16_100, INTY=16_200, ENUMERATION=16_400,
              BOOLEAN=16_800, STRINGY=16_1000

%routine CROAK(%string(255) s,t)
  printstring(s);  printstring(t);  newline
  %stop
%end

!$IF VAX
{%recordformat paminfo(%byte GROUPSEP,KEYFLAG, %short allflags,
{                      %record(info)%name params)
!$IF EMAS
{%recordformat paminfo(%byte GROUPSEP,KEYFLAG, %half allflags,
{                      %record(info)%name params)
!$IF VAX or EMAS
{%external%record(paminfo)%map PAM
{%ownrecord(paminfo) P=0
!$IF VAX
{%string(255) translation
{%integerfn choice(%integer which,default)
{  %result = charno(translation,which) %if which <= length(translation) %c
{      %and charno(translation,which) >= ' ' %c
{      %and %not 'a' <= charno(translation,which)!32 <= 'z'
{  %result = default
{%end
{  %if p_groupsep = 0 %start;  !first call
{    translation = translate("PAM_INFO")
{!    p_groupsep = choice(1,' ');  p_keyflag = choice(2,'/')
{    p_groupsep = choice(1,'/');  p_keyflag = choice(2,'-')
{  %finish
!$IF EMAS
{  p_groupsep = '/';  p_keyflag = '-'
!$IF VAX or EMAS
{  %result == p
{%end
!$FINISH

%routine ASSIGN(%record(info)%name p,
                %string(255)%name word,%integer num)
%integer i
  %if p_flags&enumeration # 0 %start
    %if p_flags&boolean # 0 %start
      i = 1<<p_size
      integer(p_addr) = integer(p_addr)&(\i)
      integer(p_addr) = integer(p_addr)!i %if num # 0
    %else
      byteinteger(p_addr) = num
    %finish
  %finish %else %if p_flags&inty # 0 %start
    integer(p_addr) = stoi(word)
!  %finish %else %if p_flags&realy # 0 %start
!    real(p_addr) = stor(word)
  %else;  !string cases
    length(word) = p_size %if length(word) > p_size
    %if p_flags&keepcase = 0 %start
      %for i = 1,1,length(word) %cycle
        charno(word,i) = charno(word,i)-32 %if 'a' <= charno(word,i) <= 'z'
      %repeat
    %finish
    string(p_addr) = word
  %finish
  p_flags = p_flags&(\nodefault)
%end

%integerfn CHAR(%string(*)%name s,%integer i)
  %result = nl %if i > length(s)
  %result = charno(s,i)
%end

%integerfn MATCHED(%string(*)%name name,word)
!Returns -1 for no match; 0,1,2... otherwise
%integer i,wi,k,res
  i = 0;  res = 0
  %cycle
    wi = 0
    %cycle
      i = i+1;  wi = wi+1
      k = char(name,i)
      %if char(word,wi) = nl %start
        i = i+1 %and k = char(name,i) %while 'a' <= k <= 'z'
        %result = res %if k <= ','
      %finish
    %repeat %until k!32 # char(word,wi)!32
    %while k # ',' %cycle
      %result = -1 %if k < ','
      i = i+1;  k = char(name,i)
    %repeat
    res = res+1
  %repeat
%end
    
%routine ACQUIRE(%record(info)%name p)
%integer sym,num,i
%string(255) prom,word
  prom = p_text
  %if p_flags&nodefault = 0 %start
    %if p_flags&enumeration # 0 %start
      %if p_flags&boolean # 0 %then num = integer(p_addr)>>p_size&1 %c
      %else num = byteinteger(p_addr)
      i = 0
      %cycle
        word = "";  i = i+1
        %while char(prom,i) > ',' %cycle
          word = word.tostring(char(prom,i))
          i = i+1
        %repeat
        num = num-1
      %repeat %until num < 0
    %finish %else %if p_flags&inty # 0 %start
      word = itos(integer(p_addr),0)
!    %finish %else %if p_flags&realy # 0 %start
!      word = rtos(real(p_addr),0,3)
    %else;  !string cases
      word = string(p_addr)
    %finish
    prom = prom." [".word."]"
  %finish
  prom = prom.": "
  prompt(prom)
  %cycle
    word = ""
    read symbol(sym) %until sym # ' '
    prompt("") %and %return %if sym < ' '
    %cycle
      word = word.tostring(sym)
      read symbol(sym)
    %repeat %until sym < ' '
    num = 99
    %exit %if p_flags&enumeration = 0
    num = matched(p_text,word)
  %repeat %until num >= 0
  assign(p,word,num)
  prompt("")
%end

%external%routine ACQUIRE PARAMETERS %alias "PAM_ACQUIRE"(%integer full)
%record(info)%name cur
%integer k;k=0
  cur == pam_params
  %while cur ## nil %cycle
    k = k-1
    %if cur_flags&(major!nodefault) # 0 %or full # 0 %start
      acquire(cur);  k = 999
    %finish
    cur == cur_link
  %repeat
  %if k <= 0 %start
    printstring("This command has no ")
    printstring("major ") %if k # 0
    printstring("parameters")
    newline
  %finish
%end

%external%routine PROCESS PARAMETERS %alias "PAM_PROCESS"(%string(255) parm)
%constinteger starting=0,ongoing=1,restarting=2
%string(255) word,keyword
%record(paminfo)%name pamp
%record(info)%name pos,cur
%integer i,ii,j,k,l,sym,num,state,groupsym,keysym
%integer insno,outsno
%on %event 3 %start;  !failure in STOI,STOR
  croak("*Faulty numeric value: ",word)
%finish

%routine skip
  i = i+1 %while char(parm,i) = ' '
%end

%routine next
  i = i+1;  sym = char(parm,i)
%end

%routine get word(%integer equals)
  word = ""
  sym = char(parm,i)
  %if sym = '"' %start
    %cycle
      next
      %return %if sym < ' '
      %if sym = '"' %start
        next
        %return %if sym # '"'
      %finish
      word = word.tostring(sym)
    %repeat
  %finish
  %cycle
    %return %if sym <= ' ' %or sym = ',' %or sym = groupsym %or sym = '?' %c
            %or sym = equals %c
            %or ((sym = '-' %or sym = keysym) %and 'a'<=char(parm,i+1)!32<='z')
    word = word.tostring(sym)
    next
  %repeat
%end

%routine check(%record(info)%name p)
!$IF VAX or APM
  %on %event 9 %start
    select input(0);  select output(0)
    printstring(event_message);  newline
    p_flags = p_flags!nodefault
  %finish
!$FINISH
  %while p_flags&nodefault # 0 %cycle
    acquire(p)
  %repeat
!$IF VAX or APM
  %if p_flags&infile # 0 %start
    open input(insno+1,string(p_addr))
    select input(0)
    insno = insno+1
  %finish %else %if p_flags&outfile # 0 %start
    open output(outsno+1,string(p_addr))
    select output(0)
    outsno = outsno+1
  %finish
!$FINISH
%end

%routine REJECT
  croak("*Faulty form: ",substring(parm,i,length(parm)))
%end

  insno=0;  outsno=0
  pamp == pam
  groupsym = pamp_groupsep
  keysym = pamp_keyflag
  select input(0);  select output(0)
  i = 1
  pos == pamp_params
  %if pos == nil %start
    acquire parameters(0) %if parm # "";  !for no param report
    %return
  %finish
  %cycle
    ii = i;  skip
    sym = char(parm,i)
    %if sym = '?' %start
      next
      %if sym = '?' %then acquire parameters(1) %c
      %else acquire parameters(0)
      %exit
    %finish
    %exit %if sym < ' '
    %if sym = '-' %or sym = keysym %start
      i = i+1
      get word('=')
      keyword = word
      reject %if keyword = ""
      cur == pamp_params
      %cycle
        num = matched(cur_text,keyword)
        %exit %if num >= 0
        cur == cur_link
        croak("*Unknown keyword: ",keyword) %if cur == nil
      %repeat
      %if sym = '=' %start
        reject %if cur_flags&enumeration # 0
        i = i+1;  skip;  get word(0)
      %finish %else %if cur_flags&enumeration = 0 %start
        croak("*No value given for ",keyword)
      %finish
      assign(cur,word,num)
    %else
      %if groupsym = ' ' %and i > ii %and pos ## pamp_params %start
        i = i-1;  sym = ' '
      %finish
      %cycle
        %if pos == nil %or pos_flags&(major+newgroup+stringy) = 0 %start
          croak("*Too many parameters: ",substring(parm,i,length(parm)))
        %finish
        %if sym = ',' %start
          reject %if pos_flags&newgroup # 0
          i = i+1 %if pos ## pamp_params
          %exit
        %finish
        %if sym # groupsym %start
          reject %if pos ## pamp_params %c
                 %or pos_flags&newgroup # 0
          %exit
        %finish
        i = i+1 %and %exit %if pos_flags&newgroup # 0
        pos == pos_link
      %repeat
      skip;  get word(0)
      num = 0
      assign(pos,word,num) %if word # ""
      pos == pos_link
    %finish
  %repeat
!$IF VAX
{  cur == pamp_params
{  %cycle
{    check(cur)
{    pos == cur_link
{    dispose(cur)
{    cur == pos
{  %repeat %until cur == nil
!$IF APM or EMAS
  cur == pamp_params
  %cycle
    check(cur)
    cur == cur_link
  %repeat %until cur == nil
  dispose(pamp_params);  !allocated sequentially
!$FINISH
  pamp_params == nil;  pamp_allflags = 0
%end

!Internal routine with explicit size (&extra flags)
%routine DEFINE(%string(255) text, %name variable, %integer size,flags)
%integer i
%record(paminfo)%name pamp
%record(info)%name list
!$IF VAX
{%own%record(info)%name r;  !own to avoid "unassigned" on Vax
{  r == new(r)
!$IF APM or EMAS
%record(info)%name r
  r == new(sizeof(r))
!$FINISH
  pamp == pam
  flags = flags!newgroup %if flags&outfile # 0 %and pamp_allflags&outfile = 0
  pamp_allflags = pamp_allflags!flags
 ! Set up record details
  r_text = text
  r_addr = addr(variable);  r_size = size
  r_flags = flags;  r_link == nil
 ! Add at end of list
  %if pamp_params == nil %then pamp_params == r %c
  %else %start
    list == pamp_params
    list == list_link %while list_link ## nil
    list_link == r
  %finish
%end

%external%routine DEFINE PARAM %alias "PAM_DEFSTRING" %c
      (%string(255) text, %string(*)%name variable, %integer flags)
!  define(text,variable,sizeof(variable),flags&sbasic!stringy)
  define(text,variable,255,flags&sbasic!stringy);  !**for now**
%end

%external%routine DEFINE INT PARAM %alias "PAM_DEFINT" %c
      (%string(255) text, %integername variable, %integer flags)
  define(text,variable,4,flags&nbasic!inty)
%end

%external%routine DEFINE ENUM PARAM %alias "PAM_DEFENUM" %c
      (%string(255) text, %bytename variable, %integer flags)
  define(text,variable,1,flags&nbasic!enumeration)
%end

%external%routine DEFINE BOOLEAN PARAMS %alias "PAM_DEFBOOL" %c
    (%string(255) text, %integername variable, %integer flags)
%constinteger boolflags=boolean!enumeration
%integer i,j
%string(255) word
  i = 0;  j = 31
  %cycle
    i = i+1;  word = ""
    %exit %if char(text,i) < ' '
    %while char(text,i) > ',' %cycle
      word = word.tostring(char(text,i))
      i = i+1
    %repeat
    define("NO".word.",".word,variable,j,flags&nbasic!boolflags) %if word # ""
    j = j-1
  %repeat
%end

!%external%routine DEFINE REAL PARAM %alias "PAM_DEFREAL"
!    (%string(255) text, %realname variable, %integer flags)
!  define(text,variable,4,flags&nbasic!realy)
!%end
!$IF VAX or EMAS
{%endoffile
!$FINISH
%endoffile
