CMD - DDT subroutines.

To use this, add (CMDS) to the sname search list.  Then make a
translation from DSK: (CMDS); TS * to DSK: SYS3; TS CMD.  Add a file
<HSNAME>; <XUNAME> (CMDS) where each subroutine is one line for the
subroutine name, followed by a body of commands terminated by a ^_
control character.

src/dcp/cmd.34

@@ -0,0 +1,283 @@
+
+title cmd
+
+a=1
+b=2
+c=3
+d=4
+e=5
+t=6
+tt=7
+
+x=14
+y=15
+z=16
+p=17
+
+ttyo==1
+dski==2
+
+jcllen==20.
+cmdlen==100.
+pdllen==50.
+buflen==1000.
+
+define princ &string&
+	movei y,.length string
+	move x,[440700,,[ascii string]]
+	.call cprinc
+	 .lose %lsfil
+termin
+
+define tyo loc
+	.iot ttyo,loc
+termin
+
+define terpri
+	.iot ttyo,[^M]
+	.iot ttyo,[^J]
+termin
+
+call=pushj p,
+return=popj p,
+
+.vector pdl(pdllen)
+.scalar uname,xuname,jname,xjname,sname,hsname
+
+go:	move p,[-pdllen,,pdl-1]
+	.call [setz ? sixbit /open/
+		move [.uao,,ttyo]
+		setz [sixbit /tty/]]
+	 .lose %lssys
+	.suset [-6,,[	.runame,,uname
+			.rxuname,,xuname
+			.rjname,,xjname
+			.rxjname,,xjname
+			.rsname,,sname
+			.rhsname,,hsname]]			
+	.call [setz ? sixbit /open/
+		move [.uai,,dski]
+		move [sixbit /dsk/]
+		move xuname
+		move [sixbit /(cmds)/]
+		setz hsname]
+	 jrst [	princ /No command file?/
+		jrst die]
+
+	setzi c,
+	move a,xjname
+	jumpe a,rcmdl0
+rcmdlp:	setzi b,
+	rotc a,6
+	addi b,40
+	movem b,cmd(c)
+	aoj c,
+	jumpn a,rcmdlp
+rcmdl0:	setzm cmd(c)
+
+	.suset [.roption,,a]
+	tlne a,%opcmd
+	 jrst rjcl
+	jrst search
+	
+rjcl:	.break 12,[..rjcl,,jclbuf]
+	move a,[440700,,jclbuf]
+
+	move b,xjname
+	came b,[sixbit/cmd/]
+	 jrst jclall
+	setzi c,
+rjcl1:	ildb b,a
+	cail b,"a
+	 caile b,"z
+	  skipa
+	   subi b,"a-"A
+	caig b,40
+	 jrst jclrst
+	movem b,cmd(c)
+	aoja c,rjcl1
+
+jclall: movei b,40
+	movem b,cmd(c)
+	aoj c,
+	ildb b,a
+
+jclrst:	caie b,^C
+	 cain b,^M
+	  skipa
+	   cain b,^_
+	    jrst jclend
+	movem b,cmd(c)
+	ildb b,a
+	aoja c,jclrst	
+
+jclend:	setzm cmd(c)
+
+.vector cmd(cmdlen)
+
+search:	setzi a,		;no first character.
+	call fndsig		;find a significant character
+searc1:	call fndtok		;find a token
+	call fndmat		;try to find a match
+	 jrst [	call pnttok	;punt the current token
+		jrst searc1 ]	;try next token
+	call fndeol		;find eol
+	call pnteol		;and punt it
+
+.vector buffer(buflen)
+
+	move  [ascii /:kil/]
+	movem buffer
+	move  [asciz /l /]
+	movem buffer+1
+	move b,[170700,,buffer+1]
+copy:	jumpl a,gotit		;EOF
+	cain a,^_		;EOR
+	 jrst gotit
+	idpb a,b
+	.iot dski,a
+	jrst copy
+
+gotit:	setzi 
+	idpb  b
+	.value buffer
+	.value [asciz /:HUH?  This can't happen!/]
+
+
+
+define key name,routine,args
+	asciz /name/,,[routine,,args]
+termin
+
+;;; comtbl:	key	uname,	ins6,	uname
+;;; 	key	xuname,	ins6,	xuname
+;;; 	key	jname,	ins6,	jname
+;;; 	key	xjname,	ins6,	xjname
+;;; 	key	sname,	ins6,	sname
+;;; 	key	hsname,	ins6,	hsname
+;;; 	key	cname,	inscnm
+;;; 	key	jcl,	insjcl
+;;; 	key	rstjcl,	insrjc
+;;; 	key	atom,	insatm
+;;; 	key	squoze,	inssqz
+;;; 	0,,0
+
+
+fndsig:	call skpsig
+	 skipa			;insig
+	  return		;sig
+	.iot dski,a
+	jumpge a,fndsig
+	jrst fail
+
+fndeol:	caie a,^M
+	 cain a,^J
+	  return
+	.iot dski,a
+	jumpge a,fndeol
+	jrst fail		;EOF
+
+fndeor:	cain a,^_
+	 return
+	.iot dski,a
+	jumpge a,fndeor
+	jrst fail		;EOF
+
+pnteor:	cain a,^_
+	 .iot dski,a
+	return
+
+fndtok:	call skpsig		;is it a significant character?
+	 skipa			;nope, do some other checks
+	  return
+	call skpeol		;is it an end of line character?
+	 skipa			;nope, it is really insig
+	  jrst fndto2
+	.iot dski,a
+	jumpge a,fndtok
+	jrst fail
+
+fndto2:				;eol found
+	call fndeor		;go find end of record
+	call pnteor		;and punt it
+	jrst fndsig		;and go find a significant character
+
+fndmat:	setzi b,
+fndma1:	move c,cmd(b)
+	caig c,40
+	 jrst fndma7
+	cail a,"a
+	 caile a,"z
+	  skipa
+	   subi a,"a-"A
+	came a,c
+	 return			;no match, so return
+	.iot dski,a
+	jumpl a,fail		;EOF
+	aoja b,fndma1
+
+fndma7:	call skpsig
+	 jrst cpopj1		;match if insig
+	return			;no match if sig
+
+skpsig:	caie a,40
+	 cain a,^I
+	  popj p,
+	caie a,^J
+	 cain a,^M
+	  popj p,
+	skiple a		;catches ^@ and EOF
+cpopj1:	 aos (p)
+cpopj:	popj p,
+
+skpeol:	caie a,^M
+	 cain a,^J
+	  aos (p)
+	   return
+
+pnteol:	call skpeol
+	 return
+	.iot dski,a
+	jrst pnteol
+
+pnttok:	call skpsig
+	 return
+	.iot dski,a
+	jrst pnttok
+
+fail:	princ /Command "/
+	setzi b,
+fail0:	skipn a,cmd(b)
+	 jrst fail1
+	tyo a
+	aoja b,fail0
+
+fail1:	princ /" not found/
+die:	skipe debug
+	 .value
+	.break 16,164000
+	.value [asciz /:HUH?  This can't happen!/]
+
+cprinc:	setz
+	sixbit /siot/
+	movei ttyo
+	move x
+	setz y
+
+constants
+
+debug:	0			;-1 => debugging
+
+jclbuf:	block jcllen
+	-1
+
+variables
+
+	end go
+
+;;; local modes:
+;;; mode:midas
+;;; auto fill mode:
+;;; fill column: 70
+;;; compile command: :midas dcp;ts cmd_1 î
+;;; end: