COMMENT

	These procedures comprise a complete package interfacing
the SAIL programming language with the COMND jsys.  They were
written in 1978 and 1979 by Andrew R. Lowry and David S. Millman
of the Columbia University Center for Computing Activities, User
Services Group.  Many thanks go to Frank da Cruz, Chris Ryland and
Norman Kincl of the CUCCA Systems Group and to Ted Markowitz, Ken
Rossman, Harry Yudenfriend and Jeffrey Slavitz of the CUCCA User
Services Group for their assistance and many suggestions.
;


entry CM!SIZE;
entry CM!IOJ;
entry CM!TAKE;
entry CM!RETRY;
entry CM!GETATM;
entry CM!TBUILD;
entry CM!INI;
entry CM!KEY;
entry CM!CFM;
entry CM!NUM;
entry CM!NOI;
entry CM!IFI;
entry CM!OFI;
entry CM!FIL;
entry CM!CMA;
entry CM!SWI;
entry CM!FLD;
entry CM!USR;
entry CM!DIR;
entry CM!FLT;
entry CM!DEV;
entry CM!TXT;
entry CM!NUX;
entry CM!TOK;
entry CM!UQS;
entry CM!QST;
entry CM!TAD;
entry CM!ACT;
entry CM!NOD;
entry CM#KEY;
entry CM#CFM;
entry CM#NUM;
entry CM#NOI;
entry CM#IFI;
entry CM#OFI;
entry CM#CMA;
entry CM#SWI;
entry CM#FLD;
entry CM#USR;
entry CM#DIR;
entry CM#FLT;
entry CM#DEV;
entry CM#TXT;
entry CM#ACT;
entry CM#TOK;
entry CM#FIL;
entry CM#NOD;
entry CM#NUX;
entry CM#TAD;
entry CM#UQS;
entry Cm#QST;
entry CM#RESET;
entry CM#CALL;

begin "comnd"

require "{}{}" delimiters;
define ! = {comment};

! Macro Definitions
  ================= 
  ;

! *** Data Manipulations;

