; -*- Midas -*-

.symtab 3001.,1999.

title Probe around in a job.

a=:1
b=:2
c=:3
d=:4
e=:5
t=:6	? intacs==:t_6+2	; T and TT saved on interrupt
tt=:7
x=:10
y=:11
z=:12

u=:16
p=:17

ch==:0,,-1
chttyi==:1
chttyo==:2
cherri==:3
chusr==:4
chhsti==:5
chdump==:6

;;;Flags:
%fddt==:1_17.			;DDT is superior
%fbrk==:1_16.			;Superior claims to hack .break
%fhsts==:1_15.			;HOSTS3 database loaded.
%ftemp==:1_14.			;For hacks...

;;;Instructions:
call=:pushj p,
return=:popj p,
jcall==:jrst
save=:push p,
rest=:pop p,
tyo=:.iot chttyo,

stop=:call .
$stop:	skipe debug
	 .break 16,104000
	trne %fbrk
	 .break 16,164000
	.logout 1,

define syscall name,args
	.call [setz ? sixbit /name/ ? args(400000)]
termin

define princ &string&
	move t,[440700,,[ascii string]]
	movei tt,.length string
	.call siot
	 .lose %lssys
termin

siot:	setz
	sixbit /siot/
	movei chttyo
	move t
	setz tt

;;;FORMAT

format"$$pcode==:1
format"$$errs==:1
format"erri==:cherri
.insrt dsk:syseng;format

outstr:	syscall siot,[movei chttyo ? a ? b]
	 .lose %lssys
	return

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

fmtin:	push p,a
	push p,b
	push p,c
	push p,[fmtout]
	jrst @-4(p)

fmtout:	pop p,c
	pop p,b
	pop p,a
	pop p,(p)
	return

lpdl==:100.
.vector pdl(lpdl)
ljcl==:20.			;100. characters
.vector jcl(ljcl+1)
.scalar jclbp

