Added CALPRT.

README.md

@@ -111,6 +111,7 @@ There's a [DDT cheat sheet](doc/DDT.md) for Unix users.
    - ATSIGN TCP, TCP support.
    - BINPRT, display information about binary executable file.
    - BYE, say goodbye to user. Used in LOGOUT scripts.
+   - CALPRT, decode a .CALL instructions CALL block
    - CHTN, CFTP, Chaosnet TELNET and FTP support.
    - COMPLR, lisp compiler.
    - COMSAT, Mail server.

build/build.tcl

@@ -823,6 +823,10 @@ respond "*" ":link sys1;ts luser,sysbin;luser bin\r"
 respond "*" ":midas sys2;ts arccpy_sysen2;arccpy\r"
 expect ":KILL"
 
+# CALPRT
+respond "*" ":midas sys2;ts calprt_sysen2;calprt\r"
+expect ":KILL"
+
 # ndskdmp tape
 respond "*" ":link kshack;good ram,.;ram ram\r"
 respond "*" ":link kshack;ddt bin,.;@ ddt\r"

src/sysen2/calprt.23

@@ -0,0 +1,226 @@
+; -*-MIDAS-*-
+
+title calprt -- decode a .call's arguments
+
+.insrt rms;macros
+
+ch==,,-1
+chjob==1
+chtyo==2
+
+tmploc 42,tsint
+
+define kilprt string		;commit suicide, typing <string>.
+	.value [asciz — :string
+:kill Ý
+termin
+
+define prt string
+	movei g,[asciz ïstringÝ
+	call ascprt
+termin
+
+start:	move p,[-lpdl,,pdl-1]
+	.break 12,[..rljb,,jobidx]
+	move a,jobidx
+	syscal open,[[.uao,,chtyo] ? ['tty,,]]
+	 .lose %lsfil
+	syscal open,[%clbit,,.uii+10 ? %climm,,chjob	;Don't reown!
+		    ['usr,,] ? %climm,,400000(a) ? %climm,,0]
+	 kilprt [Can't access current job?]
+	.suset [.smask,,[%pimpv]]
+	syscal usrvar,[%climm,,%jself ? %climm,,.roptio ? 0 ? [tlo %opopc]]
+	 .lose %lssys
+	movsi a,-20
+rdacs:	call read		;set up to do effective address calculations.
+	 .value			;job has no acs???
+	movem d,ac(a)
+	aobjn a,rdacs
+	.value [asciz * 4/ 1q 
+:vp *]				;get the .call insn in a.
+	movem d,insn
+	call ea
+	hrrzm d,blkadr		;calculate address of the argument block.
+	hrrz a,d
+	call read
+	 jrst mpvdie
+	came d,[setz]
+	 kilprt [Invalid .CALL block:  1st word not SETZ?? ]
+	setzm incnt
+	setzm outcnt
+	movei a,1(a)		;skip the call name.  Assume DDT already mentioned that.
+rdarg:	call rednxt		;read the next argument.
+	 kilprt [.CALL block fell through into NXM?? ]
+	ldb b,[330300,,d]	;get argument type (0 = input, 1 = immediate, etc.)
+	save a
+	save d
+	call @argtyp(b)		;handle this type of arg.
+	rest d
+	rest a
+	jumpge d,rdarg		;print more args if there are any.
+	kilprt []
+
+argtyp:	inarg
+	immarg
+	outarg
+	errarg
+	cwarg
+	cbarg
+	badarg
+	badarg
+
+;here to handle an input argument.
+inarg:	call inarg1
+inarg2:	call argea
+	call sprint
+	prt [/   ]
+	move a,d
+	call read		;get contents of the location.
+	 jrst [	prt [??   ]	;print ?? if MPV,
+		jrst argend]
+argprt:	.value [asciz * 4/ 1j s;     ha;r    ' 
+CALPRTj :vp *]
+argend:	prt [
+]
+	ret
+
+inarg1:	prt [Arg #]
+	aos g,incnt
+	call decprt
+	prt [: ]
+	ret
+
+;here to handle an immediate argument.
+immarg:	call inarg1
+	call argea
+argimm:	.value [asciz * 4/ 1j s;     ha;r 
+CALPRTj :vp *]
+	jrst argend
+
+;here to handle an output arg
+outarg:	prt [Value #]
+	aos g,outcnt
+	call decprt
+	prt [: ]
+	jrst inarg2
+
+;here to handle an error code return arg.
+errarg:	prt [Error return: ]
+	jrst inarg2
+
+;here to handle a word of control bits:
+cwarg:	prt [Control Bits: ]
+	jrst inarg2
+
+;here to handle immediate control bits:
+cbarg:	prt [Control Bits: ]
+	call argea
+	jrst argimm
+
+;here to handle an argument of type 6 or 7 (meaningless).
+badarg:	prt [Bad argument type: ]
+	jrst inarg2
+
+;print the address in d.  If it is indexed or indirect, print <spec'd> -> <effective>.
+argea:	and d,[37,,-1]
+	tlnn d,-1
+	 ret
+	tlo d,(move)		;make ddt print the stuff as @addr(idx) instead of lh,,rh
+	call sprint
+	prt [ -> ]
+	call ea
+	andi d,-1
+	ret
+
+;print the number in g in decimal, clobbering h.
+decprt:	idivi g,10.
+	hrlm h,(p)
+	skipe g
+	 call decprt
+	hlrz h,(p)
+	addi h,"0
+	.iot chtyo,h
+	ret
+
+;print the asciz string that g contains the address of.
+ascprt:	hrli g,440700
+ascpr1:	ildb h,g
+	jumpe h,cpopj
+	.iot chtyo,h
+	jrst ascpr1
+
+;come here after getting an irrecoverable MPV (one which means that the
+;whole call-block is garbage).
+mpvdie:	kilprt [??   ]
+
+;print symbolically, using the decoded job's symbol table, the value in D.
+sprint:	.value [asciz * 4/ 1j s ; 
+CALPRTj :vp *]
+	ret
+
+;Perform effective address calculation on instruction in D.
+;The index and indirect fields are zeroed, and the rh gets the effective address.
+ea:	save a
+	save b
+	save c
+	movei c,20.
+ea1:	ldb a,[220400,,d]
+	skipe b,a		;get contents of index register, or 0 if unindexed.
+	 hrrz b,ac(a)
+	add b,d
+	hrr d,b			;add that into rh of word, not changing lh.
+	tlz d,17
+	tlnn d,(@)
+	 jrst eax		;not indirect => all done.
+	soje c,eax		;trap infinite loops;  don't indirect more than 20 times.
+	hrrz a,d
+	move b,d
+	call read		;indirect => read word indirected through.
+	 jrst [	move d,b
+		jrst eax]
+	dpb d,[002700,,b]	;take rh, index and @ from it,
+	move d,b		;but keep the opcode and ac from the original arg.
+	jrst ea1
+
+eax:	rest c
+	rest b
+	rest a
+	ret
+
+
+;Get in D the contents of the decoded job's word with address in A.
+;Skip if successful (memory exists at that address).
+rednxt:	movei a,1(a)		;REDNXT to increment a and then read.
+read:	save a
+	andi a,-1
+	.access chjob,a
+	rest a
+mpvex:	.iot chjob,d
+	 aos (p)		;mpv here makes the iot skip, so read doesn't skip.
+cpopj:	ret
+
+tsint:	0
+	0
+	movem a,tsinta
+	hrrz a,tsint+1
+	caie a,mpvex		;if we got an MPV from the .IOT in read,
+	 .value
+	aos tsint+1		;make the .IOT skip.
+	move a,tsinta
+	.dismis tsint+1
+
+tsinta:	0		;a saved during tsint.
+
+jobidx:	0		;job number of decoded job.
+insadr:	0		;address of the .call insn being decoded.
+insn:	0		;the .call itself.
+blkadr:	0		;the effective address of the .call.
+incnt:	0		;number of input args seen
+outcnt:	0		;number of value return args seen
+
+ac:	block 20	;the acs of the job being decoded, for address calculations.
+
+lpdl==20
+pdl:	block lpdl+10
+
+end start