PDP-10.its/src/sysen1/arcsal.11

TITLE New Archive Salvager  -- MARC (8/18/76)
A=1
B=2
C=3
D=4
E=5
F=6
G=7
H=10
I=11
J=12
K=13
Q=15
R=16
P=17
ARCIN==0
ARCOUT==1
TTYO==3
TTYI==4
LPDL==100
DIRLEN=2000+6+199.

;TTYCOM HACKS

%TOERS==40000	; system symbol for erasable display
%TOSAI==4000	;  "	   "	"   sail character set
%TIDIS==4000	; display mode

;UFD INFO
;USER DIR IN TRACK NUMBERED SAME AS INDEX IN MFD (SEE QFL2)


NUDSL==200.	;# UFDS SPACE RESERVED
UFDBYT==6	;SIZE OF BYTES
UFDBPW==36./UFDBYT	;NUMBER OF BYTES PER WORD
	;RANDOM INFO

	ARCTYP==0	;-1=>NEW ARCHIVE, OTHERWISE OLD FORMAT
	UDESCP==1	;FS PNTR TO DESC AREA
	UDNAMP==2	;PNTR TO ORG OF NAME AREA
	GCTAG==3	;DATE/TIME OF LAST GARBAGE COLLECT



	UDDESC==11.	;FIRST LOC AVAIL FOR DESC

	;UFD DESCRIPTORS
	;0 => FREE  1-UDTKMX => TAKE NEXT N
	;UDTKMX+1 THRU UDWPH-1 => SKIP N-UDTKMX AND TAKE ONE
	;40 BIT SET => LOAD ADDRESS.  LOWER 5 BITS PLUS NEXT TWO CHARS (17 BITS IN ALL)

	;IF LINK DESCR
	;6 CHAR OR UNTIL ; = SYS NAME.  MUST HAVE NO CHAR = 0 IN THIS OR NEXT 2 NAMES
	;NEXT CHAR QUOTED BY : (FOR NAMES WITH : OR ;)
	;NEXT CHAR N1
	;NEXT CHAR N2
	;END BY 0

	UDTKMX==12.	;HIGHEST "TAKE N" CODE
	UDWPH==31.	;PLACE HOLDER ON WRITE (OR NULL FILE)
;	NXLBYT==2	;# ADDITIONAL BYTES FOR LOAD ADDR
			;ACTUAL PARAMETER ASSIGN MUST BE AT FRONT OF FILE

	;NAME AREA DATA

	LUNBLK==5	;WDS/NAME BLK
	UNFN1==0	;FIRST FN
	UNFN2==1	;SECOND FN
	UNRNDM==2	;ALL KINDS OF RANDOM INFO
		UNDSCP==1500,,	;PNTR TO DESC

		UNPKN==150500,,	;PACK #
		UNBOJN==150500,,	;BOJ # ON LAST WRITE

		UNLINK==1	;LINK BIT
		UNLNKB==220100,,
		UNWRIT==4	;OPEN FOR WRITING
		UNMARK==10	;GC MARK BIT
		UNCDEL==20	;DEL WHEN CLOSED
		UNPDEL==40	;DEL FROM UNMOUNTED PACK
		UNDS1==100000	;HAS BEEN HALF DELETED AND HAS 1 STRIKE
		UNHD==200000	;HAS BEEN HALF DELETED
		DELBTS==UNCDEL+UNPDEL+UNHD	;DELETED -- IGNORE
		UNIGFL==DELBTS+UNWRIT	;BITS TO IGNORE FILE
		UNWRDC==301200,,	; WORD COUNT OF LAST BLOCK MOD 2000
		UNDUMP==400000	;HAS BEEN DUMPED
	UNDATE==3	;DATE ETC.
		UNTIM==2200,,	;COMPACTED TIME OF CREATION
		UNYMD==222000,,	;Y,M,D OF CREATION
		UNMON==270400,,	;MONTH
		UNDAY==220500,,	;DAY
		UNYRB==330700,,
	UNREF==4	; REFERENCE DATE SAME AS LEFT HALF OF UNDATE


; ARCHIVE FORMAT


; FIRST BLOCK LOOKS ALMOST EXACTLY LIKE A DISK DIRECTORY EXCEPT FOR
; THE FIRST FOUR WORDS:

;	WORD 0 - ALWAYS -1 TO DISTINGUISH FROM OLD ARCHIVES
;	WORD 1 - "UDNAMP" RELATIVE POINTER WITHIN DIRECTORY TO
;		START OF FIRST NAME AREA BLOCK
;	WORD 2 - "UDESCP" BYTE NUMBER OF NEXT AVAILABLE BYTE IN
;		DESCRIPTOR AREA
;	WORD 3 - GC TAG - SYSTEM PACKED DATE/TIME OF LAST REARRANGEMENT
;		OF DIRECTORY (E.G. DELETION, INSERTION, GARBAGE COLLECTION)

; ONLY OTHER DIFFERENCE FROM STANDARD DISK DIRECTORY IS IN 5TH WORD
; OF EACH NAME BLOCK.  DISK USES LEFT HALF FOR REFERENCE DATE, DOESN'T
; USE RIGHT HALF.  ARC USES LEFT HALF FOR REFERENCE DATE, USES RIGHT HALF
; FOR COUNT OF NUMBER OF OPENS FOR READING.

; SECOND BLOCK:

;	WORD 2000 - ACCESS POINTER TO FIRST BLOCK IN FREE BLOCK CHAIN
;			(0=>CHAIN IS EMPTY)
;	WORD 2001 - NUMBER OF FREE WORDS IN ENTIRE ARCHIVE
;	WORD 2002 - NUMBER OF FREE BLOCKS IN ENTIRE ARCHIVE
;	WORD 2003 - NUMBER OF WORDS IN USE IN ENTIRE ARCHIVE
;	WORD 2004 - NUMBER OF BLOCKS IN USE IN ENTIRE ARCHIVE
;	WORD 2005 - RELATIVE POINTER (RELATIVE TO 2005) TO NEXT AVAILABLE
;			FBAT ENTRY  (0=>FBAT IS FULL)
;	WORDS 2006-<2005+200.> - THE FBAT - EACH ENTRY POINTS TO
;			THE FIRST DATA BLOCK IN A FILE.
;	WORDS <2005+200.>-EOF - DATA BLOCKS

; A DATA BLOCK:

;	HEADER - 4.9 BIT - 1=>BLOCK IS FREE
;		 4.8 BIT - 1=>LAST BLOCK IN FILE CHAIN
;		 4.9,4.8 BITS BOTH 1 => SINGLE WORD OF GARBAGE
;		 4.7 BIT - UNUSED
;		 4.6-3.6 - LENGTH-1 OF DATA AREA (NOT INCLUDING HEADER AND TRAILER)
;		 3.4-1.1 - DISK ADDRESS OF NEXT DATA BLOCK IN THE CHAIN

;	TRAILER - IDENTICAL TO HEADER EXCEPT
;		 3.4-1.1 - DISK ADDRESS OF PREVIOUS DATA BLOCK IN THE CHAIN


LOC 42
	JSR TSINT
LOC 100

START:	MOVE P,[-LPDL,,PDL]
	PUSHJ P,TTYOPN
	.BREAK	12,[5,,COMMND]
	OASCR [ASCIZ /Archive Salvager/]
	SKIPE COMMND
	JRST ARCLP1
ARCLP:	MOVE P,[-LPDL,,PDL]
	OASC [ASCIZ /*/]
	MOVEI D,ARCIN
	PUSHJ P,GETLIN
	JRST .+2
ARCLP1:	SETOM JCLHAK
	PUSHJ P,NMFLS
	MOVE E,[440700,,COMMND]
	PUSHJ P,FPARSS
	MOVEI D,ARCOUT
	PUSHJ P,FPARSS
	SKIPN DIRECT(D)
 	 JRST [MOVE A,DIRECT
	       MOVEM A,DIRECT(D)
	       JRST .+1]
	SKIPN FNAME1(D)
	 JRST [MOVE A,FNAME1
	       MOVEM A,FNAME1(D)
	       SETZ D,
	       JRST .+1]
	MOVE A,[SIXBIT /QUIT/]
	CAMN A,FNAME1(D)
	 .BREAK 16,40000
	.CALL ARCOPN
	 JRST ARCNFN
	.CALL FILLEN
	 .VALUE
	TRC D,1
	.CALL DSKOPN
	 JRST OPNFAL
	PUSHJ P,ARCSAL
	.CLOSE ARCIN,
	.CLOSE ARCOUT,
	SKIPE JCLHAK
FINIS:	.BREAK 16,40000
	JRST ARCLP


ARCNFN:	OASCR [ASCIZ /Archive not found?/]
	JRST ARCLP

BLKTBG:	OASCR [ASCIZ /Block too big?/]
	.VALUE

OPNFAL:	OASCR [ASCIZ /Output open failed?/]
	JRST ARCLP

ARCSAL:	MOVE A,[-DIRLEN,,ODIR]	;READ OLD DIRECT
	.IOT ARCIN,A
	SETZM NDIR	;ZERO OUT OLD
	MOVE A,[NDIR,,NDIR+1]
	BLT A,NDIR+DIRLEN-1
	SETOM NDIR
	AOS NDIR+UDESCP
	MOVEI A,2000
	MOVEM A,NDIR+UDNAMP
	SETOM NDIR+GCTAG
	MOVE A,[-198.,,2]	;SET UP FBAT
	HRRM A,NDIR+2004(A)
	AOBJN A,.-1
	AOS NDIR+2005
	MOVE A,[-2000,,NDIR]	;OUTPUT FIRST PART OF DIRECTORY
	.IOT ARCOUT,A	;OUTPUT DIRECT
	MOVEI A,DIRLEN
	MOVEM A,NHDPNT
	ANDI A,1777
	AOS A
	MOVEM A,NRLPNT	;RELATIVE POINTER
	MOVEI A,2000
	MOVEM A,BLKPOS
	MOVEI A,DIRLEN+1
	MOVEM A,NACPNT
	MOVEI A,4000-DIRLEN-2
	MOVEM A,NLEN
	SETZM CURLEN
 	MOVEI Q,2000-5
ARCSA1:	CAMGE Q,ODIR+UDNAMP
	JRST SALDON
	SKIPN UNFN1+ODIR(Q)
	SKIPE UNFN2+ODIR(Q)
	SKIPA
	JRST NEXFIL
	MOVE A,UNRNDM+ODIR(Q)
	TLNE A,64
	JRST NEXFIL
	LDB A,[UNDSCP+ODIR+UNRNDM(Q)]
	PUSHJ P,GDESBT
	ADDI A,ODIR
	MOVEM A,OLDDBP
	MOVE B,A
	ILDB A,B
	SKIPN A
	JRST NEXFIL	;SKIP ZERO LENGTH FILES
	MOVE R,NDIR+UDNAMP
	SUBI R,5
	MOVEM R,NDIR+UDNAMP
	HRLI A,ODIR(Q)
	HRRI A,NDIR(R)
	BLT A,NDIR+4(R)
	HLLZS NDIR+4(R)
	MOVE A,NDIR+UDESCP
	DPB A,[UNDSCP+NDIR+UNRNDM(R)]
	PUSHJ P,GDESBT
	ADDI A,NDIR
	MOVEM A,NEWDBP
	SETZM A
	ILDB B,OLDDBP
	DPB B,[140600,,A]
	ILDB B,OLDDBP
	DPB B,[060600,,A]
	ILDB B,OLDDBP
	DPB B,[000600,,A]
	TRZ A,400000
	MOVE A,ODIR+2005(A)
	MOVEM A,OACPNT	;BEGINNING OF FIRST BLOCK
	CAML A,LENGTH
	JRST ARCSA3
	MOVE A,NDIR+2005	;GET NEXT FBAT ENTRY
	MOVEM A,CURFBT
	MOVE A,NDIR+2005(A)
	MOVEM A,NDIR+2005
	MOVE A,CURFBT
	ADDI A,400000	;FOR PROPPER DESC
	LDB B,[140600,,A]
	IDPB B,NEWDBP
	AOS NDIR+UDESCP
	LDB B,[060600,,A]
	IDPB B,NEWDBP
	AOS NDIR+UDESCP
	LDB B,[000600,,A]
	IDPB B,NEWDBP
	AOS NDIR+UDESCP
ARCSA2:	ILDB A,OLDDBP
	IDPB A,NEWDBP
	AOS NDIR+UDESCP
	SKIPE A
	JRST ARCSA2
	PUSHJ P,FILCPY
NEXFIL:	SUBI Q,5
	JRST ARCSA1

ARCSA3:	PUSHJ P,FILLGP
	SETZM A
	DPB A,[UNDSCP+NDIR+UNRNDM(R)]
	JRST NEXFIL

FILLGP:	OASC [ASCIZ /î*** /]
	OSIX NDIR(R)
	MOVEI A,40
	.IOT TTYO,A
	OSIX NDIR+1(R)
	MOVEI A,40
	.IOT TTYO,A
	OASCR [ASCIZ /POINTS OUTSIDE OF ARCHIVE, FILE BEING TRUNCATED ***/]
CPOPJ:	POPJ P,

SALDON:	PUSHJ P,MAKFRE	;MAKE FREE CHAIN
	PUSHJ P,BLKFLS	;FLUSH OUT BLOCK
	.ACCESS ARCOUT,[0]
	MOVE A,[-DIRLEN,,NDIR]
	.IOT ARCOUT,A
	.CLOSE ARCOUT,
	POPJ P,

MAKFRE:	MOVE A,NLEN
	CAIN A,2000-2
	POPJ P,		;NOTHING IN BLOCK. NO FREE CHAIN NEEDED
	ADDM A,NDIR+2001
	AOS NDIR+2002	;ONE MORE FREE BLOCK
	SOS B,A
	LSH B,27
	TLO B,400000	;MAKE IT A FREE BLOCK
	MOVE A,NHDPNT
	MOVEM A,NDIR+2000
	ANDI A,1777
	MOVEM B,NDATA(A)
	MOVEM B,NDATA+1777
	AOS A,NLEN
	ADDM A,NRLPNT
	ADDM A,NACPNT
	POPJ P,

BLKFLS:	MOVE A,NRLPNT
	CAIN A,1
	POPJ P,	;NOTHING WRITTEN
	MOVE A,[-2000,,NDATA]
	.IOT ARCOUT,A
	MOVE A,NACPNT
	MOVEM A,NHDPNT
	MOVEM A,BLKPOS
	SETZM NRLPNT
	AOS NRLPNT
	AOS NACPNT
	MOVEI A,2000-2
	MOVEM A,NLEN
	SETZM CURLEN
	POPJ P,

BLKGET:	MOVE A,OACPNT
	TRZ A,1777
	.ACCESS ARCIN,A
	MOVE A,[-2000,,ODATA]
	.IOT ARCIN,A
	MOVE A,OACPNT
	MOVEM A,OHDPNT
	ANDI A,1777
	MOVEM A,ORLPNT
	MOVE A,ODATA(A)
	MOVEM A,OHEAD
	LDB B,[271200,,OHEAD]
	AOS B	;LENGTH OF BLOCK
	CAILE B,2000-2
	JRST BLKTBG	;BLOCK TOO BIG
	MOVEM B,OLEN
	AOS ORLPNT
	AOS OACPNT
	POPJ P,

FILCPY:	SETZM LHDPNT
	MOVE A,NHDPNT
	MOVE B,CURFBT
	MOVEM A,NDIR+2005(B)	;SET STARTING LOCATION
	PUSHJ P,BLKGET
FILCP1:	SKIPN A,OLEN
	JRST FILCP2
	CAMLE A,NLEN
	JRST FILCP3
	MOVE B,ORLPNT
	MOVE C,NRLPNT
	HRLI D,ODATA(B)
	HRRI D,NDATA(C)
	ADDI C,-1(A)
	BLT D,NDATA(C)
	SETZM OLEN
	ADDM A,NRLPNT
	ADDM A,ORLPNT
	ADDM A,NACPNT
	ADDM A,OACPNT
	ADDM A,CURLEN
	MOVE B,NLEN
	SUB B,A
	MOVEM B,NLEN
	CAILE B,1
	JRST FILCP1
	PUSHJ P,MAKHED
	JRST FILCP1

FILCP2:	MOVE A,OHDPNT
	ANDI A,1777
	MOVE B,ODATA(A)
	TLNE B,200000
	JRST FILCP4	;END
	LDB B,[2700,,ODATA(A)]
	SKIPN B
	JRST FILCP4	;POINTS TO 0
	CAML B,LENGTH	;FILE TOO LONG
	JRST FILCP5
	MOVEM B,OACPNT
	PUSHJ P,BLKGET
	JRST FILCP1
FILCP4:	SKIPE CURLEN
	PUSHJ P,MAKHED
	POPJ P,

FILCP5:	PUSHJ P,FILLGP	;PRINT NAME OF TRUNCATED FILE
	JRST FILCP4	;CONTINUE, SIMULATE EOF

FILCP3:	MOVE A,NLEN
	MOVE B,ORLPNT
	MOVE C,NRLPNT
	HRLI D,ODATA(B)
	HRRI D,NDATA(C)
	ADDI C,-1(A)
	BLT D,NDATA(C)
	SETZM NLEN
	ADDM A,NRLPNT
	ADDM A,ORLPNT
	ADDM A,NACPNT
	ADDM A,OACPNT
	ADDM A,CURLEN
	MOVE B,OLEN
	SUB B,A
	MOVEM B,OLEN
	PUSHJ P,MAKHED
	JRST FILCP1
	
	
MAKHED:	MOVE A,CURLEN
	ADDM A,NDIR+2003
	AOS NDIR+2004	;ONE MORE DATA BLOCK
	SOS A
	LSH A,27
	TLO A,200000
	MOVE B,NHDPNT
	ANDI B,1777
	MOVEM A,NDATA(B)
	MOVE C,LHDPNT
	DPB C,[2700,,A]
	MOVE C,NRLPNT
	MOVEM A,NDATA(C)
	MOVE B,LHEAD
	MOVE A,NHDPNT
	DPB A,[2700,,B]
	SKIPN A,LHDPNT
	JRST MAKHE1
	PUSHJ P,HEDPUT
	MOVE B,LHEAD
	LDB A,[271200,,B]
	ADDI A,2
	ADD A,LHDPNT
	PUSHJ P,HEDPUT
MAKHE1:	MOVE A,NHDPNT
	MOVEM A,LHDPNT
	MOVE A,NRLPNT
	MOVE A,NDATA(A)
	TLZ A,200000
	MOVEM A,LHEAD
	AOS NACPNT
	AOS A,NRLPNT
	CAIN A,1777
	PUSHJ P,ONEGAR
	SETZM CURLEN
	CAIN A,2000
	JRST BLKFLS
	MOVE A,NACPNT
	MOVEM A,NHDPNT
	AOS NACPNT
	AOS NRLPNT
	SOS NLEN
	SOS NLEN
	POPJ P,

ONEGAR:	HRLZI B,600000	;SINGLE QORD OF GARBAGE
	MOVEM B,NDATA+1777
	AOS A,NRLPNT
	AOS NACPNT
	POPJ P,

HEDPUT:	CAMGE A,BLKPOS
	JRST HEDPU1
	ANDI A,1777
	MOVEM B,NDATA(A)
	POPJ P,
HEDPU1:	.ACCESS ARCOUT,A
	MOVE A,[-1,,B]
	.IOT ARCOUT,A
	.ACCESS ARCOUT,BLKPOS
	POPJ P,

GDESBT:	PUSH P,B
	IDIVI A,6
	HLL A,IBTBL(B)
	ADDI A,UDDESC
	POP P,B
	POPJ P,


IBTBL:	440600,,0
BTBL:	360600,,0
	300600,,0
	220600,,0
	140600,,0
	060600,,0
	000600,,0
ODIR:	BLOCK DIRLEN
NDIR:	BLOCK DIRLEN	
ODATA:	BLOCK 2000	;ONE BLOCKS WORTH
NDATA:	BLOCK 2000	;ONE BLOCKS WORTH OF DATA
SNAM:	0
JCLHAK:	0
CURFBT:	0	;CURRENT FBAT POINTER
NLEN:	0	;NUMBER OF DATA WORDS THAT CAN BE STORED IN CURRENT BLOCK
OLEN:	0	;NUMBER OF DATA WORDS IN CURRENT BLOCK
CURLEN:	0	;NUMBER OF WORDS WRITTEN IN CURRENT BLOCK
LENGTH:	0	;LENGTH OF OLD ARCHIVE FILE
OACPNT:	0	;READ POINTER
NACPNT:	0	;NEW ACCESS POINTER
OHEAD:	0	;OLD HEADER
NHEAD:	0	;NEW HEADER
LHEAD:	0	;LAST HEADER
OHDPNT:	0	;OLD HEADER POINTER
NHDPNT:	0	;NEW HEADER POINTER
LHDPNT:	0	;LAST HEADER LOCATION
BLKPOS:	0	;ADDRESS OF BEGINNING OF BLOCK
NRLPNT:	0	;RELATIVE POINTER WITHIN CURRENT BLOCK
ORLPNT:	0	;SAME BUT FOR READING
OLDDBP:	0	;OLD DESC BYTE PNTR
NEWDBP:	0