go:	move p,[-lpdl,,pdl-1]
	setzi 0,		;clear flags
	call sysini
	call purify
	.open chttyo,[%tjdis\.uao,,'tty ? setz ? setz]
	 .lose %lssys
	.open chttyi,[.uai,,'tty ? setz ? setz]
	 .lose %lssys
	;;^S and ^G interrupt, ^I ^J and ^? don't echo (mimic DDT):
	syscall ttyset,[movei chttyi ? [222222,,222222] ? [230222,,220222]]
	 .lose %lssys
	.suset [.roption,,a]
	tlne a,%opddt
	 tro %fddt
	tlne a,%opbrk
	 tro %fbrk
	tlo a,%opint\%opopc
	move tt,[-4,,[	.s40addr,,[twenty,,forty]
			.soption,,a
			.smask,,[%pipdl]
			.smsk2,,[1_chttyi\1_chttyo\1_chusr]
			]]
	.suset tt

	tlnn a,%opcmd
	 jrst nojcl
	setzm jcl
	move tt,[jcl,,jcl+1]
	blt tt,jcl+ljcl-1
	setom jcl+ljcl
	.break 12,[..rjcl,,jcl]
	move tt,[440700,,jcl]
	movem tt,jclbp
	call getsix
	 jrst usage
	move b,a
	call getsix
	 jrst [	came b,[sixbit /?/]
		 camn b,[sixbit /help/]
		  jrst usage
		exch a,b
		call sixnum
		 jrst numjcl
		call ttynum
		 jrst ttyjcl
		jrst .+1]
	syscall open,[moves e ? [10\.bii,,chusr]	; Insist on old job
			[sixbit /usr/] ? b ? a]
	 skipa
	  jrst ready
	jumpn b,nojob
	save e
	syscall open,[[10\.bii,,chusr]	; Insist on old job.
			[sixbit /usr/] ? a ? [sixbit /hactrn/]]
	 jrst nouser
	.uset chusr,[.rcnsl,,a]
	jrst ttyjcl
	
nouser:	rest e
nojob:	princ "AJob "
	skipe b
	 format "~S ",b
	format "~S -- ~:@E.",[a,e]
	stop

nojcl:	trnn %fddt
	 jrst usage
	.break 12,[..rljb,,a]
numjcl:	syscall open,[moves e ? [10\.bii,,chusr]	; Insist on old job
			[sixbit /usr/] ? movei %jsnum(a) ? movei 0]
	 skipa
	  jrst ready
	format "~&Job ~O -- ~:@E.",[a,e]
	stop

ttyjcl:	move b,a
	syscall styget,[moves e ? movei 400000(b)
			movem a ? movem a]
	 jrst [	format "~&Console ~O -- ~:@E.",[b,e]
		stop]
	jumpge a,numjcl
	format "~&Console ~O is free.",b
	stop

usage:	.suset [.rxjname,,a]
	format "~&Usage is:
:~S <uname> <jname>
or
:~S <job number>
or
:~S T<console number>
or
:~S <jname>
or
:~S <uname>

With no JCL under DDT, operates on previously selected job.

:~S ?
or
:~S HELP
or with null JCL prints this help message.
",[a,a,a,a,a,a,a,a,a,a]
	stop

.vector fname(4)
.scalar mode

usrvar:
irp var,,[uind,cnsl,bchn]
.scalar var
	sixbit /var/
	movem var
termin
lusrvar==:.-usrvar

.vector pmap(400)
rpmap:	repeat 400, .rpmap+.rpcnt ? movem pmap+.rpcnt
lrpmap==:.-rpmap

ttyvar:
irp var,,[idltim,tctyp,ttytyp]
.scalar var
	sixbit /var/
	movem var
termin
lttyvar==:.-ttyvar

ready:	move tt,[-lrpmap,,rpmap]
	syscall usrvar,[movei chusr ? tt]
	 .lose %lssys
	move tt,[-lusrvar,,usrvar]
	syscall usrvar,[movei chusr ? tt]
	 .lose %lssys
	move u,uind
	imul u,lublk
	skipge t,cnsl
	 jrst start
	move tt,[-lttyvar,,ttyvar]
	syscall ttyvar,[movei 400000(t) ? tt]
	 .lose %lssys

start:	format "~& Job ~O: ~S ~S",[uind,@uname,@jname]
	skipn a,@ustp
	 jrst ready0
	princ ", Stopped"
	tdnn a,[#1_33.]
	 jrst ready0
	ldb b,[360600,,a]
	and a,[7777,,-1]
	format ": ~O!~O",[b,a]
ready0:	skipl @aprc		;Disowned?
	 jrst redy01
	princ ", Disowned"
redy01:	move a,@time
	sub a,@lubtm
	idivi a,30.
	jumpe a,ready1
	princ ", Idle "
	call ptime
ready1:	move a,@aprc
	tlnn a,100000		;BUMRTL
	 jrst redy11
	princ ", Will die"
redy11:	skipge a,cnsl
	 jrst ready2
	format "~& Console ~O",cnsl
	move a,idltim
	idivi a,30.
	jumpe a,ready2
	princ ", Idle "
	call ptime
	jrst ready3

ready2:	came a,[-1]
	 jrst ready3
	princ ", System"
ready3:	call pwho
	movsi a,-16.
	movei b,@iochnm
chloop:	skipn (b)
	 jrst nextch
	syscall rfname,[movei chusr ? movei (a)
			movem fname+0 ? movem fname+1
			movem fname+2 ? movem fname+3
			movem mode]
	 .lose %lssys
	skipn fname+0
	 jrst nextch
	movei tt,(a)
	format "~& ~2<~O~>)  ",tt
	call pfname
	princ " 	"	;<space><tab>
	call pmode

nextch:	aos b
	aobjn a,chloop
	ldb t,[232100,,@siocp]
	skipe t
	 format "~& ~O channel~P pushed on IOPDL.",t
	move a,bchn
	addi a,@iochst
	ldb a,[221600,,(a)]
	jumpe a,nobchn
	princ "A Last error"
	skipe bchn
	 format " (on channel ~O)",bchn
	format ": ~:@E.",a
nobchn:	princ "A Last UUO:	"
	move a,@sv40
	call pinstr
	ldb a,[271500,,@sv40]
	caie a,.call_-27
	 jrst notcal
	hrrz t,@uuac
	format " (~S) [~O]",[@lscall,t]
notcal:	move a,@upc
	move b,a
	tlnn b,%psusr
	 move a,@suuoh
	princ "A PC:		"
	call prinpc
	tlne b,%psusr
	 jrst nsyspc
	move a,b
	princ "A System PC:	"
	call prinpc

nsyspc:	skipn t,@epdlt4
	 jrst ready8
	movem t,fname+0
	move t,@epdlt1
	movem t,fname+1
	move t,@epdlt2
	movem t,fname+2
	move t,@epdlt3
	movem t,fname+3
	princ "A Last filename:	"
	call pfname
ready8:	move t,@xuname
	came t,@uname
	 format "~& XUNAME:	~S",t
	move t,@xjname
	came t,@jname
	 format "~& XJNAME:	~S",t
	move t,@hsname
	came t,@xuname
	 format "~& HSNAME:	~S",t
	move t,@usysnm
	came t,@hsname
	 format "~& SNAME:		~S",t
	skipn a,@option
	 jrst nooptn
	princ "A Options:	"
	hlrz a,a
	move b,[-lmp%op,,mp%op]
	movei c,bitset
	call bitmap
nooptn:	move a,@mskst
	move b,@mskst2
	hrroi c,[asciz "Enabled:	"]
	call pintwd
	skipn @piclr
	 format "~& All deferred (PICLR)"
	move a,@idf1
	move b,@idf2
	hrroi c,[asciz "Deferred:	"]
	call pintwd
	move a,@pirqc
	move b,@ifpir
	hrroi c,[asciz "Pending:	"]
	call pintwd

	hrlzi a,-400		; A: aobjn into PMAP
pmaplp:	skipn b,pmap(a)
	 aobjn a,pmaplp
	jumpge a,pmapzz
	and b,pmapsk		; B: PMAP word
	movei c,(a)		; C: Starting page
	ldb d,[.bp 777,b]	; D: Type code
	setzi e,		; E: # swapped out
pmapnx:	tlzn b,100000
	 aoj e,
	caie d,777		; Abs or shared?
	 addi b,1000		; Yes: Expect next page number.
	aobjp a,pmaprt		; Point at next page
	skipn tt,pmap(a)
	 jrst pmaprt
	and tt,pmapsk
	tlne tt,100000
	 tlo b,100000
	camn tt,b
	 jrst pmapnx
pmaprt:	caie c,-1(a)
	 jrst pmapr1
	format "~& ~7<~O~>",c
	jrst pmapr2
	
pmapr1:	movei tt,-1(a)
	format "~& ~7<~O-~O~>",[c,tt]
pmapr2:	tlnn b,%cbwrt
	 format ", Pure"
	tlne b,%cbpub
	 format ", Public"
	tlne b,%cblok
	 format ", Locked"
	tlne b,%cbslo
	 format ", Slow"
	jumpe d,pmapr5
	jumpe e,pmapr3
	cain c,-1(a)
	 jrst pmapr4
	movei t,(a)
	subi t,(c)
	format ", ~D/~D Out",[e,t]
	jrst pmapr3

pmapr5:	format ", Abs"
	jrst pmapsh

pmapr4:	format ", Out"
pmapr3:	cain d,777
	 jrst pmaprz
	save u
	move u,d
	imul u,lublk
	format ", ~S ~S (~O)",[@uname,@jname,d]
	rest u
	ldb tt,[.bp <377,,0>,b]
	subi tt,2
	skiple tt
	 format " +~D",tt
pmapsh:	ldb tt,[.bp 777000,b]
	cain c,-1(a)
	 soja tt,pmaps1
	movei t,(c)
	subi t,(a)
	add t,tt
	subi tt,1
	format " Pg ~O-~O",[t,tt]
	jrst pmaprz

pmaps1:	format " Pg ~O",tt
pmaprz:	jumpl a,pmaplp
pmapzz:	princ "A"
	stop

;;; Bits in the PMAP word that we really care about.
;;; %CBWRT	Writable
;;; %CBPUB	Public
;;; %CBLOK	Locked in core
;;; %CBSLO	In slow memory (Doesn't work; Moon says it never will)
;;; 4.7		Swapped in
;;; 3.8 - 3.1	Number of times shared
;;; 2.9 - 2.1	Page number for absolute or shared page.
;;; 1.9 - 1.1	000 => Absolute
;;;		777 => Unshared
;;;		<N> => Shared with job N
pmapsk:	%cbwrt\%cbpub\%cblok\%cbslo\100377,,-1

pwho:	skiple a,@uwho1
	 tdnn a,[.byte 8 ? 77 ? 177 ? 77 ? 177]
	  return
	princ "A Who line: "
	move b,@uwho2
	call pwho1
	lsh a,16.
	tlnn a,(.byte 8 ? 200)
	 tyo [40]
	move b,@uwho3
pwho1:	hlrz c,b
	ldb t,[.bp <.byte 8 ? 70>,a]
	call pwho3(t)
	ldb c,[.bp <.byte 8 ? 0 ? 177>,a]
	jumpe c,pwho2
	tyo c
	tlne a,(.byte 8 ? 0 ? 200)
	 tyo c
pwho2:	tlnn a,(.byte 8 ? 100)
	 tyo [40]
	hrrz c,b
	ldb t,[.bp <.byte 8 ? 7>,a]
	jrst pwho3(t)

pwho3:	return			; 0: nothing
	jrst pwdate		; 1: date
	jrst pwtm40		; 2: time (40ths)
	jrst pwtime		; 3: time (halfs)
	jrst pwoct		; 4: octal
	jrst pwdec		; 5: decimal
	jrst pwsix		; 6: sixbit
	return			; 7: unused

pwoct:	format "~O",c
	return

pwdec:	format "~D",c
	return

pwsix:	ldb t,[140600,,c]
	addi t,40
	tyo t
	ldb t,[060600,,c]
	addi t,40
	tyo t
	ldb t,[000600,,c]
	addi t,40
	tyo t
	return

pwdate:	ldb z,[130700,,c]	; year
	ldb x,[070400,,c]	; month
	ldb y,[020500,,c]	; day
	format "~D/~D/~D",[x,y,z]
	return

pwtime:	lsh c,-1
pwtim0:	idivi c,60.*60.		; C: hours
	idivi d,60.		; D: minutes  E: seconds
	format "~2<~;0~D~>:~2<~;0~D~>:~2<~;0~D~>",[c,d,e]
	return

pwtm40:	lsh c,-2
	idivi c,10.
	hrlm d,(p)
	call pwtim0
	hlr d,(p)
	addi d,"0
	tyo [".]
	tyo d
	return

ptime:	tro %ftemp		; %FTEMP => Nothing printed yet.
	save b
	idivi a,60.
	save b
	idivi a,60.
	save b
	idivi a,24.
	jumpe a,ptime1
	trz %ftemp
	format "~D day~P",a
ptime1:	jumpe b,ptime2
	trzn %ftemp
	 tyo [40]
	format "~D hour~P",b
ptime2:	rest b
	jumpe b,ptime3
	trzn %ftemp
	 tyo [40]
	format "~D min~P",b
ptime3:	rest b
	jumpe b,ptime4
	trzn %ftemp
	 tyo [40]
	format "~D sec~P",b
ptime4:	rest b
	return

pinstr:	ldb t,[331100,,a]
	cain t,.call_-33
	 jrst p.call
	cain t,.oper_-33
	 jrst p.oper
pibck1:	caige t,luuotbl
	 skipn t,uuotbl(t)
	  jrst pinum
	call 6princ
	tyo [40]
	call piac
piaddr:	tlnn a,(@)
	 jrst pinoat
	princ "@"
pinoat:	hrrz t,a
	cail t,774000
	 hrre t,a
	skipe t
	 format "~O",t
	ldb t,[220400,,a]
	skipe t
	 format "(~O)",t
	return

piac:	ldb t,[270400,,a]
	skipe t
	 format "~O,",t
	return

pinum:	format "~O_33 ",t
	call piac
	jcall piaddr

p.call:	ldb t,[270400,,a]
	caige t,lcaltbl
	 skipn t,caltbl(t)
	  jrst piback
	call 6princ
	tyo [40]
	jcall piaddr

piback:	ldb t,[331100,,a]
	jrst pibck1

p.oper:	hrrz t,a
	caige t,loprtbl
	 skipn t,oprtbl(t)
	  jrst piback
	call 6princ
	tyo [40]
	jcall piac

pmode:	princ "(."
	ldb t,[000300,,mode]
	move t,(t)[
irpc ai,,ai
irpc ub,,ub
irpc io,,io
440700,,[ascii "ub!!ai!!io"]
termin
termin
termin
]
	movei tt,3
	.call siot
	 .lose %lssys
	move t,fname+0
	camn t,[sixbit /tty/]
	 jrst ttybts
	move t,mode
	andcmi t,7
	skipe t
	 format "+~O",t
pmodez:	princ ")"
	return

ttybts:	save a
	save b
	save c
	move a,mode
	move b,[-lmp%tj,,mp%tj]
	trnn a,%doout
	 move b,[-lmp%ti,,mp%ti]
	andcmi a,7
	movei c,ttybt1
	call bitmap
	skipe a
	 format "+~O",a
	rest c
	rest b
	rest a
	jrst pmodez

ttybt1:	hrro t,(b)
	format "+~A",t
	return

pfname:	format "~S:",fname+0
	move t,fname+1
	camn t,[sixbit /.file./]
	 jrst [	move t,fname+2
		camn t,[sixbit /(dir)/]
		 jrst pfnam0
		jrst .+1]
	move t,fname+0
	camn t,[sixbit /err/]
	 jrst errhak
	came t,[sixbit /chaos/]
	 camn t,[sixbit /tcp/]
	  jrst tcphak
	camn t,[sixbit /usr/]
	 jrst usrhak
	camn t,[sixbit /spy/]
	 jrst spyhak
pfnam0:	skipe fname+3
	 format "~S;",fname+3
	skipe fname+1
pfnam1:	 format "~S ~S",[fname+1,fname+2]
	return

spyhak:	format " Tty ~O",fname+1
	return

usrhak:	skipn fname+2
	 jrst usrhk1
	skipe fname+1
	 jrst pfnam1
	format " Own ~S",fname+2
	return

usrhk1:	hrrz t,fname+1
	caige t,20
	 jrst [	format " Channel ~O",t
		return]
	cain t,%jself
	 jrst [	princ " Self"
		return]
	cain t,%jssup
	 jrst [	princ " Superior"
		return]
	cain t,%jssix
	 jrst [	princ " The PDP-6!"
		return]
	subi t,%jsnum
	format " Job ~O",t
	return

errhak:	save a
	syscall open,[moves a ? [.uai,,cherri] ? [sixbit /err/]
			fname+1 ? fname+2]
	 jrst [	format "~S ~S (~:@E.)",[fname+1,fname+2,a]
		rest a
		return]
	syscall rfname,[movei cherri ? movem a ? movem a ? movem a]
	 .lose %lssys
	ldb a,[221600,,a]
	format | Error ~O: "|,a
	jrst errhk1

errhk9:	princ |, |
errhk0:	tyo a
errhk1:	.iot cherri,a
	cail a,40
	 jrst errhk0
	caie a,^M
	 jrst errhk2
	.iot cherri,a
	caie a,^J
	 jrst errhk2
	.iot cherri,a
	cail a,40
	 jrst errhk9
errhk2:	.close cherri,
	princ |"|
	rest a
	return

netwrk"$$hst3==1
netwrk"$$hstmap==1
netwrk"$$look==1
.insrt dsk:syseng;netwrk

tcphak:	save a
	save b
	save c
	save d
	save e
	troe %fhsts
	 jrst tcphk1
	move a,nxpage
	movei b,chhsti
	call netwrk"hstmap
	 .lose
	hrrzm a,nxpage
tcphk1:	move b,fname+3
	call netwrk"hstsrc
	 jrst nmhost
	hrroi a,(a)
	format " Host ~A, ",a
	skipa
nmhost:	 format " Host ~O, ",fname+3
	format "Local ~O, Foreign ~O",[fname+1,fname+2]
	rest e
	rest d
	rest c
	rest b
	rest a
	return

prinpc:	save b
	save c
	hrrz t,a
	format "~O",t
	hlrz a,a
	jumpe a,npcbts
	princ "	{"		;<tab><brace>
	move b,[-luserpc,,userpc]
	trnn a,%psusr
	 move b,[-lexecpc,,execpc]
	movei c,bitset
	call bitmap
	skipe a
	 format "~O",a
	princ "}"
npcbts:	rest c
	rest b
	return

bitset:	hrro t,(b)
	jumpe a,btset1
	format "~A,",t
	return

btset1:	format "~A",t
	return

pintwd:	skipn a
	 jumpe b,[return]
	format "~& ~A",c
	jumpe a,pintw1
	camn a,[-1]
	 jrst pintw7
	save b
	move b,[-lmp%pi,,mp%pi]
	movei c,bitset
	call bitmap
	move b,[-lmpn.m,,mpn.m]
	movei c,bitset
	call bitmap
	rest b
	jumpn b,pintw0
	return

pintw7:	princ "PI*"
pintw0:	princ ","
pintw1:	hrrz a,b
	caie a,1_20-1
	 cain a,-1
	  jrst [princ "CH*"
		hllz b,b
		jumpe b,[return]
		princ ","
		jrst .+1]
	hlrz a,b
	caie a,1_8-1
	 cain a,-1
	  jrst [princ "INF*"
		hrrz b,b
		jumpe b,[return]
		princ ","
		jrst .+1]
	move a,b
	move b,[-lmpifp,,mpifp]
	movei c,bitset
	call bitmap
	return

;;;Convert a word of sixbit to a number if possible.  Skips if it isn't.
sixnum:	aos (p)
	move t,a
sixnm0:	setzi x,
sixnm1:	setzi tt,
	rotc t,6
	cail tt,'0
	 caile tt,'9
	  return
	lsh x,3			;octal
	addi x,-<'0>(tt)
	jumpn t,sixnm1
	move a,x
	sos (p)
	return

;;;Convert a word of sixbit to a TTY number if possible.  Skips if it isn't.
ttynum:	aos (p)
	move t,a
	setzi tt,
	rotc t,6
	cain tt,'T
	 jrst sixnm0
	return

;;;Gobble a word of sixbit from JCL.
;;;A (val): word of SIXBIT or 0 at EOF
;;;Fails to skip at EOF.
getsix:	save b
	setzi a,
	move b,[440600,,a]
getsx1:	call jclch
	 jrst getsx9
	 jrst getsx1
	aos -1(p)
getsx2:	caige t,140		;convert to sixbit
	 subi t,40
	came b,[000600,,a]
	 idpb t,b
	call jclch
	 jrst getsx9
	 jrst getsx9
	jrst getsx2

getsx9:	rest b
	return

;;;Reads one character from JCL.
;;;T (val): character
;;;Skips twice on pseudosixbit, once on non-pseudosixbit, never at EOF.
jclch:	ildb t,jclbp
	caie t,^M
	 cain t,^C
	  return
	caie t,^_
	 cain t,0
	  return
	aos (p)
	caile t,40
	 aos (p)
	return

tsint:	intacs,,p
	0 ? 1_chttyo ? 0 ? 1_chusr ? morint
	0 ? 1_chttyi ? 0 ? 1_chusr ? ctlint
	0 ? 1_chusr ? 0 ? 0 ? usrint
ltsint==:.-tsint

dismis:	setz
	sixbit /dismis/
	movsi intacs
	setz p

ctlint:	movei t,chttyi
	.ityic t,
	 jrst disint
	caie t,^S
	 cain t,^G
	  jrst iflush
disint:	.call dismis
	 .lose %lssys

morint:	princ "--More--"
	syscall iot,[movsi %tipek ? movei chttyi ? movem t]
	 .lose %lssys
	caie t,40
	 cain t,177
	  .iot chttyi,t
	caie t,40
	 jrst flush
	tyo [^P]
	tyo ["A]
	.call dismis
	 .lose %lssys

iflush:	.reset chttyo,
	syscall ttyfls,[movsi 1 ? movei chttyi]
	 .lose %lssys
flush:	princ "Flushed"
	stop

usrint:	.reset chttyo,
	princ "AJob went away."
	stop

.scalar nxpage			;Contains first unused page.

;;;Allocate some pages
;;;A: (arg) number of pages to allocate.
;;;A: (val) address of first word in RH.
;;;T: (val) -<page count>,,<page number> for CORBLK
alloc:	hrrz t,a
	addb t,nxpage
	caile t,400
	 .lose
	hrlz a,a
	subb t,a
	lsh a,10.
	return

.vector sysmap(400)		;One word for every page in the system
				;address space.
.scalar machine			; Name of this machine.
.scalar version			; ITS version number

$page==:121000,,0

sysini:	save a
	save b
	syscall sstatu,[repeat 6, movem machine
			movem version]
	 .lose %lssys
	setzm sysmap
	move tt,[sysmap,,sysmap+1]
	blt tt,sysmap+377
	move a,[-lsymtbl,,symtbl]

sysin1:	move t,1(a)
	.eval t,
	 .lose
	hrrm t,(a)
	skipl 1(a)		;4.9 => this is an address.
	 movem t,(a)
	ldb t,[$page t]
	skipge 1(a)
	 setom sysmap(t)
	add a,[1,,1]
	aobjn a,sysin1
	move a,lublk
	imul a,maxj
	add a,usrstg
	subi a,1		;A: address of last word of user variables
	ldb a,[$page a]		;A: page number of last word of user variables
	ldb tt,[$page usrstg]
	hrl tt,tt
	add tt,[sysmap,,sysmap+1]
	blt tt,sysmap(a)
	movsi a,-400		;A: AOBJN into system page tables
	movei b,ffpage		;B: our next free page
sysin2:	skipn sysmap(a)
	 jrst sysin3
	movem b,sysmap(a)
	syscall corblk,[movei %cbndr
			movei %jself ? movei (b)
			movei %jsabs ? movei (a)]
	 .lose %lssys
	aos b
sysin3:	aobjn a,sysin2
	movem b,nxpage
	move a,[-lsymtbl,,symtbl]
sysin4:	skipl 1(a)
	 jrst sysin5
	ldb t,[$page (a)]
	move t,sysmap(t)
	dpb t,[$page (a)]
sysin5:	add a,[1,,1]
	aobjn a,sysin4
	rest b
	rest a
	return

.scalar dump.0

purify:	movsi tt,-npure
	syscall corblk,[movei %cbndr
			movei %jself ? move tt]
	 .lose %lssys
	skipe debug
	 return
	syscall open,[moves t ? [.uio,,chdump]
			dumpdv
			[sixbit /_probe/]
			[sixbit /output/]
			dumpsn]
	 return
	setzi tt,
	movem 0,dump.0		;PDUMP misses AC0
	syscall pdump,[moves t ? movei %jself ? movei chdump ? move tt]
	 return
	.iot chdump,[jrst purgo]
	move tt,[-4,,2]
	.iot chdump,tt
irp name,,[symbdv,symbn1,symbn2,symbsn]
	rot tt,1
	add tt,name
	.iot chdump,name
termin
	.iot chdump,tt
	.iot chdump,[jrst purgo]
	syscall renmwo,[movei chdump ? dumpn1 ? dumpn2]
	 return
	.close chdump,
purgo:	move 0,dump.0
	syscall sstatu,[repeat 6, movem t
			movem tt]
	 .lose %lssys
	camn t,machine
	 came tt,version
	  jrst go
	return

symbdv: sixbit /dsk/		;Filename where original SBLK with symbols
symbsn:	sixbit /sysbin/		;can be found. 
symbn1:	sixbit /probe/
symbn2:	sixbit /bin/

dumpdv:	sixbit /dsk/		;Filename where PDUMP file should go.
dumpsn:	sixbit /sys/
dumpn1:	sixbit /ts/
dumpn2:	sixbit /probe/

;;;Type out the SIXBIZ string in T
6princ:	hrli t,440600
	jrst 6prnc2

6prnc1:	addi tt,40
	tyo tt
6prnc2:	ildb tt,t
	jumpn tt,6prnc1
	return

if1, .insrt dsk:syseng;its defs

define maktbl -rest
irps sym,,[rest]
rest
.zzz.==.ldb .ppss.,sym
ifg .zzz.-.max., .max.==.zzz.
loc .beg.+.zzz.
	[sixbit /sym /]		;SIXBIZ
.istop
termin
termin

define deftbl label,len,def,ppss
label:
.ppss.==ppss
.beg.==label
.max.==-1
def maktbl
len==:.max.+1
loc .beg.+len
termin

deftbl uuotbl,luuotbl,.itsuu,331100

deftbl oprtbl,loprtbl,.itsop,002200

deftbl caltbl,lcaltbl,.itscl,270400

;;;CALL BITMAP to map over the bits in a word calling a routine at each 1.
;;;A: (arg) the word to map
;;;B: (arg) aobjn pointer to field table
;;;C: (arg) routine to call for each non-zero field:
;;;	Should not clobber A, B or C.
;;;	A: (arg) unprocessed bits
;;;	D: (arg) value of the field
;;;A: (val) remaining bits
bitmap:	save d
bitmp0:	hrri t,a
	hll t,(b)
	setzi tt,
	ldb d,t
	dpb tt,t
	skipe d
	 call (c)
	aobjn b,bitmp0
	rest d
	return

define defmap name,prefix,fields
name:
irp field,,[fields]
	.bp prefix!!field,[asciz /field/]
termin
l!name==:.-name
termin

defmap mp%tj,,[%tjcns,%tjcp1,%tjcp2,%tjech,%tjctn,%tjstp,%tjdis
%tjsio,%tjmor,%tjpp2,%tjink,%tjhde]

defmap mp%ti,,[%ticns,%tiech,%tipek,%tiact,%tiint,%tinwt,%tiful]

defmap mp%op,%op,[TRP,DEC,DDT,LSP,BRK,CMD,INT,OPC,LOK,LKF,LIV,OJB]

defmap mp%pi,%pi,[RLT,RUN,NXI,JST,DCL,ATY,TTY,PAR,FOV,WRO,FET,TRP,DBG,LOS
CLI,PDL,LTP,MAR,MPV,CLK,1PR,BRK,OOB,IOC,VAL,DWN,ILO,DIS,ARO,B42,C.Z,TYI]

define asconc foo,bar
[asciz /foo!bar/]!termin

mpifp:
repeat 18., .bp 1_.rpcnt,asconc CH,\.rpcnt
repeat 18., .bp 1_<.rpcnt+18.>,asconc INF,\.rpcnt
lmpifp==:.-mpifp

mpn.m:
radix 10.
repeat 9, .bp 1_.rpcnt,asconc 1.,\<1+.rpcnt>
repeat 9, .bp 1_<.rpcnt+9>,asconc 2.,\<1+.rpcnt>
repeat 9, .bp 1_<.rpcnt+18.>,asconc 3.,\<1+.rpcnt>
repeat 9, .bp 1_<.rpcnt+27.>,asconc 4.,\<1+.rpcnt>
radix 8
lmpn.m==:.-mpn.m

defmap execpc,%ps,[USR,PCU,PUB,PCP,CR0,CR1,FOV,FXU,DIV,INH,TR1,TR2,FPD]

defmap userpc,%ps,[USR,UIO,PUB,ARO,CR0,CR1,FOV,FXU,DIV,INH,TR1,TR2,FPD]

cnstnts:
constants

npure==:<.+1777>/2000

loc npure*2000

variables

symtbl:
;;; "=" => store full 36-bit value.
;;; ":" => store as address indexed by U.
;;; "-" => store as unindexed address.
irps sym,type,[
	lublk=
	maxj=
	usrstg-
	time-
	epdlt1:
	epdlt2:
	epdlt3:
	epdlt4:
	lscall:
	uuac:
	siocp:
	aprc:
	lubtm:
	iochnm:
	iochst:
	uwho1:
	uwho2:
	uwho3:
	uname:
	jname:
	xuname:
	xjname:
	hsname:
	usysnm:
	option:
	ustp:
	upc:

	sv40:
	suuoh:
	pirqc:
	ifpir:
	mskst:
	mskst2:
	idf1:
	idf2:
	piclr:
	]
ifse type,=,[
sym:	0
	squoze 00,sym
	]
ifse type,:,[
sym:	u,,0
	squoze 40,sym
	]
ifse type,-,[
sym:	0,,0
	squoze 40,sym
	]
termin
lsymtbl==:.-symtbl

twenty:	block 20

pat:
patch:	block 100.

forty:	0
	0
	-ltsint,,tsint

debug:	-1

ffpage==:<.+1777>/2000

end go
