Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

{Notes for Tops-10 users.  This file is intended to be included in
 your program.  It defines the procedures used to support the
 Tops-20 COMND jsys.  These procedures are included in PASLIB, so
 all you have to do to use them is include this file in your source
 file.  PASLIB also includes routines that simulate the Tops-20
 COMND jsys.  You should probably have a copy of Tops-20 Monitor
 Calls to use this to its fullest.  At the moment, the following
 restrictions exist:
  - not all of these things are implemented.  You will get an
	appropriate error message if you try to use one that
	isn't.  So far implementation includes the following:
	cmkey, cmnum, cmnum8, cmnoi, cmswi, cmifi, cmofi, cmfil,
	cmfld, cmcfm, cmdir, cmusr, cmcma, cmini
	Also the support routines needed for switches and files
	are finished (TBMAK, TBADD, and the GJxxx routines).
  - the options involving files do not cause files to be looked
	up.  That is, you can do CMIFI and give it a file name
	that has no corresponding file.  Obviously the system
	will notice this when it tries to open the file, but
	it will not be noticed by this package.  On Tops-20,
	the COMND jsys actually looks to make sure the file
	exists.
  - recognition is not done on file names.  That is, you can't
	type part of a name and have it completed if there is
	only one file starting with that.  However if you
	default an entire field (e.g. there is a default
	extension), <ESC> will still show you that.
  - wildcard file names are not allowed (because Pascal does not
	implement them on tops-10).
  - ? works only at the beginning of fields.  On Tops-20, you
	can say /F? and get the names of all switches beginning
	with F.
  - note that you can't rubout over an <ESC>.  This scanner
	operates in the normal line activation mode (i.e. it
	uses INCHWL).  So once you type <ESC>, <CR>, or <LF>,
	any characters up to that can't be backed over.  You
	can use ^G (bell) to kill the entire command line.
	It will echo as XXX and reissue the prompt for the line.

On a more positive note, here is what is implemented:
  Interaction with the user is via INCHWL.  So normal ^U, ^R, etc. work.
	However they only work on data since the last <CR>, <LF>, or
	<ESC>.  And ^U and ^R redo the line without the prompt.
	You may find ^G more useful than ^U, as explained below.
	In a pinch ? can sometimes be used as a more intelligent ^R.
  ^G is defined by this code as an additional editing character. It
	kills the entire "logical line", that is the whole command.
	This is useful in case <ESC> was used in the middle of a line
	for recognition.  ^G echoes as XXX, and causes the prompt to be
	retyped.  Because of this reissuing of the prompt, it is
	slightly nicer than ^U.
  - is defined as a continuation character.  If typed immediately
	before a terminator (<CR>, <LF>, <ESC>), both it and the
	terminator are ignored.
  ? will tell you what kind of input is being looked for.  It must
	be typed at the beginning of a field.  That is, don't try
	typing it in the middle of a file name or a switch.  In most
	cases a single phrase will be given for each option, but
	for switches and keywords, all legal switches and keywords
	will be listed.  After listing the options, Pascal will
	retype the command line up to the ?, so that the context
	of your typein will be visible.
  <ESC> will do the following things:
    if typed at the beginning of a field, and there is a default
	value for the field, the default value will be supplied.
	It will be typed out in place of the <ESC>.
    if typed at the end of a switch or keyword that you 
	abbreviated, it will be "completed".  I.e. the rest of the
	name will be typed.
    if typed at the end of a file spec, any default values that
	come after what you typed will be shown.  Note that this
	doesn't affect what happens:  the default values would be
	used anyway - you just get to see them.
    if any field is ended with an <ESC> and there is "noise" after
	it, you see the noise.  E.g.
	   dele<ESC>TE (FILES)   
	The (FILES) is noise.

Here are my interpretations of Tops-20 objects that are not obvious:
  directory name - this is a [p,pn,sfd...].  The [] is required.
	If only a PPN is given, that PPN is returned.  Otherwise
	NEW is used to get a small block of memory and the path
	is put there.  What is returned is the address of this
	block.  This can be used by lookup and enter as if it were
	a PPN.
  user name - this is a [p,pn].  The [] is required.  The PPN is
	returned.
}

type
 t=array[0:100]of integer;
 table=^t;
 tadrec=packed record
	year:0..777777B; month:0..777777B;
	dayofmonth:0..777777B; dayofweek:0..777777B;
	zoneused:boolean;
	daylightsavings:boolean;
	zoneinput:boolean;
	julianday:boolean;
	dum:0..377B;
	zone:0..77B;
	seconds:0..777777B
	end;
 cmmodes=(normal,rescan);
	
procedure cmini(prompt:string);extern;
  {Use this procedure first.  It will issue the prompt, and set things
   up for reparsing in case of errors.  Beware that if an error occurs
   in any of the other CM functions, control may be returned to the
   statement after the CMINI.  Effectively this is done with a non-local
   GOTO.  Thus the code between the CMINI and the end of the parse must
   be designed so that it can be restarted.  Also, you must not exit the
   block in which the CMINI is issued until the entire parse is done.
   Since control will be returned to the CMINI in case of an error, it
   would cause serious troubles if that block was no longer active. }

procedure cminir(prompt:string);extern;
{Special version of CMINI to be used when you want to read a rescanned
   command from the EXEC.  If this is done in a loop, the second time
   it is done, the program exits.}
function cmmode:cmmodes;extern;
{Says what "mode" we are running in.  At the moment normal or rescan.
   Rescan means that a CMINIR succeeded in finding valid rescanned data.}

{The following two procedures are used in making up tables of commands
 and switches.  Note that tables and their contents are stored in the
 heap.  So you can use MARK and RELEASE to release them.}
function tbmak(size:integer):table;extern;
    {Issue this one first.  It allocates space for a table with the
     specified number of entries.  It returns a table pointer,
     which is used for the other functions that operate on tables.}
procedure tbadd(t:table;value:integer;key:string;bits:integer);extern;
    {Issue this once for each entry to go in the table.
	T - the value return by the call to TBMAK that allocated the table.
	VALUE - This is the value that will be returned when this entry
		in the table is found.
	KEY - This string is the name of the table entry.
	BITS - as documented in the JSYS manual.  Normally zero.
     For example, one entry in a table of terminal types might be
	tbadd( termtable, 6, 'I400', 0)
     This entry will be matched by the string 'I400' (or any unique
     abbreviation), and will return the value 6, presumably the internal
     code for the I400 terminal.}
  {WARNING:  You must issue these in reverse alphabetical order, i.e.
   the last entry in the table must be done first.  This may be a
   monitor bug.}

{The following procedures are used to parse individual fields in a command.
 They should be issued in the same order that the user is expected to
 type the fields.}

function cmkey(t:table):integer;extern;
   {Expects the user to type one of the keywords in the table.  It returns
    the value that was specified by TBADD when the keyword was put in the
    table.  E.g. if the user typed I400, this would return 6 if the
    table had the entry shown above.}

