PDP-10.its/src/sysen3/usq.61

;-*- Midas -*-    GZ@MIT-MC, March, 1983
	TITLE USQ - Unsqueeze/uncram files
F==0
T1==1
T2==2
T3==3
T4==4
A=5
B=6				;Current input byte
C=7				;Number of bits left in file.
D=10
E=11

T=12				;First unused byte in memory
IBP=13				;Input byte pointer
CS=14				;Checksum
L=15				;Last character

IntAC=16

P=17

EOF==400
DLE==220
ID1==166			;First ID byte
SQID2==377			;Second ID byte for SQ'ed files
oCRID2==367			;Second ID byte for old CRAM'ed files
CRID2=357			;Second ID byte for CRAM'ed files

inch==1
outch==inch
tyoch==2
tyich==3

call=<pushj p,>
return=<popj p,>

pdllen==60.
.vector pdl(pdllen)

Jclbuf:	block 40
	^C_35

.vector Tree(400)

IDev:	sixbit/DSK/
IFn1:	0
IFn2:	sixbit/>/
ISnm:	0

ODev:	sixbit/DSK/
OFn1:	0
OFn2:	sixbit/USQ/
OSnm:	0

define syscal op,args
	.call [setz ? sixbit/op/ ? args ((setz))]
termin

tsiot:	setz
	sixbit/SIOT/
	%Climm,,tyoch
	T2
	T1 ((setz))

define type &string
	movei T1,<.length string>
	move T2,[440700,,[ascii string]]
	.call tsiot
	  .Lose %LsSys
termin

define jerr &string
	jrst [type string
	      jrst Die]
termin

f%type==1			;This is a TYPEsq
f%com==2			;Output COM file
f%bin==4			;Output BIN file
f%asc==10			;Output Ascii file
f%tty==20			;Output to TTY
f%crm==40			;Doing a CRAM'ed file
f%rpt==100			;Do DLE-repeat stuff
f%z==200			;Allow ^Zs inside (ascii) file

Tsint:	loc 42
	-Tsintl,,Tsint
	loc Tsint
	P
	0 ? 1_tyich ? 0 ? 1_tyich ? Flush
Tsintl==.-Tsint

Flush:	movei IntAC,tyich
	.ityic IntAC,
	  jrst flush0
	caie IntAC,^G
	  cain IntAC,^S
	    jrst flush1
flush0:	syscal dismis,[p]
	  .Lose %LsSys

flush1:	.reset outch,
	syscal ttyfls,[%clbit,,1 ? %climm,,tyich]
	  .Lose %LsSys
	.iot outch,IntAC
	Jrst Die

RSIXTP:	trne F,f%type
	  return
	caie A,"/
	  cain A,",
	    aos (p)
	return

SWITCH:	cain A,"A
	  jrst [tro F,f%asc ? return]
	cain A,"B
	  jrst [tro F,f%bin ? return]
	cain A,"C
	  jrst [tro F,f%com ? return]
	cain A,"T
	  jrst [tro F,f%tty ? return]
	cain A,"Z
	  jrst [tro F,f%z ? return]
	type "AIllegal switch -- /"
	.iot tyoch,A
	jrst Die

SwiChk:	trnn F,f%bin\f%com
	   return
	trne F,f%asc\f%tty
	  jrst SwiCh1
	trne F,f%bin
	  trnn F,f%com
	     return
SwiCh1:	type "AIncompatible switches"
	jrst Die

$$RFN==1
$$SWITCH==1
.insrt dsk:syseng;rfn >

