GET ".ECCE-HDR"

/*-------------------------------------------------------------------------

Module for handling parameters to programs sensibly, in CTL terms the
logical handling of literal data.

The template supplied by the application program is a string of the form:

<template name> <argument name> <argument type> { ( {default string} ) }
                <next argument> ... etc

Any argument not having a default must be specified by the user otherwise
the default will apply to any unspecified argument. A null default is
specified using ().

EXAMPLE

ECCE FROM 0 TO 0 () WITH 0 (**) OPT 255 ()

The types are integers having the same meaning as those returned by AOF
analyse.

---------------------------------------------------------------------------

The template is compiled into the following form:

TABLE <Template name>,
      <argument 1>, <type>, <default>,
      <argument 2>, <type>, <default>,
      0

where <argument 1> is a pointer to a 16 character zero filled name,
      <type> is an integer,
      <default> is a BCPL string or 0 meaning null, -1 meaning no default.

-------------------------------------------------------------------------*/

MANIFEST $(argitem
arg_name=0
arg_type=1
arg_default=2
arg_size=3
$)argitem

MANIFEST $(errors
missing_arg = -1
bad_arg = -2
repeated_arg = -3
too_small = -4
$)errors

STATIC $(
arg_ptr = ?  // used by 'arg_err_report' to locate argument name.
$)

LET name(type) = VALOF
$( SWITCHON type INTO
   $( CASE 0:   RESULTIS "Filespec"
      CASE 255: RESULTIS "Name"
      CASE 254: RESULTIS "label"
      CASE 253: RESULTIS "Number"
      CASE 252: RESULTIS "String"
      CASE 251: RESULTIS "Numeric"
      CASE 249: RESULTIS "Number-label"
      CASE 248: RESULTIS "Null"
      CASE 247: RESULTIS "Semi-colon"
      CASE 246: RESULTIS "End"
      DEFAULT:  RESULTIS "Not a literal data type"
   $)
$)

LET size(item) = VALOF 
$( LET type = item%0

   RESULTIS  type=0 -> 19, 
                type=252 -> (item!1+5) >> 1,
                    (255-type)!TABLE 19, 19, 3, 0, 2, 0, 19, 1, 1, 1
$)

LET compare_strings(s1, s2) = VALOF
$( FOR i=1 TO s1%0 DO
      UNLESS uppercase(s1%i) = uppercase(s2%i) RESULTIS FALSE
   RESULTIS TRUE
$)
 
LET arg_err_report(err_code, proforma) BE
$( LET s = VALOF
   SWITCHON err_code INTO
   $( CASE missing_arg:  RESULTIS "Missing argument - %S"
      CASE bad_arg:      RESULTIS "Argument %S should be of type %S"
      CASE repeated_arg: RESULTIS "Repeated argument - %S"
      DEFAULT:           RESULTIS "Bad err_code"
   $)
   writef("%S: ", !proforma)
   writef(s, !arg_ptr, name(arg_ptr!arg_type))
   newline()
$)
 
LET request_user(arg_desc, sv) BE
$( LET v = vec 80
   LET s = !sv

   $( askfor(-1, arg_desc!arg_name, v)
      TEST v%0=0 THEN
      $( IF arg_desc!arg_default<0 LOOP
         IF arg_desc!arg_default=0 RETURN
         analyse.it(arg_desc!arg_default, s)
      $)
      ELSE analyse.it(v, s)
      IF s%0=arg_desc!arg_type THEN
      $( arg_desc!arg_default:=s
         !sv+:=size(s)
         RETURN
      $)
   $) REPEAT
$)

LET default_litdat() = litdat!0=20 & litdat%2=0 & litdat%7=3

LET to_string(name) = VALOF
// convert 16 char space-filled (with parity) name to bcpl string
$( FOR i=0 TO 15 DO
   $( LET ch=name%i & #X7F
      IF ch=' ' THEN
      $( workspace%0:=i
         RESULTIS workspace
      $)
      workspace%(i+1):=ch
   $)
   workspace%0:=16
   RESULTIS workspace
$)

LET help_requested() = litdat!0=20 & 
                       (litdat%2=lit.name | litdat%2=lit.label) & 
                         compare_strings(to_string(litdat+12), "PROFORMA")
 
LET lookup_keyword(proforma, keyword) = VALOF
$( IF keyword%0 = 0 RESULTIS -1
   proforma +:=1
   UNTIL !proforma=0 DO
   $( IF comparestrings(keyword, !proforma, FALSE) RESULTIS proforma
      proforma +:= arg_size
   $)
   RESULTIS -1
$)

LET get_arg(proforma, arg) = VALOF
$( LET r = lookup_keyword(proforma, arg)
   RESULTIS r<0 -> r, r!arg_default
$)