function cmswi(t:table):integer;extern;
   {Similar to cmkey, except the table is of switches.  The slash should
    not be part of the name in the table.

    If the user ended the switch with a colon (i.e. you can
    expect a value after the switch), the negative of the value 
    normally returned will be returned.}

procedure cmifi(var f:file);extern;
   {Expects the user to type an input file name.  The argument should
    be a Pascal file.  That file will be preset to use the file specified.
    E.g. if you say CMIFI(INPUT), you can then use RESET(INPUT) and INPUT
    will be open on the file that the user specified.  This function
    actually gets a jfn for the file specified by the user.  That jfn is
    then stored in the file's file control block.}

procedure cmofi(var f:file);extern;
   {Expects an output file name.}

procedure cmfil(var f:file);extern;
   {Expects a general file spec.  You must set up an extended gtjfn
    block appropriately to read the file spec.  This is done with
    the gjxxx procedures below.  At least gjgen must be used.}

function cmnum:integer; extern;
   {Get a decimal number.}

function cmnum8:integer; extern;
   {Get an octal number.}

function cmnux:integer; extern;
   {Get a decimal number, ends with any non-numeric}

function cmnux8:integer; extern;
   {Get an octal number, ends with any non-numeric}

function cmflt:real; extern;
   {Get a real number}

procedure cmnoi(stuff:string);extern;
   {Puts out a noise word if the user types altmode.  Note that the
    parentheses are not part of the noise word.}

procedure cmcfm; extern;
   {Expects the user to type a carriage return.  This would usually be
    the last call made for parsing a command.}

procedure cmcma; extern;
   {Expects the user to type a comma.  If this is for an optional
    field, you should set CMAUTO(false) first, to prevent an error
    trap if there isn't one.}

procedure cmtok(stuff:string);extern;
   {Expects the user to type that particular thing.  See cmcma.}

function cmdir:integer; extern;
   {Expects a directory name: returns the 36-bit dir. number.  To
    see the text, use CMATOM.}

function cmdirw:integer; extern;
   {as above, but allows wildcards}

function cmusr:integer; extern;
   {Expects a user name:  returns a 36-bit user number.(CMATOM for text)}

function cmdev:integer; extern;
   {Expects a device name:  returns a device designator (CMATOM for text)}

{The following functions parse date and/or time.  We have the following
 method:
   TAD - both date and time       null - returns internal form
   T - time only		  N - puts unconverted form into a record
   D - date only}

function cmtad:integer; extern;
function cmt:integer; extern;
function cmd:integer; extern;
procedure cmtadn(var r:tadrec); extern;
procedure cmtn(var r:tadrec); extern;
procedure cmdn(var r:tadrec); extern;

{The following procedures all return strings where you specify, and
 a count indicating how many characters were actually seen.  Any
 extra characters in the destination array are filled with blanks.
 If there is not enough space, an error message is given and a
 reparse triggered.}

function cmatom(var s:string):integer; extern;
   {This returns the contents of the "atom buffer".  It is useful when
    you want to see what the user actually typed for the last field.  It
    not cause any extra parsing, the data comes from the last field parsed.}

function cmfld(var s:string):integer; extern;
   {Field delimited by first non-alphanumeric}

function cmtxt(var s:string):integer; extern;
   {To next end of line}

function cmqst(var s:string):integer; extern;
   {String in double quotes.  Quotes not returned.}

function cmact(var s:string):integer; extern;
   {Account string.  Not verified for legality}

function cmnod(var s:string):integer; extern;
   {network node name.  Not verified for legality}

{The following procedures are used to set up the extended gtjfn block
 for cmfil.  They must be given before the cmfil call.  gjgen must 
 always be used, and must be the first one of these to be called, as
 it clears the rest of the block.  These procedures simply set the
 corresponding words in the gtjfn block, so see the jsys manual for
 details.}

procedure gjgen(flags_and_generation:integer);extern;

procedure gjdev(default_device:string);extern;

procedure gjdir(default_directory:string);extern;

procedure gjnam(default_name:string);extern;

procedure gjext(default_extension:string);extern;

procedure gjpro(default_protectin:string);extern;

procedure gjact(default_account:string);extern;

procedure gjjfn(try_to_use_this_jfn:integer);extern;


{The following procedures are only needed for more complex parsers.
 They allow one to turn off various of the features that are normally
 supplied by default.}

procedure cmauto(useauto:Boolean);extern
	setzm fdb+.cmdef
	setzm fdb+.cmhlp
	popj p,

;setcom
;	This is the first half of DOCOM, for mult mode
;  a - function code
;  b - contents of .cmdat, if any
;  d,e - data for evaluation routine if this FDB is chosen

setcom:	move c,mulnxt	;next position inside MULFDB to use
	cail c,mulend	;if haven't run out of space
	 jrst mulser	;out of space
	movem d,m.loc(c) ;save data for continuation
	movem e,m.loc+1(c)
	lsh a,33	;move function code to proper position
	skipe d,fdb+.cmhlp ;if user gave help message
	tlo a,(cm%hpp!cm%sdh) ;then tell comnd to use his and not its
	movem d,.cmhlp(c)  ;and copy current into real FDB
	setzm fdb+.cmhlp
	skipe d,fdb+.cmdef ;if user gave default
	tlo a,(cm%dpp)	;then tell comnd
	movem d,.cmdef(c)  ;and copy current into real FDB
	setzm fdb+.cmdef
	hrri a,m.size(c) ;pointer to next FDB
	movem a,.cmfnp(c)
	movem b,.cmdat(c)
	pop p,m.disp(c)	;save return addr for later continue
	addi c,m.size	;advance to next FDB
	movem c,mulnxt
	popj p,		;return to our caller's caller

ifn tops10,<
mulser:	outstr [asciz /
? Too many options after CMMULT
/]
	exit
> ;ifn tops10
ife tops10,<
mulser:	hrroi a,[asciz /Too many options after CMMULT
/]
	jrst fatal
> ;ife tops10

;<

;cmdo --> which FDB was done
cmdo:	move c,mulnxt	;clear next pointer of last FDB
	hllzs -m.size(c)
	setzm erseen	;assume no errors
	movei a,state	;now do the COMND
	movei b,mulfdb
ifn simcom,<pushj p,comnd>
ife simcom,<comnd>
	setzm fdb+.cmdef ;forget user def and hlp from this one
	setzm fdb+.cmhlp
	setzm mulnxt	;and turn off multiple mode
	tlne a,(cm%nop)	;if errors
	jrst mulerr	;process them
	hrrz d,c	;d = FDB used
	subi d,mulfdb	;d _ offset into MULFDB
	idivi d,m.size	;e _ FDB index no.
	addi d,1	;should be indexed off 1
	push p,d	;save as final return value
	move f,m.disp(c);a _ dispatch addr
	move d,m.loc(c);d _ data saved at setup
	move e,m.loc+1(c)
	pushj p,(f)
	move a,2(p)	;value he tried to return
	movem a,mulret	;save for later
	pop p,(p)	;now set up our return value (saved by PUSH above)
	popj p,		;and return

;cmint and cmreal just return the saved-away return value
cmint:
cmreal:	move a,mulret	;get saved value
	movem a,1(p)	;and return
	popj p,

mulerr:	setzm 1(p)	;give zero return
	aos erseen	;say saw error
	skipe erOK	;if error OK
	popj p,		;return to him
	jrst parerr	;else give error message and reparse

;
;End of special section for multiple alternatives
;


;cmauto(boolean)
;  if on, we automatically handle errors, else he an one line, just call cmhlp several
    times.  Each call will add a line to the message.  (Thus cmhlp
    is vaguely like writeln.)  Note that the help message stays in
    effect only for the next field parsed.}

procedure cmdef(default:string); extern;
   {Used to supply a default value for the next field parsed.  This
    default stays in effect only for the next field.}

{In some cases you may want to allow a choice of several alternatives.
 To do this, issue CMMULT, to go into "multiple choice mode".  Once
 in this mode, issue CMxxx calls as usual.  Instead of being done
 immediately, these calls store away specifications of the legal
 alternatives.  For those that are functions, the values returned are
 garbage.  Once you have specified all the alternatives, call
 CMDO.  This returns an integer, 1..the number of alternatives,
 telling you which (if any) succeeded, 0 if none did.
	For alternatives that return values, you can then do
 CMINT to get the returned value if it is an integer, or CMREAL if it
 is real.  Alternatives that return values in variables passed by
 reference will do so, using the variable passed when the original
 CMxxx was called.  (Needless to say, that variable has better still
 be accessible.)}

procedure cmmult; extern;
  {Enter multiple choice mode.  All CMxxx procedures until the next
   CMDO are interpreted as specifications, rather than done immediately.}

function cmdo:integer; extern;
  {Do a COMND jsys, specifying the alternatives stored up since the
   last CMMULT.  Returns a code indicating which succeeded, or 0 if
   none did.  Since the return value is used to indicate which
   alternative was found, there is a possible question:  how do we
   get the returned value, if there is one (i.e. if the alternative
   found is a Pascal function that returns some value)?  The answer
   to this is that the value returned is stored away internally
   and is available by CMINT or CMREAL, depending upon its type.
   Note that files and strings are returned through variables
   passed by reference.  They do not need this mechanism, since
   that will be set automatically.  (What happens is that the
   addresses of all reference variables are stored away when the
   alternative is first set up, and the appropriate one is set when
   we find out which alternative is actually there.)}

function cmint:integer; extern;
  {Return a value from the last CMDO, if the alternative that succeeded
   was an integer}

function cmreal:real; extern
  {Return a value from the last CMDO, if the alternative that succeeded
   was a real}


.
p,a		;a _ value
	hrl a,b		;a _ arg addr,,value
	pop p,b		;b _ table addr
	exch a,b	;jsys wants a and b reversed
ife simcom,<
	jtbadd
	popj p,
> ;ife simcom
ifn simcom,<
;tbadd simulation
;  a - addr of header
;  b - arg addr,,value
;  c - current number of entries
;  d - offset into table we are looking at now
	hlrz c,(a)	;c _ max offset existing
	hrrz e,(a)	;see if too big for table
	caige e,1(c)
	jrst tbaddb	;too big
	movs e,b	;e _ byte ptr to string to compare
	hrli e,000700			
	movei d,1	;d _ current offset
tbaddl:	camle d,c	;if new offset .GT. end
	jrst tbaddn	;then add to end
	pushj p,tbaddc	;now compare new with table
	jumpl t,tbaddh	;less - add here
	jumpe t,tbaddo	;same - old elt
	aoja d,tbaddl

;here to add elt at offset d
tbaddh:	addi c,1	;table now 1 bigger
	hrlm c,(a)	;so update count field
	add d,a		;d _ addr of last elt to move
	add a,c		;a _ addr of new end elt
tbadhl:	move t,-1(a)	;now shift things
	movem t,(a)
	cail d,-1(a)	;if last to move still not moved
	jrst tbadhx	;it has
	soja a,tbadhl	;no, then do next
tbadhx:	movem b,(d)	;now have place for new data
	popj p,

;here to add to end
tbaddn:	addi c,1	;table now 1 bigger
	hrlm c,(a)	;so update count field in table
	add a,c		;compute addr of new elt
	movem b,(a)	;put it there
	popj p,

ifn tops10,<
tbaddo:	outstr [asciz /
? New elt. was already there - TBADD
/]
	exit

tbaddb:	outstr [asciz /
? Table too small - TBADD
/]
	exit
> ;ifn tops10
ife tops10,<
tbaddo:	hrroi a,[asciz /New elt. was already there - TBADD/]
	jrst fatal

tbaddb:	hrroi a,[asciz /Table too small - TBADD/]
	jrst fatal
> ;ife tops10

;tbaddc - compare string with table entry
;  a - addr of table header
;  e - byte pointer to string to compare
;  d - offset into table
;  returns in t - +1, 0, -1 if string gt, eq, lt
tbaddc:	move f,h	;f _ compare byte ptr
	move g,a	;g _ table byte ptr
	add g,d
	movs g,(g)
	hrli g,000700
tbadcl:	ildb t,f	;get comp byte
	cail t,141	;make upper case
	caile t,172
	jrst .+2
	subi t,40
	ildb h,g	;get table byte
	cail h,141	;make upper case
	caile h,172
	jrst .+2
	subi t,40
	came t,h	;now compare
	jrst tbadcx	;found difference - stop
	jumpn t,tbadcl	;same, if non-null, go back for more
	popj p,		;same - complete match	
tbadcx:	caml t,h
	jrst tbadcg	;greater
	seto t,		;less
	popj p,
tbadcg:	movei t,1	;greater
	popj p,
> ;ifn simcom

;<
;cmkey(table) --> value
;  parse a keyword - return the value from the table for it    <
;cmswi(table) --> value
;  parse a switch - return the value from the table for it

cmswi:	skipa a,[exp .cmswi]
cmkey:	movei a,.cmkey	;b already has contents of .cmdat
	pushj p,docom	;b _ addr of table entry found
	hrrz t,(b)	;get value from table entry
	tlne a,(cm%swt)	;if switch ended in colon
	movn t,t	;then negate the value
	movem t,1(p)	;return it
	popj p,

	subttl CMCFM, CMNUM, CMNUM8, CMNUX, CMNUX8, CMNOI

;cmcfm
;  wait for CR
;cmcma
;  look for comma

cmcma:	skipa a,[exp .cmcma]
cmcfm:	movei a,.cmcfm
	setz b,
	pushj p,docom
	popj p,

;cmnum
;  number, base 10
;cmnum8
;  number, base 8

cmnum8:	skipa b,[exp ^D8]
cmnum:	movei b,^D10
	movei a,.cmnum
	pushj p,docom
	movem b,1(p)
	popj p,

;cmnux
;  number, base 10, term on first non-numeric
;cmnux8
;  number, base 8, term on first non-numeric

cmnux8:	skipa b,[exp ^D8]
cmnux:	movei b,^D10
	movei a,.cmnux
	pushj p,docom
	movem b,1(p)
	popj p,

	subttl functions that take string arguments

starg:	cail c,argsiz*5	;be sure string is not too long
	jrst argovr	;is too long
	hrli b,440700	;b _ source
	move a,[point 7,argbuf] ;a _ destination
	jumpe c,starg2	;now copy
starg1:	ildb t,b
	idpb t,a
	sojg c,starg1
starg2: setz t,		;null
	idpb t,a
	move b,[point 7,argbuf] ;b _ pointer to argument
	popj p,

ife tops10,<
argovr:	hrroi a,[asciz /Argument too large for buffer
/]
	jrst fatal
> ;ife tops10
ifn tops10,<
argovr:	outstr [asciz /
? Argument too large for buffer
/]
	exit
> ;ifn tops10

;cmnoi(string)
;  noise words

cmnoi:	pushj p,starg	;puts string into argument area
	movei a,.cmnoi
	pushj p,docom
	popj p,

;cmtok(string)
;  match specified thing

cmtok:	pushj p,starg
	movei a,.cmtok
	pushj p,docom
	popj p,

	subttl functions that return the atom buffer

;cmatom(var string):count;
;  copies the atom buffer into the string

cmatom:	movei a,0	;a _ count
	hrli b,440700	;b _ destination
			;c _ size of destination
	move d,[point 7,atbuf] ;d _ source
	jumpe c,atmovr	;now copy until null or space runs out
cmatm1:	ildb t,d
	jumpe t,cmatm2
        sojl c,atmovr   ;[2] if no more room to copy, post message
	idpb t,b	;[2]
	aoja a,cmatm1	;[2]
cmatm2:	jumpe c,cmatm4	;clear rest of destination to blanks
	movei t,40	;clear rest of destination to blanks
cmatm3:	idpb t,b
	sojg c,cmatm3
cmatm4:	movem a,1(p)	;return count of char's copied
	popj p,

atmovr:	hrroi a,[asciz /Field too big
/]
	jrst nonfat

;cmfld(var string):count
;  scan arbitrary field
;cmtxt(var string):count
;  scan rest of line as one field

cmtxt:	skipa a,[exp .cmtxt]
cmfld:	movei a,.cmfld
cmfl:	move d,b
	move e,c
	setz b,
	pushj p,docom
	move b,d
	move c,e
	jrst cmatom	;return the data and count

;cmqst(var string):count
;  quoted string (quotes not returned)

cmqst:	movei a,.cmqst
	jrst cmfl

;cmact(var string):count
;  account string

cmact:	movei a,.cmact
	jrst cmfl

;cmnod(var string):count
;  node name

cmnod:	movei a,.cmnod
	jrst cmfl

	subttl routines that just return a scalar

;cmdir:integer
;  get directory number
;cmdirw:integer
;  allow wildcard

cmdirw:	skipa b,[exp cm%dwc]
cmdir:	setz b,
	movei a,.cmdir
	pushj p,docom
	movem b,1(p)
	popj p,

;cmusr:integer
;  get user number
;cmflt:real
;  get floating point number

cmflt:	skipa a,[exp .cmflt]
cmusr:	movei a,.cmusr
cmx:	setz b,
	pushj p,docom
	movem b,1(p)
	popj p,

;cmdev:integer
;  get device designator

cmdev:	movei a,.cmdev
	jrst cmx

	subttl time and day stuff

;cmtad:integer
;  time and date in internal format
;cmd:integer
;  date in internal format

cmd:	skipa b,[exp cm%ida]
cmtad:	movsi b,(cm%ida!cm%itm)
cmtadx:	movei a,.cmtad
	pushj p,docom
	movem b,1(p)
	popj p,

;cmt:integer
;  time in internal format

cmt:	movsi b,(cm%itm)
	jrst cmtadx

;cmtadn(var tadrec);
;  time and date not converted

cmtadn:	hrli b,(cm%ida!cm%itm!cm%nci)
cmtnx:	movei a,.cmtad
	pushj p,docom
	popj p,

;cmdn(var tadrec);
;  date not converted

cmdn:	hrli b,(cm%ida!cm%nci)
	jrst cmtnx

;cmtn(var tadrec);
;  time not converted

cmtn:	hrli b,(cm%itm!cm%nci)
	jrst cmtnx

ifn simcom,<

 subttl COMND jsys

;AC usage:

;a - state block
;b - 1st ftn block, will be used for return
;c - LH = orig ftn block, RH = cur ftn block
;d - data from caller (FCB in case of files)
;e - bptr to current input char
;f - # chars left in input

comnd:	push p,e	;don't touch e
	hrl c,b		;once-only inits - cur ftn to first
	hrr c,b
	move t,.cmflg(a)
	hrrzs .cmflg(a)	;clear flags
	movsi g,(cm%pfe);set prev field esc
	tlne t,(cm%esc)	;if esc was on
	iorm g,.cmflg(a)
;main loop - here once for each function
cmlop:	trnn c,777777	;any function to do?
	jrst retnop	;no - return with CM%NOP
	move e,.cmptr(a);restore input scanner
	move f,.cminc(a)
	ldb g,[point 9,(c),8] ;ftn code
	caile g,maxftn	;see if valid
	 jrst illftn
	pushj p,@ftntab(g)	;returns value in B, skip if fails, sets flags
	 jrst gotit
	 jrst ftnfai
	 jrst ftnhlp
	 jrst nulhlp
	 jrst killin

ftnfai:	hrr c,(c)		;failed, go to next ftn
	jrst cmlop

ftnhlp:	hrr c,(c)		;help - if there is another function
	trnn c,777777
	jrst hlpend
	outstr [asciz /  or/]	;then say OR and go do it
	jrst cmlop

;nulhlp - for function which don't output a help message - no "OR"
nulhlp:	hrr c,(c)
	trnn c,777777
	jrst hlpend
	jrst cmlop

hlpend:	move t,e		;clear the ?
	setz g,
	idpb g,t		;to null
  ;now put out prompt if any
	skipn g,.cmrty(a)
	jrst hlpret
hlprom:	ildb h,g
	jumpe h,hlpret
	outchr h
	jrst hlprom
  ;now retype the line and go try again
hlpret:	move g,.cmbfp(a)	;start of buffer
hlprtl:	ildb h,g
	jumpe h,hlpxit
	outchr h
	jrst hlprtl
hlpxit:	hlr c,c			;restart with first function
	jrst cmlop

gotit:	movem e,.cmptr(a)	;save state in state block
	movem f,.cminc(a)
	hll a,.cmflg(a)		;return flags to user
	pop p,e
	popj p,

retnop:	movsi t,(cm%nop)	;set no-parse bit
	iorm t,.cmflg(a)
	hll a,.cmflg(a)
	pop p,e
	popj p,

;killin - respond to bell - clear line and reprompt
killin:	outstr [asciz / XXX
/]
	pushj p,doini
	movem e,.cmptr(a)
	movem f,.cminc(a)
	hrrz g,.cmflg(a)	;see if he supplied a reparse addr
	jumpn g,kilrep		;yes, use it
	movsi t,(cm%rpt)	;no - set need reparse
	iorm t,.cmflg(a)
	hll a,.cmflg(a)
	pop p,e
	popj p,

kilrep:	pop p,e
	pop p,(p)		;go to reparse
	jrst (g)

illftn:	movei t,[asciz /Unimplemented function code in call to COMND/]
	movem t,errstr
	jrst retnop

doini:	hlrz t,.cmrty(a)	;normalize pointers
	cain t,777777
	movei t,440700
	hrlm t,.cmrty(a)
	hlrz t,.cmbfp(a)
	cain t,777777
	movei t,440700
	hrlm t,.cmbfp(a)
	hlrz t,.cmabp(a)
	cain t,777777
	movei t,440700
	hrlm t,.cmabp(a)
	skipn g,.cmrty(a)	;put out prompt
	jrst noprom
proml:	ildb h,g
	jumpe h,noprom
	outchr h
	jrst proml

noprom:	setz f,			;f (.cminc)  nothing here now
	move e,.cmbfp(a)	;e (.cmptr)  start of text is start of buf
	setz t,			;clear first char as sign of empty buf
	idpb t,e
	move e,.cmbfp(a)	;get e back again
	hrrzs .cmflg(a)		;clear flags
	popj p,

	subttl COMND function table

;To work with this, a function must obey the following:

;preserves A, C, D
;updates E and F if it reads char's
;returns value in B, if any (else preserves it)
;skips if it fails
;sets any appropriate flags in in .CMFLG

maxftn==14

ftntab:	exp dokey	;0
	exp donum	;1
	exp donoi	;2
	exp doswi	;3
	exp doifi	;4
	exp doofi	;5
	exp dofil	;6
	exp dofld	;7
	exp docfm	;10
	exp dodir	;11
	exp dousr	;12
	exp docma	;13
	exp doini	;14

;The normal prolog for a function is as follows:
;  pushj p,getskp	;or getatm if you don't want to skip blanks
;  jrst givhelp
;  pushj p,copyxxx  	;routine to copy atom into atom buffer

;The routine should return
;  nonskip if it parsed the thing requested
;  skip 1 if it didn't
;  skip 2 if it did help

;The help routine normally starts with
;  pushj p,chkhlp

;CHKHLP checks for user help, and outputs it, aborting the caller, and
;  	returning +2
;  If no user help, it sets up its caller to return +2, and returns to
;	its caller

;Getskp does the following:
;  clear atom buffer
;  skip blanks
;  if null, read a line from the terminal and go skip blanks again
;  if ^G, abort caller and make him return +4
;  if ?, non-skip ret
;  if lf, copy default to atom buffer and skip 2
;	   if no default, skip 1 (user will copy LF to buffer)
;  if esc, copy default to atom buffer, output, and line buffer and skip 2
;	   if no default, wipe out the esc, beep, and treat as a null ending
;  else skip 1

getskp:	move g,.cmabp(a)	;clear atom buffer
	setz t,
	idpb t,g		;null in first char is enough
;skip blanks
doskip:	move t,e		;peek
	ildb t,t
	cain t,11		;tab is like blank
	movei t,40
	caie t,40		;if not blank
	jrst endskp
	subi f,1		;it is, gobble it
	ildb t,e
	jrst doskip		;and try again	
;if null, read a line from the terminal
endskp:	jumpn t,chkbel		;if not a null, go on
ifn tops10,<
getmor:	move g,.cmcnt(a)	;g _ last legal position in buffer
	adjbp7 g,.cmbfp(a)	;normalize
	tlnn g,400000		;if 440700
	jrst endskx		;not
	tlc g,450000		;change to 010700
	subi g,1		;in previous word
endskx:	move h,e		;h _ place to put new char's
readl:	inchwl t		;get a char
	idpb t,h		;put it down
	camn h,g		;see if at end of buffer
	jrst cmtool		;yes - line too long
	addi f,1		;now have one more char
	aos .cminc(a)
	cain t,15		;cr is special
	jrst [	inchwl t
		dpb t,h		;put down lf
		jrst readx]
	caie t,33
	cain t,12
	jrst readx		;stop on term's
	jrst readl

readx:	move i,h		;look at prev char
	subi i,1
repeat 4,<ibp i>
	ldb t,i
	cain t,"-"		;if -, this is continuation
	jrst readcn
	setz t,			;make asciz
	idpb t,h
> ;ifn tops10
ife tops10,<printx Code for read line not yet written>
	jrst doskip		;now go skip blanks in new line

readcn:	subi i,1		;now backup over - and lf
repeat 4,<ibp i>
	move h,i
	subi f,2
	sos .cminc(a)
	sos .cminc(a)
	jrst readl

chkbel:	caie t,7
	jrst chkqes		;if not bel, go on
	pop p,(p)		;abort caller
	movei t,4		;make him return +4
	addm t,(p)
	popj p,

;  if ?, non-skip ret
chkqes:	caie t,"?"		;do we have question mark
	jrst chklf		;no - go on
	popj p,			;yes - return without advancing anything

;  if lf, copy default to atom buffer and skip 2
;	   if no default, skip 1 (user will copy LF to buffer)
chklf:	caie t,12		;do we have a line feed?
	jrst chkesc		;no - go on
	move t,.cmfnp(c)	;get function flags
	aos (p)			;will skip at least once
	tlnn t,(cm%dpp)		;is there a default?
	popj p,			;no, skip 1
	pushj p,copydf		;copy default to atom buffer
	aos (p)			;skip 2
	popj p,

copydf:	hlrz g,.cmdef(c)	;g - source of copy
	cain g,-1		; normalize bpt
	movei g,440700
	hrl g,g
	hrr g,.cmdef(c)
	move h,.cmabp(a)	;h - dest of copy
	move i,.cmabc(a)	;i - size of dest
cpydfl:	jumpe i,dftool		;copy loop
	ildb t,g
	jumpe t,cpydfx		;done at null
	idpb t,h
	soja i,cpydfl
cpydfx:	setz t,			;make asciz
	idpb t,h
	popj p,

;  if esc, copy default to atom buffer, output, and line buffer and skip 2
;	   if no default, ignore it and read more.
chkesc:	caie t,33		;do we have an esc?
	jrst chknor		;no - go on
	move t,.cmfnp(c)	;get function flags
	tlnn t,(cm%dpp)		;is there a default?
	jrst nodflt		;no default - read more
	movsi t,(cm%esc)	;say we say esc, for noise
	iorm t,.cmflg(a)
	pushj p,copydf		;copy default to atom buffer
  ;copy default to text buffer and output
	hlrz g,.cmdef(c)	;g - source of copy
	cain g,-1		; normalize bpt
	movei g,440700
	hrl g,g
	hrr g,.cmdef(c)
	move i,.cmcnt(a)	;i _ last legal position in buffer
	adjbp7 i,.cmbfp(a)	;normalize
	tlnn i,400000		;if 440700
	jrst chkes1		;not
	tlc i,450000		;change to 010700
	subi i,1		;in previous word
chkes1:	outchr [exp 10]
   ;note that this loop uses e - that is, it appends to the buffer and
   ;also advances the current pointer.  This is because we are going
   ;to do a skip return, having copied into the atom buffer already.
   ;this is also why we don't incr F, since these characters aren't
   ;available for future reading in this pass (though they are in the
   ;buffer, so .CMINC is incr'ed)
appdfl:	ildb t,g		;append to buffer
	jumpe t,appdfx
	idpb t,e
	outchr t
	camn e,i		;if went too far
	jrst cmtool		;complain
	aos .cminc(a)		;now have one more char
	jrst appdfl
appdfx:	setz t,			;make asciz
	move h,e
	idpb t,h
  ;skip 2
	aos (p)
	aos (p)
	popj p,

;here if no default.  Ignore the esc and read more, except that
;if it is .CMFIL and there is a default device or name, allow it,
;because GTJFN will supply the default.
nodflt:	ldb g,[point 9,(c),8] 	;ftn rmally COPYxx will adjust E and F as it copies from
  ;the buffer into the atom buffer.  But with a file, only
  ;PARSE knows the syntax well enough to be sure when the
  ;string is empty.  So COPFIL just fills the atom buffer.
  ;PARSE then tells us how many of these characters were really
  ;part of the file name.  Here we adjust E and F to show that
  ;only those characters were copied.  G tells us whether we
  ;have to do this.  if the file name was defaulted, then
  ;we didn't get it from the text buffer, so there is nothinng
  ;to skip.  Note that PARSE makes the atom buffer ASCIZ.
  ;It puts the null at the end of the full file spec, including
  ;anything it added due to recognition.
	jumpe g,filrec	;if copied from input
	move i,h	;adjust E and F to skip right num of char's
	adjbp7 i,e
	movem i,e
	sub f,h
;here to do recognition on file names (if any).  What we do is check
;to see if there are any characters in the atom buffer beyond the
;number returned in H.
filrec:	move i,h		;adjust to end of original str. in atom buf
	adjbp7 i,.cmabp(a)
	move t,i
	ildb t,t
	jumpe t,filnrc		;nothing more - no completion
	movsi g,(cm%esc)	;say we did completion (for noise)
	iorm g,.cmflg(a)
	outchr [exp 10]		;back over esc
	move g,.cmcnt(a)	;g _ last legal position in buffer
	adjbp7 g,.cmbfp(a)	;normalize
	tlnn g,400000		;if 440700
	jrst endskx		;not
	tlc g,450000		;change to 010700
	subi g,1		;in previous word
				;i - source (set up above)
  ;start of copy loop
filrcl:	ildb h,i
	jumpe h,filrcx
	idpb h,e		;now copy to text
	outchr h		;and terminal
	camn e,g		;see if at end of buffer
	jrst cmtool		;yes - line too long
	aos .cminc(a)		;one more thing in buf
	jrst filrcl		;now loop for more
 ;end of loop - make asciz
filrcx:	move t,e		;use copy of bpt since this is one ahead
	idpb h,t
	camn t,g		;see if this went too far
	jrst cmtool
;recognition finished.  Check for errors
filnrc:	skipn fileof(d)	;if error
	popj p,
	movei t,[asciz /invalid syntax in file specification/]
	movem t,errstr
	aos (p)
	popj p,

dofits:	movei t,[asciz /file specification too long for internal working space/]
	movem t,errstr
	aos (p)
	popj p,

hlpfil:	pushj p,chkhlp		;see if use gave help msg
	move g,.cmgjb(a)	;look at flags
	move g,.gjgen(g)
	movei h,[asciz / output filespec
/]				;assume input
	tlnn g,(gj%old)		;but if OLD is on
	tlnn g,(gj%fou)		;or NEW is off
	movei h,[asciz / input filespec
/]				;then it is input
	outstr (h)
	popj p,

copyfi:	move g,.cmabp(a)	;g _ ptr to at buf
	move h,.cmabc(a)	;h _ cntr to at buf
	move i,e		;i _ ptr to input
	move j,f		;j _ cntr to input
copyfl:	jumpe h,copyfx		;test for done
	jumpe j,copyfx
	soj h,
	soj j,
	ildb t,i		;copy char
	idpb t,g
	jrst copyfl
copyfx:	popj p,

> ;ifn tops10
ife tops10,<printx Code for file scanning not yet written>

	subttl Switches and keywords

doswi:	pushj p,getskp
	jrst hlpswi
	pushj p,copysw
	 skipa
	 jrst cpopj1
	move g,.cmabp(a)
	ildb t,g		;get slash (we hope)
	caie t,"/"
	jrst dosnsw		;no - not a switch
	push p,g		;pass pointer to keywd part
	pushj p,dokey1		;now treat as keyword
	 skipa
         jrst [	pop p,g
		jrst cpopj1]	
	pop p,g			;adj stack
	move k,.cmabc(a)	;count of space in atom buf
	subi k,1		;already beyond /
	pushj p,swcomp		;completion if appropriate
	 skipa
	 jrst cpopj1
	move g,.cmabp(a)	;now see if atom buffer ended in colon
doswl:	ildb t,g
	caie t,0
	cain t,":"		;see if term with colon
	jrst .+2
	jrst doswl
	caie t,":"
	popj p,			;no - nothing special
	movsi t,(cm%swt)	;say found a colon
	iorm t,.cmflg(a)
	popj p,

dokey:	pushj p,getskp
	jrst hlpkey
	pushj p,copykw
	 skipa
	 jrst cpopj1
	move g,.cmabp(a)
	push p,g
	pushj p,dokey1
	 skipa
         jrst [	pop p,g
		jrst cpopj1]
	pop p,g
	move k,.cmabc(a)	;space in at buf
	pushj p,swcomp
	 popj p,
	 jrst cpopj1

dokey1:	move t,-1(p)		;make sure we have something
	ildb t,t
	caie t,0
	cain t,":"
	jrst dosnul
;  g - aobjn pointer into table
;  h - 0 if no match so far, else value (addr in table) of match
	move g,.cmdat(c)	;g _ aobjn pointer into table - this is table
	hlrz h,(g)		;    this is number of entries
	movn h,h		;    negative
	hrl g,h			;   in LH of G
	addi g,1		;   now have our AOBJN
	setz h,
	jumpge g,dosnom		;if table is empty, no match
doswil:	move i,-1(p)		;look up thing in at buf
	pushj p,lookc
	jumpg t,doswie		;exact match
	jumpl t,doswia		;abbrev
doswii:	aobjn g,doswil		;try again
;here if we fall out of the loop
	jumpe h,dosnom		;if no possibilities, no match
	move g,h		;exactly one, do it
	;jrst doswie		;same as exact
;here for exact match
doswie:	hrrz b,g		;return addr of table entry
	popj p,

doswia:	jumpn h,dosamb		;already have one possibility - ambig
	move h,g		;save this as first poss
	jrst doswii		;now try again

;lookc - compare string with table entry
;  g - addr of table entry
;  i - byte pointer to string to compare (can be changed)
;  returns in t -   -1=abbr, +1=exact, 0=none

lookc:	movs j,(g)	;j - bpt to string in table
	hrli j,000700
lookcl:	ildb t,i	;get comp byte
	cail t,141	;make upper case
	caile t,172
	jrst .+2
	subi t,40
	ildb k,j	;get table byte
	cail k,141	;make upper case
	caile k,172
	jrst .+2
	subi k,40
	came t,k	;now compare
	jrst lookcx	;found difference - stop
	jumpn t,lookcl	;same, if non-null, go back for more
	movei t,1
	popj p,		;same - complete match	
lookcx:	caie t,0
	cain t,":"
	jrst lookca	;comp ran out - abbrev
	setz t,		;just plain failure - say so
	popj p,
lookca:	seto t,		;say abbrev
	popj p,

hlpkey:	pushj p,chkhlp
	movei i,0
	jrst hlpsw0
hlpswi:	movei i,1		;i - 1 if switches
	pushj p,chkhlp		;see if user gave help
hlpsw0:	outstr [asciz / one of the following:/]
	move g,.cmdat(c)	;get switch table
	hlrz h,(g)		;make aobjn word in H
	movn h,h
	hrl h,h
	hrri h,1(g)
	jumpge h,hlpswx		;nothing to do
  ;first we figure out the maximum length of the switches
hlpsw1:	move j,h		;use copy
	movei l,2		;l will get max len
	jumpge j,hlpsw5
hlpsw2:	hlrz g,(j)		;start of this one
	hrli g,010700
	movei k,2(i)		;start with 0 for key, 1 for swi, +2
hlpsw3:	ildb t,g		;get next char, and count char's in K
	jumpe t,hlpsw4
	aoja k,hlpsw3		;next char in this switch
hlpsw4:	camle k,l		;l = l max k
	move l,k
	aobjn j,hlpsw2		;next switch
hlpsw5:	movei j,.towid		;get terminal width
	seto k,
	trmno. k,		;find our term's udx
	 jrst use72		;can't - assume 72 wide
	move t,[xwd 2,j]
	trmop. t,
use72:	 movei t,^D72		;can't - assume 72 wide
	hrl j,t
	hrr j,l
	setz l,
  ;loop to print out things
  ;g - ildb addr in string
  ;h - aobjn addr in table
  ;i - flag is switch
  ;j - LH - line length, RH - object len
  ;k - char's left in this object
  ;l - char's left in line
hlpswl:	hlrz g,(h)		;get the string address
	cail l,(j)		;room for one obj on this line?
	jrst hlpsw6
	outstr [asciz /
/]				;no - go to new one
	hlrz l,j		;and reinit line
hlpsw6:	hrrz k,j		;init object size ctr
	outchr [exp " "]
	subi l,1
	subi k,1
	skipe i			;put out / only if switches
	outchr [exp "/"]
	sub l,i
	sub k,i
	hrli g,010700		;make byte pointer to string
  ;loop on string
hlpsw7:	ildb t,g
	jumpe t,hlpsw8
	outchr t
	subi l,1		;and count
	soja k,hlpsw7
  ;now put out trailing blanks if any
hlpsw8:	outchr [exp " "]
	subi l,1		;count
	sojg k,hlpsw8
  ;go to next item
	aobjn h,hlpswl
hlpswx:	outstr [asciz /
/]
	popj p,

;copy switch into atom buffer
copysw:	jumpe f,cpopj		;make sure there is something there
	move g,.cmabp(a)	;get place to put it
	move h,.cmabc(a)
	subi f,1
	ildb t,e		;get the slash (one assumes)
	caie t,"/"		;if slash
	popj p,			; not - done
	idpb t,g		;copy it
	subi h,1		;and count it
	pushj p,cpykw1		;copy rest of keyword
	skipa
	jrst cpopj1
	move t,e		;see if have a term :
	ildb t,t
	skipe f
	caie t,":"
	popj p,			;no - done
	ildb t,e		;yes - copy it
	subi f,1
	dpb t,g
	subi h,1
	jumpe h,copyks		;and make asciz
	setz t,
	idpb t,g
cpopj:	popj p,

;copy keyword into atom buffer
copykw:	move g,.cmabp(a)	;g _ ptr to at buf
	move h,.cmabc(a)	;h _ cntr to at buf
cpykw1:	move i,e		;i _ ptr to input
	move j,f		;j _ cntr to input
copykl:	jumpe h,copyks		;test for done
	jumpe j,copykx
	ildb t,i		;copy char
  ;now stop unless it is alphanumberic
	cain t,"-"		;- is alph
	jrst copyko
	caige t,"0"
	jrst copykx		;below numbers
	caig t,"9"
	jrst copyko		;is a number, ok
	caige t,"A"
	jrst copykx		;between numbers and letters
	caig t,"Z"
	jrst copyko		;is a letter, ok
	caige t,"a"
	jrst copykx		;between upper and lower case
	caig t,"z"
	jrst copyko		;lower case, ok
	jrst copykx		;above lower case
   ;here if it is alphnumeric
copyko:	soj h,
	soj j,
	move e,i		;make permanent
	move f,j
	idpb t,g
	jrst copykl
copykx:	setz t,			;make at buf asciz
	idpb t,g
	popj p,

;swcomp - completion for switches - g has bpt to user's string in atbuf,
;  k has space in at buf.
swcomp:	jumpe f,cpopj		;see if esc is next
	move t,e		;peek
	ildb t,t
	caie t,33
	popj p,			;no escape
;now see whether user's string or switch ends first
	movs j,(b)		;j - bpt to string in table
	hrli j,000700
compl:	move t,g		;peek at next user's char
	ildb t,t		;t - user's char
	ildb h,j		;h - match char
	caie t,":"		;no compl if user ends with :
	cain h,0		;or if match ends first
	popj p,			;nothing to complete
	cain t,0		;user ends without match ending
	jrst docomp		;that's when we complete
	ibp g			;advance source - G and K
	subi k,1
	jrst compl		;no end, keep going
  ;here we actually do the completion
docomp:	movsi t,(cm%esc)	;say we did completion (for noise)
	iorm t,.cmflg(a)
	outchr [exp 10]		;back over esc
	move i,.cmcnt(a)	;i _ last legal position in buffer
	adjbp7 i,.cmbfp(a)	;normalize
	tlnn i,400000		;if 440700
	jrst endskx		;not
	tlc i,450000		;change to 010700
	subi i,1		;in previous word
  ;start of copy loop
docmpl:	jumpe k,copyks		;out of space?
	idpb h,e		;now copy to text
	idpb h,g		;and atom
	outchr h		;and terminal
	camn e,i		;see if at end of buffer
	jrst cmtool		;yes - line too long
	aos .cminc(a)		;one more thing in buf
	ildb h,j		;get next char
	skipe h			;if something there
	soja k,docmpl		;now loop for more
 ;end of loop - make asciz
	jumpe k,copyks		;make outputs asciz
	move t,e		;use copy of bpt since this is one ahead
	idpb h,t
	camn t,g		;see if this went too far
	jrst cmtool
	idpb h,g		;and in atom buffer
	popj p,

dosnom:	movei b,[asciz /does not match switch or keyword/]
	movem b,errstr
cpopj1:	aos (p)
	popj p,

dosamb:	skipa b,[exp [asciz /ambiguous switch or keyword/]]
copyks: movei b,[asciz /switch too long for internal working space/]
	movem b,errstr
	aos (p)
	popj p,

dosnul:	skipa b,[exp [asciz /null switch or keyword given/]]
dosnsw:	movei b,[asciz /not a switch - does not begin with a slash/]
	movem b,errstr
	aos (p)
	popj p,

	subttl numbers

;This parses a number and stops on first non-digit
donux:	pushj p,getskp
	jrst hlpnum	
	pushj p,numcpy
	 skipa
	 jrst cpopj1
	move i,.cmabp(a)	;i - source
	move h,.cmdat(c)	;h - radix
	cail h,2
	caile h,^D10
	jrst donumr		;bad radix
	ildb g,i		;and it had better be a digit
	cail g,"0"
	caile g,"0"(h)		;in the proper radix
	jrst donumd		;not a digit
	subi g,"0"
	move b,g		;init b to first digit
;now loop as long as there are more digits
donuxl:	ildb g,i
	cain g,0		;done if nothing more
	popj p,
	subi g,"0"		;turn g into number
	pushj p,.%adgb##	;add digit (in pasnum to avoid overflow)
	jrst donumo		;overflow
	jrst donuxl

;This parses a number, and requires that the whole atom form a legal number
donum:	pushj p,getskp
	jrst hlpnum	
	pushj p,copykw		;copy whole atom
	 skipa
	 jrst cpopj1
	move i,.cmabp(a)	;i - source
	move h,.cmdat(c)	;h - radix
	cail h,2
	caile h,^D10
	jrst donumr		;bad radix
	setz b,			;start with zero
;now loop as long as there are more digits
donuml:	ildb g,i
	cain g,0		;done if nothing more
	popj p,
	cail g,"0"
	caile g,"0"(h)		;in the proper radix
	jrst donmnd		;not a digit
	subi g,"0"		;turn g into number
	pushj p,.%adgb##	;add digit (in pasnum to avoid overflow)
	jrst donumo		;overflow
	jrst donuml

hlpnum:	pushj p,chkhlp		;check for user help
	move g,.cmdat(c)	;get radix
	cail g,2		;make sure it is valid
	caile g,^D10
	 jrst [	outstr [asciz / illegal radix for input number
/]
		popj p,]
	cain g,^D8
	 jrst [	outstr [asciz / octal number
/]
		popj p,]
	cain g,^D10
	 jrst [	outstr [asciz / decimal number
/]
		popj p,]
	outstr [asciz / a number in base /]
	addi g,"0"
	outchr g
	outstr [asciz /
/]
	popj p,

numcpy:	move g,.cmabp(a)	;g - dest
	move h,.cmabc(a)	;h - dest count
	move i,.cmdat(c)	;i - radix
	cail i,2
	caile i,^D10
	jrst donumr		;bad radix
numcpl:	jumpe f,numcpx		;if nothing there, done
	jumpe h,numtol		;if no space left, error
	move t,e		;peek
	ildb t,t
	cail t,"0"
	caile t,"0"(i)
	jrst numcpx		;not legal - done
	ildb t,e		;done, copy it
	subi f,1
	idpb t,g
	subi h,1
	jrst numcpl

numcpx:	jumpe h,numtol		;done, make asciz
	setz t,
	idpb t,g
	popj p,	

donmnd:	movei b,[asciz /invalid character in number/]
	movem b,errstr
	aos (p)
	popj p,

numtol:	skipa b,[exp [asciz /number too long for internal working space/]]
donumr:	movei b,[asciz /radix is not in range 2 to 10/]
	movem b,errstr
	aos (p)
	popj p,

donumo:	skipa b,[exp [asciz /overflow (number is greater than 2**35)/]]
donumd:	movei b,[asciz /first nonspace character is not a digit/]
	movem b,errstr
	aos (p)
	popj p,
	

	subttl Simple COMND functions

;cpyone - copy one char into atom buffer
cpyone:	jumpe f,cpopj
	ildb t,e
	subi f,1
	move g,.cmabp(a)
	idpb t,g
	setz t,
	idpb t,g
	popj p,

;hlpnul - default help is nothing
hlpnul:	pushj p,chkhlp		;check for user help
	aos (p)			;return +3 (chkhlp did +2)
	popj p,

docfm:	pushj p,getskp
	jrst hlpcfm
	pushj p,cpyone
	move g,.cmabp(a)
	ildb t,g
	cain t,12		;better be LF
	popj p,			;yes
docfmn:	movei t,[asciz /not confirmed/]
	movem t,errstr
	aos (p)
	popj p,

hlpcfm:	pushj p,chkhlp		;check for user help
	outstr [asciz / confirm with carriage return
/]
	popj p,

docma:	pushj p,getskp
	jrst hlpcma
	pushj p,cpyone
	move g,.cmabp(a)
	ildb t,g	
	cain t,","		;better be comma
	popj p,			;yes
	movei t,[asciz /comma not given/]
	movem t,errstr
	aos (p)
	popj p,

hlpcma:	pushj p,chkhlp		;check for user help
	outstr [asciz / comma
/]
	popj p,

;Noise is very odd, because usually no input is to be read.  Output
; is triggered by an escape in the previous.  The current code will
; not recognize noise if input, and will not respond to help.  The
; problem is that ? is almost certainly for the next field, not this
; one.  Probably the code should go
;   put out noise if requested
;   skip any noise in input
donoi:	move g,.cmflg(a)
	tlnn g,(cm%pfe)		;only do this is prev field was escape
	popj p,
	outstr [asciz / (/]
	move g,.cmdat(c)
donoil:	ildb t,g
	jumpe t,donoix
	outchr t
	jrst donoil
donoix:	outstr [asciz /) /]
	popj p,

dofld:	pushj p,getskp
	jrst hlpnul
	pushj p,copykw
	 skipa
	 jrst cpopj1
	popj p,

	sub