FType:	move T1,(A)
	call 6Type
	.iot tyoch,[":]
	move T1,3(A)
	call 6Type
	.iot tyoch,[";]
	move T1,1(A)
	call 6Type
	.iot tyoch,[40]
	move T1,2(A)
6Type:	setz T2,
	rotc T1,6
	addi T2,40
	.iot tyoch,T2
	jumpn T1,6Type
	return

.scalar OutPtr

.scalar Memt			;End of memory

OSize:	0			;Output file size (for CRAM'ed files)

NextTr:	Tree			;Next tree for CRAM'ed files

TrInit:	trne F,f%crm
	  jrst CRInit
	sojl C,ErrEof
	ildb E,IBP		;Number of nodes
	sojl C,ErrEof
	ildb T1,IBP
	lsh T1,8
	addb E,T1
	caile E,256.
	  jerr "ABad node count in file."
	imuli T1,4		;Account for # words taken by tree
	sub C,T1
	jumpl C,ErrEof
	imuli C,8		;Convert to bit count
	jumpe E,[movei T1,-1#EOF ? movem T1,NextTr ? return]
	setz D,
SqTree:	call sqnode
	move A,T1
	call sqnode
	hrl T1,A
	movem T1,Tree(D)
	aoj D,
	came D,E
	  jrst SqTree
cpopj:	return

sqnode:	ildb T1,IBP
	ildb T2,IBP
	lsh T2,34
	ash T2,-24
	add T1,T2
	jumpl T1,cpopj
	caml T1,E
	  jerr "ABad tree pointer."
	movei T1,Tree(T1)
	return


CRInit:	sojl C,ErrEof
	ildb E,IBP
	imuli C,8.
	setzm Tree		;Clear Tree for error checking later
	move T1,[Tree,,Tree+1]
	blt T1,Tree+377
CRTree:	call inchr		;Read the trees
	movei D,Tree(A)
	call crnode
	sojge E,CRTree
	call inchr		;Get first char
	move L,A
	move T1,Tree(L)
	movem T1,NextTr
	return

crnode:	trnn C,7
	  ildb B,IBP
	sojl C,ErrEof
	rot B,-1
	jumpge B,[call inchr	;Leaf
		  setca A,
		  hrrm A,(D)
		  return]
	caml T,Memt		;Else branch, allocate a cell for it
	  jrst [movei T1,2000
		addm T1,Memt
		.suset [.sMemt,,Memt]
		jrst .+1]
	hrrm T,(D)		;Save pointer to branch node
	move D,T
	aoj T,
	push p,D
	call crnode		;Get car
	pop p,D
	movss (D)		;Put it on the left
	jrst crnode		;And put cdr on the right

inchr:	subi C,8
	jumpl C,ErrEof
	ildb A,IBP
	movei T2,7
	and T2,C
	movn T1,T2
	rot B,(T1)
	lshc A,-8(T2)
	lsh B,-34
	exch A,B
	return


getch:	hrre A,NextTr
	jumpe A,[type "AAttempt to access an undefined tree."
		 jrst Die]
	jumpl A,getch2		;Predetermined
getch1:	trnn C,7
	 ildb B,IBP
	sojl C,ErrEof
	rot B,-1
	hrre T1,(A)
	skipl B
	  hlre T1,(A)
	move A,T1
	jumpge A,getch1
getch2:	setca A,
	trnn F,f%crm
	  return
	move T1,Tree(A)
	movem T1,NextTr
	return

ZCnt:	0

putch:	trnn F,f%bin\f%com
	  caie A,^Z
	    jrst putch1
	aos ZCnt
	return

putch1:	skipn ZCnt
	  jrst putch2
	trnn F,f%z
	  return		;Wants to ignore stuff after first ^Z
	push p,A
	movei A,^Z
	call putch2
	sose ZCnt
	  jrst .-2
	pop p,A
putch2:	trne F,f%tty\f%type
	  jrst [.iot outch,A ? return]
	came T,Memt
	  jrst putch3
	movei T1,2000
	addb T1,Memt
	movei T1,1(T1)
	.suset [.sMemt,,T1]
putch3:	idpb A,T
	return


Begin:	move p,[-pdllen,,pdl-1]
	syscal open,[%clbit,,.uao\%tjdis ? %climm,,tyoch ? [sixbit/TTY/]]
	  .Lose %LsFil
	movei F,f%rpt		;Assume do DLE stuff
	.suset [-4,,[.rHsname,,B ? .rXuname,,IFn1 ? .rMemt,,Memt
		     .rXjname,,A ]]
	movem B,ISnm
	movem B,OSnm
	ldb T1,[360600,,A]
	cain T1,'T
	  tro F,f%type
	.break 12,[..rJCL,,Jclbuf]
	skipn Jclbuf
	  jrst NoJcl
	ldb T1,[261600,,Jclbuf]
	cain T1,<ascii/?î/>_-26
	  jrst Help
IFile:	movei B,IDev
	move D,[440700,,Jclbuf]
	call RFN"rfn
	syscal open,[%clbit,,.uii ? %climm,,inch ? IDev ? IFn1 ? IFn2 ? ISnm]
	  jrst [movei A,IDev ? call FType ? type " - file not found."
		jrst Die]
;	syscal rfname,[%climm,,inch ? %clout,,IDev
;		       %clout,,IFn1 ? %clout,,IFn2 ? %clout,,ISnm]
;	  .Lose %LsFil
	syscal fillen,[%climm,,inch ? %clout,,L]
	  .Lose %LsFil
	jumpe L,ErrEof		;Flush COM header if any
	.iot inch,T1
	camn T1,[sixbit/DSK8/]
	  sosa L
	    .access inch,[0]
	jumpe L,ErrEof		;Get 1st word now to look at the ID.
	.iot inch,FBuf
	move IBP,[441000,,FBuf]
	ildb T1,IBP
	caie T1,ID1
	  jrst IDErr
	ildb T1,IBP
	cain T1,SQID2
	  jrst OFile
	tro F,f%crm
	cain T1,CRID2
	  jrst OFile
	trz F,f%rpt
	cain T1,oCRID2
	  jrst OFile
IDErr:	type "AThis file was not SQ'ed or CRAM'ed!"
	jrst Die

OFile:	move T1,IFn1
	movem T1,OFn1
	move T1,[sixbit/UNCRAM/]
	trne F,f%crm
	  movem T1,OFn2
	movei B,ODev
	cain A,",
	  call RFN"rfn
	call SwiChk
;Output defaults to home dir now.
;	move T1,[sixbit/DSK/]
;	skipn OSnm
;	  move T1,IDev
;	skipn ODev
;	  movem T1,ODev
;	move T1,ISnm
;	skipn OSnm
;	  movem T1,OSnm
Snarf:	movei T,FBuf(L)
	camg T,Memt
	  jrst Snarf1
	movei T1,1777(T)
	trz T1,1777
	movem T1,Memt
	.suset [.sMemt,,T1]
Snarf1:	move T1,[004400,,FBuf]
	movei T2,-1(L)
	syscal siot,[%climm,,inch ? T1 ? T2]
	  .Lose %LsFil
	.close inch,
Header:	move IBP,[241000,,FBuf]	;IBP=byte pointer
	movei C,-1(L)		;C=Byte count
	imuli C,4
	ildb CS,IBP		;Checksum
	ildb T2,IBP
	lsh T2,8
	add CS,T2
	trnn f,f%crm
	  jrst FName
	sojl C,ErrEof
	ildb T1,IBP		;Sector max
	sojl C,ErrEof
	ildb T2,IBP
	lsh T2,8
	add T1,T2
	aoj T1,
	imuli T1,128.
	movem T1,OSize
FName:	type "AOriginal name = "
FName1:	sojl C,ErrEof
	ildb A,IBP
	jumpe A,FName2
	.iot tyoch,A
	jrst FName1
FName2:	trne F,f%tty\f%type
	  .iot tyoch,[^M]
	call TrInit		;Set up tree(s) and bit i/o
	trne F,f%type\f%tty
	  jrst TTYIni

DSKIni:	soj T,			;Set up output pointer
	hrli T,010700
	trne F,f%bin\f%com
	  hrli T,041000
	movem T,OutPtr
	hllm T,Memt		;Make Memt into BP to last avail byte
	sos Memt
	camn T,Memt
	  jrst [move T1,2000
		addb T1,Memt
		aoj T1,
		.suset [.sMemt,,T1]
		jrst .+1]
	trne F,f%com
	  aoja T,[move T1,[sixbit/DSK8/] ? movem T1,(T) ? jrst Data]
	jrst Data

TTYIni:	syscal open,[%clbit,,.uao ? %climm,,outch ? [sixbit/TTY/]]
	  .Lose %LsFil
	syscal open,[%clbit,,.uai ? %climm,,tyich ? [sixbit /TTY/]]
	  .Lose %LsFil
	syscal ttyset,[%climm,,tyich ? [424242,,424242] ? [434242,,424242]]
	  .Lose %LsSys
	.suset [-2,,[.sOption,,[optint,,] ? .sMSK2,,[1_tyich]]]
	;jrst Data

Data:	setz E,
	trnn f,f%crm
	  jrst DataIn
DataRp:	move A,L
DataOu:	trnn f,f%crm
	  caie A,EOF
	    skipa
	jrst Finish
	sub CS,A
	call putch
	sosn OSize
	  jrst Finish
	move L,A
DataIn:	sojge E,DataRp
	call getch
	trne f,f%rpt
	 caie A,DLE
	  jrst DataOu
	call getch
	sosl E,A
	  jrst DataIn
	movei A,DLE
	jrst DataOu

Finish:	jumpg E,[type "AWarning -- file ended in the middle of a repeat."
		 jrst .+1]
	trne CS,177777
	  jrst [type "AWarning -- bad checksum in file."
		jrst .+1]
	trne F,f%tty\f%type
	  jrst Die
	move B,OutPtr
	movei C,(T)		;C= #words in use
	subi C,(B)
	trnn F,f%bin\f%com
	  jrst ASav
	hrli B,004400
	movei E,.uio
	setz T1,
BSav:	tlnn T,700000		;Round out word
	  jrst Sav
	idpb T1,T
	jrst BSav

ASav:	move T1,T
	lsh T1,-36
	idivi T1,7		;T1 has # bytes missing in last word
	imuli C,5
	sub C,T1
	hrli B,010700
	movei E,.uao

Sav:	move T1,OFn2
	came T1,[sixbit/</]
	  camn T1,[sixbit/>/]
	    jrst Sav1
	syscal open,[%clbit,,.uii ? %climm,,outch ? ODev ? OFn1 ? OFn2 ? OSnm]
	  jrst Sav1
	syscal rfname,[%climm,,outch
		     %clout,,ODev ? %clout,,OFn1 ? %clout,,OFn2 ? %clout,,OSnm]
	  .Lose %LsFil
	.close outch,
	syscal open,[%clbit,,.uai ? %climm,,tyich ? [sixbit/TTY/]]
	  .Lose %LsFil
Ask:	type "AFile "
	movei A,ODev
	call FType
	type " already exists.  "
Ask1:	type "Do you want to delete it (Y or N)?"
	.iot tyich,T1
	caie T1,"Y
	  cain T1,"y
	    jrst Yes
	caie T1,"N
	  cain T1,"n
	    jrst No
	cain T1,^L
	  jrst SClear
	.iot tyoch,[^G]
	.iot tyoch,[^M]
	.iot tyoch,[^J]
	jrst Ask1
SClear:	.iot tyoch,[^P]
	.iot tyoch,["C]
	jrst Ask

No:	.iot tyoch,["o]			;Loser
	jrst Die

Yes:	.iot tyoch,["e]
	.iot tyoch,["s]
Sav1:	syscal open,[%clbtw,,E ? %climm,,outch
		      ODev ? OFn1 ? OFn2 ? OSnm]
	  .Lose %LsFil
	syscal rfname,[%climm,,outch ? %clout,,ODev
			%clout,,OFn1 ? %clout,,OFn2 ? %clout,,OSnm]
	  .Lose %LsFil
	type "AWriting "
	movei A,ODev
	call FType
	syscal siot,[%climm,,outch ? B ? C]
	  .Lose %LsFil
	.close outch,
Die:	.break 16,120000

ErrEof:	type "APremature end of file."
	jrst Die

NoJcl:
Help:	trne F,f%type
	  jrst THelp
	type "A:USQ input file [,output file] [/A or /C or /T or /B or /Z]

/Z means ^Z's are allowed in the file.

Other switches specify the OUTPUT file format:
/A (the default) means an ascii file, /C means a COM file, /T means ascii
output to terminal, /B means a random binary file.

Output file defaults to your home directory with the same name as the input
and the file type of USQ or UNCRAM,  depending on whether the input file was
SQ'ed or CRAM'ed."
	jrst Die
THelp:	type "A:TYPESQ input file
Unsqueezes the input file and types it out."
	jrst Die

	VARIAB

junk:	CONSTA

FBuf:	0

	end begin