LET assign_args(proforma) = VALOF
$( LET param_ptr = litdat+1
   LET next_arg = proforma+1
   LET param_max = litdat+litdat!0

   WHILE param_ptr < param_max DO
   $( arg_ptr := next_arg
      IF param_ptr%0 = lit.name | param_ptr%0 = lit.label THEN
      $( // possibly a keyword
         LET p = lookup_keyword(proforma, to_string(param_ptr+11))
         UNLESS p<0 DO
         $( param_ptr +:= 19
            arg_ptr := p
            IF param_ptr>=param_max RESULTIS missing_arg
         $)
      $)
      IF arg_ptr!arg_type<0 RESULTIS repeated_arg
      UNLESS param_ptr%0=arg_ptr!arg_type RESULTIS bad_arg
      arg_ptr!arg_default:=param_ptr
      arg_ptr!arg_type:=-1
      param_ptr+:=size(param_ptr)

      next_arg+:=arg_size
   $)
$)

LET assign_defaults(proforma) = VALOF
$( LET param_space=litdat+litdat!0
   
   arg_ptr:=proforma+1    // use static for 'arg_err_report'
   UNTIL !arg_ptr=0 DO
   $( IF arg_ptr!arg_type >= 0 &
         arg_ptr!arg_default \= 0 THEN
      $( // unassigned
         TEST arg_ptr!arg_default<0 
         THEN request_user(arg_ptr, @param_space)
         ELSE 
         $( analyse.it(arg_ptr!arg_default, param_space) 
            arg_ptr!arg_default:=param_space
            param_space+:=size(param_space)
         $)
      $)
      arg_ptr+:=arg_size
   $)
   RESULTIS 0
$)

LET request_all(proforma) BE
$( LET param_space = litdat
   proforma+:=1
   UNTIL !proforma=0 DO
   $( request_user(proforma, @param_space)
      proforma+:=arg_size
   $)
$)

LET compile_proforma(template, proforma, size) = VALOF
$( STATIC $( tp = ?
             t = ?
             free = ?
          $)

   LET read_type() = VALOF
   $( LET n,d = 0, t%tp
      
      WHILE '0'<=d<='9' DO
      $( n:=n*10+(d-'0')
         tp+:=1
         d:=t%tp
      $)
      RESULTIS n
   $)

   LET skip_to() BE WHILE t%tp<=' ' DO tp+:=1

   LET read_string(max, term) = VALOF
   $( LET first=tp-1 
      FOR i=0 TO max-1 DO
      $( IF t%tp=term THEN
         $( free-:=(i+2)>>1
            FOR j=1 TO i DO
               free%j:=t%(first+j)
            free%0:=i
            tp+:=1           // skip terminator
            RESULTIS free
         $)
         tp+:=1
      $)
      RESULTIS -1
   $)

   LET read_default() = VALOF
   $( LET r = ?
      UNLESS t%tp='[' RESULTIS -1
      tp+:=1
      skip_to()
      
      IF t%tp=']' THEN
      $( tp+:=1
         RESULTIS 0
      $)

      r:= read_string(255,']')
      tp+:=1                   // remove trailing ']'
      RESULTIS r
   $)
   
   t,tp := template, 1
   free := proforma+size

   proforma!0:=read_string(16, ' ')
   proforma+:=1 

   UNTIL tp>template%0 DO
   $( skip_to()
      proforma!arg_name:=read_string(16, ' '); skip_to()
      proforma!arg_type:=read_type(); skip_to()
      proforma!arg_default:=read_default()
      proforma+:=arg_size
      IF proforma>=free RESULTIS too_small
   $)
   !proforma:=0   // tie off structure
   RESULTIS 0
$)

LET print_proforma(p) BE
$( newline()
   writef("PROFORMA %S*N", !p); p+:=1

   UNTIL !p=0 DO
   $( writef("   %S %S ", p!arg_name, name(p!arg_type))
      TEST p!arg_default=0 THEN
         writes("()")
      ELSE UNLESS p!arg_default<0 DO
         writef("(%S)", p!arg_default)
      newline()
      p+:=arg_size
   $)
$)

LET init_proforma(template, proforma, size) = VALOF
$( LET r = compile_proforma(template, proforma, size)
   IF r<0 RESULTIS r

   TEST default_litdat()
   THEN request_all(proforma)
   ELSE TEST help_requested() THEN
   $( print_proforma(proforma)
      stop(0)
   $)
   ELSE
   $( r:= assign_args(proforma)
      IF r<0 THEN
      $( arg_err_report(r, proforma)
         RESULTIS r
      $)
      assign_defaults(proforma)
   $)
   RESULTIS 0
$)