Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap1_198111 - decus/20-0003/pascmd.mac
There are 4 other files named pascmd.mac in the archive. Click here to see a list.
	title PASCMD - interface to COMND jsys for Pascal-20

	twoseg

	search pasunv,monsym
ifn tops10,<search uuosym>

	;[1] 19-OCT-79 17:20:24 Added PA2040 conditionals for KI TENEX.
	;			New routine, cmuerr, for user errors.
	;			Fixed bug to clear FDB on reparse.
	;[2] 6-May-80 by Britt  Fixed bug in CMATOM
	;[3] 13-Sep-80		Added CMRSCAN

;currently the following combinations of switches are supported
;  tops10 - UUO's
;  -tops10 - JSYS's
;  simcom - simulate of comnd and tbadd using code in this module
;  -simcom - uses jsys's or pa2050
;  tenex - use pa2050
;tops10:  tops10,simcom
;tops20:  -tops10,-simcom,-tenex
;tenex:   -tops10,-simcom,tenex
;In principle, I should support tenex sites not having pa2050, with
;the following:  -tops10,simcom
;But that code is not yet written.  Tenex should only be relevant
;under -simcom.

ifn tops10,<simcom==1>  ;simulate command jsys if tops10
ife tops10,<simcom==0>  ;use real command jsys (or pa2050) if tops20

