; -*- Midas -*-

title GETSYM - Extract ITS system symbol definitions

a=:1
b=:2
c=:3
d=:4
e=:5
t=:6
tt=:7

p=:17

chdsko=:16

call=:pushj p,
return=:popj p,
save==:push p,
rest==:pop p,
flose=:.lose %lsfil
slose=:.lose %lssys
pause=:.break 16,100000
quit=:.logout 1,

define syscall name,args
	.call [setz ? .1stwd sixbit /name/ ? args(400000)]
termin

.insrt dsk:syseng;format >

outstr:	syscall siot,[movei chdsko ? a ? b]
	 slose
	return

define format &string&,args
	call [
	call $format
.zzz.==-1
irp arg,,[args]
	save arg
.zzz.==.irpcnt
termin
	hrroi a,[ascii string]
	movei b,.length string
	movni c,.zzz.+1
	jrst format"format]
termin

$forma:	save a
	save b
	save c
	call @-3(p)
	rest c
	rest b
	rest a
	rest (p)
	return

.vector pdl(lpdl==:100.)

usrvar:	sixbit /OPTION/	? tlo %opint\%opopc
	sixbit /MASK/	? move [%pipdl]
	sixbit /XUNAME/	? movem xuname
lusrvar==:.-usrvar

.scalar xuname,itsnam,itsvrs

go:	move p,[-lpdl,,pdl-1]
	move tt,[-lusrvar,,usrvar]
	syscall usrvar,[movei %jself ? tt]
	 slose
	syscall sstatu,[repeat 5,[ movem tt ? ] movem itsnam ? movem itsvrs]
	 slose
.vector syms(lsyms==:4000)
	move t,[-lsyms,,syms]
	move tt,[sixbit /CALLS/]
	.getsys t,
	 .lose			; Just assemble with a larger LSYMS...
	hrloi a,-1-syms(t)
	eqvi a,syms		; A: aobjn to symbols
	syscall open,[movsi .uao ? movei chdsko ? [sixbit /DSK/]
			[sixbit /ITSSYM/] ? move itsvrs]
	 flose
	.rdatim t,
	format "; System symbols for ~S ITS ~S (dumped by ~S ~S-~S).~@
		UNIVERSAL ITSSYM~@
		ASUPPRESS~@
		",[itsnam,itsvrs,xuname,t,tt]
loop:	skipge 0(a)
	 jrst hkiled
	move t,1(a)
	tlne t,777000
	 jrst opdfed
	format "~U=<~:H>~%",[0(a),1(a)]
	jrst next
	
opdfed:	format "OPDEF ~U [~:H]~%",[0(a),1(a)]
	jrst next

hkiled:	format "~U==<~:H>~%",[0(a),1(a)]
next:	aobjn a,.+2
	 .lose			; Can't happen
	aobjn a,loop
	format "END~%" 
	quit

tsint:
loc 42
	-ltsint,,tsint
loc tsint
	400000,,p
ltsint==:.-tsint

cnstnts:
constants
variables

patch::
pat:	block 100.
epatch:	-1			; Make memory exist, end of patch area

end go