TTYIN:	SIXBIT /   TTY/
	0
	0

TTYOUT:	SIXBIT /  !TTY/
	0
	0
PDL:	BLOCK LPDL

COMMND:	BLOCK 20
COMPTR:	0

GETLIN:	SETZM	COMMND
	MOVE	[COMMND,,COMMND+1]
	BLT	0,COMMND+17

RCMD:	MOVE	B,[440700,,COMMND]
	MOVEM	B,COMPTR
	MOVEI	C,0
RCMD1:	.IOT	TTYI,A
	CAIN	A,177
	 JRST	RUB
	CAIN	A,^D
	 JRST	RREPEA
	CAIN	A,^L
	 JRST	RCLEAR
	CAIN	A,^J
	 JRST	RCMD1
	CAIN	A,^M
	 JRST	RCMDX

RCMDL:	IDPB	A,B
	CAMGE	B,[350700,,COMMND+17]
	 AOJA	C,RCMD1

RCFUL:	IDPB	A,B
	MOVEI	A,15
	IDPB	A,B

RCMDX:	IDPB	A,B
	MOVEI	A,0
	IDPB	A,B
	POPJ	P,

RREPEA:	OASCR	[0]
	JRST	REPPER
RCLEAR:	OCTLP	"C
	JUMPGE	DIR,REPPER
REPPER:	OASCI	"*
	OASC	COMMND
	JRST	RCMD1

RUB:	PUSHJ	P,RUBBER
	 JRST	RCMD
	JRST	RCMD1

RUBBER:	SOJL	C,[POPJ P,]
	LDB	D,B	; pick up dead character
	MOVEI	A,0
	DPB	A,B	; smash it in buffer
	XCT	XCTRUB
	ADD	B,[070000,,]
	TLNE	B,400000
	ADD	B,[347777,,-1]
	AOS	(P)
	POPJ	P,

RUBECH:	CAIN	D,177
	 JRST	[OASC	[ASCIZ /^?/]
		 POPJ	P,]
	OASCI	(D)
	POPJ	P,

RUBFLS:	MOVE	TTYOPT
	TLNE	%TOSAI
	 JRST	RUBONE
	CAIN	D,177
	 JRST	RUBTWO
	CAIL	D,40
	 JRST	RUBONE
	CAIE	D,33
	CAIN	D,10
	 JRST	RUBONE
	CAIE	D,^I
	CAIN	D,^L
	 JRST	RUBONE
RUBTWO:	OCTLP	"X	; controls that echo as ^x
RUBONE:	OCTLP	"X
	POPJ	P,

; TYPEOUT UUOS

ZZZ==.
        LOC 40
        0
        JSR UUOH
        LOC ZZZ
UUOCT==0
UUOTAB:	JRST ILUUO
	IRPS X,,[ODEC OBPTR OOCT OCTLP OASCC OSIX OASC OASCI OASCR OSIXS]
	UUOCT==UUOCT+1
	X=UUOCT_33
	JRST U!X
	TERMIN

UUOMAX==.-UUOTAB

UUOH:	0
	PUSH	P,A
	PUSH	P,B
	PUSH	P,C
	MOVEI	@40			; get eff addr. of uuo
	MOVEM	UUOE'
	MOVE	@0
	MOVEM	UUOD'			; contents of eff adr
	MOVE	B,UUOE			; eff adr
	LDB	A,[270400,,40]		; get uuo ac,
	LDB	C,[330600,,40]		; op code
	CAIL	C,UUOMAX
	MOVEI	C,0	; grt=>illegal
	JRST	@UUOTAB(C)	; go to proper rout

UUORET:	POP	P,C
	POP	P,B
	POP	P,A		; restore ac's
	JRST	2,@UUOH

ILUUO:	.VALUE	[ASCIZ /:ILLEGAL UUO/]
UOBPTR:	MOVEI	C,0
	MOVE	B,@40
	JRST	UOASC1
UOASCR:	SKIPA	C,[^M]	; cr for end of type
UOASC:	MOVEI	C,0	; no cr
	HRLI	B,440700	; make ascii pointer
