Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
utilities/fraid.fai
There are no other files named fraid.fai in the archive.
title fraid
subttl file manipulating program /MMcM
search monsym
.requir ultcmd
extern getcmd, subcmd, lstchr
xall
nolit
; AC's
f_0 ; Flags
t_7 ; Random
u_10 ; Lower bound arg
v_11 ; Upper bound arg
w_12 ; Byte pointer
y_15 ; Temp
x_16 ; Horizontal position
p_17 ; Pushdown list
; LH flags
f%f1 __ 1 ; Temp flag
f%f2 __ 2 ; Another
f%f3 __ 4
; RH flags
f%opn __ 1 ; File is open
f%wr __ 2 ; File is open for write
f%map __ 4 ; File is mapped in
f%idd __ 10 ; Use IDDT rather than RAID
f%idx __ 20 ; Have the index block mapped
; Opdef's
opdef call [pushj p, 0]
opdef ret [popj p, 0]
opdef print [1b8]
opdef utype [2b8]
opdef unoi [3b8]
opdef uerr [4b8]
eol __ 37 ; For print uuo
loc 41
call uuoh
reloc
; Minimal macro definitions
define type (x)
{ utype [asciz /x/]
}
define noise (x)
{ unoi [asciz /x/]
}
define deferr (x,y)
{ ifidn <x>,<>,{uerr y, 0}
ifdif <x>,<>,{uerr y, [asciz /x/]}
}
define error (x)
{ deferr (x,0)
}
define jerror (x)
{ deferr (x,10)
}
define cerr (x)
{ deferr (x,5)
}
define jcerr (x)
{ deferr (x,15)
}
define fatal (x)
{ deferr (x,7)
}
define jfatal (x)
{ deferr (x,17)
}
define cmd (x,y)
{ ifidn <y>,<>,{[asciz |x|],,.x}
ifdif <y>,<>,{[asciz |x|],,y }
}
define dcmd (x,y,z)
{ [asciz |x|],,[y,,z]
}
define fdbnms (y)
{ for @ x in (act,adr,bk0,bk1,bk2,bk3,bk4,byv,cnt,cre,crv,<ctl>
,exl,ext,gen,gnl,hdr,nam,prt,ref,siz,use,usw,wrt) {y}
}
define deffdb (y)
{ radix5 4,FDBy
fdbloc-frkpad+.fby
}
; Start of program
go: reset
setz f, ; Clear flags
move p, [iowd npdl, pdl]
movei 1, .priin
rfmod ; Save tty modes for ^E
movem 2, modsav
movei 1, .fhslf
rpcap
ior 3, 2
epcap ; Turn on what we can
move 2, [levtab,,chntab]
sir
eir
movsi 2, (1b0)
aic
movsi 1, .ticce
ati ; ^E on chan 0
jrst cmdlup
; ^E here
ctepsi: cis
movei 1, .priou
cfobf
movei 1, .priin
cfibf
move 2, modsav
sfmod ; Restore modes
call crif
type <^E>
skiple 1, outjfn ; Close any open output file
closf
tdn
jrst cmdres
; Top level command entry
cmdres: move p, [iowd npdl, pdl] ; Reset stack
cmdlup: call crif ; Get a fresh line
movei 1, cmdtab
call getcmd
cmdlp0: hrrz 1, (1) ; Enter here for subcommand dispatch
call (1)
jrst cmdlup
; Command table
cmdtab: [asciz /=> /],,-ncmds
[asciz //],,[ret]
[asciz /;/],,eatcmt
cmd date
cmd dump
cmd exit
cmd file
cmd fdb
cmd get
cmd iddt
cmd map
cmd new
cmd quit
cmd raid
cmd read
cmd unmap
cmd write
ncmds __ .-cmdtab-1
; Print crlf if not at start of line
crif: push p, 1
push p, 2
movei 1, .priou
rfpos
hrroi 1, crlf0
trne 2, -1
psout
pop p, 2
pop p, 1
ret
; Print crlf
crlf: push p, 1
hrroi 1, crlf0
psout
pop p, 1
ret
crlf0: byte (7) 15, 12, 0
; UUO handler
uuoh: push p, 1
push p, 2
ldb 1, [point 9, 40, 8] ; Get opcode
caile 1, maxuuo
fatal (Illegal UUO)
call @uuos(1)
pop p, 2
pop p, 1
ret
uuos: 0
%print
%type
%noi
%err
maxuuo __ .-uuos-1
; UUO Routines
%print: hrrz 1, 40
cain 1, 37 ; EOL?
jrst crlf
pbout
ret
%type: hrro 1, 40
psout
ret
%noi: move 1, lstchr
caie 1, 33 ; ESC?
ret ; No, no noise
hrroi 1, [asciz / (/]
psout
call %type
movei 1, ")"
pbout
ret
%err: call crif
move 2, 40
tlnn 2, (<4,0>) ; Use "?" ?
skipa 1, ["%"]
movei 1, "?"
pbout
hrroi 1, (2)
trne 1, -1 ; Dont print from 0
psout
tlnn 2, (<10,0>) ; Jsys error message too?
jrst %err2 ; No
movei 1, .priou
movei 2, " "
bout
hrloi 2, .fhslf ; Last error this fork
setz 3,
erstr
tdn
tdn
%err2: call crlf
movei 1, .priin
cfibf
ldb 2, [point 2, 40, 12] ; Get low order 2 bits of ac field
jrst %erret(2) ; Do dependant thing
%erret: ret
jrst cmdres
haltf
ret
; Get a file, but dont open
.file: movei 1, getinb
call getfl0
trz f, f%opn ; No file is open
ret
; Get file to read
.read: movei 1, getinb ; Input block
call getfil
movei 2, of%rd
call opnfil ; Try to open it
trz f, f%wr ; Say no write
tro f, f%opn
ret
; Get file to read/write
.write: movei 1, getoub ; Output (allows new files)
call getfil
movsi 1, (fb%nxf) ; Non-existant
tdne 1, fdbloc+.fbctl ; Is it?
type < [new]
> ; Yes
movei 2, of%rd+of%wr
call opnfil
tro f, f%wr!f%opn
ret
; Get jfn for file
getfil: noise (file)
getfl0: print " "
movem 1, savget ; Save address of gtjfn block
setz 2,
getfl1: gtjfn
jrst getflx ; See nature of error
move 2, [.fblen,,.fbhdr] ; Whole thing
movei 3, fdbloc
gtfdb
move 2, [fdbloc,,oldfdb] ; Move in as last version as well
blt 2, oldfdb+.fblen-1
push p, 1
call unmap ; Get rid of any old file
pop p, filjfn ; Set up jfn
ret
getflx: cain 1, gjfx37
jrst cmdres ; ^U
jerror
move 1, savget
jrst getfl1
; Open up file
opnfil: move 1, filjfn ; Get the jfn
openf
caia
ret ; Ok
cain 1, opnx9 ; Invalid simultaneous access?
troe 2, of%thw ; Try thawed if we havent already
jcerr ; No, give error message
call opnfil ; Recursion (sort of)
type < [thawed]>
ret
; Unmap file and otherwise clean things up
.unmap:
unmap: skipn filjfn
ret ; Noop if no file
seto 1, ; Unmap
hrlz 2, filfrk ; From inferior
trzn f, f%map ; File mapped?
jrst unmap2 ; No
hrri 2, filpag ; From this page
hrrz 3, frkpgs ; Recover number of pages
hrli 3, (pm%cnt)
pmap ; Unmap pages from lower fork
unmap2: trzn f, f%idx ; Have the index block?
jrst unmap3
hrri 2, filpag-1
setz 3,
pmap ; Yes, unmap it too
unmap3: move 1, filjfn
trzn f, f%opn ; File open?
jrst unmap5 ; No
closf
jerror (Cant close file)
unmap4: setzm filjfn
ret
unmap5: rljfn
jerror (Cant release jfn)
jrst unmap4
; Exit and quit
.exit: noise (and unmap file)
call unmap
.quit: haltf
ret
; Eat a comment
eatcmt: move 1, lstchr
cain 1, 12
ret
print " "
hrroi 1, strbuf
move 2, [rd%bel+rd%rnd+20*5]
hrroi 3, [asciz /=> ; /]
rdtty
jfatal (RDTTY failed)
ret
; Update the fdb
.fdb: skipn filjfn ; Must have a file
cerr (Must have a file first)
noise (words from)
move 1, lstchr ; Get terminator
cain 1, 12 ; LF?
jrst fdball ; Yes, do it all then
movei 1, fdbtab ; Pointer to names of fdb locs
call subcmd
hrrz u, (1) ; Save start of list
cail u, .fblen ; Within range?
jrst cmdlp0 ; No, must be ^U typed then
move 1, lstchr
cain 1, 12 ; LF?
jrst fdbal1 ; Yes, do just this one then
noise (thru)
movei 1, fdbtab
call subcmd
hrrz v, (1)
cail v, .fblen
jrst cmdlp0 ; Out of range, must be new command
jrst fdbch0
fdball: movei u, 1 ; Start with first we can modify
movei v, .fblen-1 ; Do them all
jrst fdbch0
fdbal1: movei v, (u) ; Do just the one
fdbch0: move 1, filjfn ; Get the file
tlz f, f%f1 ; Say first now
call crif
fdbch1: caile u, (v) ; Done?
ret
move 3, fdbloc(u) ; Get new value
move 2, 3
xor 2, oldfdb(u) ; Get mask of changed bits
jumpe 2, fdbch2 ; None changed
hrli 1, (u)
chfdb
erjmp fdbch2 ; Dont bomb out here
movem 3, oldfdb(u) ; Update old values too
tloe f, f%f1 ; First one
print "," ; No
print " " ; Tell what changed
utype fdbnam(u) ; Get name
fdbch2: aoja u, fdbch1 ; Do the rest
fdbtab: [asciz / /],,-.fblen
fdbnms (<cmd (x,.fbx)>)
ifn .-fdbtab-.fblen-1,<.fatal fdbtab screwed up>
; Map the file in
.map: skipn 1, filjfn
cerr (Must have a file first)
trnn f, f%opn ; Is it opened?
cerr (File must be opened)
trne f, f%map
cerr (Already have pages mapped)
noise (pages from)
move 2, lstchr
cain 2, 12 ; LF already?
jrst mapall ; Yes, map in the entire file
call getoct ; Get page number
movei u, (2)
move 2, lstchr
cain 2, 12
jrst mapal1 ; Just map in this one page
call getoct
caige 2, (u) ; Range check
cerr (Second page less than first)
subi 2, (u) ; Get number of pages
movei v, (2)
mapin1: trnn f, f%wr ; Have write access?
jrst mapal0 ; No, dont map non-existant pages
skipn 2, filfrk ; Have a fork to map into
call mkffrk ; No, make file fork
aoj v,
caile v, 777-filpag+1 ; Max we can handle
movei v, 777-filpag+1
hrlz 1, filjfn ; Get file
hrri 1, (u) ; First page
hrlz 2, 2 ; Fork
hrri 2, filpag ; Start at this page
movei 3, (v) ; Number of pages
hrli 3, (pm%cnt!pm%wr!pm%rd)
pmap ; Do the mapping
tro f, f%map ; Say it is mapped in
movem v, frkpgs ; Save count
call crif
print " "
movei 1, .priou
movei 3, 10
movei 2, (u)
nout
jerror (NOUT failure)
cain v, 1 ; Just one page?
ret
print "-" ; No
addi 2, -1(v)
nout
jerror (NOUT failure)
ret
; Attempt to map in entire file
mapall: call crif
setz u, ; Reset count in any case
hrrz v, oldfdb+.fbbyv ; Get number of pages in the file
jumpn v, mapal2 ; There are some
trnn f, f%wr ; Must have write access if there arent any
cerr (Cannot map non-existant page of read-only file)
type < [File is empty, page 0 mapped in.]
>
mapal1: setz v,
jrst mapin1
; Map in pages from ro file in the specified range
mapal0: movei w, (u) ; Starting page
addi w, 1(v) ; Plus number of pages
movei y, (u) ; Starting page offset
jrst mapa2a
; Map in entire contents of a non-empty file
mapal2: movei w, 777-filpag
setz y, ; No offset
mapa2a: tlz f, f%f1 ; Reset typeout flag
mapal3: hrlz 1, filjfn ; Find a page that exists
hrri 1, (u) ; Get page pointer
rpacs
aoj 1, ; Next page
tlne 2, (pa%pex) ; Page exists?
jrst mapal4 ; Yes, found one then
cail u, -1(w) ; Dont map past this page
jrst mapal7
aoja u, mapal3 ; Try next page then
mapal4: push p, u ; Save this page
mapal5: aoj u, ; Next page
rpacs ; Find one that does not exist
tlne 2, (pa%pex) ; Page exists?
cail u, (w) ; Or past range?
caia ; No or yes
aoja 1, mapal5 ; Yes and no, keep going
tloe f, f%f1 ; First specs?
print "," ; No
print " "
movei 1, .priou
movei 3, 10
move 2, (p) ; Get first page that exists
nout
jerror (NOUT failure)
cain 2, -1(u) ; Just one?
jrst mapal6 ; Yes, dont print any more
print "-"
movei 2, -1(u) ; Get ending page
nout
jerror (NOUT failure)
mapal6: pop p, 1
hrl 1, filjfn ; From this page of the file
skipn 2, filfrk ; Into this fork
call mkffrk
hrlz 2, 2
hrri 2, filpag(1) ; Into this page of the fork
subi 2, (y) ; Less offset
movei 3, (u) ; Get ending page
subi 3, (1) ; Get difference of pages
hrli 3, (pm%cnt!pm%rd)
trne f, f%wr ; Wants write too?
tlo 3, (pm%wr) ; Yes
pmap
tro f, f%map ; Mapped by now
subi v, (3) ; Decrement count of total pages
movei 1, 1(u) ; Just page 0 is one page
hrrzm 1, frkpgs ; Count of pages mapped
caige u, (w) ; Done?
jumpg v, mapal3 ; Continue if more to do
mapal7: trnn f, f%map ; Succeed in mapping?
cerr (No pages exist in specified range)
ret ; All done
.date: call gettad ; Get date specs
movei 1, .priou
jrst dmphlf ; Print as half words
; Get page number
getoct: print " "
getoc1: hrroi 1, strbuf
move 2, [rd%rnd+rd%pun+rd%crf+20*5]
setz 3,
rdtty
jfatal (RDTTY failed)
tlnn 2, (rd%btm)
jrst cmdres
ldb 2, 1
movem 2, lstchr
hrroi 1, strbuf
movei 3, 10
nin
caia
ret
jerror
jrst getoc1 ; Try again
gettad: print " "
getta1: hrroi 1, strbuf
move 2, [rd%rnd+rd%crf+rd%bel+20*5]
setz 3,
rdtty
jfatal (RDTTY failed)
tlnn 2, (rd%btm)
jrst cmdres
dpb 3, 1
hrroi 1, strbuf
setz 2,
idtim
caia
ret
jerror
jrst gettad ; Try again
; Get debugger
.raid: call clrscn
trza f, f%idd
.iddt: tro f, f%idd
movei 1, .ticce ; Turn off ^E
dti
skipe 1, iddfrk ; Have a fork already?
jrst contin ; Yes, just resume it
movsi 1, (cr%cap)
cfork
jfatal (Cant create fork)
movem 1, iddfrk
rpcap
tlo 2, (sc%sup) ; Let it map us so that it can touch
ior 3, 2 ; The file fork page for the symtab
epcap
movsi 1, (gj%old!gj%sht)
hrroi 2, [asciz /SYS:RAID.EXE/]
trne f, f%idd
hrroi 2, [asciz /SYS:IDDT.EXE/]
gtjfn
jfatal (Cant find debugger)
hrl 1, iddfrk
get
move 1, iddfrk
ffork ; Freeze it
skipn 2, filfrk ; Have a fork for the file yet?
call mkffrk
splfk ; Make it an inferior of it too
jfatal (SPLFK failed)
movem 1, filfk0 ; Save its fork handle on it
move 1, iddfrk ; Get back ours on it
movei 2, frkacs
sfacs ; Set up ac's right for inferior
movei 2, 2
sfrkv
jrst waitfk
; Start the iddt fork going
contin: rfsts
move 1, iddfrk ; Smashed
sfork ; Restart it
waitfk: rfork ; Thaw it
wfork ; Wait for it
movsi 1, .ticce
ati ; Back on with ^E
ret ; All done with debugger
; Create the fork for the file to be mapped into
mkffrk: push p, 1
movsi 1, (cr%cap)
cfork
jfatal (Cant create fork)
movem 1, filfrk ; Save jfn
hrlz 2, 1 ; Into page 0 of fork
move 1, [.fhslf,,frkpag]
move 3, [pm%cnt+pm%rd+pm%wr+frknpg]
pmap ; Map these pages
move 2, filfrk ; Here's where we return it
pop p, 1
ret ; All there is to it
clrscn: movei 1, .priou
rfmod
push p, 2
trz 2, tt%dam
sfmod
movei 2, "^"-100 ; Clear the screen
bout
pop p, 2
sfmod
ret
; Get the index block
.get: skipn filjfn
cerr (Must have a file)
noise (index block)
move 1, oldfdb+.fbadr
tlo 1, (1b0) ; Say virtual address
movei 2, 1000 ; One page
movei 3, indexb
dskop
erjmp [jcerr]
skipn 2, filfrk ; Have a file fork?
call mkffrk ; No, make one then
hrlz 2, 2
move 1, [.fhslf,,indexb/1000]
hrri 2, filpag-1
movei 3, (pm%cnt+pm%rd+pm%wr)
pmap
tro f, f%idx ; Say we have it
ret
; Write a new index block (gasp)
.new: trnn f, f%idx ; Had it mapped to begin with
cerr (Index block not mapped)
noise (index block)
move 1, oldfdb+.fbadr ; Get the current one
tlo 1, (1b0) ; Virtual address
movei 2, 1000
movei 3, indexb+1000 ; Into the next page after
dskop
erjmp [jcerr]
movsi t, -1000 ; See what they have munged
tlz f, f%f1 ; Nothing yet
.new2: move 1, indexb(t) ; Get present value
camn 1, indexb+1000(t) ; Match?
jrst .new3 ; Yes
tlo f, f%f1 ; Something changed
call crif
type (INDEXB+)
movei 1, .priou
movei 2, (t)
move 3, [no%lfl+3b17+10]
nout
jerror (NOUT failure)
type <[ >
move 2, indexb+1000(t) ; Old value
call dmphlf ; Print as half words
utype [asciz / => /]
move 2, indexb(t) ; New value
call dmphlf
.new3: aobjn t, .new2 ; Check the entire index block
tlnn f, f%f1 ; Anything changed?
cerr (Index block not changed)
call crif
call confrm ; Make sure this is what he wants
move 1, oldfdb+.fbadr ; Ok, here goes
tlo 1, (1b0)
move 2, [dop%wr+1000] ; Write one page
movei 3, indexb ; New copy
dskop ; Bang
erjmp [jcerr] ; Oh oh
ret ; All done
; Make sure we arent being too hasty
confrm: type < [Confirm] >
movei 1, .priou
dobe
confr0: movei 1, .priin
cfibf ; No mistakes about it
confr1: pbin
cain 1, 15
jrst confr1 ; Flush CR
cain 1, 12 ; LF confirms
ret
cain 1, "U"-100 ; Wants out?
jrst [type (XXX)
jrst cmdres]
type ( ? )
jrst confr0
; Dump out
.dump: skipe filjfn ; Have a file?
trnn f, f%opn ; Open at all?
cerr (Must have a file open)
move 1, lstchr
cain 1, 12
jrst dmpbyt ; Dump bytes
movei 1, dmcmds
call subcmd
jrst cmdlp0
; Dump subcommands
dmcmds: [asciz / /],,-ndmcms
cmd bytes,dmpbyt
cmd structure,dmprec
ndmcms __ .-dmcmds-1
; Dump modes
modtab: [asciz / Mode: /],,-nmods
dcmd ascii-character,2,dmpchr
dcmd ascii-string,5,dmpstr
dcmd date,=19,dmpdat
dcmd decimal,cvmd10,dmpdec
dcmd ebcdic-character,2,dmpebc
dcmd extended-half-word,=14,dmpehf
dcmd floating,6,dmpflt
dcmd half-word,=14,dmphlf
dcmd hexidecimal,cvmd16,dmphex
dcmd invisible,0,<[ret]>
dcmd octal,cvmod8,dmpoct
dcmd radix50,6,dmpr5
dcmd sixbit,6,dmpsix
dcmd unsigned-octal,=12,dmpabs
dcmd user-name,=10,dmpusr
nmods __ .-modtab-1
; Get mode specification, returns with num cols,,mode dispatch in 1
getmod: movei 1, modtab
call getcmd
hrrz 1, (1) ; Get word for stuff
hlrz 3, (1) ; Get column figure
cail 3, cvmod8 ; A mode conversion routine?
call (3) ; Yes, get number of columns
hrrz 1, (1) ; Get dispatch
hrli 1, (3) ; Get number of columns
ret ; All done
cvmod8: idivi 2, 3
cvmd8a: skipe 3
aoj 2,
cvmod9: movei 3, (2)
ret
cvmd16: idivi 2, 4
jrst cvmd8a
cvmd10: subi 2, 44
jumpe 2, [movei 3, =11 ; Else divide will have neg dividend
ret]
seto 3,
lsh 3, (2) ; Get largest number in this byte range
movei 2, 1 ; At least one
push p, 4
cvmd11: idivi 3, =10
skipe 3
aoja 2, cvmd11
movei 3, (2)
pop p, 4
ret
dmpbyt: call gtdmpf ; Get output file
call getbsz ; Get byte size
ldb 2, [point 6, fdbloc+.fbbyv, 11]
movem 2, dmpbsz
move 1, filjfn
sfbsz
jfatal (SFBSZ failed)
call getmod
movem 1, dmpmod
call gtdmps ; Get limits
call getbpl ; Get number of bytes per line
movei u, (2) ; Save that
move 1, filjfn
move 2, dbyte0
sfptr ; Set starting byte
jfatal (SFPTR failed)
movei w, (2)
call dmphed ; Output header
hrrz v, dmpmod ; Get mode
dmpby2: camle w, dbytez ; Done?
jrst dmpfin ; Yes
move 1, filjfn
move 2, [point 36, dmpbuf]
movni 3, (u)
sin
erjmp dmpby5
dmpby3: call dmppos
addi w, (u)
movei x, (u) ; Get number to do
setz t,
dmpby4: movei 2, " "
bout
move 2, dmpbuf(t)
hllz 3, dmpmod ; Get number of cols
call (v)
sojle x, dmpby2
aoja t, dmpby4
dmpby5: add u, 3 ; Get number actually moved
jumpe u, dmpeof ; None, really done now
jrst dmpby3 ; Just print out this much
getbpl: call crif
hrroi 3, [asciz / # bytes per line: /]
move 2, dmpbsz
cain 2, 44
hrroi 3, [asciz / # words per line: /]
utype (3)
hrroi 1, strbuf
move 2, [rd%bel+rd%crf+20*5]
rdtty
jfatal (RDTTY failed)
andi 2, -1
cain 2, 20*5-1
jrst getbp2 ; Default it
hrroi 1, strbuf
movei 3, =10
nin
jrst [uerr 14,
jrst getbpl]
ret
getbp2: movei 2, =80-2
sub 2, dmpcol ; Less columns for byte numbers
hlrz 3, dmpmod ; Get number used by this routine
idivi 2, 1(3)
ret
; Dump out as a structure
dmprec: move 1, filjfn
movei 2, 44
movem 2, dmpbsz
sfbsz ; Set up for 36 bit bytes, just in case
jfatal (SFBSZ failed)
call gtdmpf ; Get output file
call gtdmps ; Get start of things
print eol
dmprc0: setz u, ; Init offset
move v, [440000,,dmpbuf] ; Start of pointer
dmprc1: call crif
type < Record >
movei 1, .priou
movei 2, 1(u)
movei 3, 12
nout
jerror (NOUT failure)
call getbsn ; Get byte size for this record
jrst dmprc2 ; Not given, all done then
dpb 2, [point 6, v, 11] ; Set up byte size for pointer
call getmod
dmrc1a: ibp v ; Make byte pointer for this byte
movem v, dmpptr(u) ; Save pointer
movem 1, dmpmod(u) ; Set up mode
cail u, mxdmpr-1 ; Maximum number of records?
jrst dmrc1x ; Max used up
sosle 4 ; For number given
aoja u, dmrc1a ; Keep repeating
aoja u, dmprc1 ; All done this pass
dmrc1x: error (Maximum number of records used up)
dmprc2: jumpe u, dmprc0 ; Dont allow null
setzm dmpmod+1(u) ; Mark final entry
; Now do the output
call dmphed ; Output the header for it
hrrz u, dmpptr-1(u) ; Get last word touched
subi u, dmpbuf-1 ; Get number of words to read
move w, dbyte0 ; Reset byte count
move 1, filjfn
movei 2, (w)
sfptr
jfatal (SFPTR failed)
dmprc3: camle w, dbytez ; Done?
jrst dmpfin ; Yes
move 1, filjfn
move 2, [point 36, dmpbuf]
movni 3, (u) ; Get number to do
sin
erjmp dmpeof ; Done when EOF reached
call dmppos ; Output the byte position
addi w, (u) ; Update byte count
setz t,
move x, dmpcol ; Get number of columns
subi x, =80-2 ; Get number we have left on line
dmprc4: skipn 4, dmpmod(t)
jrst dmprc3
hlrz 3, 4 ; Get number of columns
addi x, (3) ; Add in
aojge x, dmprc5
movei 2, " " ; Not too far over, print space
bout
ldb 2, dmpptr(t) ; Get byte to print
hrlz 3, 3 ; Get back number of columns
call (4) ; Do routine
aoja t, dmprc4 ; Try next byte
dmprc5: hrroi 2, crlf0
setz 3, ; Too far over
sout
move x, dmpcol
movei 2, " "
movei 3, 2(x)
bout
sojg 3, .-1
subi x, =80-2
jrst dmprc4
; Get output file for dump
gtdmpf: call crif
type ( Output file: )
movsi 1, (gj%fou!gj%fns!gj%sht)
move 2, [.priin,,.priou]
gtjfn
jrst gtdmfx
move 2, [7b5+of%wr]
openf
jrst gtdmfx
gtdmf1: movem 1, outjfn
ret
gtdmfx: cain 1, gjfx33 ; Filename not spec?
jrst [movei 1, .priou
jrst gtdmf1]
uerr 14,
jrst gtdmpf
; Get byte size for dump
getbsn: tloa f, f%f3 ; Say ok for range specs
getbsz: tlz f, f%f3
call crif
type ( Byte size: )
hrroi 1, strbuf
move 2, [rd%bel+rd%crf+20*5]
hrroi 3, [asciz / Byte size: /]
rdtty
jfatal (RDTTY failed)
andi 2, -1
cain 2, 20*5-1
ret ; EOL means single return
hrroi 1, strbuf
movei 3, 12
nin
jrst [uerr 14,
jrst getbsz]
skiple 2
caile 2, =36
jrst [uerr 4, [asciz /Byte size must be 0<x<36./]
jrst getbsz]
tlnn f, f%f3 ; Ok for multiple?
jrst getbs2 ; No, done
movei 4, 1 ; Default count
ldb 5, 1 ; Get terminator
caie 5, "*" ; Wants it?
jrst getbs2 ; No, give default
push p, 2 ; Save first number
nin ; Get factor
jrst [uerr 14,
jrst getbsz]
movei 4, (2)
pop p, 2 ; Get back first
getbs2: aos (p)
ret
; Get range of dump
gtdmps: tlz f, f%f1 ; Disallow relative
call gtdms0 ; Get first of range
movem 2, dbyte0
tlo f, f%f1 ; Relative ok
call gtdms0 ; Get first of range
movem 2, dbytez
jffo 2, .+2
movei 3, 44
subi 3, 44
movm 2, 3 ; Get number of bits
idivi 2, 3
skipe 3 ; Round number of digits
aoj 2,
movsi 2, (2)
hlrzm 2, dmpcol
add 2, [no%lfl+10] ; Make it a nout field
movem 2, dmpfmt
ret
gtdms0: call crif
movei 1, rangt1
tlne f, f%f1
movei 1, rangt2
call getcmd
hrrz t, (1) ; Save type
cail t, cvdms4 ; End of file?
jrst (t) ; Yes
print " " ; No, get second arg
hrroi 1, strbuf
move 2, [rd%crf+rd%rnd+rd%bel+20*5]
setz 3,
rdtty
jfatal (RDTTY failed)
tlnn 2, (rd%btm) ; ^U typed?
jrst gtdms0
add 1, [7b5]
skipge 1
sub 1, [43b5+1]
ldb 3, 1 ; Get char before EOL
cain 3, "." ; Wants decimal?
skipa 3, [=10] ; Yes
movei 3, 10 ; No, use octal as default
tlnn f, f%f1 ; Allow relative?
jrst gtdms1 ; No
tlo f, f%f2 ; Assume relative
ldb 1, [point 7, strbuf, 6]
caie 1, "+" ; Is it?
tlza f, f%f2 ; No
skipa 1, [point 7, strbuf, 6] ; Flush first char if so
gtdms1: hrroi 1, strbuf
nin
jrst [uerr 14,
jrst gtdms0] ; Try again
call (t) ; Convert it
tlze f, f%f2 ; Relative?
add 2, dbyte0 ; Yes, add in offset
ret ; Done
; Convert to bytes from whatever
cvdms1: lsh 2, 9 ; Pages to words
cvdms2: move 4, dmpbsz ; Get byte size
movei 3, 44
idivi 3, (4)
imuli 2, (3) ; Words to bytes
cvdms3: ret ; Bytes to bytes is easy
cvdms4: tdza 2, 2
cvdms5: move 2, fdbloc+.fbsiz ; Get length of file
ret
; Range types
rangt1: [asciz / Starting with /],,-nrng1s
cmd byte,cvdms3
cmd page,cvdms1
cmd start,cvdms4
cmd word,cvdms2
nrng1s __ .-rangt1-1
rangt2: [asciz / and ending with /],,-nrng2s
cmd byte,cvdms3
cmd eof,cvdms5
cmd page,cvdms1
cmd word,cvdms2
nrng2s __ .-rangt2-1
; Output header to dump file
dmphed: move 1, outjfn
move 2, filjfn
setz 3,
jfns ; Give name of the file
hrroi 2, [asciz / bytes /]
move 4, dmpbsz ; Get byte size
cain 4, 44 ; 36 bit?
hrroi 2, [asciz / words /]
sout
movei 3, 10
move 2, dbyte0
nout
jerror (NOUT failure)
hrroi 2, [asciz / thru /]
setz 3,
sout
movei 3, 10
move 2, dbytez
nout
jerror (NOUT failure)
hrroi 2, crlf0
setz 3,
sout
ret
; Output current position
dmppos: move 1, outjfn
hrroi 2, crlf0
setz 3,
sout
move 3, dmpfmt
movei 2, (w) ; Get byte position
nout
jerror (NOUT failure)
hrroi 2, [asciz /[ /]
setz 3,
sout
ret
; Here if EOF before we expect it
dmpeof: call crif
type < [EOF at >
hrroi 1, [asciz /byte /]
move 2, dmpbsz
cain 2, 44
hrroi 1, [asciz /word /]
psout
movei 1, .priou
movei 2, (w)
movei 3, 10
nout
jerror (NOUT failure)
type <]
>
; Here when done
dmpfin: move 1, outjfn
hrroi 2, crlf0
setz 3,
sout
closf
jerror (Cant close output file)
setzm outjfn
ret ; Return all done
; Dump routines, accept output designator in 1 and value in 2
dmpchr: cail 2, " " ; Control char?
cain 2, 177 ; Or rubout?
trca 2, "@" ; Yes, print as ^x
skipa 3, [" "] ; No, print as <sp>x
movei 3, "^"
dmpch1: exch 2, 3
bout
movei 2, (3)
bout
ret
dmpstr: push p, 2
hrroi 2, (p)
movei 3, 6
setz 4,
sout
movei 2, " "
skipe 3
bout
sojg 3, .-1 ; Fill with spaces
pop p, 2
ret
dmpebc: skipn ebcasc(2)
jrst dmphex ; Not in there, dump as hex
move 2, ebcasc(2)
jrst dmpchr ; Else dump as ascii equivalent
dmpdat: setz 3,
odtim
ret
dmphex: add 3, [no%lfl+=16]
jrst dmpdc1
dmpdec: add 3, [no%lfl+=10]
dmpdc1: nout
jerror (NOUT failure)
ret
dmpehf: push p, 2
move 3, [no%lfl+6b17+10]
hlre 2, 2
nout
jerror (NOUT failure)
hrroi 2, [asciz /,,/]
setz 3,
sout
pop p, 2
hrre 2, 2
move 3, [6b17+10]
nout
jerror (NOUT failure)
ret
dmpflt: move 3, [fl%one+fl%pnt+fl%ovl+2b23+3b29]
flout
jerror (FLOUT failure)
ret
dmphlf: push p, 2
move 3, [no%lfl+6b17+10]
hlrz 2, 2
nout
jerror (NOUT failure)
hrroi 2, [asciz /,,/]
setz 3,
sout
pop p, 2
andi 2, -1
move 3, [6b17+10]
nout
jerror (NOUT failure)
ret
dmpoct: add 3, [no%lfl+10]
jrst dmpdc1
dmpr5: movei 4, 6 ; Must print this many chars
tlz 2, 740000 ; Clear high four bits
call dmpr50 ; Print the radix50 word
movei 2, " " ; Print filler spaces
sojl 4, dmpr52
bout
jrst .-2
dmpr50: idivi 2, 50
hrlm 3, (p) ; Save char
jumpe 2, dmpr51 ; Null means done
call dmpr50 ; Get next character
dmpr51: hlrz 2, (p) ; Recover this char
jumpe 2, dmpr52 ; 0 is null char
addi 2, "0"+200-1 ; 1-12 are "0"-"9"
caile 2, "9"+200
addi 2, "A"-"9"-1 ; 13-44 are "A"-"Z"
caile 2, "Z"+200
subi 2, "Z"+2-"$" ; 46-47 are "$" and "%"
cain 2, "$"+200-1
movei 2, "."+200 ; 45 is "."
bout ; Print it
soj 4,
dmpr52: ret
dmpsix: movei 4, 6
move 3, 2
dmpsx1: move 2, 3
lsh 2, -=30
movei 2, " "(2)
bout
lsh 3, 6
sojg 4, dmpsx1
ret
dmpabs: move 3, [no%mag+no%lfl+no%zro+14b17+10]
nout
jerror (NOUT failure)
ret
dmpusr: push p, 1
hrroi 1, strbuf
dirst
jrst [move 1, [point 7, strbuf]
movei 3, "#"
idpb 3, 1
movei 3, 10
nout
tdn
jrst .+1]
movei 2, " "
movei 3, 9
idpb 2, 1
sojg 3, .-1
setzm strbuf+2
pop p, 1
hrroi 2, strbuf
setz 3,
sout
ret
; Pure stuff
lit
getinb: gj%xtn!gj%old!gj%cfm ; Must be old
.priin,,.priou
block .gjjfn-.gjsrc
g1%rnd
block .gjbfp-.gjf2
getoub: gj%xtn!gj%cfm ; Allow new files too
.priin,,.priou
block .gjjfn-.gjsrc
g1%rnd
block .gjbfp-.gjf2
ebcasc: oct 0,0,0,0,0,11,0,0,0,0,0,13,14,15,0,0
oct 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
oct 0,0,0,0,0,12,0,0,0,0,0,0,0,0,0,0
oct 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
oct 40,0,0,0,0,0,0,0,0,0,133,56,74,50,53,137
oct 46,0,0,0,0,0,0,0,0,0,135,44,52,51,73,0
oct 55,57,0,0,0,0,0,0,0,0,0,54,45,0,76,77
oct 0,0,0,0,0,0,0,0,0,0,72,43,100,47,75,42
oct 0,141,142,143,144,145,146,147,150,151,0,0,0,0,0,0
oct 0,152,153,154,155,156,157,160,161,162,0,0,0,0,0,0
oct 0,0,163,164,165,166,167,170,171,172,0,0,0,0,0,0
oct 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
oct 134,101,102,103,104,105,106,107,110,111,0,0,0,0,0,0
oct 41,112,113,114,115,116,117,120,121,122,0,0,0,0,0,0
oct 0,0,123,124,125,126,127,130,131,132,0,0,0,0,0,0
oct 60,61,62,63,64,65,66,67,70,71,0,0,0,0,0,0
fdbnam: asciz /hdr/
asciz /ctl/
asciz /exl/
asciz /adr/
asciz /prt/
asciz /cre/
asciz /use/
asciz /gen/
asciz /act/
asciz /byv/
asciz /siz/
asciz /crv/
asciz /wrt/
asciz /ref/
asciz /cnt/
asciz /bk0/
asciz /bk1/
asciz /bk2/
asciz /bk3/
asciz /bk4/
asciz /usw/
asciz /gnl/
asciz /nam/
asciz /ext/
asciz /len/
ifn .-fdbnam-.fblen-1,<.fatal fdbnam screwed up>
levtab: psipc
block 2
chntab: 1,,ctepsi
block =35
; Impure stuff
psipc: 0
modsav: 0
savget: 0
frkpgs: 0 ; Number of pages mapped
iddfrk: 0 ; Fork for iddt/raid
filfrk: 0 ; Our handle on file fork
outjfn: 0 ; Output file for dump
dbyte0: 0 ; Starting byte
dbytez: 0 ; End byte
dmpfmt: 0
dmpcol: 0
dmpbsz: 0 ; Byte size
frkacs: 0 ; Acs for fork, must be filfk0-1
filfk0: 0 ; IDDT's handle on file fork
block 20-2 ; Rest of the ac's
oldfdb: block .fblen ; FDB before we touched it
mxdmpr __ =200
dmpmod: block mxdmpr
dmpptr: block mxdmpr
dmpbuf: block 500
strbuf: block 20
npdl __ 177
pdl: block npdl
; Stuff that gets put into the pages 0 thru n of the file fork
filpag __ 10 ; Start of file mapping
frkpag __ 100
frkpad __ frkpag9
loc frkpad+116 ; 116 of the inferior
symptr::-nsyms,,symadr-frkpad
loc frkpad+137 ; 137 Of the inferior fork
filjfn: 0 ; Jfn of the file
fdbloc: block .fblen ; The updated fdb
loc frkpad+200 ; 200 of the inferior
symadr:: ; Symbol table that the inferior
; fork will see
radix5 4,JFN
filjfn-frkpad
radix5 44,FDB
fdbloc-frkpad
fdbnms (<deffdb (x)>)
for @ x in (tmp,prm,nex,del,nxf,lng,dir,nod,bat,fcf,gen,drn,<ret>
,bsz,mod,pgc,eph,und,arc,nar,mrk,adl,aar,dmp)
{ radix5 44,FB%x
fb%x
}
radix5 4,FILE
filpag*1000 ; Page 10
radix5 4,INDEXB
<filpag-1>*1000
nsyms __ .-symadr
frknpg __ <.-frkpad>/1000+1 ; Number of pages
indexb __ 200000 ; Page 200 for index block
reloc
end go