1
0
mirror of https://github.com/PDP-10/its.git synced 2026-02-28 01:25:38 +00:00
Files
PDP-10.its/src/bawden/probe.258
Eric Swenson 109360ae03 Added PROBE.
2016-12-11 09:33:07 +01:00

1256 lines
21 KiB
Plaintext
Executable File
Raw Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
; -*- 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