.title	uncomp
	.enabl	lc
;++
;
; Uncompress bletcherous UNIX .Z files.
;
; By John Wilson.
;
; Based (obviously) on the Berkeley UNIX "compress" command (4.0), copyrighted
; and patented half to death by various people, and then released into the
; public domain, go figure.
;
; If I had used any of their actual code I'd include their copyright notice.
;
; .RUN UNCOMP
; *outfile[,swapfile]=infile/switches
;
; Outfile is the output (uncompressed) file.
;
; Swapfile is optional and specifies a file which UNCOMP may use as a temp
; file for paging its huge tables (the file is deleted afterwards).  If it is
; not specified UNCOMP uses DK:UNCOMP.TMP.  Maybe we have a fixed-head disk or
; something.  Whatever.  For small input files this swap file will never be
; needed and it won't even be opened.  Either way it is .PURGEd when we're
; done.
;
; Infile is the input (compressed) file.
;
; Switches:
; /B		it's a binary file, don't translate lf to crlf
;
; /B:n		compressed with a max of N bits
;		(the n is what distinguishes between the two /B's)
;
; /N		it has no header (compress 2.0)
;
; /L:n		actual length in bytes of the input file (actually we only
;		look at the low 9. bits since it's just the last 512. bytes of
;		the file that are in question).  CSI truncates to 16. bits
;		rather than freaking out so you can give whatever length it
;		really is even if it's more than 64K and we'll still get the
;		correct low 9. bits.
;
; On RT-11 we have some difficulty locating the end of file, since the last
; block is filled with 0's.  Fortunately compress translates 0's into more
; 0's (regardless of word size), so the worst that happens is that we get the
; wrong # of 0's at the eof.  This is no problem for text files, since nulls
; aren't significant and in fact we don't save nulls in text mode (except for
; the padding we add to the last output block), but could be wrong for binary
; files that end in zeroes.  So use the extremely rude /L switch (make sure
; you kept an "ls -l" directory listing of whatever piece of shit Unix box you
; got the thing from!).
;
; How's this for a bad idea:  if the file extension is exactly three octal
; digits, we will use it to indicate the number of significant bytes in the
; last black (.000 means 1000).  I'll add this one of these days...  When I
; get around to writing compress I'll make it do this instead of .Z unless
; someone tells it otherwise.
;
; 03/13/91	JMBW	Created.
; 11/20/95	JMBW	Writes to file (finally!).
;
;--
	.mcall	.close,.csigen,.print,.purge,.qset,.settop,.sreset,.wait
;
errbyt=	52	;EMT error byte in low core
;
.enter=	emt!375
.gval=	emt!375
.read=	emt!375
.readw=	emt!375
.write=	emt!375
.writw=	emt!375
;
rbufl=	2000	;read buffer length (each of two)
wbufl=	4000	;write buffer length (each of two)
;
lf=	12
cr=	15
;
; Core buffers look like this:
;		.blkb	1000	;characters
;		.blkw	1000	;pointers
buf=	3000	;.word	buffer # (0::177) *2 (0::376)
less=	3002	;.word	next LRU block (than this one)
more=	3004	;.word	next MRU block (than this one)
sfbn=	3006	;.word	swapfile blk # of copy or -1 if none
recsiz=	3010	;length
;
	.asect
;
; set job status word
.=	44			;JSW
	.word			;I feel sure I had some reason for this
	.psect
;
	.sbttl	initialization
;+
;
; Entry point.
;
; We re-init all the changeable stuff every time so that
; it's OK to START us after ^C'ing at any time.
;
;-
uncomp:	; init for next file
	mov	@#42,sp		;reinit stack
	.sreset			;close all files
	.qset	#qel,#2		;need 3 Q-el's total (input, output, swap)
	mov	#config,r0	;get CONFIG from RMON
	.gval			;.GVAL in case XM
	bic	#^C10000,r0	;isolate XM flag
	mov	r0,xm		;save (NZ => XM)
	clrb	nohdr		;assume there is a header
	movb	#12.,maxbit	;set default
	mov	#-1,lstblk	;# bytes of last block used
	mov	#text,outc	;not a binary file
	.settop	#devhnd-2	;for a quick exit on ^C
	.csigen	#devhnd,#defext,#0
	inc	r0		;.even
	bic	#1,r0
	mov	r0,core		;save begn of free core
	; handle switches
	mov	(sp)+,r2	;get option count
	beq	100$		;none, skip
10$:	mov	(sp)+,r0	;get option
	bmi	40$		;had a value
	; switch with no value -- /?, /B, /N
	cmpb	r0,#'?		;help?
	beq	30$
	cmpb	r0,#'B		;binary?
	beq	20$
	cmpb	r0,#'N		;no header?
	bne	50$
	movb	r0,nohdr	;no header
	br	90$
20$:	mov	#binary,outc	;binary file
	br	90$
30$:	.print	#help		;print message
	br	uncomp
40$:	; switch with value -- /B:n or /L:n
	mov	(sp)+,r1	;get value
	cmpb	r0,#'B		;bits?
	beq	60$
	cmpb	r0,#'L		;length?
	beq	80$
50$:	movb	r0,swter1	;set letter for msg
	.print	#swterr		;switch error
	br	uncomp
60$:	; bits
	cmp	r1,#9.		;between 9. and 16.?
	blo	70$
	cmp	r1,#16.
	bhi	70$
	movb	r1,maxbit	;yes, save
	br	90$
70$:	.print	#badbit		;bad value for /B
	br	uncomp
80$:	; length
	dec	r1		;trim to 9. bits,
	bic	#^C777,r1	;except 0 means 1000
	inc	r1
	mov	r1,lstblk	;save
90$:	sob	r2,10$
100$:	; see if swapfile exists and set SF accordingly
	mov	#-1,r1		;assume not
	.wait	#1		;set C if not
	adc	r1		;=0 if not, still -1 if so
	movb	r1,sf		;set flag
	; get all core possible w/o USR swapping (maybe it's a 12.-bit file)
	mov	@#54,r0		;get address of RMON
	mov	266(r0),r0	;get address of USR from RMON
;;; use .GVAL if virtual job under XM
;;; (detect this and take all core now?)
	tst	-(r0)		;pt at last free word
	.settop			;ask for all core below USR
	mov	core,r1		;get start of core after dev handlers
	mov	r1,corptr	;set ptr
	add	#recsiz*2-2,r1	;need at least two recs (new + swap)
	cmp	r1,r0		;this had better fit
	blos	110$		;yep, skip
	.print	#nocore		;not enough core
	br	uncomp		;punt
110$:	add	#2,r0		;pt at first unused word
	mov	r0,cormax	;save addr
	clrb	corusr		;haven't eaten USR's core yet
	clr	mrubuf		;no MRU yet
	; init output file
	mov	#wbuf1,ofwca	;set up buf
	mov	#wbuf2,outbuf	;other buffer (double buffered)
	mov	#wbuf2,outptr	;init ptr
	mov	#wbufl,outctr	;and ctr (buf is empty)
	clr	ofwbk		;block #0
	; init input file
	mov	#rbuf1,ifrca	;set up buf
	mov	#rbuf2,inbuf	;other buffer (double buffered)
	clr	ifrbk		;block #0
	clr	rdeof		;no eof yet
	call	read		;read 1st buf
	call	read		;queue 2nd
;;;	bcs	...		;null file?
;;;;;;;;; detect null file here
	; read header
	tstb	nohdr		;right?
	bne	clear		;whoops, never mind
	sub	#3,inctr	;count it, make sure record long enough
	bcs	badhdr
	add	#3,inptr	;skip
	cmp	rbuf2,#116437	;good magic #?
	bne	badhdr
	movb	rbuf2+2,r0	;get flags char
	bit	#140,r0		;unused bits are 0's, right?
	bne	badhdr
	mov	#400-1,r1	;starting code =400 (-1 for first char)
	mov	#nop,r2		;assume clears aren't allowed
	tstb	r0		;check block-compress flag
	bpl	120$		;no block-compress, skip
	inc	r1		;401 if 400 means "clear"
	mov	#beqclr,r2	;clear if code=400
120$:	mov	r1,blkcmp	;set starting code
	mov	r2,pclear	;patch instruction after "cmp <code>,#400"
	bic	#^C37,r0	;isolate low 5
	movb	r0,maxbit	;save
	bic	#^C377,r0	;isolate
	mov	#-1,r1		;all 1's
	ash	r0,r1		;mask of overflow bits (0 if r0=16.)
	mov	r1,maxmax	;save
clear:	; find starting code for new entries (400 or 401)
	mov	(pc)+,r0	;get starting code
blkcmp:	.word			;set in init
	mov	r0,code		;starting code
	mov	r0,newoff	;(also offset into first swap buffer)
	mov	#1000,r1	;entries/buffer
	sub	r0,r1		;find count free
	mov	r1,newcnt	;starting free count
	; init core buffers
	mov	#nfull,addcod	;table is not full
	mov	core,r0		;actually it's empty
	mov	r0,newbas	;allocate 1st buffer
	clr	newind		;index=0
	clr	buf(r0)		;buf #0
	mov	#-1,sfbn(r0)	;not in swapfile
	mov	r0,r1		;copy
	add	#recsiz,r0	;skip it
	mov	r0,corptr	;update ptr (this must be less than cormax)
	clr	sfeof		;swapfile is empty
	; init buffer table
	sec			;C=1
	ror	r1		;ptr to 0th buf
	mov	r1,bufs+0	;set it
	; set starting word size
	mov	#177000,maxmsk	;always 9. bits
	mov	#9.,nbits
	mov	#load9,unpack
	br	lbuf		;go load
badhdr:	.print	#invhdr		;invalid header
	jmp	uncomp		;punt
;+
;
; Main loop.
;
; r5	input ptr (bytes unpacked into 16-bit words)
; r4	input count (# variable-length bytes left at (r5))
; r3	character stack ptr
;
;-
loop:	; handle next word
	mov	(r5)+,r0	;get next secret code
	cmp	r0,#400		;fake code to forget tables?
pclear:	.word			;patch either "NOP" or "BEQ CLR"
beqclr=	beq+<<clear-.>/2&377>	;only if block-compress bit is set in header
	mov	r0,-(sp)	;save curr code (for OLDCOD at bot of loop)
	; is this supposed to work even when all 64K codes have been assigned?
	; I doubt it.
	cmp	r0,code		;has code been assigned yet?
	blo	10$		;yes
	; KwKwK special case (???)
	movb	finchr,(r3)+	;add previous first char to stack
	mov	oldcod,r0	;now where were we?
	; check to see if previous code was valid (pts at something)
	cmp	r0,code		;is that valid?
	blo	10$		;yes
	; nope, so file must have been corrupted
	.print	#corupt		;tell them so
	jmp	uncomp		;give up
10$:	bit	#^C377,r0	;actual byte?
	beq	30$		;yes
20$:	; follow linked list of characters
	call	lookup		;look up loc
	add	r1,r2		;offset
	movb	(r2),(r3)+	;add to stack
	add	r1,r2		;offset *2
	mov	1000(r2),r0	;get it
	bit	#^C377,r0	;actual data byte?
	bne	20$		;no, loop
30$:	; string ends when code fits in 8. bits (value for first 256. = index)
	movb	r0,(r3)+	;save index as char (don't bother looking up!)
	mov	r0,(pc)+	;save in case escaped next
finchr:	.word			;file input char (?)
	; add OLDCOD to table if not full
	; (save OLDCOD in code array and FINCHR
	; in char array, both at index CODE)
	jmp	@(pc)+		;add code, or not
addcod:	.word			;either NFULL if not full or FULL if full
nfull:	inc	(pc)+		;bump code #
code:	.word			;code # of next char
	mov	(pc)+,r2	;get base of buf
newbas:	.word			;base of buf we're adding to
	mov	(pc)+,r1	;get offset
newoff:	.word			;offset into buf at which we're adding
	add	r1,r2		;add offset
	movb	r0,(r2)		;save char
	add	r1,r2		;offset *2
	mov	oldcod,1000(r2)	;save code
	inc	newoff		;+1
	dec	(pc)+		;see if blk done
newcnt:	.word			;# codes to next buffer for newbas
	beq	newnew		;none, start new buffer (maybe more bits)
full:	; ADDCOD points here if tables are full
	mov	(sp)+,(pc)+	;curr code is now old
oldcod:	.word			;code from previous pass through loop
	; flush stack
	mov	r3,r2		;copy
	sub	#stack,r2	;find count
flst1:	movb	-(r3),r0	;get char
	call	@(pc)+		;write it
outc:	.word			;routine to write a char
	sob	r2,flst1	;loop
	dec	r4		;get next code
	bne	loop
	;br	lbuf		;drop through
;
	.enabl	lsb
lbuf:	; load buffer with more (8. NBITS-bit words from NBITS bytes)
	; set up r5 and r4, init r3 to #STACK
	mov	#bbuf,r4	;byte buffer
	mov	nbits,r2	;get # bytes to read
10$:	mov	inptr,r5	;input ptr
	sub	r2,inctr	;bite them off (C set if not enough)
	bcs	20$		;not enough
	; easy case (usual case too) -- just copy from the buffer
	movb	(r5)+,(r4)+	;yep
	sob	r2,.-2
	mov	r5,inptr	;update ptr
	mov	#bbuf,r4	;source
	mov	#wbuf,r5	;dest
	call	@(pc)+		;go unpack
unpack:	.word			;addr of routine to unpack bytes (LOADn)
	mov	#8.,r4		;word count
	mov	#stack,r3	;reinit
	br	loop		;loop
20$:	; not enough bytes in this .READ, get more
	mov	r2,r1		;save (initially 8.)
	add	inctr,r1	;find # available
	beq	30$		;none, it's probably eof
	sub	r1,r2		;find # left to get from next buf
	movb	(r5)+,(r4)+	;take what there are
	sob	r1,.-2
30$:	call	read		;read more (trash r0+r1)
	bcc	10$		;try again
	; hit eof -- handle last record or finish if empty
	mov	nbits,r1	;get # we wanted
	sub	r2,r1		;find # we got
	beq	done		;none, we're done
	; do last partial record
	mov	r1,-(sp)	;save length in bytes
	mov	#bbuf,r4	;source
	mov	#wbuf,r5	;dest
	call	@unpack		;unpack the record
	mov	(sp)+,r1	;restore length
	mov	nbits,r0	;get word size
	asl	r0		;*2
	add	len-<9.*2>(r0),r1 ;get length table, index
	movb	(r1),r4		;get length
	bpl	50$		;OK
	; negative length is 1's complement of # of complete words
	tst	lstblk		;did we think we knew what we were doing?
	bmi	40$		;nope, don't worry about it
	.print	#invlen		;too many bytes for n, not enough for n+1
40$:	com	r4		;fix
	beq	done		;whoops, guess we're done
50$:	mov	#stack,r3	;reinit
	jmp	loop		;go (eof next time)
	.dsabl	lsb
;
done:	; finished, close files
	call	flush		;flush output file
	.close	#0		;close it
	.purge	#1		;kill swapfile, if any
	.close	#3		;be nice to input file (no implicit .PURGE)
	jmp	uncomp
;
newnew:	; start a new "new" buffer -- first make current one MRU
	mov	newbas,r2	;pt at buffer
	mov	mrubuf,r0	;get current MRU, if any
	beq	100$
	mov	more(r0),r1	;LRU too
	mov	r1,more(r2)	;link LRU to us
	mov	r2,less(r1)	;and us to LRU
10$:	mov	r0,less(r2)	;link MRU to us
	mov	r2,more(r0)	;and us to MRU
	mov	r2,mrubuf	;now we're MRU
	; see if it's time for a new word size (always at buf boundary)
	mov	code,r0		;wrapped around to 0?
	beq	80$		;no more possible codes if so
	bit	maxmax,r0	;overflowed max word size?
	bne	80$		;stop storing if so
	bit	maxmsk,r0	;overflowed word size?
	bne	90$		;advance to next
20$:	mov	buf(r2),r1	;get old buf #
	add	#2,r1		;+2
	mov	r3,-(sp)	;save r3
30$:	; try to get it from the core pool
	mov	corptr,r2	;get ptr
	mov	r2,r3		;copy
	add	#recsiz,r3	;skip
	bcs	70$		;(must be virtual job)
40$:	cmp	r3,cormax	;will it fit?
	bhi	60$
	mov	r3,corptr	;cool, make it official
	mov	r2,r3		;copy addr
50$:	sec			;C=1
	ror	r3		;make ptr
	mov	r3,bufs(r1)	;save it
	mov	r1,buf(r2)	;set buffer #
	mov	#-1,sfbn(r2)	;not on disk
	mov	r2,newbas	;save ptr
	clr	newoff		;offset=0
	mov	#1000,newcnt	;whole buf free
	add	#1000,newind	;bump index
	mov	(sp)+,r3	;restore
	jmp	full		;continue
60$:	; out of core, try to allocate more
	tstb	corusr		;have we eaten USR's core yet?
	bne	70$		;yes
	comb	corusr		;try it
	.settop	#-2		;take everything
	add	#2,r0		;bump ptr
	mov	r0,cormax	;save
	br	40$		;try again
70$:	; already have all available core, swap something out
	mov	r4,-(sp)	;save
	call	getbuf		;swap
	mov	(sp)+,r4
	mov	more(r3),r2	;get LRU
	mov	less(r3),r0	;get 2nd MRU
	mov	r0,less(r2)	;patch us out
	mov	r2,more(r0)
	mov	r0,mrubuf	;set new MRU
	mov	r3,r2		;copy
	br	50$		;go return it
80$:	; CODE wrapped around to 0 (or overflowed MAXMAX), can't create
	; any new table entries until next CLEAR instruction (if allowed)
	mov	#full,addcod	;so don't even try
	dec	code		;code=MAXMAX-1 so range check always works
	mov	#-1,newind	;fix LOOKUP not to look at "new" buf
	jmp	full		;this should speed things up!
90$:	; CODE overflowed NBITS bits, advance to next word size
	asl	maxmsk		;allow one more 1 bit
	inc	nbits		;one more bit (up to 16.)
	mov	nbits,r0	;get #
	asl	r0		;*2
	mov	load-<9.*2>(r0),unpack ;set new vector for unpacking
	mov	#1,r4		;flush buffer (read a new record)
	br	20$		;continue
100$:	; no MRU (no buf chain at all), this is the first
	mov	r2,r0		;rig to link buf to itself
	br	10$		;continue
;+
;
; Look up an array location.
;
; Enter with 16-bit offset in r0.
; Treat high 7 bits as buffer number (buffer is 3 blks),
; low 9. will be returned as offset.
;
; The buffer is assumed to exist (new buffers need to be created
; only when we finish filling the current "new" buffer, so we'll
; put the code there and eliminate the check here).
;
; Returns:
; r1	9.-bit offset
; r2	base of buffer:
;	.blkb	1000	;entry=this character
;	.blkw	1000	;entry=pointer to next entry
;
;-
	.enabl	lsb
lookup:	mov	r0,r1		;copy
	bic	#777,r0		;lose offset
	bic	#^C777,r1	;fair is fair
	; see if it's in the new blk we're building at the end
	cmp	r0,(pc)+	;is it?
newind:	.word			;base index of latest blk
	bne	10$		;no
	mov	newbas,r2	;get base
	rts	pc
10$:	; see if MRU
	swab	r0		;into low byte
	mov	(pc)+,r2	;get base addr
mrubuf:	.word			;addr of m.r.u. buf
	cmp	r0,buf(r2)	;is this it?
	bne	20$		;no
	rts	pc
20$:	; not most-recently-used, check cache
	mov	r3,-(sp)	;save
	mov	bufs(r0),r2	;find out where it is
	bpl	30$		;non-resident, go fetch it
	; block is in core
	asl	r2		;make it an addr
	; unlink from previous position
	mov	more(r2),r0	;pt at MRU block
	mov	less(r2),r3	;next LRU blk
	mov	r0,more(r3)	;link back and forth
	mov	r3,less(r0)
	; link to MRU position
	mov	mrubuf,r0	;get MRU
	mov	more(r0),r3	;get more
	mov	r2,less(r3)	;link us to it
	mov	r3,more(r2)	;and it to us
	mov	r2,more(r0)	;link us to old MRU
	mov	r0,less(r2)	;and it to us
	mov	(sp)+,r3	;restore
	rts	pc
30$:	; non-resident, r2 is blk # in swap file, swap it in
	; punt LRU and use its buf -- we wouldn't be swapping
	; if we weren't out of core so no need to check
	mov	r4,-(sp)	;save
	call	getbuf		;flush LRU
	mov	r2,sfbn(r3)	;set disk blk #
	mov	r2,sfrbk	;set blk #
	mov	r0,buf(r3)	;set buf #
	mov	r3,r2		;copy
	sec			;C=1
	ror	r3		;/2+100000
	mov	r3,bufs(r0)	;set ptr
	mov	r2,sfrca	;set core addr
	mov	#sfrd,r0	;.READW
	.readw
	bcs	40$		;error
	mov	(sp)+,r4	;restore
	mov	(sp)+,r3
	rts	pc
40$:	; error reading swap file
	.print	#tmpred		;read error
	jmp	uncomp		;punt
	.dsabl	lsb
;+
;
; Swap out LRU block, make it MRU.
;
; Returns addr in r3.
;
; Bashes r4, others preserved.
;
;-
getbuf:	mov	r0,-(sp)	;save
	; make LRU into MRU (rotate buffers by 1)
	mov	mrubuf,r3	;get MRU
	mov	more(r3),r3	;find LRU (buffers linked in a circle)
	mov	r3,mrubuf	;yep
	; write LRU buf to swap file unless it's already there
	mov	sfbn(r3),r4	;is it in swapfile (-1 if not)?
	bpl	20$		;yes, don't bother writing again
	tstb	sf		;is there a swapfile?
	beq	30$		;go create one
10$:	; not yet in swap file, write it out
	mov	sfeof,r4	;get eof
	add	#3,sfeof	;update to skip this blk
	mov	r4,sfwbk	;set blk #
	mov	r3,sfwca	;core addr
	mov	#sfwr,r0	;write to swapfile
	.writw			;yep
	bcs	40$		;go punt
20$:	; mark in BUFS table as out to lunch
	mov	buf(r3),r0	;get buf # *2
	mov	r4,bufs(r0)	;set disk blk #
	mov	(sp)+,r0	;restore
	rts	pc
30$:	; create swapfile
	comb	sf		;swapfile will exist now
	mov	#600,tmpsiz	;first try 384. blks (max we could ever need)
	mov	#etmp,r0	;.ENTER
	.enter
	bcc	10$		;go back if OK
	clr	tmpsiz		;take what we can (better than not trying)
	mov	#etmp,r0	;.ENTER
	.enter
	bcc	10$		;maybe it's enough, otherwise output err later
	.print	#tmpcrt		;error creating temp file
	jmp	uncomp		;restart
40$:	; output error
	.print	#tmpwrt		;error writing temp file
	jmp	uncomp
;+
;
; Output text character.
;
; r0	char
; r2-r5	preserved
;
;-
text:	cmp	r0,#lf		;Unix newline?
	beq	40$		;yes
10$:	movb	r0,@outptr	;save
	beq	30$		;ignore nulls
	inc	outptr
	dec	outctr		;count it
	beq	20$
	 rts	pc
20$:	br	flush		;flush output buf, return
30$:	rts	pc
40$:	; Unix newline, convert to crlf
	mov	#cr,r0		;cr
	call	10$
	mov	#lf,r0		;lf
	br	10$
;+
;
; Output binary character.
;
; r0	char
; r2-r5	preserved
;
;-
binary:	movb	r0,@outptr	;save
	inc	outptr
	dec	outctr		;count it
	beq	10$
	 rts	pc
10$:	;br	flush		;flush buffer, return
;+
;
; Flush output buffer.
;
; r2-r5	preserved
;
;-
flush:	.wait	#0		;wait for previous .WRITE to complete (if any)
	mov	outbuf,r0	;swap buffers
	mov	ofwca,outbuf
	mov	r0,ofwca
	mov	outptr,r1	;get ptr
	bit	#1,r1		;odd?
	beq	10$
	 clrb	(r1)+		;yes, pad to even
10$:	sub	r0,r1		;find length in bytes (C=0)
	beq	20$		;0, do nothing
	ror	r1		;make word count
	mov	r1,ofwwc	;save
	mov	#ofwr,r0	;write next buf
	.write
	bcs	30$
	add	#377,r1		;round up to next block
	clrb	r1
	swab	r1		;wc => blk cnt
	add	r1,ofwbk	;update blk # for next time
20$:	mov	outbuf,outptr	;reinit ptr
	mov	#wbufl,outctr	;and counter
	rts	pc
30$:	.print	#wrerr		;punt
	jmp	uncomp
;+
;
; Read more from input file.
;
; r2-r5	preserved
;
; Return C=1 on eof.
;
;-
read:	tst	(pc)+		;eof?
rdeof:	.word			;NZ => already reached eof
	bne	70$		;yep
	; process previous buffer
	.wait	#3		;let previous .READ finish
	; swap buffers
	mov	ifrca,r0	;addr of buf just read
	mov	inbuf,ifrca	;set up next buffer
	mov	r0,inbuf	;this is the one we're reading from
	mov	r0,inptr	;init ptr
	mov	inbc,inctr	;get BC from the .READ that started us
	; start next
	mov	#ifrd,r0	;read next buffer
	.read			;queue it
	bcs	20$		;error or eof
	asl	r0		;wc*2=bc
	mov	r0,inbc		;save for when it completes
	add	#rbufl/1000,ifrbk ;bump blk # (C=0 unless huge file)
				;(or many small .READ's from seq. device)
10$:	clc			;C=0 for sure
	rts	pc
20$:	; read error or eof
	tstb	@#errbyt	;0=eof
	bne	80$		;error, complain
	; eof means previous buf was last one, so handle /L value now
	com	rdeof		;nothing more to read
	mov	lstblk,r0	;get /L value
	bmi	30$		;not specified, just scan off 0's
	sub	#1000,r0	;eat last blk, add back /L value
	add	r0,inctr	;like I said (C=0)
	rts	pc
30$:	; end of file unknown, just scan off trailing 0's
	; (uncompress translates 0's of any size as more 0's, so the worst
	; we'll do is scan off too many and the output file will be missing
	; some nulls, and if it's a text file we would have deleted them
	; anyway)
	mov	inptr,r0	;point
	add	inctr,r0
	tstb	-1(r0)		;last char NZ?
	bne	60$		;yep, forget it (C=0)
	mov	#1000,r1	;count
40$:	tstb	-(r0)		;check one
	bne	50$		;done
	sob	r1,40$		;loop
	dec	r0		;fix for below
50$:	inc	r0		;unget
	inc	r0		;plus 1 null (might be part of last code)
	sub	inptr,r0	;find length
	blos	10$		;there was <= 1 blk, must have been seq. dev
	mov	r0,inctr	;fix inctr
60$:	rts	pc		;(C=0)
70$:	; eof
	clr	inctr		;don't be fooled
	sec			;C=1
	rts	pc
80$:	; read error
	cmpb	@#errbyt,#2	;not open?
	beq	90$		;well fine
	.print	#rderr		;punt
	jmp	uncomp
90$:	; version banner
	.print	#verban		;took us long enough to notice!
	jmp	uncomp
;
	.sbttl	byte unpacking routines
;+
;
; Unpacking routines.  EIS needed.
;
; r4	source ptr
; r5	dest ptr
;
; Return r5 pointing at 8 words (usu. WBUF).
;
;-
load:	.word	load9,load10,load11,load12
	.word	load13,load14,load15,load16
;
load9:	; load 9-bit bytes
	clr	r1		;init bit count
	mov	#8.,r2		;wc
	mov	#^C777,r3	;bit mask
10$:	clr	r0		;init
	bisb	(r4)+,r0	;low byte
	swab	r0
	bisb	(r4),r0		;high byte
	swab	r0
	ash	r1,r0		;shift into place
	bic	r3,r0		;isolate
	mov	r0,(r5)+	;save
	dec	r1		;next byte is one bit to left
	sob	r2,10$		;loop
	mov	#wbuf,r5	;pt
	rts	pc
;
load10:	; load 10-bit bytes
	clr	r1		;init bit count
	mov	#4,r2		;wc
	mov	#^C1777,r3	;bit mask
10$:	clr	r0		;init
	bisb	(r4)+,r0	;low byte
	swab	r0
	bisb	(r4),r0		;high byte
	swab	r0
	ash	r1,r0		;shift into place
	bic	r3,r0		;isolate
	mov	r0,(r5)+	;save
	sub	#2,r1		;shift count -2
	sob	r2,10$		;loop
	inc	r4		;skip from 5th to 6th
	clr	r1		;same again for 2nd 4 words
	mov	#4,r2
20$:	clr	r0
	bisb	(r4)+,r0
	swab	r0
	bisb	(r4),r0
	swab	r0
	ash	r1,r0
	bic	r3,r0
	mov	r0,(r5)+
	sub	#2,r1
	sob	r2,20$
	mov	#wbuf,r5	;pt
	rts	pc
;
load11:	; load 11-bit bytes
	mov	#^C3777,r3	;mask
	clr	r0		;1st
	bisb	(r4)+,r0
	swab	r0
	bisb	(r4)+,r0
	clr	r1
	bisb	r0,r1
	swab	r0
	bic	r3,r0
	mov	r0,(r5)+
	swab	r1		;2nd
	bisb	(r4)+,r1
	clr	r0
	bisb	r1,r0
	swab	r1
	ash	#-3,r1
	bic	r3,r1
	mov	r1,(r5)+
	swab	r0		;3rd
	bisb	(r4)+,r0
	swab	r0
	movb	(r4),r1
	asr	r1
	ror	r0
	ash	#-5,r0
	bic	r3,r0
	mov	r0,(r5)+
	clr	r0		;4th
	bisb	(r4)+,r0
	swab	r0
	bisb	(r4)+,r0
	clr	r1
	bisb	r0,r1
	swab	r0
	asr	r0
	bic	r3,r0
	mov	r0,(r5)+
	swab	r1		;5th
	bisb	(r4)+,r1
	mov	r1,r0
	swab	r1
	ash	#-4,r1
	bic	r3,r1
	mov	r1,(r5)+
	clr	r1		;6th
	bisb	(r4)+,r1
	swab	r1
	bisb	(r4)+,r1
	clr	r2
	bisb	r1,r2
	swab	r1
	aslb	r0
	rol	r1
	bic	r3,r1
	mov	r1,(r5)+
	swab	r2		;7th
	bisb	(r4)+,r2
	clr	r0
	bisb	r2,r0
	swab	r2
	ash	#-2,r2
	bic	r3,r2
	mov	r2,(r5)+
	swab	r0		;8th
	bisb	(r4),r0
	swab	r0
	ash	#-5,r0
	bic	r3,r0
	mov	r0,(r5)
	mov	#wbuf,r5	;pt
	rts	pc
;
load12:	; load 12-bit bytes (easy for a change)
	mov	#^C7777,r3	;mask
	mov	#4,r2		;loop count
10$:	clr	r0		;get even word
	bisb	(r4)+,r0
	swab	r0
	bisb	(r4)+,r0
	clr	r1		;save high nibble
	bisb	r0,r1
	swab	r0
	bic	r3,r0
	mov	r0,(r5)+	;store
	swab	r1		;form odd word
	bisb	(r4)+,r1
	swab	r1
	ash	#-4,r1
	bic	r3,r1
	mov	r1,(r5)+	;store
	sob	r2,10$		;loop
	mov	#wbuf,r5	;pt
	rts	pc
;
load13:	; load 13-bit bytes (back to the salt mines)
	mov	#^C17777,r3	;mask
	clr	r0		;1st
	bisb	(r4)+,r0
	swab	r0
	bisb	(r4)+,r0
	clr	r1
	bisb	r0,r1
	swab	r0
	bic	r3,r0
	mov	r0,(r5)+
	swab	r1		;2nd
	bisb	(r4)+,r1
	swab	r1
	clr	r2
	bisb	(r4)+,r2
	mov	r2,r0
	ashc	#-5,r0
	bic	r3,r1
	mov	r1,(r5)+
	swab	r2		;3rd
	bisb	(r4)+,r2
	mov	r2,r1
	swab	r2
	ash	#-2,r2
	bic	r3,r2
	mov	r2,(r5)+
	clr	r2		;4th
	bisb	(r4)+,r2
	swab	r2
	bisb	(r4)+,r2
	clr	r0
	bisb	r2,r0
	swab	r2
	aslb	r1
	rol	r2
	bic	r3,r2
	mov	r2,(r5)+
	swab	r0		;5th
	bisb	(r4)+,r0
	swab	r0
	clr	r2
	bisb	(r4)+,r2
	swab	r2
	bisb	(r4)+,r2	;6th
	clr	r1
	bisb	r2,r1
	swab	r2
	asr	r2
	ror	r0
	ash	#-3,r0
	bic	r3,r0
	mov	r0,(r5)+
	bic	r3,r2
	mov	r2,(r5)+
	swab	r1		;7th
	bisb	(r4)+,r1
	swab	r1
	clr	r2
	bisb	(r4)+,r2
	mov	r2,r0
	ashc	#-6,r0
	bic	r3,r1
	mov	r1,(r5)+
	swab	r2		;8th
	bisb	(r4)+,r2
	swab	r2
	ash	#-3,r2
	bic	r3,r2
	mov	r2,(r5)
	mov	#wbuf,r5	;pt
	rts	pc
;
load14:	; load 14-bit bytes
	mov	#^C37777,r3	;mask
	clr	r0		;1st
	bisb	(r4)+,r0
	swab	r0
	bisb	(r4)+,r0
	clr	r1
	bisb	r0,r1
	swab	r0
	bic	r3,r0
	mov	r0,(r5)+
	swab	r1		;2nd
	bisb	(r4)+,r1
	swab	r1
	clr	r2
	bisb	(r4)+,r2
	mov	r2,r0
	ashc	#-6,r0
	bic	r3,r1
	mov	r1,(r5)+
	mov	r2,r1		;3rd
	swab	r1
	bisb	(r4)+,r1
	swab	r1
	clr	r2
	bisb	(r4)+,r2
	mov	r2,r0
	ashc	#-4,r0
	bic	r3,r1
	mov	r1,(r5)+
	swab	r2		;4th
	bisb	(r4)+,r2
	swab	r2
	ash	#-2,r2
	bic	r3,r2
	mov	r2,(r5)+
	clr	r0		;5th
	bisb	(r4)+,r0
	swab	r0
	bisb	(r4)+,r0
	clr	r1
	bisb	r0,r1
	swab	r0
	bic	r3,r0
	mov	r0,(r5)+
	swab	r1		;6th
	bisb	(r4)+,r1
	swab	r1
	clr	r2
	bisb	(r4)+,r2
	mov	r2,r0
	ashc	#-6,r0
	bic	r3,r1
	mov	r1,(r5)+
	mov	r2,r1		;7th
	swab	r1
	bisb	(r4)+,r1
	swab	r1
	clr	r2
	bisb	(r4)+,r2
	mov	r2,r0
	ashc	#-4,r0
	bic	r3,r1
	mov	r1,(r5)+
	swab	r2		;8th
	bisb	(r4)+,r2
	swab	r2
	ash	#-2,r2
	bic	r3,r2
	mov	r2,(r5)+
	mov	#wbuf,r5	;pt
	rts	pc
;
load15:	; load 15-bit bytes
	mov	#^C77777,r3	;mask
	clr	r1		;1st
	bisb	(r4)+,r1
	swab	r1
	bisb	(r4)+,r1
	mov	r1,r0
	swab	r1
	bic	r3,r1
	mov	r1,(r5)+
	clr	r2		;2nd
	bisb	(r4)+,r2
	swab	r2
	bisb	(r4)+,r2
	clr	r1
	bisb	r2,r1
	swab	r2
	aslb	r0
	rol	r2
	bic	r3,r2
	mov	r2,(r5)+
	swab	r1		;3rd
	bisb	(r4)+,r1
	swab	r1
	clr	r2
	bisb	(r4)+,r2
	mov	r2,r0
	ashc	#-6,r0
	bic	r3,r1
	mov	r1,(r5)+
	mov	r2,r1		;4th
	swab	r1
	bisb	(r4)+,r1
	swab	r1
	clr	r2
	bisb	(r4)+,r2
	mov	r2,r0
	ashc	#-5,r0
	bic	r3,r1
	mov	r1,(r5)+
	mov	r2,r1		;5th
	swab	r1
	bisb	(r4)+,r1
	swab	r1
	clr	r2
	bisb	(r4)+,r2
	mov	r2,r0
	ashc	#-4,r0
	bic	r3,r1
	mov	r1,(r5)+
	mov	r2,r1		;6th
	swab	r1
	bisb	(r4)+,r1
	swab	r1
	clr	r2
	bisb	(r4)+,r2
	mov	r2,r0
	ashc	#-3,r0
	bic	r3,r1
	mov	r1,(r5)+
	mov	r2,r1		;7th
	swab	r1
	bisb	(r4)+,r1
	swab	r1
	clr	r2
	bisb	(r4)+,r2
	mov	r2,r0
	ashc	#-2,r0
	bic	r3,r1
	mov	r1,(r5)+
	swab	r2		;8th
	bisb	(r4),r2
	swab	r2
	clc
	ror	r2
	mov	r2,(r5)
	mov	#wbuf,r5	;pt
	rts	pc
;
load16:	; load 16-bit bytes
	mov	r4,r5		;just copy ptr
	rts	pc
;
	.sbttl	pure data
;
defext:	.rad50	/Z  /	;input files are .Z (but may be .NNN some day)
	.rad50	/TXT/	;might as well become .TXT
	.rad50	/TMP/	;temp file, if they specify it
	.rad50	/   /	;no 3rd output file
;
tmpnam:	.rad50	/DK UNCOMPTMP/ ;default name of temporary swap file
;
config:	.byte	0,34	;.GVAL
	.word	300	;addr of CONFIG in RMON
;
; Tables below give the number of words of each word size which
; can be extracted from the given number of bytes (1 to NBITS-1)
; in the partial last record of the file.  If an entry is negative,
; it means that there were too many bytes for n words but not enough
; for n+1, and the value is the one's complement (^C) of n.
;
len:	.word	len9-1,len10-1,len11-1,len12-1 ;table of tables
	.word	len13-1,len14-1,len15-1,len16-1 ;(for each word size)
;
len9:	.byte	^C0,1,2,3,4,5,6,7 ;9.-bit wc for 1 through 8. bytes
len10:	.byte	^C0,1,2,3,4,^C4,5,6,7 ;and so on for 10.-bit words, etc.
len11:	.byte	^C0,1,2,^C2,3,4,5,^C5,6,7
len12:	.byte	^C0,1,2,^C2,3,4,^C4,5,6,^C6,7
len13:	.byte	^C0,1,^C1,2,3,^C3,4,^C4,5,6,^C6,7
len14:	.byte	^C0,1,^C1,2,^C2,3,4,^C4,5,^C5,6,^C6,7
len15:	; same as 1st 15. of LEN16
len16:	.byte	^C0,1,^C1,2,^C2,3,^C3,4,^C4,5,^C5,6,^C6,7,^C7
;
verban:	.asciz	/UNCOMP V01.00/	;version banner
help:	.ascii	"OUTPUT,SWAP=INPUT/switches"<cr><lf><lf>
	.ascii	"  OUTPUT[.TXT]  uncompressed output file"<cr><lf>
	.ascii	"  SWAP[.TMP]    temporary swap file (default=DK:UNCOMP.TMP)"
	.byte	cr,lf
	.ascii	"  INPUT[.Z]     compressed input file"<cr><lf><lf>
	.ascii	"Switches:"<cr><lf><lf>
	.ascii	"  /B    binary file (don't strip nulls or convert "
	.ascii	"<lf> to <cr><lf>)"<cr><lf>
	.ascii  "  /L:n  actual length (bytes) of input file (needless for"
	.ascii	" text files,"<cr><lf>
	.ascii	"        locates precise end of file for binary files which"
	.ascii	" end in 0's)"<cr><lf><lf>
	.ascii	/For processing files created with BSD "compress" 2.0:/
	.byte	cr,lf,lf
	.ascii	"  /N    input file has no header"<cr><lf>
	.asciz	"  /B:n  compressed with maximum of n bits (default=12.)"
badbit:	.asciz	'?Value for /B must be in [9.,16.]'
nocore:	.asciz	/?Not enough core available/
invhdr:	.asciz	/?Invalid header/
corupt:	.asciz	/?Corrupt input file/
tmpcrt:	.asciz	/?Error creating temporary file/
tmpwrt:	.asciz	/?Error writing temporary file/
tmpred:	.asciz	/?Error reading temporary file/
rderr:	.asciz	/?Read error/
wrerr:	.asciz	/?Write error/
invlen:	.asciz	/%File length invalid/
;
	.sbttl	initialized data
	.even
;
etmp:	.byte	1,2	;.ENTER, channel #1
	.word	tmpnam
tmpsiz:	.word		;max size of temp file (64KW+64KB=600 blks)
	.word	0	;better not be on tape!
;
sfwr:	.byte	1,11	;.WRITW, channel 1
sfwbk:	.word		;block #
sfwca:	.word		;core address
	.word	400*3	;3 blks
	.word	0	;implicit .WAIT
;
sfrd:	.byte	1,10	;.READW, channel 1
sfrbk:	.word		;block #
sfrca:	.word		;core address
	.word	400*3	;3 blks
	.word	0	;implicit .WAIT
;
ifrd:	.byte	3,10	;.READ, channel 3
ifrbk:	.word		;block #
ifrca:	.word		;core address
	.word	rbufl/2	;word count
	.word	1	;no .WAIT
;
ofwr:	.byte	0,11	;.WRITE, channel 0
ofwbk:	.word		;block #
ofwca:	.word		;core address
ofwwc:	.word		;word count
	.word	1	;no .WAIT
;
swterr:	.ascii	'?Bad switch: /'
swter1:	.asciz	'X'
;
	.sbttl	pure storage
	.even
;
qel:	.blkw	2*10.		;2 extra queue elements (10. words for XM)
;
bufs:	.blkw	200		;flag for each buffer
				;.LT.0 => flag is buf addr /2 (+100000)
				;.GE.0 => flag is blk # in swap file (0::575)
;
core:	.blkw			;first free core addr after dev handlers
corptr:	.blkw			;ptr to first unallocated word
cormax:	.blkw			;ptr to last available word
;
lstblk:	.blkw			;# of significant bytes in last block
				;or -1 if we don't know (stop at first
				;record containing only padding nulls)
;
inbc:	.blkw			;bc of outstanding .READ
inbuf:	.blkw			;current read buffer (other is being .READ)
inptr:	.blkw			;ptr into INBUF
inctr:	.blkw			;# unread bytes at @INPTR
;
outbuf:	.blkw			;curr write buffer (other is being .WRITtEn)
outptr:	.blkw			;ptr into OUTBUF
outctr:	.blkw			;# free bytes at @OUTPTR
;
sfeof:	.blkw			;first free blk in swap file
nbits:	.blkw			;current word size
maxmsk:	.blkw			;mask of high bits which won't be set now
				;(= 177777_nbits)
maxmax:	.blkw			;mask of high bits which won't ever be set
				;(= 177777_maxbit)
bbuf:	.blkb	16.		;buffer for next NBITS bytes
wbuf:	.blkw	8.		;buffer for next 8. words (NBITS bits)
xm:	.blkw			;NZ => this is an XM system
nohdr:	.blkb			;NZ => no header on this file (compress 2.0)
maxbit:	.blkb			;max # bits stored
sf:	.blkb			;NZ => swapfile exists already
corusr:	.blkb			;NZ => already begged for all free core
;
stack:	.blkb	4000.		;character stack
rbuf1:	.blkb	rbufl		;read buffers
rbuf2:	.blkb	rbufl
wbuf1:	.blkb	wbufl		;write buffers
wbuf2:	.blkb	wbufl
;
devhnd:	; device handlers load here
	.end	uncomp