define	ison(word,mask) = {((word land (mask)) neq 0)};
define	isoff(word,mask) = {((word land (mask))  =  0)};
define	right(word) = {(word land '777777)};
define	left(word) = {((word land '777777000000) rot 18)};
define	bpoint(word) = {(word lor '777777000000)};
define	memloc(str) = {memory[location(str),integer]};
define	hiord(word) = {(word lsh 27)};

! *** Jsys Codes;

define	Comnd = {jsys	'544};
define	Geter = {jsys	'12};
define  Stcmp = {jsys	'540};

! *** Comnd Jsys Function Codes;

define	#CmKey = {hiord('0)};
define	#CmNum = {hiord('1)};
define	#CmNoi = {hiord('2)};
define	#CmSwi = {hiord('3)};
define	#CmIfi = {hiord('4)};
define	#CmOfi = {hiord('5)};
define	#CmFil = {hiord('6)};
define	#CmFld = {hiord('7)};
define	#CmCfm = {hiord('10)};
define	#CmDir = {hiord('11)};
define	#CmUsr = {hiord('12)};
define	#CmCma = {hiord('13)};
define	#CmIni = {hiord('14)};
define	#CmFlt = {hiord('15)};
define	#CmDev = {hiord('16)};
define	#CmTxt = {hiord('17)};
define	#CmTad = {hiord('20)};
define	#CmQst = {hiord('21)};
define	#CmUqs = {hiord('22)};
define	#CmTok = {hiord('23)};
define	#CmNux = {hiord('24)};
define	#CmAct = {hiord('25)};
define	#CmNod = {hiord('26)};

! *** Command State Block;

define	CmFlg = {cm!csb['0]};
define	CmIoj = {cm!csb['1]};
define	CmRty = {cm!csb['2]};
define	CmBfp = {cm!csb['3]};
define	CmPtr = {cm!csb['4]};
define	CmCnt = {cm!csb['5]};
define	CmInc = {cm!csb['6]};
define	CmAbp = {cm!csb['7]};
define	CmAbc = {cm!csb['10]};
define	CmGjb = {cm!csb['11]};

! *** Function Descriptor Block;

define	CmFnp = {cm!fdb[0]};
define	CmDat = {cm!fdb[1]};
define	CmHlp = {cm!fdb[2]};
define	CmDef = {cm!fdb[3]};
define	CmBrk = {cm!fdb[4]};

! *** Multiple Function Descriptor Block;

define	CmMFnp = {cm#fdb[cm#level,0]};
define	CmMDat = {cm#fdb[cm#level,1]};
define	CmMHlp = {cm#fdb[cm#level,2]};
define	CmMDef = {cm#fdb[1,3]};
define	CmMBrk = {cm#fdb[cm#level,4]};

! *** Components of CmFnp;

define	Cm$Fnc = {((CmFnp land '777000000000) rot 9)};
define	Cm$Ffl = {((CmFnp land '000777000000) rot 18)};
define	Cm$Lst = {( CmFnp land '000000777777)};

! *** Address of GTJFN argument block;

define	Cm$Gjb = {(CmGjb land '777777)};

! *** Components of GTJFN argument block;

define	GjGen = {cm!gtbuf[0]};
define	GjSrc = {cm!gtbuf[1]};
define	GjDev = {cm!gtbuf[2]};
define	GjDir = {cm!gtbuf[3]};
define	GjNam = {cm!gtbuf[4]};
define	GjExt = {cm!gtbuf[5]};
define	GjPro = {cm!gtbuf[6]};
define	GjAct = {cm!gtbuf[7]};
define	GjJfn = {cm!gtbuf[8]};
define	GjF2  = {cm!gtbuf[9]};
define	GjCpp = {cm!gtbuf[10]};
define	GjCpc = {cm!gtbuf[11]};
define	GjRty = {cm!gtbuf[12]};
define	GjBfp = {cm!gtbuf[13]};

! *** Flags in CmFlg;

define	Cm$Esc = {'400000000000};
define	Cm$Nop = {'200000000000};
define	Cm$Eoc = {'100000000000};
define	Cm$Rpt = {'040000000000};
define	Cm$Swt = {'020000000000};
define	Cm$Pfe = {'010000000000};
define	Cm$Rai = {'004000000000};
define	Cm$Xif = {'002000000000};
define	Cm$Wkf = {'001000000000};
define	RetFlags = {'770000000000};	! Mask for flags returned by COMND;

! *** Flags in CmFnp;

define	Cm$Brk = {'000020000000};
define	Cm$Po  = {'000010000000};
define	Cm$Hpp = {'000004000000};
define	Cm$Dpp = {'000002000000};
define	Cm$Sdh = {'000001000000};

! Flag for CmDir function;

define	Cm$Dwc = {'400000000000};

! *** Flags for CmTad function;

define	Cm$Ida = {'400000000000};
define	Cm$Itm = {'200000000000};
define	Cm$Nci = {'100000000000};

! *** Flags in Keyword table (first word of string if B0-6 - 0);

define	Cm$Inv = {'000000000001};
define	Cm$Nor = {'000000000002};
define	Cm$Abr = {'000000000004};		! Nonstandard abbreviations are not
					! implemented in these routines. How-
					! ever, the user is free to modify the
					! keyword lookup tables created by
					! tbuild or to build his own in order
					! to use this feature;
define	Cm$Fw  = {'002000000000};		! Must always be on if other flags on.
					! Otherwise first word of entry should
					! actually be beginning of ASCIZ string;

! *** Input/Output Channels;

define	priin = {'000100};
define	priou = {'000101};
define	nulio = {'377777};
define  ttdes = {'400000};
define	ttdes1 = {'777777400000};
define  dvdes = {'600000000000};

! *** Self-process handle;

define	FhSlf = {'400000};

! *** Error Codes found in AC2 upon unparsable field (returned in cm!err)
!     for CmKey and CmSwi;

define	NPXAMB = {'602044};
define	NPXNSW = {'602045};
define	NPXNOM = {'602046};
define	NPXNUL = {'602047};
define	NPXINW = {'602050};
define	NPXNC  = {'602051};
define	NPXICN = {'602052};
define	NPXIDT = {'602053};
define	NPXNQS = {'602054};
define	NPXNMT = {'602055};
define	NPXNMD = {'602056};
define	NPXCMA = {'602057};
define	COMX18 = {'602134};
define	COMX19 = {'602135};

! *** Error codes causing Illegal Instruction Interrupts (not including
!     errors caused by jsyses called by COMND);

define	COMNX1 = {'601257};
define	COMNX2 = {'601260};
define	COMNX3 = {'601261};
define	COMNX5 = {'601265};
define	COMNX8 = {'601321};
define	COMNX9 = {'601413};
define	IOX4 = {'600220};	! Mon Call Ref lied - EOF gives this, not COMNX9;
define	COMX10 = {'601767};
define	COMX11 = {'602035};
define	COMX12 = {'602036};
define	COMX13 = {'602037};
define	COMX14 = {'602040};
define	COMX15 = {'602041};
define	COMX16 = {'602042};
define	COMX17 = {'602043};

! *** End of Macro Definitions;

! Outer Block Declarations
  ========================
  ;

internal integer array cm!csb[0:'11];
internal integer array cm!fdb[0:4];
internal integer array cm!gtbuf[0:13];
internal integer array cm!buffer[0:99];
internal integer array cm!atom[0:99];
internal integer array cm#fdb[1:10,0:4];
internal integer array cm!datime[2:4];
internal boolean cm!major,cm!minor,cm!fatal,cm!eof,cm!abort;
internal boolean cm!reparse,cm!colon;
internal integer cm!err;
internal integer cm#int;
internal string cm#str;
internal real cm#real;
internal integer cm#level;
external integer !skip!;
record!class jfnstack (integer ichan, ochan;
		       boolean errpop;
		       record!pointer(jfnstack) next);
record!pointer(jfnstack) jfnhead;
string array cm#hlp,cm#nze[1:10],cm#token[1:10];
integer csbad,fdbad;
integer array break!tables[0:10,0:3];
boolean minor;
string promptz,devz,dirz,namz,extz,protz,acctz;

! *** End of Outer Block Declarations;

! Procedure Definitions
  =====================
  ;


internal integer procedure cm!size
	(string array strarr);

	COMMENT
		This procedure computes a generous allocation for a lookup
	table to contain the elements of strarr.  The strings must all be
	copied into such a lookup table since the TBLUK jsys requires all
	entries to be alligned on word boundaries, and this is not generally
	the case with SAIL strings.
	;

	begin "size"
	  integer i,sum,len;

	  sum := 1;
	  for i := arrinfo(strarr,1) step 1 until arrinfo(strarr,2) do
	    begin "add"
	      len := length(strarr[i]);
	      sum := sum+1+((len+5) div 5);
	    end "add";
	  sum := sum+2+arrinfo(strarr,2)-arrinfo(strarr,1);
	  return(sum);
	end "size";

integer procedure compare
	(string a,b);

	COMMENT
	 	This procedure compares two character strings a and b,
	and returns -1 if a < b alphabetically, 1 if a > b, and 0 if 
	a = b.
	;

	begin "compare"
	  integer result,loca,locb;

	  loca := memloc(a);
	  locb := memloc(b);
	  start!code "stcmp"
		move	1,loca;
		move	2,locb;
		stcmp;
		movem	1,result;
	  end "stcmp";
	  if result=0 then return(0)
	    else if result='100000000000 then return(1)
	    else return(-1);
	end "compare";

procedure tagsort
	(string array scrmbld;
	 reference integer array tag);

	COMMENT
		This procedure does a tag sort on the strings in array
	scrmbld.  The string array is left unchanged, but indexing it through
	the tag array will result in accessing the strings in ascending alpha-
	betical order.  The two arrays should both have the same number of
	elements, and the lower bound on the indices for tag should be 1.
	Also, then indices for the scrmbld array should initially be stored
	in ascending order in the tag array.
	;

	begin "tagsort"
	  integer i,j,temp;
	  boolean changed;

	  for i := 1 step 1 until arrinfo(tag,2)-1 do
	    begin "pass"
	      changed := false;
	      for j := 1 step 1 until arrinfo(tag,2)-1 do
		if compare(scrmbld[tag[j]],scrmbld[tag[j+1]])=1 then
		  begin "switch"
		    temp := tag[j];
		    tag[j] := tag[j+1];
		    tag[j+1] := temp;
		    changed := true;
		  end "switch";
	      if not changed then done;
	    end "pass";
	  return;
	end "tagsort";

internal procedure cm!retry
	(string errmsg);

	COMMENT
		This procedure allows the user to try again on the current
	field.  The procedure prints out the error message, then retypes
	the command line, including the prompt, up to the unparsable field,
	and the user may retype that field.  The procedure also resets CMINC
	(cm!csb[6]) so that COMND will not think that anything is in the field
	yet.
	;

	begin "retry"
	  integer ptr,char;

	  print(errmsg&'15&'12);
	  CmInc := 0;
	  ibp(ptr := CmPtr);
	  if ldb(ptr)=" " then
	    begin
	      ibp(CmPtr);
	      CmCnt := CmCnt-1;
	      end;
	  ptr := CmRty;
	  while true do
	    begin "print prompt"
	      char := ildb(ptr);
	      if char=0 then done;
	      print(char&null);
	    end "print prompt";
	  ptr := CmBfp;
	  while true do
	    begin "print cm!buffer";
	      if ptr=CmPtr then done;
	      char := ildb(ptr);
	      print(char&null);
	    end "print cm!buffer";
	  return;
	end "retry";

procedure prepare;

	COMMENT
		This procedure sets up the various pointers in the cm!csb,
	and also the pointers to the cm!csb and the cm!fdb.  This procedure should
	be used before every call to COMND to minimize the possibility of the
	SAIL runtime system moving the various arrays and strings without their
	pointers being updated.
	;

	begin "prepare"
	  integer count,loc;

	  count := 5*arrinfo(cm!buffer,0)-CmCnt;
	  loc := location(cm!buffer[0])+((count-1) div 5);
	  if count=0 then CmPtr := bpoint(location(cm!buffer[0]))
	    else CmPtr := right(loc) +
			(7 lsh 24) +
			((29-7*((count-1) mod 5)) lsh 30);
	  CmRty := memloc(promptz);
	  CmBfp := bpoint(location(cm!buffer[0]));
	  CmAbp := bpoint(location(cm!atom[0]));
	  CmGjb := location(cm!gtbuf[0]);
	  CmIoj := (jfnstack:ichan[jfnhead] lsh 18) lor jfnstack:ochan[jfnhead];
	  csbad := location(cm!csb[0]);
	  fdbad := location(cm!fdb[0]);
	  return;
	end "prepare";


procedure make!break(integer tabno; string chars);

	COMMENT
		Builds a table of break characters by setting the bits
	in the table corresponding to the characters in chars.  The
	first 32 bits of each table word are used, spanning the complete
	ASCII collating sequence in ascending order.
	;

	begin "make!break"
	  integer char,indx,num;

	  for indx := 0 step 1 until 3 do
	    break!tables[tabno,indx] := 0;
  	  while length(chars) neq 0 do
	    begin "load"
	      char := lop(chars);
	      indx := char div 32;
	      num := char-32*indx;
	      break!tables[tabno,indx] :=
		break!tables[tabno,indx] lor (1 rot (35-num));
	    end "load";
	end "make!break";

internal simple procedure cm!ioj;

	COMMENT
		Sets up the initial jfn chain, consisting of a single
	entry containing priio.
	;

	begin "cm!ioj"
	  jfnhead := new!record(jfnstack);
	  jfnstack:ichan[jfnhead] := priin;
	  jfnstack:ochan[jfnhead] := priou;
	end "cm!ioj";

internal procedure cm!take(integer ichan, ochan(nulio);
			     boolean errpop(true));

	COMMENT
		This procedure facilitates the redirection of input and output
	from COMND.  The name is derived from its similarity to the 'take'
	command of the EXEC.  The files represented by ichan and ochan,
	which should not be open before the call, are first opened, and
	then they are made the current input and output jfns for COMND
	calls.  The old jfns are pushed onto a stack.  When the new input
	file is finished, the old jfns are popped back and the finished
	file is closed, along with the associated output file.  If a parsing
	error occurs during the reading of the new file, then if errpop is
	true, the old jfns are popped back, and a message printed.  If errpop
	is false, then only the normal minor error procedures are followed.
	;
	begin "cm!take"
	  record!pointer(jfnstack) newjfn;
	  integer errchan;
	  procedure open!error(integer chan,error; string mode);
	    begin "open!error"
	      cprint (errchan,"?",('15&'12),
		"Fatal error using SAIL-COMND interface package");
	      cprint (errchan,"?",('15&'12),
		"Could not open ",jfns(chan,0)," for ",mode,('15&'12));
	      cprint(errchan,"?",erstring(error, FhSlf));
	      start!code
		haltf;
	      end;
	    end "open!error";

	  errchan := jfnstack:ochan[jfnhead];
	  define jfnok(jfn) =
	    {(jfn neq nulio) and (jfn neq priin) and
	     (jfn neq priou) and
	     ((jfn land ttdes1) neq ttdes) and
	     ((jfn land dvdes) neq dvdes)};
	  if jfnok(ichan) then openf(ichan,0);
	  if !skip! then
	    if cm!major then open!error(ichan,!skip!,"input")
	      else begin
		cm!fatal := true;
		cm!err := !skip!;
		return;
	      end;
	  if jfnok(ochan) then openf(ochan,1);
	  if !skip! then
	    if cm!major then open!error(ochan,!skip!,"output")
	      else begin
		cm!fatal := true;
		cm!err := !skip!;
		cfile(ichan);
		return;
	      end;
	  newjfn := new!record(jfnstack);
	  jfnstack:ichan[newjfn] := ichan;
	  jfnstack:ochan[newjfn] := ochan;
	  jfnstack:errpop[newjfn] := errpop;
	  jfnstack:next[newjfn] := jfnhead;
	  jfnhead := newjfn;
	end "cm!take";

procedure err!handle;

	COMMENT
		This procedure handles all errors that arise during operation
	of the COMND jsys.  When an error is detected upon return from the
	jsys call, control is transfered to this procedure, which determines
	the nature of the error and takes appropriate action, which is
	as follows:
		If the error would have caused an illegal instruction interrupt
	had it not been caught (e.g. input buffer overflow), it is termed a
	"major" error.  Otherwise it is a "minor" error (e.g. input did not
	correspond to a valid keyword in cm!key).
		When a minor error occurs, the cm!minor flag is checked. If
	the flag is true, an appropriate error message is printed. Otherwise
	no message is printed. In either case, control returns to the user's
	program with the error code in cm!err.
		When a major error occurs, the cm!major flag is checked.  If
	the flag is true, an error message is printed and the program halts.
	If the flag is false, no action is taken, the error code is put in
	cm!err, and cm!fatal is set to true.  The user's program may then
	take whatever action it desires.  

		There is one major error which is not signalled in any case,
	that is, coming to the end of the input file when that file was opened
	due to a call to the take procedure.  In that case, the cm!eof variable
	is set to true, the old jfns are popped back into the CSB, and the
	program is continued silently.  Note that the call in progress is
	not automatically reissued.

		When the program is started, both cm!minor and cm!major
	are set to true.
	;

	begin "err!handler"
	  integer chan;

	  start!code "geter"
		hrrzi	1,FhSlf;
		Geter;
		hrrzm	2,cm!err;
	  end "geter";
	  if cm!err=COMNX9 or cm!err=IOX4 then
	    begin "eof"
	      cm!eof := true;
	      if jfnstack:next[jfnhead] neq null!record then
		define jfnok(jfn) =
		  {(jfn neq nulio) and (jfn neq priin) and
		   (jfn neq priou) and
		   ((jfn land ttdes1) neq ttdes) and
		   ((jfn land dvdes) neq dvdes)};
		begin "popjfn"
		  if jfnok(jfnstack:ichan[jfnhead]) then
		    cfile(jfnstack:ichan[jfnhead]);
		  if jfnok(jfnstack:ochan[jfnhead]) then
		    cfile(jfnstack:ochan[jfnhead]);
		  jfnhead := jfnstack:next[jfnhead];
		  return;
		end "popjfn";
	    end "eof";
	  chan := jfnstack:ochan[jfnhead];
	  if minor then
	    begin
	      if cm!minor then
		begin
		  if isoff(CmFlg,Cm$Eoc) then cprint (chan,'15&'12);
		  cprint(chan,"?");
		  cprint(chan,erstring(cm!err,FhSlf));
		end;
	      if jfnstack:errpop[jfnhead] then
		begin
		  if jfnok(jfnstack:ichan[jfnhead]) then
		    cfile(jfnstack:ichan[jfnhead]);
		  if jfnok(jfnstack:ochan[jfnhead]) then
		    cfile(jfnstack:ochan[jfnhead]);
		  jfnhead := jfnstack:next[jfnhead];
		  chan := jfnstack:ochan[jfnhead];
		  if cm!minor then cprint(chan,
		    ('15&'12),"?Error detected while reading commands from ",
			"external file - file aborted",('15&'12));
		  cm!abort := true;
		end;
	    end
	  else if cm!major then
	    begin
	      if isoff(CmFlg,Cm$Eoc) then cprint (chan, '15&'12);
	      cprint(chan, "?Fatal error using SAIL-COMND interface package");
	      cprint(chan,('15&'12&"?"),erstring(cm!err,FhSlf));
	      start!code
		  haltf;
	      end;
	    end
	  else
	    begin
	      if jfnstack:errpop[jfnhead] then
		begin
		  cm!abort := true;
		  if jfnok(jfnstack:ichan[jfnhead]) then
		    cfile(jfnstack:ichan[jfnhead]);
		  if jfnok(jfnstack:ichan[jfnhead]) then
		    cfile(jfnstack:ochan[jfnhead]);
		  jfnhead := jfnstack:next[jfnhead];
		end;
	      cm!fatal := true;
	    end;
	  return;
	end "err!handler";



internal string procedure cm!getatm;

	COMMENT
		This procedure returns a SAIL-type string containing the
	current contents of the cm!atom cm!buffer, with the final null character
	stripped off.
	;

	begin "getatm"
	  integer ptr,char,i;
	  string atmstr;

	  ptr := CmAbp;
	  atmstr := null;
	  while true do
	    begin "transfr"
	      char := ildb(ptr);
	      if char=0 then done;
	      atmstr := atmstr&char;
	    end "transfr";
	  return(atmstr);
	end "getatm";

internal integer procedure cm!tbuild
	(string array keys;
	 reference integer array table);

	COMMENT
		This procedure facilitates the setting up of a keyword table
	to be used with the CmKey and CmSwi COMND jsys funcion calls.  The
	procedure returns a zero if there is room in the table array to
	store the entire keyword table (including all keyword strings alligned
	on word boundaries), and -1 if not.  In the latter case the table
	will probably not be in an acceptable format for the TBLUK jsys. One
	convenient way of declaring a suitable size for the table is by using
	the size procedure (above).
		The keys parameter is a string array containing the keywords
	to be included in the table, and does not have to be alphabetized.
	Tbuild will not insert duplicate entries, and if two elements of keys
	are identical it will place the index of the last duplicate entry found
	in the cm!err variable.  Each string in keys may be prefixed by either
	or both of two punctuation characters.  If a "%" character appears
	within the first two characters of a string the Cm$Inv bit will be
	turned on for the corresponding table entry. If a "#" character is
	found the Cm$Nor bit will be turned on.  In either case the punctuation
	character will be stripped before the keyword is entered into the table.
	;

	begin "tbuild"
	  integer array tags[1:1+arrinfo(keys,2)-arrinfo(keys,1)];
	  string array copy[arrinfo(keys,1):arrinfo(keys,2)];
	  integer first,i,j,k,strip,thistag,last;
	  string trans;
	  boolean array nor,inv[arrinfo(keys,1):arrinfo(keys,2)];

	  first := arrinfo(table,1);
	  last := arrinfo(table,2);
	  for i := 1 step 1 until arrinfo(tags,2) do
	    begin "initialize"
	      thistag := (tags[i] := i+arrinfo(keys,1)-1);
	      strip := 1;
	      nor[thistag] := (inv[thistag] := true);
	      if (keys[thistag] = "#") or (keys[thistag][2 for 1] =  "#") then
		strip := strip+1 else nor[thistag] := false;
	      if (keys[thistag] = "%") or (keys[thistag][2 for 1] = "%") then
		strip := strip+1 else inv[thistag] := false;
	      copy[thistag] := keys[thistag][strip to inf]&0;
	    end "initialize";
	  table[first] := arrinfo(tags,2);
	  tagsort(copy,tags);
	  j := first+arrinfo(tags,2)+1;
	  if j > last then return (-1);
	  k := first+1;
	  for i := 1 step 1 until arrinfo(tags,2) do
	    begin "insert"
	      thistag := tags[i];
	      if i > 1 then
		if 0=compare(copy[thistag],copy[tags[i-1]]) then
		  begin "duplicate"
		    cm!err := thistag;
		    continue "insert";
		  end "duplicate";
	      table[k] := (right(location(table[j])) lsh 18) + thistag;
	      k := k+1;
	      table[j] := Cm$Fw +
			(if nor[thistag] then Cm$Nor else 0) +
			(if inv[thistag] then Cm$Inv else 0);
	      j := j+1;
	      if j > last then return(-1);
	      trans := copy[thistag];
	      while length(trans) > 0 do
		begin "transfer"
		  table[j] := cvasc(trans[1 for 5]);
		  trans := trans[6 to inf];
		  j := j+1;
		  if j > last then return(-1);
		end "transfer";
	      table[first] := table[first]+'1000000;
	    end "insert";
	  return(0);
	end "tbuild";

internal integer procedure cm!key
	(integer array table;
	 string help(null),def(null);
	 boolean sup$help(false),
		raise$input(false),
		no$indirect(false),
		wake$always(false);
	 string brchars(null));

	COMMENT
		This procedure performs the COMND jsys CmKey function for
	parsing keywords.  The keyword table is ordinarily set up by using
	the tbuild procedure. Upon successful parsing of a keyword cm!key
	returns the index of the parsed keyword in the array passed to tbuild
	containing the keyword strings.  If the input was unparsable a 0 is
	returned and the cm!err variable is set to the error condition returned
	by COMND in AC2. If reparsing is required (the user deleted into a 
	previous field) a -1 is returned, and cm!reparse is set to true.  In
	this case the entire command line must be reparsed from the beginning.

	The parameters and their defaults are as follows:

	table - Contains a keyword table in the format required by the TBLUK
		jsys. See tbuild procedure. No default.
	help  - Contains a help string to be typed when the user types a ques-
		tion mark at the keyboard. This will precede the standard help
		message if that message is not suppressed (see sup$help) -
		default is null.
	def   - Contains the default value for this field, which will be used
		if the user enters no value for this field. If def is null,
		no default value will be recognized for this field. Default
		is null string.
	sup$help - If true this will suppress the printing of the standard
		error message when the user types a question mark. Default
		is false.
	raise$input - If true the user's input will be converted to upper
		case, although he will not see the conversion. Default is false.
	no$indirect - If this is true the user will not be allowed to use an
		indirect file to supply this field value. An at-sign (@) will
		be taken as just another punctuation character. Default false.
	wake$always - If this is true each field will be parsed immediately, 
		instead of waiting for an activation character to be typed.
		This is useful for changing terminal characteristics according
		to input, e.g. turning off terminal echo before a password is
		typed in.  It requires greater overhead, however. Default false.
	brchars - An optional string of characters on which to break the
		input field.  If this is not specified it defaults to null,
		and the standard break table is used.  There is no way for
		the condition mentioned in the Monitor Calls Reference Manual
		to occur wherein the field breaks on no character, and input
		simply continues until the input buffer is full.
	;

	begin "CmKey"
	  string helpz,defz;
	  integer index,ac2;
	  label err;

	  minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
	  helpz := help&0;
	  defz := def&0;
	  CmFnp := #CmKey+
		(if length(brchars) > 0 then Cm$Brk else 0) +
		(if length(help) > 0 then Cm$Hpp else 0)+
		(if length(def)  > 0 then Cm$Dpp else 0)+
		(if sup$help then Cm$Sdh else 0);
	  CmDat := location(table[arrinfo(table,1)]);
	  CmHlp := memloc(helpz);
	  CmDef := memloc(defz);
	  CmFlg := (CmFlg land RetFlags)+
		(if raise$input then Cm$Rai else 0)+
		(if no$indirect then Cm$Xif else 0)+
		(if wake$always then Cm$Wkf else 0);
	  if length(brchars) > 0 then
	    begin
	      make!break(0,brchars);
	      CmBrk := location(break!tables[0,0]);
	    end;
	  prepare;
	  start!code "call$CmKey"
		move	1,csbad;
		move	2,fdbad;
		Comnd;
		jump	'16,err;
		setom	minor;
		movem	2,ac2;
	  end "call$CmKey";
	  if isoff(CmFlg,Cm$Nop) then
	    start!code "getindex"
		move	2,ac2;
		hrrz	1,0(2);
		movem	1,index;
	    end "getindex";
	  if ison(CmFlg,Cm$Nop) then
	    begin
	      err: err!handle;
	      return(0);
	    end;
	  cm!err := 0;
	  if ison(CmFlg,Cm$Rpt) then
	    begin
	      cm!reparse := true;
	      return(-1);
	    end;
	  return(index);
	end "CmKey";

internal integer procedure cm!num
	(string help(null),def(null);
	 boolean sup$help(false);
	 integer radix(10);
	 boolean no$indirect(false),
		 wake$always(false));

	COMMENT
		This procedure will parse an integer number field.  The
	number parsed is returned.  If the field cannot be parsed then cm!err
	will be set to the error code returned in AC2, else it will be zero.
	If the command line must be reparsed, then cm!reparse will be set to
	true.  Paramters are as in the cm!key procedure, except for optional
	paramter radix, which specifies the radix from 2 to 10 in which the
	input is to be interpreted. The default is 10.
	;

	begin "CmNum"
	  string helpz,defz;
	  integer num;
	  label err;

	  minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
	  helpz := help&0;
	  defz := def&0;
	  CmFnp := #CmNum +
		(if length(help) > 0 then Cm$Hpp else 0) +
		(if length(def)  > 0 then Cm$Dpp else 0) +
		(if sup$help then Cm$Sdh else 0);
	  CmDat := radix;
	  CmHlp := memloc(helpz);
	  CmDef := memloc(defz);
	  CmFlg := (CmFlg land RetFlags)+
		(if no$indirect then Cm$Xif else 0) +
		(if wake$always then cm$Wkf else 0);
	  prepare;
	  start!code "call$CmNum"
		move	1,csbad;
		move	2,fdbad;
		Comnd;
		jump	'16,err;
		setom	minor;
		movem	2,num;
	  end "call$CmNum";
	  if ison(CmFlg,Cm$Nop) then
	    begin
	      err: err!handle;
	      return(0);
	    end;
	  cm!err := 0;
	  if ison(CmFlg,Cm$Rpt) then 
	    begin
	      cm!reparse := true;
	      return(-1);
	    end;
	  return(num);
	end "CmNum";

internal integer procedure cm!noi
	(string noise);

	COMMENT
		This procedure will put out a guide word using the CmNoi
	function call to the COMND jsys.  The guide word is usually printed
	if the previously parsed field was terminated by an ESC and was
	recognized.  Guide words are not output if the caller hasn't started
	parsing the next field yet.
		The noise parameter is the guide word string without the
	surrounding parentheses that always accompany guide words when they
	are typed.  If the user deletes into a previous field, cm!reparse will
	be set to true before the return.
		If the guide word is parsed correctly a 1 is returned. If a
	reparse is needed, -1 is returned.  If the guide word could not be
	parsed,  0 is returned.
	;

	begin "CmNoi"
	  string noisez;
	  label err;

	  minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
	  noisez := noise&0;
	  CmFnp := #CmNoi;
	  CmDat := memloc(noisez);
	  prepare;
	  start!code "call$CmNoi"
		move	1,csbad;
		move	2,fdbad;
		Comnd;
		jump	'16,err;
		setom	minor;
	  end "call$CmNoi";
	  if ison(CmFlg,Cm$Nop) then
	    begin
	      err:err!handle;
	      return(0);
	    end;
	  cm!err := 0;
	  if ison(CmFlg,Cm$Rpt) then cm!reparse := true;
	  return(if cm!reparse then -1 else 1);
	end "CmNoi";

internal integer procedure cm!swi
	(integer array table;
	 string help(null),def(null);
	 boolean sup$help(false),
		 raise$input(false),
		 no$indirect(false),
		 wake$always(false);
	 string brchars(null));

	COMMENT
		This procedure performs the COMND jsys CmSwi function call
	for parsing a switch field.  All parameters and returns are exactly
	as in the cm!key procedure except that if the field is terminated
	by a colon (indicating that a value is to follow), the variable cm!colon
	will be set to true. Note that the keywords making up the keyword table
	for this call should not include slashes, although they may end in

	colons if values are desired upon recognition.
	;

	begin "CmSwi"
	  string helpz,defz;
	  integer index,ac2;
	  label err;

	  minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
	  helpz := help&0;
	  defz := def&0;
	  CmFnp := #CmSwi +
		(if length(brchars) > 0 then Cm$Brk else 0) +
		(if length(help) > 0 then Cm$Hpp else 0) +
		(if length(def)  > 0 then Cm$Dpp else 0) +
		(if sup$help then Cm$Sdh else 0);
	  CmDat := location(table[arrinfo(table,1)]);
	  CmHlp := memloc(helpz);
	  CmDef := memloc(defz);
	  CmFlg := (CmFlg land RetFlags)+
		(if raise$input then Cm$Rai else 0) +
		(if no$indirect then Cm$Xif else 0) +
		(if wake$always then Cm$Wkf else 0);
	  if length(brchars) > 0 then
	    begin
	      make!break(0,brchars);
	      CmBrk := location(break!tables[0,0]);
	    end;
	  prepare;
	  start!code "call$CmSwi"
		move	1,csbad;
		move	2,fdbad;
		Comnd;
		jump	'16,err;
		setom	minor;
		movem	2,ac2;
	  end "call$CmSwi";
	  if isoff(CmFlg,Cm$Nop) then
	    start!code "getindex"
		move	2,ac2;
		hrrz	1,0(2);
		movem	1,index;
	    end "getindex";
	  if ison(CmFlg,Cm$Nop) then
	    begin
	      err: err!handle;
	      return(0);
	    end;
	  cm!err := 0;
	  if ison(CmFlg,Cm$Rpt) then
	    begin
	      cm!reparse := true;
	      return(-1);
	    end;
	  cm!colon := ison(CmFlg,Cm$Swt);
	  return(index);
	end "CmSwi";

internal integer procedure cm!ifi
	(string help(null),def(null);
	 boolean sup$help(false),
		 raise$input(false),
		 no$indirect(false),
		 wake$always(false));

	COMMENT
		This procedure parses an input file specification using
	the CmIfi function call of the COMND jsys.  No special options
	are permitted. The JFN of the file is returned.  Parameters are
	as in the cm!key procedure. If the field is unparsable cm!err is
	set to the error code returned in AC2. If the user deletes into
	a previous field, cm!reparse will be set to true indicating that
	a reparse is needed.
	;

	begin "CmIfi"
	  integer ac2;
	  string helpz,defz;
	  label err;

	  minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
	  helpz := help&0;
	  defz := def&0;
	  CmFnp := #CmIfi +
		(if length(help) > 0 then Cm$Hpp else 0) +
		(if length(def)  > 0 then Cm$Dpp else 0) +
		(if sup$help then Cm$Sdh else 0);
	  CmDat := 0;
	  CmHlp := memloc(helpz);
	  CmDef := memloc(defz);
	  CmFlg := (CmFlg land RetFlags)+
		(if raise$input then Cm$Rai else 0) +
		(if no$indirect then Cm$Xif else 0) +
		(if wake$always then Cm$Wkf else 0);
	  prepare;
	  start!code "call$CmIfi"
		move	1,csbad;
		move	2,fdbad;
		Comnd;
		jump	'16,err;
		setom	minor;
		movem	2,ac2;
	  end "call$CmIfi";
	  if ison(CmFlg,Cm$Nop) then
	    begin
	      err: err!handle;
	      return(0);
	    end
	  else cm!err := 0;
	  if ison(CmFlg,Cm$Rpt) then cm!reparse := true;
	  if not cm!reparse then ac2 := setchan(ac2,cm!gtbuf[0],0);
	  return(ac2);
	end "CmIfi";

internal integer procedure cm!ofi
	(string help(null),def(null);
	 boolean sup$help(false),
		 raise$input(false),
		 no$indirect(false),
		 wake$always(false));

	COMMENT
		Same as cm!ifi, but for an output file specification.
	;

	begin "CmOfi"
	  integer ac2;
	  string helpz,defz;
	  label err;

	  minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
	  helpz := help&0;
	  defz := def&0;
	  CmFnp := #CmOfi +
		(if length(help) > 0 then Cm$Hpp else 0) +
		(if length(def)  > 0 then Cm$Dpp else 0) +
		(if sup$help then Cm$Sdh else 0);
	  CmDat := 0;
	  CmHlp := memloc(helpz);
	  CmDef := memloc(defz);
	  CmFlg := (CmFlg land RetFlags)+
		(if raise$input then Cm$Rai else 0) +
		(if no$indirect then Cm$Xif else 0) +
		(if wake$always then Cm$Wkf else 0);
	  prepare;
	  start!code "call$CmOfi"
		move	1,csbad;
		move	2,fdbad;
		Comnd;
		jump	'16,err;
		setom	minor;
		movem	2,ac2;
	  end "call$CmOfi";
	  if ison(CmFlg,Cm$Nop) then
	    begin
	      err: err!handle;
	      return(0);
	    end
	  else cm!err := 0;
	  if ison(CmFlg,Cm$Rpt) then cm!reparse := true;
	  if not cm!reparse then ac2 := setchan(ac2,cm!gtbuf[0],0);
	  return(ac2);
	end "CmOfi";

internal integer procedure cm!fil
	(string help(null),def(null);
	 integer flag$gen('440004000000);
	 string device(null),
		directory(null),
		name(null),
		extension(null),
		protection(null),
		account(null);
	 integer jfn(0);
	 boolean sup$help(false),
		 raise$input(false),
		 no$indirect(false),
		 wake$always(false));

	COMMENT
		This procedure parses an arbitrary file specification
	using the CmFil function call of the COMND jsys.  The flag$gen
	parameter gives the contents to be set in the first word (.GTGEN)
	of the GTJFN block.  See the description of the GTJFN jsys in
	the Monitor Calls Reference Manual.  The device, directory, name,
	extension, protection and account parameters give the defaults
	which are to be given to the appropriate fields of the file
	specification.  Note that any fields present in the def parameter
	will take precedence over these parameters.  The jfn parameter
	specifies a jfn to be associated with the file.  See the GJ%JFN
	bits (9 & 10) of the .GJGEN word in the description of GTJFN in
	Monitor Calls Reference Manual.

	All other parameters are as in cm!key.  If the parse is successful,
	the SAIL channel number is returned (the file is not opened).
	Otherwise cm!err is set to the TOPS-20 error code.  If a reparse
	is needed, cm!reparse is set to true.
	;

	begin "CmFil"
	  integer ac2;
	  string helpz,defz;
	  label err;

	  minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
	  helpz := help&0;
	  defz := def&0;
	  devz := device&0;
	  dirz := directory&0;
	  namz := name&0;
	  extz := extension&0;
	  protz := protection&0;
	  acctz := account&0;
	  CmFnp := #CmFil +
		(if length(help) > 0 then Cm$Hpp else 0) +
		(if length(def)  > 0 then Cm$Dpp else 0) +
		(if sup$help then Cm$Sdh else 0);
	  CmDat := 0;
	  CmHlp := memloc(helpz);
	  CmDef := memloc(defz);
	  CmFlg := (CmFlg land RetFlags)+
		(if raise$input then Cm$Rai else 0)+
		(if no$indirect then Cm$Xif else 0)+
		(if wake$always then Cm$Wkf else 0);
	  GjGen := flag$gen;
	  GjDev := if length(device) > 0 then memloc(devz) else 0;
	  GjDir := if length(directory) > 0 then memloc(dirz) else 0;
	  GjNam := if length(name) > 0 then memloc(namz) else 0;
	  GjExt := if length(extension) > 0 then memloc(extz) else 0;
	  GjPro := if length(protection) > 0 then memloc(protz) else 0;
	  GjAct := if length(account) > 0 then memloc(acctz) else 0;
	  GjJfn := jfn;
	  prepare;
	  start!code "call$CmFil"
		move	1,csbad;
		move	2,fdbad;
		Comnd;
		jump	'16,err;
		setom	minor;
		movem	2,ac2;
	  end "call$CmFil";
	  if ison(CmFlg,Cm$Nop) then
	    begin
	      err: err!handle;
	      return(0);
	    end
	  else cm!err := 0;
	  if ison(CmFlg,Cm$Rpt) then cm!reparse := true;
	  if not cm!reparse then ac2 := setchan(ac2,GjGen,0);
	  return(ac2);
	end "CmFil";

internal string procedure cm!fld
	(string help(null),def(null);
	 boolean raise$input(false),
		 no$indirect(false),
		 wake$always(false);
	 string brchars(null));

	COMMENT
		This procedure parses an arbitrary field up to the first non-
	alphanumeric character. Anything goes here, and the data typed, not
	including the terminator is returned by the procedure. the input
	is also available in ASCIZ form for those who want it in integer
	array cm!atom[0:99], but will remain there only until the next field is
	parsed. Parameters are as in cm!key, but note that since COMND hasn't
	the foggiest idea what you are looking for in this field, there is no
	standard help message, so no sup$help parameter.  You are free to supply
	you own help message.
	;

	begin "CmFld"
	  string helpz,defz;
	  label err;

	  minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
	  helpz := help&0;
	  defz := def&0;
	  CmFnp := #CmFld +
		(if length(brchars) > 0 then Cm$Brk else 0) +
		(if length(help) > 0 then Cm$Hpp else 0) +
		(if length(def)  > 0 then Cm$Dpp else 0);
	  CmHlp := memloc(helpz);
	  CmDef := memloc(defz);
	  CmFlg := (CmFlg land RetFlags)+
		(if raise$input then Cm$Rai else 0) +
		(if no$indirect then Cm$Xif else 0) +
		(if wake$always then Cm$Wkf else 0);
	  if length(brchars) > 0 then
	    begin
	      make!break(0,brchars);
	      CmBrk := location(break!tables[0,0]);
	    end;
	  prepare;
	  start!code "call$CmFld"
		move	1,csbad;
		move	2,fdbad;
		Comnd;
		jump	'16,err;
		setom	minor;
	  end "call$CmFld";
	  if ison(CmFlg,Cm$Nop) then
	    begin
	      err: err!handle;
	      return(null);
	    end;
	  cm!err := 0;
	  if ison(CmFlg,Cm$Rpt) then
	    begin 
	      cm!reparse := true;
	      return(null);
	    end;
	  return(cm!getatm);
	end "CmFld";

internal integer procedure cm!cfm
	(string help(null);
	 boolean sup$help(false));

	COMMENT
		This procedure performs the COMND jsys CmCfm function,
	which merely waits for the user to confirm the command line by
	typing a carriage return. The parameters are as in the cm!key 
	procedure.  If proper confirmation is given a 1 is returned.  
	Otherwise, cm!err is set to the error code returned in AC2 and a 0
	is returned.  If the user deletes into a previous field, cm!reparse is
	set to true and a -1 is returned.
	;

	begin "CmCfm"
	  string helpz;
	  label err;

	  minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
	  helpz := help&0;
	  CmFnp := #CmCfm +
		(if length(help) > 0 then Cm$Hpp else 0) +
		(if sup$help then Cm$Sdh else 0);
	  CmHlp := memloc(helpz);
	  prepare;
	  start!code "call$CmCfm"
		move	1,csbad;
		move	2,fdbad;
		Comnd;
		jump	'16,err;
		setom	minor;
	  end "call$CmCfm";
	  if ison(CmFlg,Cm$Nop) then
	    begin
	      err: err!handle;
	      return(0);
	    end;
	  cm!err := 0;
	  if ison(CmFlg,Cm$Rpt) then
	    begin
	      cm!reparse := true;
	      return(-1);
	    end;
	  return(1);
	end "CmCfm";

internal integer procedure cm!dir
	(string help(null),def(null);
	 boolean sup$help(false),
		 allow$wild(false),
		 raise$input(false),
		 no$indirect(false),
	 	 wake$always(false),
		 parse$only(false));

	COMMENT
		This procedure performs the CmDir function call of the COMND
	jsys for parsing direct names.  The 36-bit direct number associated with
	the parsed name is returned. The directory name may be obtained from 
	this using the DIRST built-in Sail function.  Parameters are as in the
	cm!key procedure, with one addition: if parse$only is true, the field
	will be parsed, but not verified.  The default is false.
		One additional feature is the allow$wild parameter which, if
	true, will allow the user to use wild card characters in the directory
	name. The default is false.
		Values returned are exactly as in the cm!usr procedure.
	;

	begin "CmDir"
	  integer direct;
	  string helpz,defz;
	  label err;

	  minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
	  helpz := help&0;
	  defz := def&0;
	  CmFnp := #CmDir +
		(if length(help) > 0 then Cm$Hpp else 0) +
		(if length(def)  > 0 then Cm$Dpp else 0) +
		(if sup$help then Cm$Sdh else 0) +
		(if parse$only then Cm$Po else 0);
	  CmHlp := memloc(helpz);
	  CmDef := memloc(defz);
	  CmDat := (if allow$wild then Cm$Dwc else 0);
	  CmFlg := (CmFlg land RetFlags)+
		(if raise$input then Cm$Rai else 0) +
		(if no$indirect then Cm$Xif else 0) +
		(if wake$always then Cm$Wkf else 0);
	  prepare;
	  start!code "call$CmDir"
		move	1,csbad;
		move	2,fdbad;
		Comnd;
		jump	'16,err;
		setom	minor;
		movem	2,direct;
	  end "call$CmDir";
	  if ison(CmFlg,Cm$Nop) then
	    begin
	      err: err!handle;
	      return(0);
	    end;
	  cm!err := 0;
	  if ison(CmFlg,Cm$Rpt) then
	    begin
	      cm!reparse := true;
	      return(0);
	    end;
	  return(direct);
	end "CmDir";

internal integer procedure cm!usr
	(string help(null),def(null);
	 boolean sup$help(false),
		 raise$input(false),
		 no$indirect(false),
		 wake$always(false),
		 parse$only(false));

	COMMENT
		This procedure performs the CmUsr function call of the COMND
	jsys for parsing user names.  The 36-bit user number associated with
	the parsed name is returned.  The user name may be obtained from this
	using the DIRST built-in Sail function.  Parameters are as in the cm!key
	procedure, with one addition: if parse$only is true, the field will
	be parsed, but not verified.  The default is false.  If the field
	was unparsable (even if parse$only was true), then cm!err will contain
	the error code returned in AC2.  If a reparse is required then cm!reparse
	will be set to true.
	;

	begin "CmUsr"
	  integer user;
	  string helpz,defz;
	  label err;

	  minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
	  helpz := help&0;
	  defz := def&0;
	  CmFnp := #CmUsr +
		(if length(help) > 0 then Cm$Hpp else 0) +
		(if length(def)  > 0 then Cm$Dpp else 0) +
		(if sup$help then Cm$Sdh else 0) +
		(if parse$only then Cm$Po else 0);
	  CmHlp := memloc(helpz);
	  CmDef := memloc(defz);
	  CmFlg := (CmFlg land RetFlags)+
		(if raise$input then Cm$Rai else 0) +
		(if no$indirect then Cm$Xif else 0) +
		(if wake$always then Cm$Wkf else 0);
	  prepare;
	  start!code "call$CmUsr"
		move	1,csbad;
		move	2,fdbad;
		Comnd;
		jump	'16,err;
		setom	minor;
		movem	2,user;
	  end "call$CmUsr";
	  if ison(CmFlg,Cm$Nop) then
	    begin
	      err: err!handle;
	      return(0);
	    end;
	  cm!err := 0;
	  if ison(CmFlg,Cm$Rpt) then
	    begin
	      cm!reparse := true;
	      return(0);
	    end;
	  return(user);
	end "CmUsr";

internal procedure cm!cma
	(string help(null);
	 boolean sup$help(false));

	COMMENT
		This procedure parses a comma.  Blanks can appear on either
	side of it. cm!err is set to true if a comma is not found.  cm!reparse
	is set to true if a reparse is needed.
	;

	begin "CmCma"
	  label err;
	  string helpz;

	  minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
	  helpz := help&0;
	  CmFnp := #CmCma+
		   (if length(help) > 0 then Cm$Hpp else 0)+
		   (if sup$help then Cm$Sdh else 0);
	  CmDat := 0;
	  prepare;
	  start!code "call$CmCma"
		move	1,csbad;
		move	2,fdbad;
		Comnd;
		jump	'16,err;
		setom	minor;
	  end "call$CmCma";
	  if ison(CmFlg,Cm$Nop) then
	    begin
	      err: err!handle;
	    end
	  else cm!err := 0;
	  if ison(CmFlg,Cm$Rpt) then cm!reparse := true;
	  return;
	end "CmCma";

internal boolean procedure cm!ini
	(string prompt;
	 boolean newcomm(true));

	COMMENT
		This procedure gives a call to the COMND jsys with function
	code CmIni. This function sets up the command status block and prints
	the supplied prompt string.  This function should be used to start
	the parsing of all command lines.  If the user types a ctrl/h as the
	first character after the prompt, and the CSB is in a proper state,
	the call will automatically cause all the correct fields of the
	previous command line to be re-used, up to a bad field.  In this
	case, although no special attention is actually required in the
	following calls, the cm!ini procedure returns the value true.  Other-
	wise it returns false.  If the newcomm parameter is true, the
	entire CSB will be reset as for a new command.  This will cause the
	ctrl/h feature to fail, so this is normally not done when reinitiating
	a command line after a parse error.
	;

	begin "cmini"
	  label ctrl$h;

	  promptz := prompt&0;
	  if newcomm then
	    begin
	      CmFlg := 0;
	      CmCnt := 5*arrinfo(cm!buffer,0);
	      CmInc := 0;
	      CmAbc := 5*arrinfo(cm!atom,0);
	    end;
	  CmFlg := (CmFlg land '777777000000) lor location(ctrl$h);
	  CmFnp := #CmIni;
	  CmDat := 0;
	  CmHlp := 0;
	  CmDef := 0;
	  prepare;
	  start!code "call$cmini";
		move	1,csbad;
		move	2,fdbad;
		Comnd;
	  end "call$cmini";
	  return(false);

	  ctrl$h: return(true);
	end "cmini";

internal real procedure cm!flt
	(string help(null),def(null);
	 boolean sup$help(false),
		 no$indirect(false),
		 wake$always(false));

	COMMENT
		This procedure uses COMND to parse a real number from the
	keyboard.  Parameters are as in the cm!key procedure, but there
	is no raise$input parameter, since, of course, no alphabetic
	data is expected anyway.   Successful parsing returns the number
	typed as the value of the function.  If the field could not be
	parsed, cm!err is set to the error code returned in AC2.  If
	reparsing is needed, cm!reparse is set to true.
	;

	begin "CmFlt"
	  real num;
	  string helpz,defz;
	  label err;

	  minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
	  helpz := help&0;
	  defz := def&0;
	  CmFnp := #CmFlt +
		(if length(help) > 0 then Cm$Hpp else 0) +
		(if length(def)  > 0 then Cm$Dpp else 0) +
		(if sup$help then Cm$Sdh else 0);
	  CmHlp := memloc(helpz);
	  CmDef := memloc(defz);
	  CmFlg := (CmFlg land RetFlags)+
		(if no$indirect then Cm$Xif else 0) +
		(if wake$always then Cm$Wkf else 0);
	  prepare;
	  start!code "call$CmFlt"
		move	1,csbad;
		move	2,fdbad;
		Comnd;
		jump	'16,err;
		setom	minor;
		movem	2,num;
	  end "call$CmFlt";
	  if ison(CmFlg,Cm$Nop) then
	    begin
	      err: err!handle;
	      return(0.0);
	    end;
	  cm!err := 0;
	  if ison(CmFlg,Cm$Rpt) then
	    begin
	      cm!reparse := true;
	      return(0.0);
	    end;
	  return(num);
	end "CmFlt";

internal integer procedure cm!dev
	(string help(null),def(null);
	 boolean sup$help(false),
		 raise$input(false),
		 no$indirect(false),
		 wake$always(false);
	 string brchars(null));

	COMMENT
		This procedure uses the CmDev function call of the COMND jsys
	to parse a device name.  Parameters are as in the cm!key procedure,
	and the procedure normally returns the device designator.  If reparsing
	is needed cm!reparse is set to true, and if the field is unparsabel as
	a device name, cm!err will contain the error code returned in AC2.
	;

	begin "CmDev"
	  integer devdeg;
	  string helpz,defz;
	  label err;

	  minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
	  helpz := help&0;
	  defz := def&0;
	  CmFnp := #CmDev +
		(if length(brchars) > 0 then Cm$Brk else 0) +
		(if length(help) > 0 then Cm$Hpp else 0) +
		(if length(def)  > 0 then Cm$Dpp else 0) +
		(if sup$help then Cm$Sdh else 0);
	  CmHlp := memloc(helpz);
	  CmDef := memloc(defz);
	  CmFlg := (CmFlg land RetFlags)+
		(if raise$input then Cm$Rai else 0) +
		(if no$indirect then Cm$Xif else 0) +
		(if wake$always then Cm$Wkf else 0);
	  if length(brchars) > 0 then
	    begin
	      make!break(0,brchars);
	      CmBrk := location(break!tables[0,0]);
	    end;
	  prepare;
	  start!code "call$CmDev"
		move	1,csbad;
		move	2,fdbad;
		Comnd;
		jump	'16,err;
		setom	minor;
		movem	2,devdeg;
	  end "call$CmDev";
	  if ison(CmFlg,Cm$Nop) then
	    begin
	      err: err!handle;
	      return(0);
	    end;
	  cm!err := 0;
	  if ison(CmFlg,Cm$Rpt) then
	    begin
	      cm!reparse := true;
	      return(0);
	    end;
	  return(devdeg);
	end "CmDev";

internal string procedure cm!txt
	(string help(null),def(null);
	 boolean sup$help(false),
		 raise$input(false),
		 no$indirect(false),
		 wake$always(false);
	 string brchars(null));

	COMMENT
		This procedure does the CmTxt function call on the COMND jsys.
	It will return all text typed until the next carriage return. The
	text is also available in ASCIZ representation in integer array cm!atom
	[0:99], but only until the next field is parsed.  If a reparse is
	required, cm!reparse will be set to true. There is no such thing as
	not being able to parse this field.
	;

	begin "CmTxt"
	  string helpz,defz;
	  label err;

	  minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
	  helpz := help&0;
	  defz := def&0;
	  CmFnp := #CmTxt +
		(if length(brchars) > 0 then Cm$Brk else 0) +
		(if length(help) > 0 then Cm$Hpp else 0) +
		(if length(def)  > 0 then Cm$Dpp else 0) +
		(if sup$help then Cm$Sdh else 0);
	  CmHlp := memloc(helpz);
	  CmDef := memloc(defz);
	  CmFlg := (CmFlg land RetFlags)+
		(if raise$input then Cm$Rai else 0) +
		(if no$indirect then Cm$Xif else 0) +
		(if wake$always then Cm$Wkf else 0);
	  if length(brchars) > 0 then
	    begin
	      make!break(0,brchars);
	      CmBrk := location(break!tables[0,0]);
	    end;
	  prepare;
	  start!code "call$CmTxt"
		move	1,csbad;
		move	2,fdbad;
		Comnd;
		jump	'16,err;
		setom	minor;
	  end "call$CmTxt";
	  if ison(CmFlg,Cm$Nop) then
	    begin
	      err: err!handle;
	      return(null);
	    end;
	  cm!err := 0;
	  if ison(CmFlg,Cm$Rpt) then
	    begin
	      cm!reparse := true;
	      return(null);
	    end;
	  return(cm!getatm);
	end "CmTxt";

internal integer procedure cm!tad
	(string help(null),def(null);
	 boolean sup$help(false),
		 date(true),time(true),
		 no$convert(false),
		 raise$input(false),
		 no$indirect(false),
		 wake$always(false));

	COMMENT
		This procedure does the CmTad function call of the COMND
	jsys, which parses a date and/or time.  If date is true, the date
	is parsed, and if time is true, the time is parsed.  Both default 
	to true.  If no$convert is false (the default), then the date/time
	is returned in internal format.  Otherwise a zero is returned, and
	the date and time information are stored in integer array cm!datime
	(dimensioned [2:4] so as to agree with accumulator assignments in
	the IDTNC monitor call return).  cm!datime[2] contains the year
	in the left half and the month (0=Jan) in the right half. cm!datime[3]
	contains the day of the month (0=first day) in the left half and
	the day of the week (0=Mon) in the right half. The right half of
	cm!datime[4] contains the time as seconds from midnight, and the left
	half contains the following flag bits:

		B0	- on if a time zone was input
		B1	- on if daylight savings time was input
		B2	- on if a time zone was input
		B3	- on if a number in Julian day format was input
		B12-B17 - time zone if one was specified or the local time
			  if none was specified.

	;

	begin "CmTad"
	  string helpz,defz;
	  integer intern;
	  label err;

	  minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
	  helpz := help&0;
	  defz := def&0;
	  CmFnp := #CmTad +
		(if length(help) > 0 then Cm$Hpp else 0) +
		(if length(def)  > 0 then Cm$Dpp else 0) +
		(if sup$help then Cm$Sdh else 0);
	  CmFlg := (CmFlg land RetFlags)+
		(if raise$input then Cm$Rai else 0) +
		(if no$indirect then Cm$Xif else 0) +
		(if wake$always then Cm$Wkf else 0);
	  CmHlp := memloc(helpz);
	  CmDef := memloc(defz);
	  CmDat := (if date then Cm$Ida else 0) +
		(if time then Cm$Itm else 0) +
		(if no$convert then Cm$Nci else 0) +
		location(cm!datime[2]);
	  prepare;
	  start!code "call$CmTad"
		move	1,csbad;
		move	2,fdbad;
		Comnd;
		jump	'16,err;
		setom	minor;
		movem	2,intern;
	  end "call$CmTad";
	  if ison(CmFlg,Cm$Nop) then
	    begin
	      err: err!handle;
	      return(0);
	    end;
	  cm!err := 0;
	  if ison(CmFlg,Cm$Rpt) then
	    begin
	      cm!reparse := true;
	      return(0);
	    end;
	  return(if no$convert then 0 else intern);
	end "CmTad";

internal string procedure cm!qst
	(string help(null),def(null);
	 boolean sup$help(false),
		 raise$input(false),
		 no$indirect(false),
		 wake$always(false));

	COMMENT
		This procedure does the CmQst function call to the COMND
	jsys.  It returns the contents of a quoted string (not included
	the double quotes which must delimit the string).  This is useful
	for obtaining strings which may include action characters (ESC, ?,
	^F). A carriage return is an illegal character and will cause cm!err
	to be set.  A double quote may be entered in the string as two con-
	secutive double quotes.
	;

	begin "CmQst"
	  string helpz,defz;
	  label err;

	  minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
	  helpz := help&0;
	  defz := def&null;
	  CmFnp := #CmQst +
		(if length(help) > 0 then Cm$Hpp else 0) +
		(if length(def)  > 0 then Cm$Dpp else 0) +
		(if sup$help then Cm$Sdh else 0);
	  CmFlg := (CmFlg land RetFlags)+
		(if raise$input then Cm$Rai else 0) +
		(if no$indirect then Cm$Xif else 0) +
		(if wake$always then Cm$Wkf else 0);
	  CmHlp := memloc(helpz);
	  CmDef := memloc(defz);
	  prepare;
	  start!code "call$CmQst"
		move	1,csbad;
		move	2,fdbad;
		Comnd;
		jump	'16,err;
		setom	minor;
	  end "call$CmQst";
	  if ison(CmFlg,Cm$Nop) then
	    begin
	      err: err!handle;
	      return(null);
	    end;
	  cm!err := 0;
	  if ison(CmFlg,Cm$Rpt) then 
	    begin
	      cm!reparse := true;
	      return(null);
	    end;
	  return(cm!getatm);
	end "CmQst";

internal string procedure cm!uqs
	(string brchars,
	 	help(null),def(null);
	 boolean raise$input(false),
		 no$indirect(false),
		 wake$always(false));

	COMMENT
		This procedure executes the CMUQS function call of the COMND
	jsys.  It is used for parsing a field with arbitrary break characters.
	The characters to be used as break characters are supplied in the 
	string parameter brchars.  The procedure will return all characters 
	typed up to, but not including the first of these characters typed. 
	Note that in this call all action characters lose their significance
	unless they are included in the brchars string.
	;

	begin "CmUqs"
	  integer ptr;
	  string result,helpz,defz;
	  label err;

	  minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
	  helpz := help&0;
	  defz := def&0;

	  CmFnp := #CmUqs+
		 (if length(help) > 0 then Cm$Hpp else 0)+
		 (if length(def)  > 0 then Cm$Dpp else 0);
	  CmFlg := (CmFlg land RetFlags)+
		 (if raise$input then Cm$Rai else 0)+
		 (if no$indirect then Cm$Xif else 0)+
		 (if wake$always then Cm$Wkf else 0);
	  make!break(0,brchars);
	  CmDat := location(break!tables[0,0]);
	  ptr := CmPtr;
	  prepare;
	  start!code "call$CmUqs"
		move	1,csbad;
		move	2,fdbad;
		Comnd;
		jump	'16,err;
		setom	minor;
	  end "call$CmUqs";
	  if ison(CmFlg,Cm$Nop) then
	    begin
	      err: err!handle;
	      return(null);
	    end;
	  if ison(CmFlg,Cm$Rpt) then
	    begin
	      cm!reparse := true;
	      return(null);
	    end;
	  result := null;
	  while ptr neq CmPtr do
	    result := result&ildb(ptr);
	  return(result);
	end "CmUqs";

internal boolean procedure cm!tok
	(string token,
	        help(null),def(null);
	 boolean sup$help(false),
		 raise$input(false),
		 no$indirect(false),
		 wake$always(false));

	COMMENT
		This procedure performst the CMTOK function call of the COMND
	jsys.  It returns true if what is typed by the user matches the token
	parameter, false otherwise.
	;

	begin "CmTok"
	  string tokenz,helpz,defz;
	  label err;

	  minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
	  helpz := help&0;
	  defz := def&0;
	  tokenz := token&0;
	  CmFnp := #CmTok +
		(if length(help) > 0 then Cm$Hpp else 0) +
		(if length(def)  > 0 then Cm$Dpp else 0) +
		(if sup$help then Cm$Sdh else 0);
	  CmHlp := memloc(helpz);
	  CmDef := memloc(defz);
	  CmDat := memloc(tokenz);
	  CmFlg := (CmFlg land RetFlags)+
		(if raise$input then Cm$Rai else 0) +
		(if no$indirect then Cm$Xif else 0) +
		(if wake$always then Cm$Wkf else 0);
	  prepare;
	  start!code "call$CmTok"
		move	1,csbad;
		move	2,fdbad;
		Comnd;
		jump '16,err;
		setom	minor;
	  end "call$CmTok";
	  cm!err := 0;
	  if ison(CmFlg,Cm$Rpt) then
	    begin
	      cm!reparse := true;
	      return(false);
	    end;
	  if ison(CmFlg,Cm$Nop) then return(false)
	  else return(true);
	  err: err!handle;
	  return(false);
	end "CmTok";

internal integer procedure cm!nux
	(string help(null),def(null);
	 boolean sup$help(false);
	 integer radix(10);
	 boolean no$indirect(false),
		 wake$always(false));

	COMMENT
		This procedure will parse an integer number field.  The 
	difference between cm!nux and cm!num is that cm!nux will terminate
	on the first non-numeric character, without giving a minor error if
	that character is not one of the valid terminators for cm!num.  The
	number parsed is returned.  If the field cannot be parsed then cm!err
	will be set to the error code returned in AC2, else it will be zero.
	If the command line must be reparsed, then cm!reparse will be set to
	true.  Paramters are as in the cm!key procedure, except for optional
	paramter radix, which specifies the radix from 2 to 10 in which the
	input is to be interpreted. The default is 10.
	;

	begin "CmNux"
	  string helpz,defz;
	  integer num;
	  label err;

	  minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
	  helpz := help&0;
	  defz := def&0;
	  CmFnp := #CmNux +
		(if length(help) > 0 then Cm$Hpp else 0) +
		(if length(def)  > 0 then Cm$Dpp else 0) +
		(if sup$help then Cm$Sdh else 0);
	  CmDat := radix;
	  CmHlp := memloc(helpz);
	  CmDef := memloc(defz);
	  CmFlg := (CmFlg land RetFlags)+
		(if no$indirect then Cm$Xif else 0) +
		(if wake$always then cm$Wkf else 0);
	  prepare;
	  start!code "call$CmNux"
		move	1,csbad;
		move	2,fdbad;
		Comnd;
		jump	'16,err;
		setom	minor;
		movem	2,num;
	  end "call$CmNux";
	  if ison(CmFlg,Cm$Nop) then
	    begin
	      err: err!handle;
	      return(0);
	    end;
	  cm!err := 0;
	  if ison(CmFlg,Cm$Rpt) then 
	    begin
	      cm!reparse := true;
	      return(0);
	    end;
	  return(num);
	end "CmNux";

internal string procedure cm!act
	(string help(null),def(null);
	 boolean sup$help(false),
		 raise$input(false),
		 no$indirect(false),
		 wake$always(false));

	COMMENT
		This procedure does the CmAct function call of the COMND
	jsys.  It returns the account string up to, but not including, the
	first non-alphanumeric character typed.  No verification is done,
	so cm!err is never set.  cm!reparse is set to true if a reparse is
	needed.
	;

	begin "CmAct"
	  string helpz,defz;
	  label err;

	  minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
	  helpz := help&0;
	  defz := def&0;
	  CmFnp := #CmAct +
		(if length(help) > 0 then Cm$Hpp else 0) +
		(if length(def)  > 0 then Cm$Dpp else 0) +
		(if sup$help then Cm$Sdh else 0);
	  CmFlg := (CmFlg land RetFlags)+
		(if raise$input then Cm$Rai else 0) +
		(if no$indirect then Cm$Xif else 0) +
		(if wake$always then Cm$Wkf else 0);
	  CmHlp := memloc(helpz);
	  CmDef := memloc(defz);
	  prepare;
	  start!code "call$CmAct"
		move	1,csbad;
		move	2,fdbad;
		Comnd;
		jump	'16,err;
		setom	minor;
	  end "call$CmAct";
	  if ison(CmFlg,Cm$Nop) then
	    begin
	      err: err!handle;
	      return(null);
	    end;
	  cm!err := 0;
	  if ison(CmFlg,Cm$Rpt) then
	    begin
	      cm!reparse := true;
	      return(null);
	    end;
	  return (cm!getatm);
	end "CmAct";

internal string procedure cm!nod
	(string help(null),def(null);
	 boolean sup$help(false),
	 	 no$indirect(false),
		 wake$always(false));

	COMMENT -
		This procedure performs the CMNOD function of the COMND jsys.
	It parses a network node name.  A node name consists of 1 to 6 alpha-
	numeric characters.  Lowercase characters are always converted to upper
	case (hence no raise$input parameter).  The node name, as delimited
	by the first non-alphanumeric character, is returned as the value of
	the function.  No verification is done to ensure that the named node
	actually exists.  If a reparse is needed, the variable cm!reparse
	will be set to true.  Any errors will be returned in the variable
	cm!err, which will otherwise be zero.
	;

	begin "CmNod"
	  string helpz,defz;
	  label err;

	  minor := cm!fatal := cm!eof := cm!abort := cm!err := cm!reparse := false;
	  helpz := help&0;
	  defz := def&0;
	  CmFnp := #CmNod +
		(if length(help) > 0 then Cm$Hpp else 0) +
		(if length(def)  > 0 then Cm$Dpp else 0) +
		(if sup$help then Cm$Sdh else 0);
	  CmHlp := memloc(helpz);
	  CmDef := memloc(defz);
	  CmFlg := (CmFlg land RetFlags)+
		(if no$indirect then Cm$Xif else 0) +
		(if wake$always then Cm$Wkf else 0);
	  prepare;
	  start!code "call$CmNod"
		move	1,csbad;
		move	2,fdbad;
		Comnd;
		jump	'16,err;
		setom	minor;
	  end "call$CmNod";
	  if ison(CmFlg,Cm$Nop) then
	    begin
	      err: err!handle;
	      return(null);
	    end;
	  cm!err := 0;
	  if ison(CmFlg,Cm$Rpt) then
	    begin
	      cm!reparse := true;
	      return(null);
	    end;
	  return(cm!getatm);
	end "CmNod";

internal procedure cm#reset;

	COMMENT - 
		This procedure resets the multiple fdb block by setting
	the level indicator to zero and zeroing the cm#fdb array.
	;

	begin "cm#reset"
	  integer i,j;

	  cm#level := 0;
	  for i := 1 step 1 until 10 do
	    for j := 0 step 1 until 3 do
	      cm#fdb[i,j] := 0;
	end "cm#reset";


internal integer procedure cm#call
	(string def(null);
	 boolean raise$input(false),
		 no$indirect(false),
		 wake$always(false));

	COMMENT
		This procedure makes a call to COMND using the multiple fdb
	blocks, which should previously have been set up using the various
	cm#... procedures.  If the blocks have not been set up since the
	last call to cm#reset, the procedure returns -1. Otherwise, it returns
	the position in the cm#fdb array corresponding to the function that
	was actually used.  This would also correspond to the order in which
	you called the cm#... procedures.  For instance, supposed you set
	up the fdb blocks by calling first cm#key, then cm#cma, then cm#num,
	then cm#flt.  Then if cm#call returned 3 as a value, it would mean
	that the user had typed in an integer, since cm#num was the call that
	eventually succeeded.  A zero is returned if all functions fail.
		The value actually returned by the succeeding function can be
	found in either cm#int, cm#real, or cm#str, according to whether
	that value is supposed to be an integer, real or string value, 
	respectively.  It is up to the user program to find the correct
	value on the basis of which function succeeded.
	;

	begin "cm#call"
	  label err;
	  integer i,loc,row,fnc,ptr;
	  string defz;

	  if cm#level=0 then return(-1);
	  minor := cm!fatal := cm!eof := cm!abort :=  cm!err := cm!reparse := false;
	  defz := def&0;
	  if length(def) > 0 then cm#fdb[1,0] := cm#fdb[1,0] lor Cm$Dpp;
	  cm#str := null;
	  CmFlg := (CmFlg land RetFlags)+
		(if raise$input then Cm$Rai else 0)+
		(if no$indirect then Cm$Xif else 0)+
		(if wake$always then Cm$Wkf else 0);
	  for i := 1 step 1 while i < cm#level do
	    begin
	      cm#fdb[i,0] := cm#fdb[i,0]+right(location(cm#fdb[i+1,0]));
	      cm#fdb[i,2] := memloc(cm#hlp[i]);
	    end;
	  CmMHlp := memloc(cm#hlp[cm#level]);
	  CmMDef := memloc(defz);
	  ptr := CmPtr;
	  prepare;
	  fdbad := location(cm#fdb[1,0]);
	  start!code "call$mult"
		move	1,csbad;
		move	2,fdbad;
		Comnd;
		jump	'16,err;
		setom	minor;
		movem	2,cm#int;
		movem	2,cm#real;
		hrrzm	3,loc;
	  end "call$mult";
	  if ison(CmFlg,Cm$Nop) then
	    begin
	      err: err!handle;
	    end;
	  if ison(CmFlg,Cm$Rpt) then cm!reparse := true;
	  if ison(CmFlg,Cm$Rpt lor Cm$Nop) then
	    begin
	      cm#int := 0;
	      cm#real := 0.0;
	      return(0);
	    end;
	  row := 1+((loc-location(cm#fdb[1,0])) div 4);
	  fnc := cm#fdb[row,0] land '777000000000;
	  if fnc = #CmTok then cm#int := true;
	  if (fnc = #CmKey) or (fnc = #CmSwi) then
	    start!code "getindex"
		move	2,cm#int;
		hrrz	1,0(2);
		movem	1,cm#int;
	    end "getindex";
	  if fnc = #CmSwi then cm!colon := ison(CmFlg,Cm$Swt);
	  if fnc = #CmFlt then cm#int := 0 else cm#real := 0;
	  if (fnc = #CmFld) or (fnc = #CmTxt) or (fnc = #CmAct)  or
	     (fnc = #CmNod) or (fnc = #CmQst) then
	    begin
	      cm#int := 0;
	      cm#str := cm!getatm;
	    end;
	  if fnc = #CmUqs then
	    begin "Get uqs string"
	      cm#int := 0;
	      while ptr neq CmPtr do
		cm#str := cm#str & ildb(ptr);
	    end "Get uqs string";
	  if (fnc = #CmIfi) or (fnc = #CmOfi) or (fnc = #CmFil) then
	    cm#int := setchan(cm#int,cm!gtbuf[0],0);
	  if fnc = #CmCma then cm#int := 0;
	  if (fnc = #CmCfm) or (fnc = #CmNoi) then cm#int := 1;
	  if fnc = #CmTad and ison(cm#fdb[row,1],Cm$Nci) then cm#int := 0;
	  return(row);
	end "cm#call";


internal integer procedure cm#key
	(integer array table;
	 string help(null);
	 boolean sup$help(false);
	 string brchars(null));

	COMMENT
		This procedure is the multiple fdb counterpart to cm!key
	;

	begin "CmMKey"
	  if cm#level = 10 then return(-1);
	  cm#level := cm#level+1;
	  cm#hlp[cm#level] := help&0;
	  make!break(cm#level,brchars);
	  CmMBrk := location(break!tables[cm#level,0]);
	  CmMFnp := #CmKey+
		(if length(brchars) > 0 then Cm$Brk else 0) +
		(if length(help) > 0 then Cm$Hpp else 0)+
		(if sup$help then Cm$Sdh else 0);
	  CmMDat := location(table[arrinfo(table,1)]);
	  return(0);
	end "CmMKey";

internal integer procedure cm#cfm
	(string help(null);
	 boolean sup$help(false));

	COMMENT
		This procedure is the multiple fdb counterpart to cm!cfm
	;

	begin "CmMCfm"
	  if cm#level = 10 then return(-1);
	  cm#level := cm#level+1;
	  cm#hlp[cm#level] := help&0;
	  CmMFnp := #CmCfm +
		(if length(help) > 0 then Cm$Hpp else 0) +
		(if sup$help then Cm$Sdh else 0);
	  return(0);
	end "CmMCfm";

internal integer procedure cm#num
	(string help(null);
	 boolean sup$help(false);
	 integer radix(10));

	COMMENT
		This is the multiple fdb counterpart to cm!num
	;

	begin "CmMNum"
	  if cm#level = 10 then return(-1);
	  cm#level := cm#level+1;
	  cm#hlp[cm#level] := help&0;
	  CmMFnp := #CmNum +
		(if length(help) > 0 then Cm$Hpp else 0) +
		(if sup$help then Cm$Sdh else 0);
	  CmMDat := radix;
	  return(0);
	end "CmMNum";

internal integer procedure cm#noi
	(string noise);

	COMMENT
		This is the multiple fdb counterpart to cm!noi
	;

	begin "CmMNoi"
	  if cm#level = 10 then return(-1);
	  cm#level := cm#level+1;
	  cm#nze[cm#level] := noise&0;
	  CmMFnp := #CmNoi;
	  CmMDat := memloc(cm#nze[cm#level]);
	  return(0);
	end "CmMNoi";

internal integer procedure cm#ifi
	(string help(null);
	 boolean sup$help(false));

	COMMENT
		This is the multiple fdb counterpart to cm!ifi
	;

	begin "CmMIfi"
	  if cm#level = 10 then return(-1);
	  cm#level := cm#level+1;
	  cm#hlp[cm#level] := help&0;
	  CmMFnp := #CmIfi +
		(if length(help) > 0 then Cm$Hpp else 0) +
		(if sup$help then Cm$Sdh else 0);
	  CmMDat := 0;
	  return(0);
	end "CmMIfi";

internal integer procedure cm#ofi
	(string help(null);
	 boolean sup$help(false));

	COMMENT
		This is the multiple fdb counterpart to cm!ofi
	;

	begin "CmMOfi"
	  if cm#level = 10 then return(-1);
	  cm#level := cm#level+1;
	  cm#hlp[cm#level] := help&0;
	  CmMFnp := #CmOfi +
		(if length(help) > 0 then Cm$Hpp else 0) +
		(if sup$help then Cm$Sdh else 0);
	  CmMDat := 0;
	  return(0);
	end "CmMOfi";

internal integer procedure cm#cma
	(string help(null);
	 boolean sup$help(false));

	COMMENT
		This is the multiple fdb counterpart to cm!cma
	;

	begin "CmMCma"
	  if cm#level = 10 then return(-1);
	  cm#level := cm#level+1;
	  cm#hlp[cm#level] := help&0;
	  CmMFnp := #CmCma +
		    (if length(help) > 0 then Cm$Hpp else 0)+
		    (if sup$help then Cm$Sdh else 0);
	  CmMDat := 0;
	  return(0);
	end "CmMCma";

internal integer procedure cm#swi
	(integer array table;
	 string help(null);
	 boolean sup$help(false);
	 string brchars(null));

	COMMENT
		This is the multiple fdb counterpart to cm!swi
	;

	begin "CmMSwi"
	  if cm#level = 10 then return(-1);
	  cm#level := cm#level+1;
	  cm#hlp[cm#level] := help&0;
	  make!break(cm#level,brchars);
	  CmMBrk := location(break!tables[cm#level,0]);
	  CmMFnp := #CmSwi +
		(if length(brchars) > 0 then Cm$Brk else 0) +
		(if length(help) > 0 then Cm$Hpp else 0) +
		(if sup$help then Cm$Sdh else 0);
	  CmMDat := location(table[arrinfo(table,1)]);
	  return(0);
	end "CmMSwi";

internal integer procedure cm#fld
	(string help(null),
		brchars(null));

	COMMENT
		This is the multiple fdb counterpart to cm!fld
	;

	begin "CmMFld"
	  if cm#level = 10 then return(-1);
	  cm#level := cm#level+1;
	  cm#hlp[cm#level] := help&0;
	  make!break(cm#level,brchars);
	  CmMBrk := location(break!tables[cm#level,0]);
	  CmMFnp := #CmFld +
		(if length(brchars) > 0 then Cm$Brk else 0) +
		(if length(help) > 0 then Cm$Hpp else 0);
	  return(0);
	end "CmMFld";

internal integer procedure cm#usr
	(string help(null);
	 boolean sup$help(false),
		 parse$only(false));

	COMMENT
		This is the multiple fdb counterpart to cm!usr
	;

	begin "CmMUsr"
	  if cm#level = 10 then return(-1);
	  cm#level := cm#level+1;
	  cm#hlp[cm#level] := help&0;
	  CmMFnp := #CmUsr +
		(if length(help) > 0 then Cm$Hpp else 0) +
		(if sup$help then Cm$Sdh else 0) +
		(if parse$only then Cm$Po else 0);
	  return(0);
	end "CmMUsr";

internal integer procedure cm#dir
	(string help(null);
	 boolean sup$help(false),
		 allow$wild(false),
		 parse$only(false));

	COMMENT
		This is the multiple fdb counterpart to cm!dir
	;

	begin "CmMDir"
	  if cm#level = 10 then return(-1);
	  cm#level := cm#level+1;
	  cm#hlp[cm#level] := help&0;
	  CmMFnp := #CmDir +
		(if length(help) > 0 then Cm$Hpp else 0) +
		(if sup$help then Cm$Sdh else 0) +
		(if parse$only then Cm$Po else 0);
	  CmMDat := (if allow$wild then Cm$Dwc else 0);
	  return(0);
	end "CmMDir";

internal integer procedure cm#flt
	(string help(null);
	 boolean sup$help(false));

	COMMENT
		This is the multiple fdb counterpart to cm!flt
	;

	begin "CmMFlt"
	  if cm#level = 10 then return(-1);
	  cm#level := cm#level+1;
	  cm#hlp[cm#level] := help&0;
	  CmMFnp := #CmFlt +
		(if length(help) > 0 then Cm$Hpp else 0) +
		(if sup$help then Cm$Sdh else 0);
	  return(0);
	end "CmMFlt";

internal integer procedure cm#dev
	(string help(null);
	 boolean sup$help(false);
	 string brchars(null));

	COMMENT
		This is the multiple fdb counterpart to cm!dev
	;

	begin "CmMDev"
	  if cm#level = 10 then return(-1);
	  cm#level := cm#level+1;
	  cm#hlp[cm#level] := help&0;
	  make!break(cm#level,brchars);
	  CmMBrk := location(break!tables[cm#level,0]);
	  CmMFnp := #CmDev +
		(if length(brchars) > 0 then Cm$Brk else 0) +
		(if length(help) > 0 then Cm$Hpp else 0) +
		(if sup$help then Cm$Sdh else 0);
	  return(0);
	end "CmMDev";
internal integer procedure cm#txt
	(string help(null);
	 boolean sup$help(false);
	 string brchars(null));

	COMMENT
		This is the multiple fdb counterpart to cm!txt
	;

	begin "CmMTxt"
	  if cm#level = 10 then return(-1);
	  cm#level := cm#level+1;
	  cm#hlp[cm#level] := help&0;
	  make!break(cm#level,brchars);
	  CmMBrk := location(break!tables[cm#level,0]);
	  CmMFnp := #CmTxt +
		(if length(brchars) > 0 then Cm$Brk else 0) +
		(if length(help) > 0 then Cm$Hpp else 0) +
		(if sup$help then Cm$Sdh else 0);
	  return(0);
	end "CmMTxt";

internal integer procedure cm#act
	(string help(null);
	 boolean sup$help(false));

	COMMENT
		This is the multiple fdb counterpart to cm!act
	;

	begin "CmMAct"
	  if cm#level = 10 then return(-1);
	  cm#level := cm#level+1;
	  cm#hlp[cm#level] := help&0;
	  CmMFnp := #CmAct +
		(if length(help) > 0 then Cm$Hpp else 0) +
		(if sup$help then Cm$Sdh else 0);
	  return(0);
	end "CmMAct";

internal integer procedure cm#tok
	(string token,
	        help(null);
	 boolean sup$help(false));

	COMMENT
		This is the multiple fdb counterpart to cm!tok;

	begin "CmMTok"
	  if cm#level = 10 then return(-1);
	  cm#level := cm#level+1;
	  cm#hlp[cm#level] := help&0;
	  cm#token[cm#level] := token&0;
	  CmMDat := memory[location(cm#token[cm#level])];
	  CmMFnp := #CmTok +
		(if length(help) > 0 then Cm$Hpp else 0) +
		(if sup$help then Cm$Sdh else 0);
	  return(0);
	end "CmMTok";

internal integer procedure cm#fil
	(string help(null);
	 integer flag$gen('440004000000);
	 string device(null),
		directory(null),
		name(null),
		extension(null),
		protection(null),
		account(null);
	 integer jfn(0);
	 boolean sup$help(false));

	COMMENT
		This is the multiple fdb counterpart to cm!tok;

	begin "CmMFil"
	  if cm#level = 10 then return(-1);
	  cm#level := cm#level+1;
	  cm#hlp[cm#level] := help&0;
	  devz := device&0;
	  dirz := directory&0;
	  namz := name&0;
	  extz := extension&0;
	  protz := protection&0;
	  acctz := account&0;
	  CmMFnp := #CmFil +
		(if length(help) > 0 then Cm$Hpp else 0) +
		(if sup$help then Cm$Sdh else 0);
	  CmMDat := 0;
	  GjGen := flag$gen;
	  GjDev := if length(device) > 0 then memloc(devz) else 0;
	  GjDir := if length(directory) > 0 then memloc(dirz) else 0;
	  GjNam := if length(name) > 0 then memloc(namz) else 0;
	  GjExt := if length(extension) > 0 then memloc(extz) else 0;
	  GjPro := if length(protection) > 0 then memloc(protz) else 0;
	  GjAct := if length(account) > 0 then memloc(acctz) else 0;
	  GjJfn := jfn;
	  return(0);
	end "CmMFil";

internal integer procedure cm#nod
	(string help(null);
	 boolean sup$help(false));

	COMMENT
		This is the multiple fdb counterpart to cm!nod;

	begin "CmMNod"
	  if cm#level = 10 then return(-1);
	  cm#level := cm#level+1;
	  cm#hlp[cm#level] := help&0;
	  CmMDat := 0;
	  CmMFnp := #CmNod +
		(if length(help) > 0 then Cm$Hpp else 0) +
		(if sup$help then Cm$Sdh else 0);
	  return(0);
	end "CmMNod";

internal integer procedure cm#nux
	(string help(null);
	 boolean sup$help(false);
	 integer radix(10));

	COMMENT
		This is the multiple fdb counterpart to cm!nux;

	begin "CmMNux"
	  if cm#level = 10 then return(-1);
	  cm#level := cm#level+1;
	  cm#hlp[cm#level] := help&0;
	  CmMDat := radix;
	  CmMFnp := #CmNux +
		(if length(help) > 0 then Cm$Hpp else 0) +
		(if sup$help then Cm$Sdh else 0);
	  return(0);
	end "CmMNux";

internal integer procedure cm#tad
	(string help(null);
	 boolean sup$help(false),
	 date(true),time(true),
	 no$convert(false));

	COMMENT
		This is the multiple fdb counterpart to cm!tad;

	begin "CmMTad"
	  if cm#level = 10 then return(-1);
	  cm#level := cm#level+1;
	  cm#hlp[cm#level] := help&0;
	  CmMDat := (if date then Cm$Ida else 0) +
		(if time then Cm$Itm else 0) +
		(if no$convert then Cm$Nci else 0) +
		location(cm!datime[2]);
	  CmMFnp := #CmTad +
		(if length(help) > 0 then Cm$Hpp else 0) +
		(if sup$help then Cm$Sdh else 0);
	  return(0);
	end "CmMTad";

internal integer procedure cm#uqs
	(string brchars,help(null));	 	 

	COMMENT
		This is the multiple fdb counterpart to cm!uqs;

	begin "CmMUqs"
	  if cm#level = 10 then return(-1);
	  cm#level := cm#level+1;
	  cm#hlp[cm#level] := help & 0;
	  make!break(cm#level,brchars);
	  CmMDat := location(break!tables[cm#level,0]);
	  CmMFnp := #CmUqs +
		(if length(help) > 0 then Cm$Hpp else 0);
	  return(0);
	end "CmMUqs";

internal integer procedure cm#qst
	(string help(null);
	 boolean sup$help(false));

	COMMENT
		This is the multiple fdb counterpart to cm!qst;

	begin "CmMQst"
	  if cm#level = 10 then return(-1);
	  cm#level := cm#level+1;
	  cm#hlp[cm#level] := help&0;
	  CmMDat := 0;
	  CmMFnp := #CmQst +
		(if length(help) > 0 then Cm$Hpp else 0) +
		(if sup$help then Cm$Sdh else 0);
	  return(0);
	end "CmMQst";

end "comnd"