ife tops10,<
ife tenex,<		;[1] check monitor call for TOPS-20
opdef jtbadd[jsys 536]
>
ifn tenex,<
opdef jtbadd[pushj p,$$tbadd##]	;[1] subroutine call for TENEX
opdef comnd[pushj p,$$comnd##]  ;[1]
>
>

ife klcpu,<
define	adjbp7	(reg,effadr) <	;[1]
	push p,reg+1		;[1] save register
	idivi reg,5		;[1] bytes/5 in a, bytes mod 5 in b
	add reg,effadr		;[1] number of words
	jumple reg+1,.+3	;[1] skip if multiple of 5 characters 
	ibp reg			;[1]
	sojg reg+1,.-1		;[1]
	pop p,reg+1		;[1] restore reg

 >> ;ife klcpu
ifn klcpu,<
opdef adjbp7[adjbp]
 > ;ifn klcpu


	entry cmini,cmifi,cmofi,cmfil,cmcfm,cmkey,cmuerr
	entry cmnum,cmnum8,cmnoi,cmswi
	entry cmauto,cmerrmsg,cmerr,cmhlp,cmdef,cmagain
	entry cmatom,cmfld,cmtxt,cmqst,cmact,cmnod
	entry cmdir,cmdirw,cmusr,cmflt,cmdev
	entry cmcma,cmt,cmd,cmtad,cmtn,cmdn,cmtadn
	entry cmnux,cmnux8,cmtok
	entry tbmak
if2,<	entry tbadd>
	entry gjgen,gjdev,gjdir,gjnam,gjext,gjpro,gjact,gjjfn
	entry cmmult,cmreal,cmint,cmdo
	entry cminir,cmmode	;[3]

bufsiz==^D80	;size of text buffer in words
abufsz==^D20	;size of atom buffer in words
files==^D40	;number of files that can be parsed in one command
prmsiz==^D20	;maximum size of prompt
hlpsiz==^D300	;size of area for building up help message
defsiz==^D20	;size of area for default
argsiz==^D20	;size of area for string arguments

	reloc 0

 ;the following must be contiguous, as the are initilized from stini
inibeg:
state:	block .cmgjb+1	;state block
curfil:	z		;pointer into filstk for last file gtjfn'ed
curhlp:	block 1
iniend==.-1
 ;the following must also be contiguous, they are zeroed
zerbeg:
ifn simcom,<
errstr:	block 1		;addr of error string
>
fdb:	block 4		;function descriptor block
erOK:	block 1		;user will handle errors himself
erseen:	block 1		;an error has actually occured
mulnxt:	block 1		;addr of next FDB in mulfdb - 0 if not in mult mode
zerend==.-1
 ;end contiguous section
savebc:	block 2		;saved value of B and C in CMINIR
iniret:	block 1		;return address for CMINIR
rscanf:	block 1		;0 - first time
			;1 - one rscanned command done
			;-1 - known not to be in rscan mode
errabt:	block 1		;non-zero means in RSCAN mode or such-like, and
			;we want to abort on any attempted reparse
ffcb:	block filcmp+1	;fake file control block
gjfblk:	block .gjatr+1	;extended gtjfn block for file name functions
txtbuf:	block bufsiz	;text buffer
txtend:
atbuf:	block abufsz	;atom buffer
prmbuf:	block prmsiz	;copy of prompt
filstk:	block files	;place to store files we have gtjfn'ed
defbuf:	block defsiz	;place to put user default
hlpbuf:	block hlpsiz	;place to put user help message
argbuf:	block argsiz	;place to put user arguments
usrret:	block 1
stkret:	block 2
 ;variables to be used for linked functions (multiple)
mulfdb:	block 12*6
mulend=.
m.fdb==0	;fdb itself, 4 words
m.disp==4	;where to go if it is this option
m.loc==5	;local storage for this option (2 words)
m.size==7
mulret:	block 1	;value to be returned

	reloc 400000

stini:	xwd 0,repars	;state block initialized to this
	xwd .priin,.priou
	xwd -1,prmbuf
	xwd -1,txtbuf
	xwd -1,txtbuf
	exp bufsiz*5
	z
	xwd -1,atbuf
	exp abufsz*5
	exp gjfblk
	exp filstk+files ;initial value for curfil
	point 7,hlpbuf	;initial value for pointer to help area
	subttl cmini - put out prompt and prepare for reparse

;[3] begin

igntbl:	xwd 3,3		;table of commands that mean no rescanned data
	xwd [asciz /ERUN/],1
	xwd [asciz /RUN/],1
	xwd [asciz /START/],1

;cmmode --> cmmodes
;  return one of
;    0 if normal
;    1 if in rscan mode
cmmode:	setz a,			;assume normal
	skiple rscanf
	movei a,1		;but if seen rescanned command, use 1
	movem a,1(p)
	popj p,

;cminir('prompt string');
;  special CMINI that accepts rescanned commands

cminir:	skiple rscanf		;already done one rscanned command?
	jrst rscanx		;yes - exit
	skipe rscanf		;known to be no rescanned data?
	jrst cmini		;yes - forget this
	setom rscanf		;now assume no rscanned data
	movem b,savebc		;save original arguments
	movem c,savebc+1
ife tops10,<
	movei a,0		;see if anything rescanned
	rscan
	 erjrst norscn
	jumple a,norscn		;nothing - normal cmini
	movei a,.priin		;set position to start of line to avoid CRLF
	rfpos			;get current position
	hrri b,0		;zero the column number
	sfpos
> ;ife tops10
ifn tops10,<
	movei a,0		;see if anything rescanned
	RESCAN	1		;BACK UP TTY INPUT TO SEE IF COMMAND
	  SKPINC		;SEE IF ANYTHING THERE
	    JRST NORSCN		;NO--MUST HAVE COME FROM CUSP LEVEL
> ;ifn tops10
;this section of code examines the command that was used to run the
; program, and bypasses it if appropriate.
	movei b,0		;now read the rescanned command
	movei c,0		;with no prompt
	move a,0(p)		;our return address
	movem a,iniret		;we will return by jrst @iniret	
	pushj p,cmini
	movei a,1
	movem a,erOK
;command that never has valid data?
	movei b,igntbl
	pushj p,cmkey
	move a,2(p)		;result returned by cmkey
	jumpn a,norscn		;RUN or START - no rescanned command
;probably file name for running us - bypass it
	movsi b,40		;file we came from - spec only
	pushj p,gjgen
	movei b,ffcb
	pushj p,cmfil		;scan the file spec
ifn tops10,<
	setzm ffcb+filnam	;and release the jfn we got for it
	setzm ffcb+fildev
> ;ifn tops10
ife tops10,<
	hrrz a,ffcb+filjfn	;and release the jfn we got for it
	rljfn
	 jfcl
> ;ife tops10
;now past command - see if anything more for us
	pushj p,cmcfm		;see if anything more
	skipn erseen		;was there a crlf?
	jrst norscn		;no error - yes, crlf, no rescanned data
;there is real data - set up to use it
	movei a,1		;say have done one rescanned command
	movem a,rscanf
	setom errabt		;and make us abort on error
	setzm erOK		;now go to default error mode
	move a,iniret		;and get back return addr if this is rescan
	movem a,0(p)
	popj p,			;we have already done cmini

;here second time through when rescanned - exit
ifn tops10,<
rscanx:	exit
> ;ifn tops10
ife tops10,<
rscanx:	haltf
	setom rscanf		;if continued, leave rscan mode
	jrst cmini
> ;ife tops10

;here if no rescanned data - go do normal cmini
norscn:	move b,savebc		;get back user's arguments
	move c,savebc+1
;	jrst cmini

;[3] end

;cmini('prompt string');

cmini:	setzm errabt		;on normal cmini - don't abort for error
	move t,[xwd stini,inibeg] ;initialize state variables
	blt t,iniend
	setzm zerbeg	;and zero the ones that should be zero
	move t,[xwd zerbeg,zerbeg+1]
	blt t,zerend
	cail c,prmsiz*5-1	;be sure his prompt isn't too long
	jrst prmlng
	hrli b,440700	;b _ pointer to his prompt
	move a,[point 7,prmbuf] ;a _ pointer to place to put it
	jumpe c,cmprm2	;now copy it
cmprm1:	ildb t,b
	idpb t,a
	sojg c,cmprm1
cmprm2: setz t,		;now put in null
	idpb t,a
	move t,0(p)	;save user's return addr for reparse
	movem t,usrret
	movem 16,stkret;save display and stack ptr.
	movem 17,stkret+1
cmprm3:	movei a,state	;reinitialize comnd
	movei b,[byte (9).cmini
		z
		z
		z]
ifn simcom,<pushj p,comnd>
ife simcom,<comnd>
	popj p,		;now return after call of cmprompt

reprom: skipn errabt	;[3] abort on error?
	jrst cmprm3	;[3] no - treat normally
	jrst endl##	;[3] yes - do the abort
	subttl reparse and error handling


ife tops10,<

;print the error message

cmerrm:	hrroi a,[asciz / /]
	esout		;?
	movei a,.priou
	hrloi b,.fhslf
	setz c,
ife simcom,<
	erstr		;official error msg
	 jfcl
	 jfcl
> ;ife simcom
ifn simcom,<
	hrro a,errstr
	psout
> ;ifn simcom
	hrroi a,[asciz / - /]
	psout		; -
	hrroi a,atbuf	
	psout		;erroneous thing
	hrroi a,[asciz /
/]	
	psout		;crlf
	popj p,

;cmuerr prints user error message then calls CMAGAIN
cmuerr: hrroi a,[0]	;[1] empty asciz string
	esout		;[1] empty output buffer, print crlf and ?, clear input
	movei a,.priou	;[1] where to print message
	hrli b,(point 7,0);[1]
	setz d,		;[1] terminate on null or count whichever first
	sout		;[1]

>  ;ife tops10

ifn tops10,<

;print the error message

cmerrm:	skpinc
	jfcl
	outstr [asciz /
? /]
	outstr @errstr
	outstr [asciz / - /]
	movei a,40
	ldb t,[point 7,atbuf,6]
	caige t,40		;if unprintable,kill it
	dpb a,[point 7,atbuf,6]
	outstr atbuf	
	outstr [asciz /
/]	
	popj p,

;cmuerr prints user error message then calls CMAGAIN
cmuerr: skpinc
	jfcl
	outstr [asciz /
?/]
	hrli b,(point 7,0);[1]
	jumpe c,cmagai

;now stop on count or null
cmuerl:	ildb a,b
	jumpe a,cmagai
	outchr a
	sojg c,cmuerl

>  ;ifn tops10
	jrst cmagai	;[1] go to reprompt routine

;parerr is where we go when an argument is not what the user asked for.
;  print the error message
;  reprompt and kill the old command line
;  reparse

parerr:	pushj p,cmerrm

;reprompt and kill the old command line
cmagai:	pushj p,reprom	;reprompt him
;reparse the new command
	;pjrst repars

;reparse is used to reparse when the user does rubout or something
;  restore stack and display to context of original CMINI call
;  reset return location so we go back to the user program right
;     after the original CMINI call, to redo all parsing
;  release all jfn's we have gotten

;restore stack and display
repars:	hrrz t,stkret	;be sure we are called from a legal level
	caile t,(p)
	jrst badstk
	move 16,stkret	;restore to the way we were at the cmprompt
	move 17,stkret+1
;reset return location
	move t,usrret	;also get the return address back
	movem t,0(p)	;so we return after call of cmprompt

	setzm mulnxt	;clear from multiple FDB mode
	setzm fdb+.cmdef ;[1] forget user def and hlp 
	setzm fdb+.cmhlp ;[1]

;release all jfn's
	move d,curfil	;now release all jfn's
repar1:	cain d,filstk+files ;done releasing?
	popj p,		;yes - return to reparse
	move b,(d)	;b _ current file to release
ife tops10,<
	move a,filjfn(b) ;a _ jfn of that file
	rljfn		;release the jfn
	 jfcl		;couldn't - trouble
> ;ife tops10
ifn tops10,<
	setzm filnam(b)	;release the jfn
	setzm fildev(b)
> ;ifn tops10
	aos d,curfil	;go to next file
	jrst repar1

ifn tops10,<
prmlng:	outstr [asciz /
? Prompt is too long
/]
	exit

badstk:	outstr [asciz /
? Reparse requested from block outside CMPROMPT
/]
	exit
> ;ifn tops10
ife tops10,<
prmlng:	skipa a,[xwd -1,[asciz /Prompt is too long
/]]
badstk:	hrroi a,[asciz /Reparse requested from block outside CMPROMPT
/]
fatal:	esout
	haltf
	jrst .-1
> ;ife tops10
	subttl general purpose routines for doing the COMND jsys

;docom
;  a - function code
;  b - contents of .cmdat, if any
;  d - some data needing to be preserved until after COMND
;Normally this actually does the COMND.  However if CMMULT has
;been done, it only sets up an FDB.

docom:	skipe mulnxt	;if in multiple mode
	jrst setcom	;just set up
	lsh a,33	;move function code to proper position
	skipe fdb+.cmhlp ;if user gave help message
	tlo a,(cm%hpp!cm%sdh) ;then tell comnd to use his and not its
	skipe fdb+.cmdef ;if user gave default
	tlo a,(cm%dpp)	;then tell comnd
	movem a,fdb+.cmfnp
	movem b,fdb+.cmdat
	setzm erseen	;assume no errors
	movei a,state	;now do the COMND
	movei b,fdb
ifn simcom,<pushj p,comnd>
ife simcom,<comnd>
	setzm fdb+.cmdef ;forget user def and hlp from this one
	setzm fdb+.cmhlp
	tlnn a,(cm%nop)	;if no errors
	popj p,		;then done
	pop p,(p)	;else return to context of caller
	setzm 1(p)	;give zero return (if any)
	aos erseen	;say saw error
	skipe erOK	;if error OK
	popj p,		;return to him
	jrst parerr	;else give error message and reparse

;
;Here are the special versions of the above for multiple options
;

;cmmult
;  initialize for multiple option command
cmmult:	movei a,mulfdb	;reset next to point to first space
	movem a,mulnxt	;non-zero mulnxt is flag that in mult mode
	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 t,c	;t = FDB used
	subi t,mulfdb	;t _ offset into MULFDB
	idivi t,m.size	;a _ FDB index no.
	addi t,1	;should be indexed off 1
	push p,t	;save as final return value
	move a,m.disp(c);a _ dispatch addr
	move d,m.loc(c);d _ data saved at setup
	move e,m.loc+1(c)
	pushj p,(a)
	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 has to test with cmerr

cmauto:	setz t,		;assume we handle errors
	cain b,0	;but if he wants to
	seto t,		;let him
	movem t,erOK
	popj p,		;<

;cmerr --> boolean
;  true if there has been an error

cmerr:	move t,erseen
	movem t,1(p)
	popj p,
	subttl user help and default texts

;cmhlp(string)
;  append one line to the user help message

cmhlp:	move a,c	;a _ no. of characters in his message
	addi a,3	;cr, lf, null
	adjbp7 a,curhlp	;[1] a _ end of message
	hrli a,0	;word involved with end of message
	cail a,hlpbuf+hlpsiz ;if not beyond end
	jrst hlpovr	;is too long
	hrli b,440700	;b _ source
	move a,curhlp	;a _ destination
	skipn fdb+.cmhlp ;if this is not the first line
	jrst cmhlp0
	movei t,15	;then use crlf to separate
	idpb t,a
	movei t,12
	idpb t,a
cmhlp0:	jumpe c,cmhlp2	;now copy
cmhlp1:	ildb t,b
	idpb t,a
	sojg c,cmhlp1
cmhlp2: movem a,curhlp	;save current end for next time
	setz t,		;null
	idpb t,a
;now we have to set up word .cmhlp to show there is a help message
	move t,[point 7,hlpbuf]
	movem t,fdb+.cmhlp
	popj p,

;cmdef(string)
;  sets this string as the default for the next call

cmdef:	cail c,defsiz*5	;be sure string is not too long
	jrst defovr	;is too long
	hrli b,440700	;b _ source
	move a,[point 7,defbuf] ;a _ destination
	movem a,fdb+.cmdef ;save in fdb to show there is a default
	jumpe c,cmdef2	;now copy
cmdef1:	ildb t,b
	idpb t,a
	sojg c,cmdef1
cmdef2: setz t,		;null
	idpb t,a
	popj p,

ife tops10,<
hlpovr:	hrroi a,[asciz /Help text too long for buffer
/]
	jrst fatal
defovr:	hrroi a,[asciz /Default too long for buffer
/]
	jrst fatal
> ;ife tops10
ifn tops10,<
hlpovr:	outstr [asciz /
? Help text too long for buffer
/]
	exit

defovr:	outstr [asciz /
? Default too long for buffer
/]
	exit
> ;ifn tops10
	subttl file parsing

;cmifi(file)
;  parse an input file

cmifi:	movei d,.cmifi
	jrst cmfile

;cmofi(file)
;  parse an output file

cmofi:	movei d,.cmofi	
	jrst cmfile

;cmfil(file)
;  parse an arbitrary file

cmfil:	movei d,.cmfil
cmfile: move t,filtst(b)
	caie t,314157	;if not valid
	pushj p,initb.##;init it
ife tops10,<pushj p,relf.##>
ifn tops10,<pushj p,rclose##>;release any old jfn - about to get a new one
        move a,d	;a _ function
	move d,b	;save file in d
	setz b,		;b _ 0
	pushj p,docom	;will set up data in FCB in D
ife tops10,<movem b,filjfn(d)> ;return jfn we got
	sos a,curfil	;save in file stack
	caige a,filstk	;run out of room?
	jrst filovr	;yes
	movem d,(a)	;save file in stack
	popj p,

;gjxxx - routines to set up various words in the gtjfn block.
;  we assume that gjgen is always called first.

fldsiz==^D8		;size of one field in a file name

gjgen:	setzm gjfblk	;clear block first
	move t,[xwd gjfblk,gjfblk+1]
	blt gjfblk+.gjatr
	movem b,gjfblk+.gjgen ;now put in this argument
	popj p,

gjdev:	movei d,.gjdev
	movei e,devblk
	jrst gjstr

gjdir:	movei d,.gjdir
	movei e,dirblk
	jrst gjstr

gjnam:	movei d,.gjnam
	movei e,namblk
	jrst gjstr

gjext:	movei d,.gjext
	movei e,extblk
	jrst gjstr

gjpro:	movei d,.gjpro
	movei e,problk
	jrst gjstr

gjact:	movei d,.gjact
	movei e,actblk
	jrst gjstr

gjjfn:	movem b,gjfblk+.gjjfn
	popj p,

gjstr:	;b - addr of string
	;c - length of string
	;d - offset in gjfblk
	;e - place to copy string

	cail c,fldsiz*5	;be sure string is small enough
	jrst defovr	;is too long
	hrli b,440700	;b _ source
	hrli e,440700	;e _ destination
	movem e,gjfblk(d) ;save pointer to it in gtjfn block
	jumpe c,gjstr2	;now copy
gjstr1:	ildb t,b
	idpb t,e
	sojg c,gjstr1
gjstr2: setz t,		;null
	idpb t,e
	popj p,

	reloc

devblk:	block fldsiz
dirblk:	block fldsiz
namblk:	block fldsiz
extblk:	block fldsiz
problk:	block fldsiz
actblk:	block fldsiz

	reloc

filovr:	hrroi a,[asciz /Too many jfn's
/]
nonfat:	esout
	jrst cmagai
	subttl TBMAK, TBADD, and CMKEY - keyword stuff

;tbmak(size) --> pointer to table
;  generates table with specified number of entries, returns pointer to
;	it.  the table is in the heap

tbmak:	push p,b	;save size for later
	addi b,1	;need extra word for header
	pushj p,new##	;b _ addr of header
	pop p,a		;a _ size
	movem a,(b)	;0,,size is header word
	movem b,1(p)	;return addr of header
	popj p,

;tbadd(table pointer, value, string, bits)
;  adds an entry to the table

tbadd:	push p,b	;table pointer
	push p,c	;value
	push p,d	;string addr
	push p,e	;string length
	push p,f	;bits
	addi e,1	;e _ size of arg required
	idivi e,5	;  convert to words (added 1 for null)
	caie f,0	;  round up
	addi e,1
	movei b,1(e)	;add one for the header
	pushj p,new	;b _ addr of argument block
	pop p,t		;t _ bits
	tlo t,(cm%fw)	;  bit that says first word is bits
	movem t,(b)	;put t in header
	pop p,a		;a _ # characters
	pop p,c		;c _ source byte pointer
	hrli c,440700
	movei d,1(b)	;d _ destination byte pointer (in arg block)
	hrli d,440700
	jumpe a,tbadd2	;now copy a characters
tbadd1:	ildb t,c
	idpb t,d
	sojg a,tbadd1
tbadd2:	setz t,		;add a null
	idpb t,d
	pop 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 code
	caie g,.cmfil		;if a file, with long form GTJFN
	jrst nodfln
	move g,.cmgjb(a)	;look at defaults
	skipn .gjdev(g)		;if device
	skipe .gjnam(g)		;or name
	jrst cpopj1		;then there are defaults, user will get them
;here to go read more
nodfln:	outchr [exp 10]
	jrst getmor

;  else skip 1
chknor:	aos (p)
	popj p,

ifn tops10,<
dftool:	outstr [asciz /
? Default too long for internal working space
/]
	exit
cmtool:	outstr [asciz /
? Input line too long for buffer
/]
	exit
> ;ifn tops10
ife tops10,<
dftool:	hrroi a,[asciz /Default too long for internal working space/]
	jrst fatal
cmtool:	hrroi a,[asciz /Input line too long for buffer/]
	jrst fatal
> ;ife tops10

;chkhlp - do user help if any - sets up +2 return
chkhlp: aos -1(p)		;caller will return +2
	aos -1(p)
	move g,.cmfnp(c)	;get ftn flags
	tlnn g,(cm%hpp)		;user help?
	popj p,			;no - user default
	outchr [exp " "]	;yes - get his
	move g,.cmhlp(c)
	hlrz h,g		;normalize it
	cain h,777777
	movei h,440700
	hrl g,h
chkhll:	ildb t,g		;now output it
	jumpe t,chkhlx
	outchr t
	jrst chkhll
chkhlx:	outstr [asciz /
/]
	pop p,(p)		;abort caller, since we have done his job
	popj p,
	subttl File scanning functions

ifn tops10,<
doofi:	skipa h,[exp gj%fou]	;output file
doifi:	movsi h,(gj%old)	;input file
	move g,.cmgjb(a)  ;clear all the fields we are currently using
	movem h,.gjgen(g)
	setzm .gjdev(g)
	setzm .gjnam(g)
	setzm .gjext(g)
dofil:	setz g,		;g is flag as to whether COPYFI is done
;the problem here is that COPYFI doesn't know when a file spec
;is done.  thus it copies as much as it can.  The parser then
;tells it how many char's were actually part of the spec.  At
;that point e and f are updated.
	pushj p,getskp
	jrst hlpfil
	pushj p,copyfi
	push p,a
	push p,b
	push p,c
	push p,d
	push p,e
	push p,f
	push p,g
	push p,t	;will be garbaged
	move b,d
	hrrz c,.cmabp(a)
	move d,.cmabc(a)
	move e,.cmgjb(a)
	pushj p,cmpars##
	move h,2(p)
	pop p,t
	pop p,g
	pop p,f
	pop p,e
	pop p,d
	pop p,c
	pop p,b
	pop p,a
;h is number of char's read.  Adjust various counts as if we had
;read them one at a time
	caml h,.cmabc(a);if read to the end of at buf
	jrst dofits	;then at buf was too small
  ;the atom buffer is used for two things - in case there was
  ;an error, it is dumped by the error msg.  In case of
  ;recognition, PARSE appends the added portions.  Note that the
  ;value returned in H includes only what was there orginally,
  ;not the parts added by recognition.
  ;  Normally 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,
	subttl Directory and user
;On Tops-10, I define a directory as being [p,pn,sfd...]
;  and a user as being [p,pn].  One could argue that user should
;  be p,pn without brackets, but this seems so unusual that I am
;  not going to do it.
dousr:	pushj p,getskp
	jrst hlpusr
	pushj p,copydr
	 skipa
	 jrst cpopj1
	movei g,0
	jrst dodir1

dodir:	pushj p,getskp
	jrst hlpdir
	pushj p,copydr
	 skipa
	 jrst cpopj1
	movei g,1
dodir1:	push p,a
	push p,c
	push p,d
	push p,e
	push p,f
	push p,t
	hrrz b,.cmabp(a)
	move c,g		;g - is SFD allowed?
	pushj p,cmdird##
	move b,2(p)
	pop p,t
	pop p,f
	pop p,e
	pop p,d
	pop p,c
	pop p,a
	jumpe b,illdir
	popj p,

hlpusr:	pushj p,chkhlp
	outstr [asciz / [p,pn]
/]
	popj p,

hlpdir:	pushj p,chkhlp
	outstr [asciz / [p,pn,sfd...]
/]
	popj p,

;copy directory into atom buffer
copydr: move g,.cmabp(a)	;g _ ptr to at buf
	move h,.cmabc(a)	;h _ cntr to at buf
copydl:	jumpe h,copyks		;test for done
	jumpe f,copydm
	ildb t,e		;copy char
	soj h,			;count it
	soj f,
	idpb t,g
	caie t,"]"		;stop when ]
	jrst copydl
copydx:	jumpe h,copyks		;make at buf asciz
	setz t,
	idpb t,g
	popj p,

copydm:	jumpe h,copyks
	setz t,
	idpb t,g
	skipa b,[exp [asciz /directory does not end in ]/]]
illdir:	movei b,[asciz /syntax error in directory/]
	movem b,errstr
	aos (p)
	popj p,
	subttl floating point numbers

doflt:	
	
> ;ifn simcom


	end