{PAM: parameter acquisition module}

! GDMR 12/12/88 Make KeepCase the default (only!) mode.

!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)
!$IF VAX or EMAS
{%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
!!!!***** TEMP MOD TO USE REVISED UTIL.IMP ******!!!!!
%include {"INC:}"UTILS:UTIL.IMP" {for STOI, etc -- also PAM flags}
!$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, EXTENDED=PAM EXTENDED+PAM OPTEXTENDED,
              OPTEXTENDED=PAM OPTEXTENDED,
              NULL=PAM NULL, TERMINAL=PAM TERMINAL, SYSTEM=PAM SYSTEM,
              CROSSREF=PAM CROSSREF, STEM=PAM CROSSREFSTEM-crossref,
              NAMELIST=PAM NAMELIST
%constinteger DEFAULTS=16_700+nodefault,
              NBASIC=newgroup!nodefault!major,
              INTY=16_1000, REALY=16_2000,
              ENUMERATION=16_4000, BOOLEAN=16_1000,
              STRINGY=16_8000

%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

%integer%fn EXTPOS(%string(*)%name s)
%integer i;  i = length(s)
  %cycle
    %result = 0 %if i = 0 %or charno(s,i) = ':'
    %result = i %if charno(s,i) = '.'
    i = i-1
  %repeat
%end

%routine ASSIGN(%record(info)%name p,%string(255) 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
    %if p_flags&extended # 0 %start
      i = extpos(word)
      %if i = 0 %or p_flags&optextended = 0 %start
        length(word) = i-1 %if i # 0
        word = word.substring(string(p_addr),
                            extpos(string(p_addr)),length(string(p_addr)))
      %else %if i = length(word) # 0;    !remove trailing dot
        length(word) = length(word)-1
      %finish
    %finish
!GDMR    to upper(word) %if p_flags&keepcase = 0
!    length(word) = p_size %if length(word) > p_size
    string(p_addr) = word
  %finish
  p_flags = p_flags&(\defaults)
%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;  !end of WORD
        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,holdin,holdout
%on %event 4 %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,flags)
  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 = groupsym %or sym = '?' %c
            %or sym = equals %c
            %or (sym = ',' %and flags&namelist = 0) %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)
%string(255) word
%record(info)%name q
!$IF VAX or APM
  %on %event 3 %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 p_flags&(defaults-stem) = crossref %start
    q == pam_params
    word = string(p_addr)
    length(word) = extpos(word)-1 %if extpos(word) # 0
    %while q ## p %cycle
      %if matched(q_text,word) = 0 %start
        word = string(q_addr)
        length(word) = extpos(word)-1 %if p_flags&stem # 0 %and extpos(word) # 0
        assign(p,word,0)
        %exit
      %finish
      q == q_link
    %repeat
  %finish
!$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

%routine DISPOSE ALL(%record(info)%name p)
! In reverse order of creation
  %return %if p == nil
  dispose all(p_link)
  dispose(p)
%end

  insno = 0;  outsno = 0
  pamp == pam
  groupsym = pamp_groupsep
  keysym = pamp_keyflag
  holdin = instream;  holdout = outstream
  select input(0);  select output(0)
  i = 1
  pos == pamp_params
  %if pos == nil %start
    acquire parameters(0) %if parm # "";  !for no param report
  %else
    %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('=',0)
        keyword = word
        reject %if keyword = ""
        cur == pamp_params
        %cycle
          num = matched(cur_text,keyword)
          %if num >= 0 %start
            %if sym = '=' %start
              %exit %if cur_flags&enumeration = 0
            %else
              %exit %if cur_flags&enumeration # 0
            %finish
          %finish
          cur == cur_link
          croak("*Unknown keyword: ",keyword) %if cur == nil
        %repeat
        %if sym = '=' %start
          i = i+1;  skip;  get word(0,cur_flags)
        %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,pos_flags)
        num = 0
        assign(pos,word,num) %if word # ""
        pos == pos_link
      %finish
    %repeat
    cur == pamp_params
    %cycle
      check(cur)
      cur == cur_link
    %repeat %until cur == nil
    dispose all(pamp_params)
    pamp_params == nil;  pamp_allflags = 0
  %finish
  select input(holdin);  select output(holdout)
%end;  !process parameters

!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 or APM
%own%record(info)%name r;  !own to avoid "unassigned" on Vax
  r == new(r)
!$IF 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 %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)
!$IF APM
  %if flags&defaults = system %then variable = ":" %c
  %else %if flags&defaults = terminal %then variable = ":T" %c
  %else %if flags&defaults = null %then variable = ":N"
!$FINISH
  define(text,variable,255,flags&16_0FFF!stringy)
%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

%endoffile