; -*-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