; -*- 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
