diff --git a/build/misc.tcl b/build/misc.tcl index 070b2d21..722368db 100644 --- a/build/misc.tcl +++ b/build/misc.tcl @@ -819,3 +819,7 @@ respond "*" ":link sys; ts tj6, sys; ts ntj6\r" respond "*" ":midas sys3;ts versa_dcp; versa\r" expect ":KILL" # respond "*" ":link channa; rakash v80spl,sys3; ts versa\r" + +# DDT subroutines +respond "*" ":midas sys3;ts cmd_dcp; cmd\r" +expect ":KILL" diff --git a/doc/programs.md b/doc/programs.md index 6dc649ab..23506b53 100644 --- a/doc/programs.md +++ b/doc/programs.md @@ -33,6 +33,7 @@ - COMIFY, convert HEX to COM format. - COMPLR, lisp compiler. - COMSAT, Mail server. +- CMD, DDT subroutines. - CREATE, creates a text file in your home directory from console input. - CROCK, analog watch. - CROSS, cross assembler for micros. diff --git a/src/dcp/cmd.34 b/src/dcp/cmd.34 new file mode 100644 index 00000000..9280335c --- /dev/null +++ b/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: