mirror of
https://github.com/PDP-10/its.git
synced 2026-01-30 21:41:56 +00:00
957 lines
22 KiB
Plaintext
Executable File
957 lines
22 KiB
Plaintext
Executable File
; -*- MIDAS -*-
|
||
TITLE BINPRT -- Print info in random info block of bin files
|
||
|
||
; Canonical source location is
|
||
; [MIT-MC] SYSEN1;BINPRT >
|
||
; Info file is
|
||
; [MIT-MC] INFO;BINPRT >
|
||
|
||
;;; Alan 1/11/85
|
||
;;; Interaction with DDT's ^R defaults now resembles an ordinary DDT
|
||
;;; command as much as possible. There is also some hairy defaulting,
|
||
;;; and the ^R names are updated.
|
||
;;; Also added /S to set ^R names to source file if possible.
|
||
;;; Devon 4/26/83
|
||
;;; Made it understand SYS: to search DSK:SYS*;
|
||
;;; KLH 11/12/82
|
||
;;; Added /L to also print location of blocks in file.
|
||
;;; Alan 8/22/81
|
||
;;; 1) If no filename is given in JCL then the DDT ^R default is
|
||
;;; used if possible.
|
||
;;; 2) Checksum errors are no longer fatal.
|
||
;;; 3) I left the text finding hack (the /T switch) slightly smarter.
|
||
;;; 4) I fixed a bug that was only to be found here in the source not in
|
||
;;; the installed object. I take no responsibilty for any bugs
|
||
;;; introduced by installing the only available source. Piss on
|
||
;;; RWK if something breaks because of this.
|
||
|
||
a=1
|
||
b=2
|
||
c=3
|
||
d=4
|
||
e=5
|
||
f=6
|
||
ch=7
|
||
t=10
|
||
tt=11
|
||
p=17
|
||
|
||
binc=16
|
||
tyoc=15
|
||
outc=14
|
||
tyic=13
|
||
|
||
call=pushj p,
|
||
ret=popj p,
|
||
|
||
|
||
pdllen=100
|
||
|
||
define syscal op,args
|
||
.call [setz ? sixbit /OP/ ? args ((setz))]
|
||
termin
|
||
|
||
argi=1000,,0
|
||
val=2000,,0
|
||
errv=3000,,0
|
||
cnt=4000,,0
|
||
cnti=5000,,0
|
||
|
||
|
||
define type &string
|
||
move t,[440700,,[asciz string]]
|
||
movei tt,<.length string>
|
||
.call typblk
|
||
.lose %lsfil
|
||
termin
|
||
|
||
|
||
define OUT &string
|
||
move t,[440700,,[asciz string]]
|
||
call $out
|
||
termin
|
||
|
||
|
||
loc 40
|
||
0
|
||
0
|
||
-intlng,,tsint
|
||
loc 100
|
||
tsint: p
|
||
%pimpv ? 0 ? -1 ? -1 ? mpvint
|
||
0 ? <1_tyoc>\<1_outc> ? -1 ? -1 ? morint
|
||
intlng==.-tsint
|
||
|
||
pdl: [.lose 1+.lz %pipdl] ;PDL underflow
|
||
block pdllen
|
||
|
||
$$RFN==1 ;We want the RFN routine
|
||
$$PFN==1 ;We want the PFN routine
|
||
$$SWITCH==1 ;Recognize switches
|
||
|
||
IFBLK:: ;; In RFN ordering
|
||
ifdev: 0
|
||
iffn1: 0
|
||
iffn2: 0
|
||
ifdir: 0
|
||
|
||
OFBLK:: ;; In RFN ordering
|
||
ofdev: 0
|
||
offn1: 0
|
||
offn2: 0
|
||
ofdir: 0
|
||
|
||
TFBLK:: ;; In RFN ordering
|
||
tfdev: 0
|
||
tffn1: 0
|
||
tffn2: 0
|
||
tfdir: 0
|
||
|
||
C.RBLK:: ;; In random DDT ordering
|
||
c.rdev: sixbit /DSK/
|
||
c.rdir: 0 ; Filled in with SNAME
|
||
c.rfn1: sixbit /FOO/
|
||
c.rfn2: sixbit /BIN/
|
||
|
||
sname: 0 ; Filled in with SNAME
|
||
|
||
option: 0 ; %OP bits
|
||
|
||
.insrt syseng;rfn >
|
||
|
||
rsixtp:
|
||
psixtp: cain a,"( ;( starts switches
|
||
aos (p)
|
||
caie a,"/
|
||
cain a,"_ ;_ is special
|
||
aos (p) ; we skip
|
||
ret
|
||
|
||
switch: caie a,"a
|
||
cain a,"A
|
||
jrst allset ; Turn on all switches
|
||
caie a,"l
|
||
cain a,"L
|
||
jrst locset ; Turn on switch for file-location format
|
||
caie a,"s
|
||
cain a,"S
|
||
jrst srcset
|
||
caie a,"d
|
||
cain a,"D
|
||
jrst datset ; Turn on switch for data area info
|
||
caie a,"t
|
||
cain a,"T
|
||
jrst txtset ; Turn on switch for de-controlified
|
||
type \AUnknown switch --/\
|
||
.iot tyoc,a
|
||
type /
|
||
/
|
||
.logout 1,
|
||
|
||
allset: call datset
|
||
call txtset
|
||
ret
|
||
locset: setom locsw
|
||
ret
|
||
srcset: setom srcsw
|
||
ret
|
||
datset: setom datasw
|
||
ret
|
||
txtset: hllos textsw ;turn on rh, to indicate we want it.
|
||
setom flast ;start out as if having flushed non-text
|
||
movni t,-5
|
||
movem okcnt
|
||
ret
|
||
|
||
$$out==1 ;we want time output routines
|
||
.insrt syseng;datime >
|
||
|
||
go: move p,[-pdllen,,pdl]
|
||
|
||
syscal OPEN,[cnti .uao\%tjdis ? argi tyoc ? [sixbit /TTY/]]
|
||
.lose %lsfil
|
||
|
||
syscal OPEN,[cnti .uai ? argi tyic ? [sixbit /TTY/]]
|
||
.lose %lsfil
|
||
|
||
.suset [.roption,,a]
|
||
tlo a,%opint\%opopc
|
||
move tt,[-4,,[ .soption,,a
|
||
.smask,,[%pimpv\%pipdl]
|
||
.smsk2,,[1_tyoc\1_outc]
|
||
.rsname,,b
|
||
]]
|
||
.suset tt
|
||
movem a,option
|
||
movem b,c.rdir
|
||
movem b,sname
|
||
tlne a,%opbrk
|
||
.break 12,[..rpfi,,c.rblk]
|
||
tlnn a,%opcmd
|
||
jrst endjcl
|
||
setzm jclbuf
|
||
move tt,[jclbuf,,jclbuf+1]
|
||
blt tt,jclbuf+ljclbuf-1
|
||
.break 12,[..rjcl,,jclbuf]
|
||
move d,[440700,,jclbuf]
|
||
movei b,ifblk ; Probably there are input filenames.
|
||
call rfn"rfn
|
||
caie a,"_ ; Was that actually the output filenames?
|
||
jrst endjcl ; No: All done with JCL
|
||
move tt,[ifblk,,ofblk] ; Yes: OK, so we put them in the wrong
|
||
blt tt,ofblk+3 ; place. Put them in the right place.
|
||
repeat 4, setzm ifblk+.rpcnt ; Clear the old place.
|
||
movei b,ifblk ; And go get the real input names.
|
||
call rfn"rfn
|
||
jrst endjcl
|
||
|
||
define default ac,loc
|
||
skipn loc
|
||
movem ac,loc
|
||
termin
|
||
|
||
sysdrs:
|
||
irp dir,,[SYS,SYS1,SYS2,SYS3]
|
||
sixbit /dir/
|
||
termin
|
||
lsysdrs==:.-sysdrs
|
||
|
||
endjcl: move a,c.rdev
|
||
skipe ifdir ; If he typed a directory, default input
|
||
movsi a,(sixbit /DSK/) ; device to "DSK".
|
||
default a,ifdev
|
||
|
||
move a,c.rdir
|
||
default a,ifdir
|
||
|
||
move a,c.rfn2
|
||
skipe iffn1 ; If he typed a FN1, default FN2 to "BIN".
|
||
movsi a,(sixbit /BIN/)
|
||
default a,iffn2
|
||
|
||
move a,c.rfn1
|
||
default a,iffn1
|
||
|
||
movsi a,(sixbit /TTY/) ; Default device to "TTY".
|
||
skipe ofdir ; Unless he typed a directory, in which
|
||
movsi a,(sixbit /DSK/) ; case use "DSK"
|
||
default a,ofdev
|
||
|
||
move a,sname ; Default directory to our SNAME
|
||
default a,ofdir
|
||
|
||
move a,iffn1 ; Default FN1 to input FN1
|
||
default a,offn1
|
||
|
||
move a,[sixbit /BININF/] ; Default FN2 to "BININF".
|
||
default a,offn2
|
||
|
||
movei b,ifblk ;So FLOSS knows what to print
|
||
move d,ifdev
|
||
hrroi e,ifdir ; [-1,,ifdir]
|
||
came d,[sixbit /SYS/]
|
||
jrst openlp
|
||
movsi d,(sixbit /DSK/)
|
||
move e,[-lsysdrs,,sysdrs]
|
||
openlp: syscal open,[cnti .uii ? argi binc ? d ? iffn1 ? iffn2 ? (e) ? errv c]
|
||
jrst [ cain c,%ensfl
|
||
aobjn e,openlp
|
||
jrst floss]
|
||
|
||
move a,option
|
||
tlnn a,%opbrk
|
||
jrst openo
|
||
movem d,c.rdev
|
||
move a,(e)
|
||
movem a,c.rdir
|
||
move a,iffn1
|
||
movem a,c.rfn1
|
||
move a,iffn2
|
||
movem a,c.rfn2
|
||
.break 12,[..spfi,,c.rblk]
|
||
|
||
openo: movei b,ofblk
|
||
syscal open,[cnti .uao ? argi outc ? ofblk ? [sixbit /_BINPR/]
|
||
[sixbit /OUTPUT/] ? ofblk+3 ? errv c]
|
||
jrst floss
|
||
|
||
setzm bufcnt ;note our input buffer is empty
|
||
movsi a,-1 ;we want one word
|
||
call getwrd ;get one word
|
||
call badfil ; Not binary?
|
||
|
||
skipe datasw ;are we into displaying the data area?
|
||
jrst ndatp1
|
||
;No data area display
|
||
move c,outptr ;type info starts here
|
||
movem c,typptr
|
||
out /
|
||
File Type: /
|
||
jumpe a,pdumpt ;If first word non-zero it's a SBLK file
|
||
out /SBLK
|
||
/
|
||
jrst ndatp1 ;Otherwise
|
||
|
||
pdumpt: out /PDUMP
|
||
/
|
||
|
||
ndatp1: setz c,
|
||
idpb c,outptr ;mark end of type field
|
||
|
||
ndatp2: jumpe a,pdumpf ;if first word 0, it's a pdump file
|
||
|
||
skipn datasw ;Are we into displaying the data area?
|
||
jrst rrim10 ; No, get to work on it right now
|
||
|
||
move c,outptr ;Mark start of data area
|
||
movem c,datptr
|
||
out /
|
||
-- Data Area --
|
||
|
||
File Type: SBLK
|
||
|
||
SBLK # Start Address Size
|
||
|
||
/
|
||
|
||
rrim10: camn a,[jrst 1] ;JRST 1 ends RIM10 loader
|
||
jrst rsblk ; At start of SBLK
|
||
movsi a,-1 ;get 1 word
|
||
call getwrd
|
||
call badfil ; Not binary?
|
||
jrst rrim10 ;try again
|
||
|
||
rsblk: setzm page ;Counts SBLK's
|
||
rsblk0: setzm chksum ;starting checksum afresh
|
||
movsi a,-1 ;get AOBJN ptr for SBLK
|
||
call getwrd ;get the word
|
||
call badfil ; huh?
|
||
jumpge a,start ;if 0 or positive, is the start instruction
|
||
|
||
skipn datasw ;Are we into printing the data?
|
||
jrst rsblk1 ; no, don't calculate it
|
||
skipe locsw ; Wants to know file loc too?
|
||
jrst [ call locprt ; Print it
|
||
out /: /
|
||
jrst .+1]
|
||
aos t,page
|
||
call decprt
|
||
movei t,^I ;Tab over
|
||
idpb t,outptr
|
||
hrrz t,a ;Get start address
|
||
call octprt
|
||
movei t,^I ;Tab over
|
||
idpb t,outptr
|
||
idpb t,outptr
|
||
hlre t,a ;Get length
|
||
movns t
|
||
call octprt
|
||
out/
|
||
/
|
||
rsblk1: move t,
|
||
|
||
call datblk ;get each word in the block
|
||
call badfil
|
||
move b,chksum ;get the checksum for that block
|
||
movsi a,-1 ;get the checksum from the file
|
||
call getwrd
|
||
call badfil
|
||
came a,b ;are they equal?
|
||
call chkerr ; no, note that we may be losing...
|
||
jrst rsblk0 ; yes, it:s ok, get next SBLK
|
||
|
||
chkerr: type /AChecksum error encountered.
|
||
/
|
||
ret
|
||
|
||
start: setz ch,
|
||
idpb ch,outptr
|
||
|
||
start0: movsi a,-1 ;get AOBJN ptr for whatever
|
||
setzm chksum ;initialize the checksum
|
||
call getwrd
|
||
jrst endfil ; end of file, no information
|
||
jumpge a,endfil ;end of file?
|
||
hrrz b,a ;get the type of info
|
||
cain b,3 ;is it our cup of tea?
|
||
jrst binfo ; yes, hack it
|
||
call getwrd ;no, gobble it down
|
||
call badfil ; not supposed to end in middle of SBLK
|
||
chkchk: move b,chksum ;get our computed checksum
|
||
movsi a,-1 ;get the checksum from the file
|
||
call getwrd
|
||
call badfil
|
||
came a,b ;are they equal?
|
||
call chkerr ;no, tell him.
|
||
jrst start0 ;try next block.
|
||
|
||
binfo: hllz b,a ;B <- AOBJN to outer block
|
||
movsi a,-1 ;get AOBJN ptr to inner block
|
||
call getwrd
|
||
call badfil ; ending in the middle, lose!
|
||
add b,[1,,0] ;account for that word
|
||
hrrz c,a ;C <- type for inner block
|
||
hllzs a ;A <- AOBJN for inner block
|
||
sub b,a ;keep count of total words
|
||
cain c,1 ;is this MIDAS's output?
|
||
jrst mbinf ; yes, print it out
|
||
call getwrd ;unknown, ignore it
|
||
call badfil
|
||
infchk: jumpl b,binfo ;if there's more to read, read it
|
||
caile b,
|
||
call badfil ;if they don't match up, complain!
|
||
jrst chkchk ;go check the checksum and handle any
|
||
;more SBLK's
|
||
|
||
;;;comes here at the start of a block of midas-output info.
|
||
;;;A contains -<count>,,0
|
||
;;;B must be preserved.
|
||
mbinf: push p,b ;B must be conserved
|
||
move b,outptr ;this is the start of our info
|
||
movem b,midptr
|
||
move b,a ;Use B as our counter
|
||
out / --- MIDAS Provided Info ---
|
||
/
|
||
skipe locsw
|
||
jrst [ out / From file locs /
|
||
call locprt
|
||
move a,t ; Save value
|
||
out /-/
|
||
movei t,7(a) ; 6 words plus header
|
||
call octprt
|
||
jrst .+1]
|
||
movsi a,-1 ;get one word
|
||
call getwrd ;get the word
|
||
call badfil ; urk!
|
||
out /
|
||
Assembled by /
|
||
call 6type ;type that word out
|
||
out / on /
|
||
movsi a,-1 ;get the next word
|
||
call getwrd
|
||
call badfil
|
||
push p,b ;DATIME frob clobbers B
|
||
move d,[440700,,jclbuf]
|
||
call datime"twdasc
|
||
move t,[440700,,jclbuf] ;send the date down
|
||
call $out
|
||
pop p,b ;restore B
|
||
out /
|
||
Assembled from file /
|
||
movsi a,-1 ;get the device
|
||
call getwrd
|
||
call badfil
|
||
movem a,tfdev
|
||
movem a,c.rdev
|
||
movsi a,-1 ;SNAME
|
||
call getwrd
|
||
call badfil
|
||
movem a,tffn1
|
||
movem a,c.rfn1
|
||
movsi a,-1 ;FN1
|
||
call getwrd
|
||
call badfil
|
||
movem a,tffn2
|
||
movem a,c.rfn2
|
||
movsi a,-1 ;FN2
|
||
call getwrd
|
||
call badfil
|
||
movem a,tfdir
|
||
movem a,c.rdir
|
||
|
||
move a,option
|
||
tlne a,%opbrk
|
||
skipn srcsw
|
||
skipa
|
||
.break 12,[..spfi,,c.rblk]
|
||
push p,b ;Need B for PFN
|
||
movei b,tfblk
|
||
move d,[440700,,jclbuf]
|
||
call rfn"pfn ;cons up printing of name
|
||
move t,[440700,,jclbuf] ;type the stuff in the JCLBUF
|
||
call $out
|
||
out /
|
||
/
|
||
pop p,b ;recover our B
|
||
add b,[6,,0] ;account for words we've used
|
||
move a,b ;and let's gobble down the rest
|
||
call getwrd
|
||
call badfil
|
||
pop p,b ;recover outer block's B
|
||
setz ch, ;mark end of this string
|
||
idpb ch,outptr
|
||
jrst infchk
|
||
|
||
endfil: call outfrc
|
||
syscal renmwo,[argi outc ? ofblk+1 ? ofblk+2] ;try to assign final
|
||
jfcl ;names
|
||
.close outc,
|
||
.logout 1,
|
||
|
||
outfrc: move a,ofblk ;check to see if we're talking to our TTY
|
||
move t,[440700,,txtbuf]
|
||
skipl txoptr ;If there has been any text found
|
||
movem t,txtptr ; set up to output it
|
||
move t,midptr ;output the various info
|
||
call $type ; .
|
||
move t,typptr ; .
|
||
call $type ; .
|
||
move t,datptr ; .
|
||
call $type ; .
|
||
move t,symptr ; .
|
||
call $type ; .
|
||
skipn textsw
|
||
ret
|
||
move t,[440700,,[asciz /
|
||
--- Text Strings ---
|
||
|
||
/]]
|
||
skipl txoptr ;If there was any text found
|
||
call $type ; type the header
|
||
move t,txtptr
|
||
skipl txoptr
|
||
call $type ; and the text
|
||
move t,[440700,,[asciz /
|
||
/]]
|
||
call $type
|
||
ret
|
||
|
||
$type: setz tt,
|
||
push p,t ;save it to use another day
|
||
$type1: ildb ch,t
|
||
skipe ch ;until the end of the string
|
||
aoja tt,$type1 ; count the chars
|
||
pop p,t ;get pointer again
|
||
syscal siot,[argi outc ? t ? tt] ;output it
|
||
.lose %lsfil
|
||
ret
|
||
|
||
pdumpf: skipn datasw ;are we into displaying data?
|
||
jrst pdump0
|
||
|
||
move c,outptr ;Mark start of data area
|
||
movem c,datptr
|
||
|
||
out /
|
||
-- Data Area --
|
||
|
||
File Type: PDUMP
|
||
|
||
Page Type Shared With Writable
|
||
/
|
||
setzm page ;page counter
|
||
|
||
pdump0: move b,[-400,,filbuf+1] ;256 entries in the page map
|
||
setz c, ;count data pages
|
||
pdump1: move a,(b) ;get the map word
|
||
tdnn a,[700000,,600000] ;non-existant?
|
||
jrst pdump9 ; yes, ignore it
|
||
skipn datasw ;are we into printing the data areas?
|
||
jrst pdump8 ; no, don't calculate display
|
||
move t,page ;print page number
|
||
call octprt ;print it
|
||
movei t,^I ;tab over
|
||
idpb t,outptr
|
||
|
||
tlne a,400000 ;absolute?
|
||
jrst [out /System /
|
||
jrst pdump5]
|
||
tlne a,100000 ;Shared with other page?
|
||
jrst [out \Shared w/ page \
|
||
jrst pdump5]
|
||
tlne a,200000 ;copied?
|
||
jrst [out /Unshared /
|
||
jrst pdump5]
|
||
|
||
trne a,400000 ;is it impure?
|
||
jrst [out /Impure /
|
||
jrst pdump4] ; no "shared with"
|
||
|
||
trne a,200000 ;Is it at least readable?
|
||
jrst [out /Pure /
|
||
jrst pdump4] ; no "shared with"
|
||
|
||
out /Weird!! / ;Shouldn't get here!
|
||
hlrz t,a ;print lh,,rh for sake of debugging
|
||
call octprt
|
||
out /,,/
|
||
hrrz t,a
|
||
call octprt
|
||
movei t,^I ;tab over one
|
||
idpb t,outptr
|
||
jrst pdumpx ;and continue parsing
|
||
|
||
pdump4: out /---/ ;No "shared with"
|
||
jrst pdump6
|
||
|
||
pdump5: move t,a
|
||
andi t,777 ;page # shared with
|
||
call octprt ;print it
|
||
|
||
pdump6: movei t,^I ;tab over two
|
||
idpb t,outptr
|
||
idpb t,outptr
|
||
|
||
pdumpx: tlnn a,400000 ;If system page
|
||
trnn a,400000 ; Or pure
|
||
jrst pdump7 ; go say NO
|
||
out /Yes
|
||
/
|
||
jrst pdump8
|
||
|
||
pdump7: out /No
|
||
/
|
||
|
||
pdump8: tlne a,600000 ;absolute or shared?
|
||
jrst pdump9 ; yes, doesn't have data page
|
||
trne a,600000 ;exists?
|
||
aos c ; yes, count it
|
||
pdump9: aos page ;count pages
|
||
aobjn b,pdump1 ;do it for all pages in the map
|
||
|
||
aos c ;count the initial page
|
||
push p,c ;remember page count
|
||
skipn textsw ;are we looking for text?
|
||
call ptext ; yes, go hack text
|
||
pop p,c ;recover page count
|
||
setzm bufcnt ;invalidate the buffer
|
||
lsh c,12 ;convert to word number
|
||
.access binc,c ;get ready to read after last data page
|
||
movsi a,-1 ;and read the start instruction
|
||
call getwrd
|
||
call badfil
|
||
caige a,
|
||
call badfil ;must be positive or 0
|
||
jrst start ;and handle as SBLK from starting adress
|
||
|
||
ptext: movei c,1
|
||
ptext0: .access binc,c ;start on the first page
|
||
move t,[444400,,filbuf]
|
||
movei tt,2000
|
||
syscal siot,[argi binc ? t ? tt] ;read in the page
|
||
.lose %lsfil
|
||
caie tt,
|
||
call badfil ;if EOF, die.
|
||
move t,[-2000,,filbuf+1]
|
||
ptext1: call texthk
|
||
aobjn t,ptext1
|
||
ret
|
||
|
||
|
||
getblk: syscal rfpntr,[argi binc ? movem bufloc] ; Get current file loc
|
||
.lose %lsfil
|
||
move t,[444400,,filbuf]
|
||
movei tt,2000
|
||
syscal siot,[argi binc ? t ? tt]
|
||
.lose %lsfil
|
||
subi tt,2000
|
||
jumpe tt,cpopj2 ;EOF if can't get anything at all
|
||
hrls tt
|
||
hrri tt,filbuf
|
||
movem tt,bufcnt ;BUFCNT gets AOBJN ptr into buffer
|
||
move t,tt ;And T gets a copy too.
|
||
ret
|
||
|
||
cpopj2: sub p,[1,,1] ;return from caller
|
||
ret
|
||
|
||
getwrd: jumpge a,popj1 ;return immediately if none requested
|
||
skipl t,bufcnt ;Get count of words in buffer
|
||
call getblk ; out, get more
|
||
move tt,chksum ;get old checksum
|
||
rot tt,1 ;and compute new checksum
|
||
add tt,(t)
|
||
movem tt,chksum
|
||
add t,[1,,1] ;account for that word
|
||
movem t,bufcnt
|
||
skipge textsw ;is TEXTSW full on?
|
||
call texthk ; yes, hack text
|
||
aobjn a,getwrd ;get next word if wanted
|
||
move a,-1(t) ;get that word
|
||
popj1: aos (p)
|
||
cpopj: ret ;and return it
|
||
|
||
datblk: skipe textsw ;are we hacking text?
|
||
hrros textsw ; yes, turn on TEXTSW all the way
|
||
call getwrd ;hack the stuff
|
||
caia ; eof, don't skip
|
||
aos (p)
|
||
hrrzs textsw ;half-turn-off TEXTSW
|
||
ret
|
||
|
||
texthk: movei tt,-1(t) ;TT <== pointer to word just hacked
|
||
move ch,(tt)
|
||
trne ch,1 ;if low bit set, can't be ascii!
|
||
jrst tflush ;jcall
|
||
hrli tt,440700 ;make Byte Pointer to it
|
||
ildb ch,tt ;get first char
|
||
call termp ;do whatever with this char
|
||
ildb ch,tt
|
||
call termp
|
||
ildb ch,tt
|
||
call termp
|
||
ildb ch,tt
|
||
call termp
|
||
ildb ch,tt
|
||
call termp
|
||
ret
|
||
|
||
termp: cain ch,^M
|
||
jrst ter.m
|
||
cain ch,^J
|
||
jrst ter.j
|
||
setzm terflg ;note last char not ^M
|
||
cain ch,^L
|
||
jrst ter.l
|
||
cain ch,^P ;Is it a ^P?
|
||
jrst termp0 ; yes, it might be cursor control
|
||
cail ch,40 ;real
|
||
cain ch,177 ; not rubout?
|
||
jrst tflush ; no, flush
|
||
termp0: setzm flast ;This one was not flushed
|
||
setzm terflg ;and not CR either
|
||
idpb ch,@tttptr ;send output down whichever pointer
|
||
aose okcnt ;have there been enough to call this a
|
||
;string?
|
||
ret ; no change of state
|
||
jrst nowok ;yes, it's now OK, make the switch
|
||
|
||
ter.m: skipe flast ;was last one flushed?
|
||
ret ; yes, so this must be garbage
|
||
setom terflg ;note last char was ^M
|
||
ret
|
||
|
||
ter.j: skipn terflg ;was last thing a ^M?
|
||
jrst tflush ; no, must be garbage
|
||
setzm terflg ;last was not ^M
|
||
movei ch,^M ;send down a
|
||
idpb ch,@tttptr ;send output down whichever pointer
|
||
movei ch,^J
|
||
jrst termp0
|
||
|
||
ter.l: skipn flast ;was the last thing flushed?
|
||
idpb ch,@tttptr ; No, send this down after it
|
||
jrst termp0
|
||
|
||
nowok: move ch,@tttptr ;get the pointer we've been using
|
||
movem ch,txoptr ;and make it the real output pointer
|
||
movei ch,txoptr ;and continue using the real output pointer
|
||
movem ch,tttptr ;for the rest of this string
|
||
ret
|
||
|
||
tflush: skipe flast ;have be already been flushing?
|
||
ret ; yes.
|
||
setom flast ;note that we're flushing
|
||
movei ch,". ;output an elipsis
|
||
idpb ch,@tttptr
|
||
idpb ch,@tttptr
|
||
idpb ch,@tttptr
|
||
; movei ch,^M
|
||
; idpb ch,@tttptr
|
||
; movei ch,^J
|
||
; idpb ch,@tttptr
|
||
move ch,txoptr ;and flush if we haven't made it permanent
|
||
movem ch,tmpptr ;by making the temp pointer same as perm
|
||
movei ch,tmpptr ;and make it use the temp pointer again
|
||
movem ch,tttptr
|
||
movn ch,strcnt ;CH <== -<# alpahbetics needed for string>
|
||
movem ch,okcnt ;and reset counter to require that many
|
||
ret
|
||
|
||
mpvint: push p,a ;an AC to use
|
||
move a,-1(p) ;get PC
|
||
hlrz a,(a) ;get instruction
|
||
andi a,777000 ;isolate opcode
|
||
caie a,(idpb) ;only IDPB is legal to create page
|
||
jrst mpvlos ; Lossage!
|
||
.suset [.rmpva,,a] ;A gets address
|
||
lsh a,-12 ;turn into page #
|
||
syscal corblk,[cnti %cbndw\%cbndr ? argi 0
|
||
argi %jself ? a ? argi %jsnew]
|
||
.lose %lssys
|
||
pop p,a
|
||
dismis: syscal dismis,[p]
|
||
.lose %lssys
|
||
|
||
mpvlos: move a,-1(p) ;get PC
|
||
hrlm a,intwrd
|
||
pop p,a
|
||
syscal dismis,[p ? (p) ? 0,,-1(p) ? 0,,-2(p) ? intwrd]
|
||
.lose %lssys
|
||
|
||
morint: push p,t
|
||
push p,tt
|
||
push p,a
|
||
push p,ch
|
||
type /HL--MORE--/
|
||
.iot tyic,a
|
||
caie a,40 ;More?
|
||
jrst [type /HL--FLUSHED--
|
||
/
|
||
jrst delewo]
|
||
type /
|
||
/
|
||
pop p,ch
|
||
pop p,a
|
||
pop p,tt
|
||
pop p,t
|
||
jrst dismis
|
||
|
||
6type: move tt,a ;copy word for shifting
|
||
movei ch,^Q
|
||
6type1: setz t, ;clear character frob
|
||
lshc t,6 ;get first character
|
||
addi t,40 ;convert to ascii
|
||
cain t,40 ;space?
|
||
idpb ch,outptr
|
||
idpb t,outptr ;and output it
|
||
jumpn tt,6type1 ;and keep typing until end of frob
|
||
ret ;all done
|
||
|
||
;;; LOCPRT - Type current file location in octal.
|
||
;;; Loc is that of word last read by getwrd.
|
||
;;; Leave in T.
|
||
|
||
locprt: hrrz t,bufcnt
|
||
subi t,filbuf+1 ; Get offset in buffer (allow for wd just read)
|
||
add t,bufloc ; Get offset in file
|
||
push p,t
|
||
call octprt
|
||
pop p,t
|
||
ret
|
||
|
||
;;; type T in OCTAL
|
||
|
||
octprt: setz tt,
|
||
lshc t,-3 ;shift instead of IDIVI, don't forget
|
||
lsh tt,-41 ;negative!
|
||
push p,tt ;push remainder
|
||
skipe t ;done?
|
||
call octprt ;no compute next one
|
||
|
||
octpn1: pop p,tt ;yes, take out in opposite order
|
||
addi tt,60 ;make ascii
|
||
idpb tt,outptr
|
||
ret ;and return for the next one.
|
||
|
||
|
||
decprt: call decpr0 ;Type the number
|
||
movei t,". ;and end with a . so we know it's decimal
|
||
idpb t,outptr
|
||
ret
|
||
|
||
decpr0: idivi t,10.
|
||
push p,tt ;push remainder
|
||
skipe t ;done?
|
||
call decpr0 ;no, compute next one
|
||
jrst octpn1 ;then print this and previous ones
|
||
|
||
$out: ildb tt,t ;get a char
|
||
jumpe tt,cpopj ;null ==> end
|
||
idpb tt,outptr ;send it down the B.P.
|
||
jrst $out
|
||
|
||
badfil: call outfrc
|
||
type /AError in file format - may not be binary file?
|
||
/
|
||
jrst delewo
|
||
|
||
noinfo: call outfrc
|
||
type /ANo Info in file.
|
||
/
|
||
jrst delewo
|
||
|
||
floss: move a,[asciz /A/]
|
||
movem a,jclbuf
|
||
move d,[260700,,jclbuf]
|
||
call rfn"pfn
|
||
setz a,
|
||
move d,[440700,,jclbuf]
|
||
floss1: ildb b,d
|
||
skipe b
|
||
aoja a,floss1
|
||
move d,[440700,,jclbuf]
|
||
syscal siot,[argi tyoc ? d ? a]
|
||
.lose %lsfil
|
||
type / -- /
|
||
syscal open,[cnti .uai ? argi binc ? [sixbit /ERR/] ? argi 4 ? c]
|
||
.lose %lsfil
|
||
move a,[440700,,jclbuf]
|
||
movei b,500
|
||
syscal siot,[argi binc ? a ? b]
|
||
.lose %lsfil
|
||
|
||
setz a, ;Do it this way to flush trailing ^L lossage
|
||
move d,[440700,,jclbuf]
|
||
floss2: ildb b,d
|
||
skipe b
|
||
cain b,^L
|
||
jrst floss3
|
||
caie b,^C
|
||
aoja a,floss2
|
||
|
||
floss3: move d,[440700,,jclbuf]
|
||
syscal siot,[argi tyoc ? d ? a]
|
||
.lose %lsfil
|
||
type /
|
||
/
|
||
.logout 1,
|
||
|
||
delewo: syscal delewo,[argi outc]
|
||
.logout 1,
|
||
.logout 1,
|
||
|
||
typblk: setz ? sixbit /SIOT/ ? argi tyoc ? t ? setz tt
|
||
|
||
page: 0
|
||
|
||
intwrd: 0,,1+.lz %pimpv
|
||
|
||
ljclbuf==:100
|
||
jclbuf: block ljclbuf
|
||
-1
|
||
|
||
locsw: 0 ;-1 ==> Include file-location info in printout
|
||
srcsw: 0 ;-1 ==> Set ^R names to source file names
|
||
datasw: 0 ;-1 ==> Print data areas
|
||
textsw: 0 ;-1 ==> Print text
|
||
|
||
|
||
chksum: 0 ;our running computed checksum
|
||
bufloc: 0 ; Loc in file that current buffer came from
|
||
bufcnt: 0
|
||
filbuf: block 2000
|
||
|
||
tttptr: tmpptr ;IDPB CH,@'d through, either
|
||
;through the temporary pointer or
|
||
;through the permanent pointer when
|
||
;it is determined that it is a bona-fide
|
||
;text string
|
||
tmpptr: 440700,,txtbuf
|
||
txoptr: 440700,,txtbuf
|
||
|
||
okcnt: 0
|
||
strcnt: 5 ;count of alphabetics needed to output
|
||
|
||
terflg: 0 ;-1 means last char was CR
|
||
flast: 0 ;-1 means we flushed the last char
|
||
|
||
variables
|
||
constants
|
||
|
||
;;; **** No literals or variables after this point ****
|
||
|
||
nil: 0
|
||
outptr: 440700,,outbuf ;ILDB ptr for our output
|
||
midptr: 440700,,nil ;ptr to the block of MIDAS info
|
||
typptr: 440700,,nil ;pointer to the type line
|
||
datptr: 440700,,nil ;pointer to the page/sblk description
|
||
symptr: 440700,,nil ;pointer to the info on the symbol table
|
||
txtptr: 440700,,nil ;pointer to ascii text found
|
||
|
||
outbuf: ;buffer for our output info.
|
||
|
||
|
||
txtbuf=:400000 ;upper core is text buffer
|
||
end go
|