UOASC1:	ILDB	A,B	; get char
	JUMPE	A,.+3	; finish?
	PUSHJ	P,IOTA
	JRST	.-3	; and get another
	SKIPE	A,C	; get saved cr?
	PUSHJ	P,IOTA
	JRST	UUORET

UOASCC:	HRLI	B,440700	; make ascii pointer
UOAS1C:	ILDB	A,B	; get char
	CAIN	A,^C
	JRST	UUORET
	PUSHJ	P,IOTA
	JRST	UOAS1C	; and get another

UOCTLP:	MOVEI	A,^P
	PUSHJ	P,IOTA1

UOASCI:	MOVE	A,B	; prt ascii immediate
	PUSHJ	P,IOTA
	JRST	UUORET

UOSIX:	MOVE	B,UUOD
USXOOP:	JUMPE	B,UUORET
	LDB	A,[360600,,B]
	ADDI	A,40
	PUSHJ	P,IOTA
	LSH	B,6
	JRST	USXOOP

UOSIXS:	MOVE	A,[440600,,UUOD]
USLOOP:	ILDB	C,A
	ADDI	C,40
	PUSHJ	P,IOTC
	TLNE	A,770000
	JRST	USLOOP
	JRST	UUORET

UODEC:	SKIPA	C,[10.]	; get base for decimal
UOOCT:	MOVEI	C,8.	; octal base
	MOVE	B,UUOD	; get actual word to prt
	JRST	.+3	; join code
UODECI:	SKIPA	C,[10.]	; decimal
UOOCTI:	MOVEI	C,8.
	MOVEM	C,BASE'
	SKIPN	A
	HRREI	A,-1	; a=digit count
	PUSHJ	P,UONUM	; print numbr
	JRST	UUORET

UONUM:	IDIV	B,BASE
	HRLM	C,(P)	; save digit
	SOJE	A,UONUM1	; done if 0
	SKIPG	A		; + => more
	SKIPE	B		; - => b=0 => done
	PUSHJ	P,UONUM	; else more
UONUM1:	HLRZ	C,(P)	; retreive digits
	ADDI	C,"0	; make to ascii
	CAILE	C,"9	; is it good dig
	ADDI	C,"A-"9-1	; make hex digit
	PUSHJ	P,IOTC
	POPJ	P,	; ret

IOTC:	PUSH	P,A
	MOVE	A,C
	PUSHJ	P,IOTA
	JRST	POPAJ

IOTA:	CAIN	A,^P
	JRST	IOTAP
IOTA1:	CAIN	A,^J
	JRST	.+3
	.IOT	TTYO,A
	CAIE	A,^M
	POPJ	P,
	POPJ	P,
IOTAP:	.IOT	TTYO,["^]
	ADDI	A,100
	JRST	IOTA1

POPAJ:	POP	P,A
	POPJ	P,


;ROUTINE TO PARSE FILE NAMES (FROM SHARER)

NAME:	0
ENDSW:	0

DEVICE:	SIXBIT /DSK/
	SIXBIT /DSK/
FNAME1:	0
	0
FNAME2:	SOJ
	SOJ
DIRECT:	0
	0

NMFLS:	MOVE A,[SIXBIT /DSK/]
	MOVEM A,DEVICE
	MOVEM A,DEVICE+1
	SETZM ENDSW
	SETZM FNAME1
	SETZM FNAME1+1
	SETZM DIRECT+1
	.SUSET [.RSNAM,,DIRECT]
	MOVE A,[SIXBIT />/]
	MOVEM A,FNAME2
	MOVEM A,FNAME2+1
	POPJ P,

FPARSS:	SETZM ENDSW 
FPARSE:	SETZM NAME			;CLEAR NAME SLOT
	SKIPE ENDSW
	POPJ P,
	MOVE F,[440600,,NAME]

GETCHR: ILDB B,E			;FIND NEXT NON-EMPTY CHARACTER
	JUMPE B,CPOPJ
	CAIE B,40
	CAIN B,^I
	JRST GETCHR
	
FIELD: 	CAIE B,40			;HERE TO GET A NAME
	 CAIN B,^I
	  JRST FNAM			;SPACE AND TAB MAKE FNAME1 AND 2
	CAIE B,0
	 CAIN B,^M
	  JRST FNAM			;SO DOES 0 AND <CR>
	CAIE B,",
	 CAIN B,"_
	  JRST [SETOM ENDSW
	        JRST FNAM]
	CAIN B,":
	 JRST DEV			;DEVICE NAME
	CAIN B,";
	 JRST DIR			;SNAME
	CAIN B,^Q			;HANDLE QUOTING
	 ILDB B,E
	CAIGE B,40			;SUBI B,40 < 0 (BAD CHARACTER)
	 JRST ILLCHR
	SUBI B,40
	CAIL B,100
	 SUBI B,40			;CASE CONVERSION
	TLNE F,770000		;IGNORE MORE THAN 6 CHARACTERS
	 IDPB B,F
FPARS2:	ILDB B,E
	JRST FIELD

DEV:	MOVE A,NAME			;SAVE DEVICE
	MOVEM A,DEVICE(D)
	JRST FPARSE

DIR:	MOVE A,NAME			;SAVE SNAME
	MOVEM A,DIRECT(D)
	JRST FPARSE

FNAM:	MOVE A,NAME
	JUMPE A,FPARSE
	SKIPE FNAME1(D)			;DOES HE HAVE AN FNAME1 ALREAD?
	JRST FNAM1			;YES - OOPS. HE IS GIVING TWO NAMES
	MOVEM A,FNAME1(D)		;NO - TRY IT AS FNAME1
	JRST FPARSE

FNAM1:	MOVEM A,FNAME2(D)	;PUT NEW NAME INTO FNAME2
	JRST FPARSE

ILLCHR:	OASC [ASCIZ /Illegal character in file name /]
	OASCI (B)
	OASCR [ASCIZ / /]
	POP P,
	JRST ARCLP

ARCOPN:	SETZ
	SIXBIT /OPEN/
	MOVSI 6
	MOVEI ARCIN
	DEVICE(D)
	FNAME1(D)
	FNAME2(D)
	SETZ DIRECT(D)
	
DSKOPN:	SETZ
	SIXBIT /OPEN/
	MOVSI 7
	MOVEI ARCOUT
	DEVICE(D)
	FNAME1(D)
	FNAME2(D)
	SETZ DIRECT(D)

RCHST:	SETZ
	SIXBIT /RCHST/
	D
	MOVEM DEVICE(D)
	MOVEM FNAME1(D)
	MOVEM FNAME2(D)
	SETZM DIRECT(D)

FILLEN:	SETZ
	SIXBIT /FILLEN/
	MOVEI ARCIN
	SETZM LENGTH

TTYSET:	SETZ				;BLOCK FOR CALL TO TTYSET
	SIXBIT	/TTYSET/
	1000,,TTYI
	[222222,,222222]
	[232222,,220222]
	SETZ [0]

TSINT:	0				;HERE TO CATCH INT. CHARS
	0
	MOVEI	0,TTYI
	.ITYIC	0,
	.VALUE
	CAIN	0,"
	JRST	FINIS
	.DISMIS	TSINT+1

TTYOPN:	.CALL	[SETZ
		 SIXBIT "OPEN"
		 [TTYI]
		 [SIXBIT "TTY"]
		 [SIXBIT "DIRED"]
		 [SIXBIT "INTTY"]
		 SETZB LSTERR]
	 .VALUE	[ASCIZ /:CAN'T OPEN IN TTY/]
	.CALL	[SETZ
		 SIXBIT "OPEN"
		 [4001,,TTYO]	; display mode == %TIDIS
		 [SIXBIT "TTY"]
		 [SIXBIT "DIRED"]
		 [SIXBIT "OUTTTY"]
		 SETZB LSTERR]
	 .VALUE	[ASCIZ /:CAN'T OPEN OUT TTY/]
	.CALL	[SETZ
		 'CNSGET
		 [TTYO]
		 MOVEM ; vsize
		 MOVEM ; hsize
		 MOVEM ; tctyp
		 MOVEM ; ttycom
		 MOVEM TTYOPT'
		 SETZB LSTERR']
	 .VALUE	[ASCIZ /:CANT GET CONSOLE TYPE/]
	.SUSET	[.SIMSK2,,[20]]
	.CALL	TTYSET	    	;SET UP TTY TO TAKE CONTROL-S AND G
	.VALUE
	MOVE	A,TTYOPT
; setup rubout hackery
	MOVE	[PUSHJ P,RUBECH]
	TLNE	A,%TOERS
	 MOVE	[PUSHJ P,RUBFLS]
	MOVEM	XCTRUB'
	POPJ 	P,
	
	END START