TITLE	RIPOFF V.5 CUSP level disk management program
	SUBTTL	Assembly and loading instructions

;	Created at Southern Methodist University
;	Supported by Alpha Systems Inc, Dallas Texas
;	by Steve Bush  begun 13-Jul-71
;
;	Highly modified at the University of Arizona,
;	Tucson, Arizona  1-Nov-77



	LOGIC==0	; For REPEAT LOGIC,<comments>

REPEAT LOGIC,<

For loading , without DDT do:

	.LOAD RIPOFF
	.[N]SSAVE


For loading with DDT, gets a little more difficult. The last location
in RIPOFF's low seg (whether pure or not) is called LOWSIZ:. Only
reference to this symbol is at RIPSIZ:, which is on the first page
of code in this listing, and reads approximately

RIPSIZ:	MOVEI	T,LOWSIZ
	MOVEM	T,.JBFF
	CORE	T,

This fixes core, which RIPOFF dynamically allocates for tables after
LOWSIZ. To keep DDT and symbols from getting wiped out in the process,
simply enter DDT after loading and examine .JBFF to determine full size
of low segment and patch RIPSIZ: to correspond. That is,

	.R LINK
	*RIPOFF/LOCALS,SYS:DDT.REL/GO	; DDT must load after RIPOFF.
	.DDT
	RIPOFF$:	.JBFF/  14206
	RIPSIZ/ MOVEI T,LOWSIZ    MOVEI T,14206 <CR>
	^C
	.[N]SSAVE RIPDDT

To make patches at any time, simply make them starting at 14206 (which
you may define symbolically to DDT as PATCH:) and retype instruction at RIPSIZ
to refer to the location just beyond your patch. Note that I use 14206
only as an example. The actual number you find there will change.
>
	SUBTTL Revision history

	COMMENT `

	Revision history since version 4 1-Jan-74


[1]   15-Apr-74	Fixed SYSINI and %RP10 to know about RP03's

[2]   10-Jun-74	Added KISW and fixed PNTCOR to print pages
		on KI-10. Also changed LOCK to %LOCK so no
		confusion with UUO.

[3]   02-Jul-74	Fixed /P bug wasnt zeroing WASTEB and TFILCT.
		Added 'Error summary for DSKx' message
		in /PE code.

[4]   25-Jul-74	Corrected table %RP10 - had 400 blocks/cylinder
		for RP03's. They are 200 blocks/cylinder.

[5]   01-Jan-75	Corrected access date byte pointer (DATE75)

[6]   15-Sep-75	Added /DT function to delete files meeting access and
		creation data criteria.

[7]   16-Sep-75	Redid logic at SYSIN2 (which determined type of disk
		pack) to be more general. Also added RP04's to tables.

[10]		Redid patching logic. Added LOWSIZ: and took out use of
		external symbol PAT. See assembly instructions at the
		beginning of this listing.

[11]		Fix DSKLST code. Remove tape label and version. Add
		number of RIB ptrs and extended RIB flag. Histogram
		number of RIB ptrs. Remove logic to provide different
		format for TTY than for hard copy. One format only.

[12]		Changed a bunch of OCTPRT's to DECPRT's. All block numbers,
		cluster addresses, etc in decimal now. No more dot to
		indicate decimal numbers. Context should be clear.

[13]		Added SUSET. UUO's under assembly switch SUPSW,
		normally on.

[14]  14-Jun-76	Preparing to submit to DECUS. Removed all assembly
		switches except PURESW. Have RIPOFF determine KA/KI/KL
		rather than assembly switch. Have it determine
		if SUSET. UUO exists instead of assembly option.
		Clean up disk code and fix RP04 in tables.

	Revision history continued


[15]  15-Jul-76	Incorporate edits from suggestions from LUG users.
		Treat *.*[*,*]/D as a special case, issue warning.
		Add [10,1] to VIPS.
		Round KA core size to K not pages.
		Fix incorrect block number printout in SAT listing.
		Change default output to TTY:
		Make = work like left arrow, replace = as used in
			/EC with ==  double equal.
		Make "K for swapping" print right.

[16]  27-Oct-76	Add RP06 table.


	University of Arizona local modifications
	Start version 5 here

[17]  14-Mar-77	Add SFD support
[20]		Clean up the convoluted and poor code.
[21]		Get standard symbols from JOBDAT, UUOSYM, and MACTEN.
[22]		Add support for DPC.
[23]		Change block numbers back to octal, thus removing
		part of edit 12.
[24]		Add the /ETS, /ETL, and /ETN switch options.
[25]		Add the /F switch
[26]		Make the /V code a little more careful about
		writing the listing to the same structure
		being DSKRATed.
[27]		Add new words to RIB for 603
[30]		Print the checksum from the pointer in the /PR code
[31]		Allow a range and increment [m<n(i)] to be specified
		in the /ET command
[32]		We normally run with several of our configured disks
		off line and the RIPOFF initialization questions for
		such disks are a real pain most of the time.  Invent
		a startup option question similar to TWICE and don't
		bother the user unless LONG is selected.
[33]		Remove the /SU option since it really doesn't
		accomplish much.
[34]		Fix RDNUMR to accept two commas between halfwords
		in addition to just one (ala DDT). Also fix HALF8
		to print two commas between halfwords.
[35]		RIPOFF sometimes Ill Mem Ref's at SYSIN5 trying to
		set up STRTAB.  It wasn't allocating enough core
		for the table.
[36]		STRTAB before compression would only hold units
		in the range 0-6. Incorrect index increment was
		being used.
	Revision history continued

[37]		If MAXSTR and MAXUNI differed, LNKDON was destroying
		information outside of STRUNI.  Fix typo in BLT.
[40]		Second pass of the /V code jumped off into the
		middle of the /A code.  Jump to the correct place.
[41]		If SUSET. failed in the check for privs, the
		USETI will fail also because the code assumes that
		an error return exists.  Remove the erroneous
		error return.
[42]		The monitor won't let a user write UFD's or SFD's
		so remove the OUTPUT UUO from MAKUFD.
[43]		Add error reporting for RP04's and RP06's.
[44]		The routine BATB used by the /PB command only
		printed the last of the bad regions.  Restructure
		the routine so that it works correctly.
[45]		Unless the P option was selected with the /PF
		command, the number of RIB pointers and the
		extended RIB flag were garbage.  If /PF is specified,
		always do the pointer calculations.
[46]		The flag F.DERR in the right half of F was doubly
		defined and used for two different things. Change
		the DELFIL flag to F.DBAD.
[47]		If the user typed an invalid response in GTDATE,
		this routine would finally return to the location
		specified by the current radix.  Solution is to
		pop the radix off the stack at GTDT5.
[50]		The /ST code was typing the block number but
		calling it the cluster number.  Put out the
		cluster number instead.
[51]		The routine GETCLS was only checking for errors
		in the first SAT for each unit.  This meant that
		errors occurring in the 2nd thru Nth SATs were
		never reported by the /V code.  In the next level
		routine up, call GETCLS once for each SAT with
		an index indicating which SAT to process.
[52]		The computation of the folded checksum in BLKRED
		compares the wrong register against what it thinks
		is the checksum from the retrieval pointer. However,
		this value is incorrect also so that the routine
		seems to always compare zero with zero.  A more
		serious problem is that the routines that call
		BLKRED with F.CSUM set do not always set up P1,
		the register that is supposed to contain the
		retrieval pointer from the RIB.  Rework all the
		code involved in computing checksums and insure
		that the code is called with the proper registers
		setup.
[53]		The routine SEARCH was adding the increment to
		the starting block number immediately thereby
		skiping the starting block.  Change all callers
		of SEARCH to take this into account.
	Revision history continued

[54]		While transfering pointers to the core block,
		the routine PTRCPY would transfer information
		outside of the RIB.  This is because the code
		assumes that the last word before the retrieval
		pointers begin is RIBUFD.  Use RIBENT instead.
[55]		RIPOFF determined if a user was privledged by
		attempting a super USETI on the physical unit
		returned by the SYSPHY UUO.  However, if this
		drive was not functioning correctly for some
		reason, RIPOFF would conclude that the user
		was not privledged and blow him off.  Make the
		check for privs in a more usual manner.
[56]  17-Nov-77	Even though there was lots of code to use the
		SUSET. UUO instead on USETI/Os, RIPOFF was always
		using USETI/Os because the location %SUSET was
		getting zeroed by the BLT at ROLL.  Same was
		true of all cells initialized between RIPOFF and
		ROLL.  Move the affected locations to after the
		label ZROEND.
[57]  03-Dec-77	The RIPOFF /VF code cleared all the bits in the last
		word of each SAT that did not correspond to actual
		clusters on the disk as a byproduct of the way it
		built it's SATs.  However, the monitor hole search
		algorithm depends on these bits being set.  The
		result was that files were being written on top
		of the SAT blocks themselves and the disk would
		go right into the pits.  Make sure that the "unused"
		bits in the last word of every SAT are set before
		writing the SATs back out
[60]  07-Dec-77	Add the /W command to do word searches for specified
		patterns in a file or range of blocks.
[61]  13-Dec-77	Don't allow /VF code to be performed on a mounted
		structure.  Also, insure that the device being /VFed
		is a structure.
[62]  15-Dec-77	Add the /DA option to force RIPOFF to ask for confirmation
		of every file to be deleted.
[63]  16-Dec-77	CURPOS(U) was getting bumped even though NOIO was set
		in calls to BLKRED/BLKWRT.  This was OK unless the next
		block to be read on a unit was one plus the last block
		skipped with NOIO set, in which case a required USETI/O
		was not being done and the wrong block was being read/
		written.
[64]  16-Dec-77	Replace all HALT instructions with jumps to a catastrophic
		error routine that closes the listing file, does a reset,
		issues an error message via OUTSTR and exits.
[65]  30-Jan-78	Modify /PU switch so that it no longer prints the
		HOME block.  If you want the block, use /PV
[66]  02-Feb-78	Add the /C switch to do conversions from one disk
		value to another
	Revision history continued

[67]  25-Feb-78	Add a ^C intercept to ask the user if the listing
		file should be closed if the listing is being written
		to a file.  (No one remembered to type /X to exit)
[70]  02-Mar-79	Modify GTDATE to read the date as dd-mmm-yy instead
		of yy/mm/dd.
[71]  02-Mar-78	Make the radix change stuff (^D, ^O, etc.) in the
		command string strictly local to the next expresion.
[72]  02-Mar-78	Make the command DEV:(relsiz)/Pl print files >=
		relsiz instead of PPNs with more than relsiz blocks.
		This was more useful to us.
[73]  08-Mar-78	Add the /DM option to force the delete routines to
		use the monitor RENAME only.
[74]  08-Mar-78	Don't let the /AM switch be used on a mounted STR.
[75]  26-Apr-78	Prevent /IR from messing up creation date on restored
		files. (U. of Texas)
[75]  11-May-78 RIPOFF loops if the user types a ^Z at command level.
		Make ^Z look like ^C.  Also ignore spaces and tabs
		correctly.
[76]  19-May-78 RIPOFF doesn't know about RS04's.  Add support for
		them
[77]   8-Aug-78 Report of files found is garbage when wildcard is used with /FD switch
[TCSAPA]3-21-80 Mark in SAT the blocks pointed to by BAT. /SMW
[TCSAPC]3-25-80 Make RIPOFF know about RPD's, per request of DEC Phoenix /SMW
`
	SUBTTL	Bits and pieces

	SEARCH	JOBDAT,MACTEN,UUOSYM	; Get standard symbols
	SALL				; Clean up the listing



	RIPVER==5	; Major edit number
	RIPMIN==0	; Minor edit number
	RIPEDT==77	; Last edit number
	RIPWHO==4	; Programmer - SRB/GMU

	LOC	<.JBVER>
	VRSN.	(RIP)	;; Plug version number
	RELOC

	PURGE	RIPVER,RIPMIN,RIPEDT,RIPWHO



; Conditional assembly switches

	IFNDEF PURESW, <PURESW==-1>	; Two segment shareable program


; Set up relocation

IFN PURESW, <	TWOSEG
		RELOC	400000
		.ZZ==.JBDA		; First low segment location
	   >
IFE PURESW, <RELOC>
	SUBTTL	Accumulator and I/O channel definitions

F=0		; Flags and switches
T=1		; First of 5 temp AC's
T1=2		;
T2=3		;
T3=4		;
T4=5		;
N=6		; Numbers across I/O subroutines
N1=7		; N+1 for remainders
CH=10		; Characters
M=11		; Message pointer and temp AC
U=12		; Unit
P1=13		; First of 4 temp pointers
P2=14		;
P3=15		;
P4=16		;
SW=P3		; Switch bits live here
P=17		; Pushdown pointer


; Monitor I/O channels

CMD==0		; TTY cmd channel
LST==1		; The list  device
STR==2		; Disk channel used for all temporary disk I/O
AUX==3		; Auxillirary channel for scratch output device
FFCHAN==4	; First free channel
	SUBTTL	Flag bits

;	Bits in LH of F

.DEV==1B17	; Seen a device
.DOT==1B16	; Seen a dot
.EXT==1B15	; File extension has been typed
.LBRKT==1B14	; Left bracket seen
.COLON==1B13	; Seen a colon
.BCHR==1B12	; AC 'CH' contains break char already.
.LBS==1B11	; Pound sign (#) seen.

F.MFD==1B17	; MFD has been 'LOOKED UP' on str
F.RALL==1B16	; Read all blocks in BLDSAT
F.TMP==1B15	; Tempory flag for any use
F.SCAN==1B14	; Force NXTFIL to treat SFDs as directories
F.OURS==1B13	; Mark bits in our SAT
F.TRB==1B12	; Be on lookout for differences in above two SATS
F.MDEL==1B11	; Use the monitor RENAME only in DELFIL/DELUFD
F.RIB==1B9	; Used by RIBCHK
F.MULT==1B8	; Multiply used clusters found
F.CRLF==1B7	; No carriage returns between blocks in ASCOUT
F.1UNI==1B6	; INIT'ed STR points to only one unit

S.SFD==1B4	; All SFD levels are * in command string
S.NAM==1B3	; Ditto for filename
S.EXT==1B2	; Ditto for extension
S.PROG==1B1	; Ditto for programmer number
S.PROJ==1B0	; Ditto for project number
STNDRD==S.PROJ!S.PROG!S.NAM!S.EXT!S.SFD

; Default command string is ALL:*.*[*,*,*,*,*,*,*]

; Flags	(In RH of F)


F.TTY==1B35	; TTY output
F.TTY2==1B34	; Force TTY output for all output (user assigned TTY LPT)
F.FAIL==1B33	; Something failed
F.INI==1B32	; DSK channell is INIT'ed.
F.IO==1B31	; 1 if writing, 0 if reading
F.NULL==1B30	; Null UFD
F.TRY==1B29	; Try count for BLKRED,BLKWRT
F.CSUM==1B28	; Tell BLKRED to checksum block
F.ERRM==1B27	; About to print an error msg. No tab on output
F.TYPE==1B26	; 1=DP,0=FH, Used by DEVERR
F.DBAD==1B25	; Delete only if file is bad (/DB)
F.RIP==1B24	; Restore in progress (/I code)
F.QUICK==1B23	; Quick option in BLDSAT (/VQ)
F.NEWR==1B22	; New RIB just read by GETPTR (Extended RIB)
		; (Flag zeroed every call otherwize)
F.DERR==1B21	; For SYSINI to tell BLKRED data error expected.
		; BLKRED supresses printing of error message.
F.NOTB==1B20	; Force NAMPNT to use dot instead of tab
		; between filename and ext
F.NPP==1B19	; NXTPPN called instead of NXTDIR
F.LEN==1B18	; Force DMPIN to ignore length of the file contained
		; in the RIB and give EOF return only when the
		; RIB pointers are exhausted
	SUBTTL	Switch bit definitions


REPEAT LOGIC,<

Switches are typed to RIPOFF in the form of /AXYZ/BQRST
Where A and B are the actual switches and XYZ are the A options
and QRST are B options. E.g., to use /P (print disk listing)
and print SATS and BATS only (S and B options), one would type

	STR:/PSB

The first switch character after the / is read and saved,
and all following chars up to the next / or line delimiter
are taken as the options which apply to that switch. The
options live in AC 'SW' as follows:

	A-Z	Set bits 35-10 respectively in SW
	0-9	Sets bits 9-0 respectively.

The following macros define these bits.
Switches may be tested by TXN{E,N}  SW,CH.X
  where 'X' is the switch to be tested.

>

	SALL

	DEFINE	SWMAC	(X)
<	IRPC X,<CH.'X==1B<^D35+<"A"-"X">>>>


	SWMAC	(ABCDEFGHIJKLMNOPQRSTUVWXYZ)

	DEFINE	SWMAC(X)
<	IRPC X,< CH.'X==1B<^D9-X>>>

	SWMAC	(0123456789)
	SUBTTL	COMMOD parameter definitions
;
;	The following three pages contain BAT block, HOME block,
;	and RIB definitions from COMMOD.  BE SURE that the following
;	definitions agree with those in your version of COMMOD.
;
;
;	BAT block definitions

BAFNAM==0	; SIXBIT /BAT/
BAFFIR==1	; -Cnt free wrds,,Rel. adr. of 1st bad region
BAFNBS==2	; Contains BAYNBS,BAYNBR,BAYKND pointers
  BAYNBS: POINT  9,BUF+BAFNBS,8	  ; # Bad sectors found by map
  BAYNBR: POINT	 9,BUF+BAFNBS,17  ; # Bad regions found by map
  BAYKDC: POINT  7,BUF+BAFNBS,24  ; Kontroler device code
BAFCNT==3	; # Pairs added by MONITOR
BAFREG==4	; First bad region pair goes here
  BAPOTH==400,,0 ; Non-zero if blocks found by other Kontroler also
  BAPNTP==40000	; Non-zero if new-type entry
  BAYNBB: POINT  9,-1(P2),8	; Number of bad blocks in this region
  BAYPUB: POINT  8,-1(P2),17	; Physial unit within Kontroller
  BAYKNM: POINT  3,-1(P2),20	; Logical Kontroller number
  BAYAPN: POINT  14,-1(P2),35	; Processor number
  BAYERR: POINT	 6,(P2),8	; Error bits on new entry
  BAYELB: POINT	 27,(P2),35	; Block adr of bad region in new entry
BAFCOD==176	; Contains unlikely code (606060)
  CODBAT==606060 ; The code itself
BAFSLF==177	; This block in unit
;	HOME block definitions

HOMNAM==0	; "HOM" in SIXBIT
HOMHID==1	; SIXBIT unit id
HOMPHY==2	; Physical address of this block,,other home block
HOMSRC==3	; Position of this STR in SYS search list
HOMSNM==4	; SIXBIT structure name
HOMNXT==5	; ID of next unit in file structure
HOMPRV==6	; ID of previous unit in file structure
HOMLOG==7	; SIXBIT logical unit # within file structure
HOMLUN==10	; Logical unit in STR
HOMPPN==11	; Proj-prog # which refreshed STR
HOMHOM==12	; LH==Logical block # within unit of Home block
		; RH==Log. block # within unit for extra Home block
HOMGRP==13	; # of blocks per group to try for
HOMBSC==14	; # blocks per supercluster on this unit
HOMSCU==15	; # of superclusters per unit
HOMCNP==16	; Byte ptr for cluster count in RIBS
HOMCKP==17	; Byte ptr for checksum in RIB
HOMCLP==20	; Byte ptr for cluster address in RIB
HOMBPC==21	; # blocks per cluster for this STR
HOMK4S==22	; # K words for swapping on this unit
HOMREF==23	; Non-zero if file must be refreshed
HOMSIC==24	; # SAT blocks in core
HOMSID==25	; Unit ID of next unit in active swapping list
HOMSUN==26	; Logical unit # in active swapping list
HOMSLB==27	; First log. block # for swapping on this unit
HOMCFS==30	; Swapping class
HOMSPU==31	; # SAT blocks per unit
HOMOVR==32	; Overdrawn limit per user on this STR
HOMGAR==33	; Upper bound on total reserved blocks
HOMSAT==34		; SAT.SYS	(Log. block within STR of first RIB)
HOMHMS==35		; HOME.SYS
HOMSWP==36		; SWAP.SYS
HOMMNT==37		; MAINT.SYS
HOMBAD==40		; BADBLK.SYS
HOMCRS==41		; CRASH.SAV
HOMSNP==42		; SNAP.SAV
HOMRCV==43		; RECOV.SYS
HOMSUF==44		; SYS UFD	[1,4] UFD
HOMPUF==45		; Printer UFD	[3,3]
HOMMFD==46		; MFD		[1,1]
HOMPT1==47	; First retrieval ptr for MFD
HOMUN1==50	; Logical unit # where MFD starts
HOMLEN==51	; Table of lengths of files created by refresh - 6 words
HOMEND==56	; Last word kept in UDB copy of Home block

HOMUTP==57	; Unit type on which HOM block was written
HOMRIP==60	; Used by RIPOFF (That's not us)
HOMKLB==61	; First of 20 words used by PDP-11 in KL10 systems
HOMKLE==104	; Last of the 20 words
HOMK4C==105	; K for CRASH.EXE file
HOMBTS==106	; Bits in the HOM block
  HOMPVS==1B35	; Unit contained in a private STR
HOMVID==165	; Volume ID (3 words, 12 PDP-11 bytes)
HOMOWN==170	; Owner name (3 words, 12 PDP-11 bytes)
HOMVSY==173	; System type (3 words, 12 PDP-11 bytes)
HOMCOD==176	; Contains XWD 0 ,, 707070 (unlikely code)
  CODHOM==707070	; Unlikely code for HOMCOD
HOMSLF==177	; This block # within unit
;	RIB definitions

RIBFIR==0	; XWD  -Nr. of retrieval ptrs ,, First pointer adress
RIBPPN==1	; XWD Project ,, Programmer number
RIBNAM==2	; SIXBIT file name
RIBEXT==3	; SIXBIT file extension ,, Access date
  EXLHCD: POINT  3,BUF+RIBEXT,20	; 3 high order bits of creation date
  EXLACD: POINT  15,BUF+RIBEXT,35	; Access date
RIBPRV==4	; Priv. bits ,, mode ,, creation time ,, creation date
  EXLPRV: POINT  9,BUF+RIBPRV,8		; Protection code
  EXLMOD: POINT  4,BUF+RIBPRV,12	; Creation mode
  EXLCRT: POINT  11,BUF+RIBPRV,23	; Creation time
  EXLLCD: POINT  12,BUF+RIBPRV,35	; 12 low order bits or creation date
RIBSIZ==5	; File length in words
RIBVER==6	; Prog # making last change ,, octal version #
RIBSPL==7	; Spooled device
RIBEST==10	; Estimated length of file in blocks
RIBALC==11	; # of blocks allocated for file
RIBPOS==12	; Log block # in STR of last group
RIBFT1==13	; Reserved for future use by DEC
RIBNCA==14	; Word for customer to define
RIBMTA==15	; Tape label if file on magtape
RIBDEV==16	; Name of STR containing file
RIBSTS==17	; Status bits
  RIPLOG==1B0		; User logged in
  RIPDIR==1B18		; This is a directory
  RIPNDL==1B19		; No deletion of this file by any user!
  RIPNCN==1B20		; No name change permitted
  RIPNFS==1B21		; Not to be dumped by BACKUP
  RIPABC==1B22		; Always bad checksum (SWAP.SYS, SAT.SYS)
  RIPABU==1B24		; Always backup this file
  RIPPAL==1B25		; Pre-allocated file
  RIPSCE==1B27		; File has checksum error
  RIPHWE==1B28		; File has had hard write error
  RIPHRE==1B29		; File has had hard read error
  RIPBFA==1B32		; File found bad by BACKUP during restore
  RIPCRH==1B33		; File closed after crash
  RIPBDA==1B35		; File found bad by damage assesment program
RIBELB==20	; Log block # where bad region begins
RIBEUN==21	; Err unit # in STR ,, Nr bad blocks in region
RIBQTF==22	; FCFS quota for this PPN in this STR (UFD only)
RIBQTO==23	; Logged out quota  (UFD only)
RIBQTR==24	; Reserved quota (UFD only)
RIBUSD==25	; Nr blocks used when job was last logged out (UFD only)
RIBAUT==26	; Author - PPN writing the file
RIBNXT==27	; Next STR for this file (unused level D)
RIBPRD==30	; Previous STR for file  (unused level D)
RIBPCA==31	; Privileged arg for customer definition
RIBUFD==32	; Block # in STR of UFD data block with ptr to this RIB
RIBFLR==33	; First logical block in file pointed to by this RIB
		;  (zero if first RIB)
RIBXRA==34	; Extended rib address
  DEYRBU: POINT  4,SAVXRA(P4),12	; Unit
  DEYRBA: POINT  23,SAVXRA(P4),35	; Cluster address
  DEYRBC: POINT  8,SAVXRA(P4),8		; Count
RIBTIM==35	; Time,,Date word in universal standard
RIBLAD==36	; Last accounting date (UFD)
RIBDED==37	; Directory expiration date (UFD)
RIBACT==40	; AOBJN pointer to account string
RIBENT==RIBACT	; Last arg or value on extended lookup/enter/rename
  RIPNUB==400000 ; Bit in retrieval ptr says new unit


RIBCOD==176	; Contains 777777 (unlikely code)
  CODRIB==777777 ; Unlikely code for RIBCOD
RIBSLF==177	; This logical block number in STR
	SUBTTL	Internal device table definitions


REPEAT LOGIC,<

	The unit data blocks (UDB's) are created as RIPOFF begins
execution, one for each unit in the system. These UDB's contain all
information about the units pertinent to RIPOFF, as defined below.
They are connected by a linked list starting in UNIDDB (RH), linking
through the right half of the first word in each UDB. AC U is reserved
for the current UNIDDB address.

	To 'INIT' a structure, a call is made to NXTSTR (PUSHJ).
Here, the next (or first) structure or device is set up, in
accordance with the command string. Within NXTSTR, all physical units
involved in the current str or device are linked through the left half,
begining at UNIDDB (LH). Thus to find all units pertinint to the current
structure, transverse the LH. Transversing the right
branches finds all units in the system.  In addition to the UDB's,
the following two tables are also of interest.

	STRTAB - Contains the SIXBIT name of each structure in
the system, followed by the address of the UDB's for each unit in
the STR. Set up at system initialization (SYSINI).  Note that this
is a compressed table, i.e., the number of entries following each
SIXBIT structure name is precisely the number of units in that structure.

	STRUNI - Block of 8 words which are the addresses
(in order) of all UDB's in the present structure. Set by each
'INIT' (NXTSTR).
>
;	Each UDB setup at system initialization contains the first
;	57 words of the HOM block (HOMNAM through HOMEND) as the first
;	57 words of the UDB.  In addition, each UDB contains the
;	following words:
;
	DEFINE UUU(X,Y)
<	UNIDDL=UNIDDL+Y
	X=UNIDDL	>

	UNIDDL=HOMEND	; The first 57 words of the Home block are
			;  always in the UDB.

;***** Note: Do not change order here without changing order
;		in UNITAB  *******

UUU(UNIWPS,1)		; Words/SAT for this unit
UUU(UNICPS,1)		; Clusters/SAT for this unit
UUU(DRIVE,1)		; Physical device name pack is on (DPA3,FHA0)
UUU(DEVKON,1)		; XWD unit within controler ,, Contr. type
			;  (See TYPMAX)
UUU(BLKCYL,1)		; Blocks/cylinder on unit
UUU(BLKTRC,1)		; Blocks/track on unit
UUU(BLKUNI,1)		; Blocks on this unit


;**** End of dont change order (This is all the info printed...)


UUU(UNISTS,1)		; CONI word after last interrupt from unit
UUU(XCHAN,1)		; Z chan,T	(Inited channel in AC field, T in adr.)
UUU(CURPOS,1)		; Last block this unit positioned to.
UUU(DSKSAT,1)		; Initial pointer to core copy of disk SATs
UUU(OURSAT,1)		; Initial ptr to our version of SATs
UUU(TRBSAT,1)		; Log of difference between above two SATs
UUU(UNIDES,1)		; DSKCHR bits for unit
UUU(PATDDB,3)		; Patching space for debugging

;**** Add new words above this line


	UNIDDL==UNIDDL	; So we can see it in CREF listing
	SUBTTL	Miscellaneous parameters
;
;	General disk parameters

BLKSIZ==200		; Length of disk blocks
HEDNUM==3		; Number of words in I/O header block
LHOM1==1		; Logical address of first Home block
LHOM2==12		; Logical address of second Home block
MAXSTR==^D13		; Maximum number of file structure on this system
			;  (Used only to limit table sizes)
MAXUNI==7		; Number of highest unit on a controller
DUFD==700000		; Standard UFD protection
DPRT==155000		; Standard file protection
STRQUE==SIXBIT/DSKB/	; Structure to be assumed for queue
			;       if GETTAB fails
SFDLVL==5		; Max level for SFD nesting
PDLSIZ==50		; Size of the PDL
;
;	File status bits
;	RH bits in IOSTS(P4) are taken from the RIB
;	LH bits in IOSTS(P4) are internally used bits

IO.FAC==1B0		; File is active (LOOK'ed UP and not hit EOF)
IO.CKS==1B1		; Checksum error
IO.WRT==1B2		; 1=File being written, 0=Reading
;
;	Extended LOOKUP/ENTER parameters

EXLLEN==32		; Number of extended lookup args
EXLERC==3		; Error code found in this word of LOOKUP/ENTER block
EXLERB:	POINT	10,BUF+RIBSTS,35	; Error bits
;
;	Parameters for EOF block (on AUX device)

EOFNAM==0	; SIXBIT /EOF/
EOFCOD==176	; Contains unlikely code
  CODEOF==506070  ; The code
EOFSLF==177	; This word within file (not implemented yet!)
;
;	Some useful opdefs

	OPDEF	TTYON	[TRO F,F.TTY]	; Enable TTY output
	OPDEF	TTYOFF	[TRZ F,F.TTY]	; Disable TTY output
;
;	and general bits of crud

TOPHIS==^D50	; Highest file size to look for in histogram
MAXCMD==^D60	; Max number of ASCII command string characters
PAGSIZ==^D58	; Number of lines per printer page
BUFNUM==0	; Number of buffers for LPT and TTY (use monitor default)
DLPT=='LPT'	; These are the default device names
DLST=='LST'	;  and also help DDT printout
DDSK=='DSK'	; More meaningful codes
DSYS=='SYS'
DTTY=='TTY'
DCTY=='CTY'
UFD6=='UFD'
	SUBTTL	Storage macro definitions

IFE PURESW,<

	DEFINE	UU(A,B)
<A:	BLOCK	B	>
>

IFN PURESW,<
	DEFINE	UU(A,B)
<	A=.ZZ
.ZZ=.ZZ+B	>>


	DEFINE	U(A)
<	UU(A,1)	>


;	Macro for generating error tables

	DEFINE	ERRMAC(X,Y)
<	XWD [ASCIZ/X/] , [ASCIZ/Y/]		>



;	Some useful macro op-code definitions

	DEFINE	MOV (X,Y)	;; Move from memory to memory (uses T)
<	MOVE	T,X
	XLIST
	MOVEM	T,Y
	LIST	>

	DEFINE	MOVI (X,Y)	;; Move immediate to memory (Uses T)
<	MOVEI	T,X
	XLIST
	MOVEM	T,Y
	LIST	>

	DEFINE	MOVPTH	(X,Y)	;; Move PATH. block in memory (Uses T)
	< IFG SFDLVL,
	  < MOVE T,[X,,Y]
	    XLIST
	    BLT T,Y+.PTPPN+1+SFDLVL+1-1
	    LIST
	  >
	>
	SUBTTL	RIPOFF main routines


RIPOFF:	JFCL			; No CCL entry
	RESET			; Reset everthing
	MOVI	SWT.X,.JBREN	; Setup reentry address
	MOV	<[4,,CCEXIT]>,INTBLK+.ERNPC ; Setup ^C intercept block
	MOVI	ER.ICC,INTBLK+.ERCLS	    ; contents
	SETZM	INTBLK+.EROPC		    ; and clear rest of block
	SETZM	INTBLK+.ERCCL
	MOVI	INTBLK,.JBINT	; and setup for intercept
	MOVE	P,PDP		; Setup pushdown list
	GETPPN	T,		; Get our PPN
	 JFCL			; Avoid stupid skip
	MOVEM	T,OURPPN	; and save for later
	MOVX	T,%LDFFA	; GETTAB for GOD PPN
	GETTAB	T,		; Get it
	 MOVE	T,[1,,2]	; Assume the obvious
	CAMN	T,OURPPN	; Same as ours?
	 JRST	RIP1		; Yes, good enough
	PJOB	T,		; Get our job number
	MOVNS	T		; Negate it
	JOBSTS	T,		; Get our job's status
	 SKIPA			; Too bad
	TXNN	T,JB.UJC	; Job running with JACCT?
	 JRST	BADBOY		; No, not privledged enough

RIP1:	SETZB	F,%SUSET	; Clear flags and assume no SUSET. UUO
	MOVEI	T,.IODMP	; Open dump mode channel
	SETZB	T1,T2		; No buffers + setup for SYSSTR
	SYSSTR	T1,		; Get structure name to use
	 JRST	RIP2		; Can only hope the rest will work
	OPEN	STR,T		; Open the channel
	 JRST	RIP2		; What can we do?
	MOVE	T,[Z STR,1]	; Set to read block 1
	SUSET.	T,		; Try it
	 JRST	RIP2		; Didn't work, use USETO/I
	STATO	STR,IO.IMP!IO.BKT ; Any errors?
	 SETOM	%SUSET		; Flag SUSET. as OK

RIP2:	RESET			; Reset the world again
RIPSIZ:	MOVEI	T,LOWSIZ	; Build free core after LOWEND
				; This location must be altered
				; whenever patches are made
	MOVEM	T,.JBFF		; Tell monitor our correct field length
	CORE	T,		; Adjust core to this value
	 JFCL			; Oh well
	IMULI	T,^D1024	; Compute CORMAX from 1K blocks returned
IFN PURESW, <
	SUBI	T,400000	; Can't core up into high seg
	    >
	MOVEM	T,.JBMAX	; Highest loc available to low segment
	SETZ	T,
	MOVSI	T1,DTTY		; First get us a TTY
	MOVE	T2,[XWD WH.CMD,RH.CMD]
	OPEN	CMD,T
	 JRST	NOTTY
	SETZ	T,
	MOVSI	T2,WH.LST
	MOVSI	P1,DLST
	DEVCHR	P1,		; Look for a listing device
	 JUMPE	P1,HAVETT	; No .ASS DEV LST..Use TTY
	TXNE	P1,DV.TTY	; .ASS TTY LST?
	 JRST	HAVETT		; Yes. Use it.
	MOVSI	T1,DLST		; No. Use device 'LST'
	OPEN	LST,T
	 JRST	HAVETT		; OPEN fails? Use TTY.
	OUTBUF	LST,BUFNUM	; Got 'LST'. Set up buffers.
	SKIPA
HAVETT:	TXO	F,F.TTY2	; Use TTY as major output device.
	INBUF	CMD,BUFNUM
	OUTBUF	CMD,BUFNUM
	TXNN	P1,DV.DIR	; Is 'LST' a directory device?
	 JRST	NOENTR		; No. Skip ENTER
	SKIPA	T,[SIXBIT .RIP0.] ; Start with RIP0.LST
MAKIT:	ADDI	T,010000	; And inc to RIP1.LST , RIP2.LST etc
	CAMLE	T,[SIXBIT .RIP9.] ; Quit after 10 tries.
	  JRST	EFAIL
	MOVSI	T1,'LST'
	SETZB	T2,T3
	LOOKUP	LST,T		; File already there?
	 TRNE	T1,-1		; No. This is a good name
	  JRST	MAKIT		; Yes. Try another
	HLLZS	T1
	SETZB	T2,T3
	ENTER	LST,T		; ENTER it.
	  JRST	MAKIT		; Can't. Try another name.
NOENTR:	MOVX	T,%CNSTS	; Get configuration status word
	GETTAB	T,
	  SKIPA
	TXNN	T,ST%TDS	; Must be level D
	  JRST	BADMON
	MOVEI	M,IDRIP
	PUSHJ	P,MSGTTY	; Must also introduce ourselves
	LDB	N,VERPTR	; Get our major version #
	PUSHJ	P,OCTPRT
	HRRZ	N,.JBVER
	JUMPE	N,ROLL
	PUSHJ	P,LPAR
	HRRZ	N,.JBVER
	PUSHJ	P,OCTPRT	; 'RIPOFF V5(nnn)'  ;Version and edit
	MOVEI	CH,")"
	PUSHJ	P,W.CMD

;	Here to start the ball rolling...

ROLL:	PUSHJ	P,CRLF
	MOVE	P,PDP		; Reset the world
	SETZM	ZROBEG		; Clear out data area
	MOVE	T,[ZROBEG,,ZROBEG+1]
	BLT	T,ZROEND	; This will work whether pure or not.
	MOV	<[IOWD BLKSIZ,BUF]>,IOW ; Set up IOWD for I/O
	MOVI	^D8,RADIX	; Assumed radix is octal

	MOVSI	T,DLST		; Get LST
	DEVNAM	T,		; Get physical name
	  SETZ	T,		; No ASS DEV LST
	CAME	T,[SIXBIT/DSK/]	; Was it ASS DSK LST?
	  JRST	ROLL1		; Nope
	MOVEI	T,T1		; Point to block
	SETO	T1,		; Return first str in search list
	MOVE	T2,OURPPN	; for our PPN
	JOBSTR	T,		; Get it
	  SETZ  T1,		; What can we do?
	MOVE	T,T1		; Get device name
ROLL1:	MOVEM	T,LSTDEV	; Save list device

	MOVE	T,[XWD 3,T1]	;
	SETOM	T1		; To read default path
	PATH.	T,		; Do it
	 SKIPA	T,T1		; T unchanged if no SFD's
	SETZ	T,		;
	SETCAM	T,%FTSFD	; =-1 if SFD's, 0 otherwise
	JUMPN	T,ROLL2		; If no SFD's in monitor
	MOVX	T,%LDSFD	;
	GETTAB	T,		; Get SFDLVL from monitor
	  SETZ	T,		;
	CAIE	T,SFDLVL	; Better be equal to what wer're
	  JRST	BADCFG		; configured for

ROLL2:	MOVX	T,%CNOPR
	GETTAB	T,		; Find operators TTY name
	  MOVSI	T,DCTY		; (CTY)
	MOVEM	T,DEVOPR
	MOVSI	T,-6		; We need 6 PPN's
GETPP:	MOVE	T1,[%LDMFD
		    %LDSYS
		    %LDFFA
		    %LDHLP
		    %LDQUE
		    %LDCRP](T) ; Pointers to necessary PPN's
	GETTAB	T1,		; Ask monitor
	 MOVE	T1,[1,,1
		    1,,4
		    1,,2
		    2,,5
		    3,,3
		   10,,1](T)
	MOVEM	T1,VIPS(T)	; and remember it.
	AOBJN	T,GETPP		; Go for next PPN.

	MOVX	T,%LDSTP
	GETTAB	T,		; Standard protection
	  MOVSI	T,DPRT		;	(155)
	MOVEM	T,STNPRT
	MOVX	T,%LDUFP
	GETTAB	T,		; Standard UFD protection
	  MOVSI	T,DUFD		;	(700)
	MOVEM	T,UFDPRT
	MOVX	T,%LDQUS
	GETTAB	T,		; STR for QUEPPN queueing
	 MOVX	T,STRQUE	; Assume something
	MOVEM	T,QUESTR
	SETOM	WMASK		; Start out with /W mask = -1

	SETZ	T1,		; Figure out what machine we have..
	MOVNI	T,1
	AOBJN	T,.+1
	JUMPN	T,XKA
	BLT	T,0
	JUMPE	T,XKI
XKL:	AOS	T1
XKI:	AOS	T1
XKA:	MOVEM	T1,CPUXX	; 0=KA,1=KI,2=KL.
	MOVX	T,%CNPGS
	GETTAB	T,		; Get unit of core allocation
	 MOVE	T,[.SUAKA
		   .SUAKI
		   .SUAKL] (T1)
	MOVEM	T,COREXX
	PUSHJ	P,STRTUP	; Get startup option from user
	PUSHJ	P,SYSINI	; Now we go initialize the world of disks
	SUBTTL	Command scanner and dispatcher

SCAN:	SETZM	CMDBEG		; Zero everything
	MOVE	T,[CMDBEG,,CMDBEG+1]
	BLT	T,ZROEND
	MOVE	P,PDP		; Make sure PDL is clean
	MOVI	SFDLVL,CMDLVL	; Assume full path
	ANDI	F,F.TTY2	; Start with no flags (except F.TTY2 if set)
	TXO	F,STNDRD	;  and defaults bits (all stars)
	TTYON			;  and turn on TTY I/O
	SETZ	SW,		; No switch options seen yet
	SKPINL			; Defeat ^O
	 JFCL
	PUSHJ	P,CRLF
	MOVEI	CH,"*"
	PUSHJ	P,W.CMD		; and start with the standard star
	OUTPUT	CMD,
	PUSHJ	P,GETCMD	; Get the command
PARSE:	PUSHJ	P,RDATOM	; Get a name from CMD string
	TXZA	F,.BCHR		; No break char read now
PARSE2:	TXO	F,.BCHR		; Enter here if 'CH' has break char
	MOVSI	T,-DISLEN	; Length of dispatch table
	HLRZ	T1,DISPTB(T)	; Search through table
	CAME	T1,CH		;  for a match to the term char
	AOBJN	T,.-2
	HRRZ	T,DISPTB(T)	; Match found (or table exausted)
	JRST	(T)		; Dispatch on it

DISPTB:	XWD	Z	,SWIT
	XWD	<":">	,FILDEV
	XWD	<".">	,FILDOT
	XWD	<"[">	,FILPPN
	XWD	<"/">	,SWIT
	XWD	<"_">	,EQL
	XWD	<"<">	,TWOARG
	XWD	<">">	,TWOARG
	XWD	<"=">	,EQL
	XWD	<"(">	,FILREL
	XWD	<"!">	,RUNUUO
DISLEN== .-DISPTB
	JRST	CMDERR		; Falls through to here if illegal break char.
; Here when word ends in colon.


FILDEV:	TXNN	F,.DOT		; Dot already seen?
	 TXOE	F,.COLON 	; No. How abot colon?
	  JRST	CMDERR		; Yes. Illegal
	MOVEM	M,USRSTR	; No. Must be a device name
	JRST	PARSE

; Here on left arror or equal sign (equivalent).
; Single equal is an output device, double is assignment for /E cmds.

EQL:	MOVE	T,CMDB		; Get CMD string pointer
	ILDB	CH,T		; Look ahead to next char
	CAIE	CH,"="		; Double equal (_= would work too...)
	 JRST	FILDST		; No. Single. Output file preceeded.
	MOVEM	T,CMDB		; Yes. Skip past character
	JRST	NEWARG		;  and get /EC args.

FILDST:	PUSHJ	P,WHAT
	MOV	USRSTR,AUXDEV	; Transfer stuff to output side..
	MOV	USRNAM,AUXNAM
	MOV	USREXT,AUXEXT
	MOVI	AUXPTH,AUXPPN	; Setup pointer to block
	MOVPTH	USRPTH,AUXPTH
	MOV	BARG3,AUXTRY
	SETZM	USRSTR
	SETZM	PTHFLG		; Used only for input path
	ANDI	F,F.TTY2
	TXO	F,STNDRD
	JRST	PARSE


; Here when name ends in a dot, must be a file.

FILDOT:	TXOE	F,.DOT		; Dot already seen?
	 JRST	CMDERR		; Yes. Can't have two
	MOVEM	M,USRNAM	; Must be a file name
	JRST	PARSE
; Here when name ends in "[", find out what preceeds, and continue
; To read a project ,, programmer number (and maybe a path).

FILPPN:	PUSHJ	P,WHAT		; Put last word where it belongs ( file or ext)
	TXO	F,.LBRKT	; Remember the left bracket
	TXZ	F,S.SFD		; Clear all SFD's flag
	SETZM	CMDLVL		; Assume no SFD's typed in path
	PUSH	P,RADIX		; Save input radix
	MOVI	^D8,RADIX	; Make it octal for now
	PUSHJ	P,RDNUMR	; Get an octal proj,prog number
	POP	P,RADIX		; Restore radix
	TLNN	M,400000	; RDNUMR see a star?
	 TXZ	F,S.PROJ	; No. No star
	TRNN	M,400000	; Same question?
	 TXZ	F,S.PROG	; Same answer
	MOVEM	M,USRPTH+.PTPPN	; Save PPN in block
	CAIN	CH,","		; Start of SFD spec?
	 SKIPN	%FTSFD		;  and monitor has SFD's?
	  SKIPA			; Nope to one of the above
	   PUSHJ P,FILPTH	; Yep
	CAIN	CH,"]"
	ILDB	CH,CMDB		; Allow optional closing bracket
	JRST	PARSE2		; Done. Now get next cmd string arg


; Here to process an SFD spec.  Store the PPN at USRPTH+.PTPPN
; and the SFD names starting at USRPTH+.PTPPN+1.  Insure no more
; than SFDLVL SFD's.  Block is initially zero, so we
; don't have to worry about the terminator.

FILPTH:	SETOM	PTHFLG		; Set have path flag
	MOVSI	T1,-SFDLVL	; Build AOBJN word to insure no
	HRRI	T1,1		; more than SFDLVL names
FLPTH1:	PUSHJ	P,RDWORD	; Get next atom from cmd string
	SKIPN	M		; Gotta be non-null
	 PJRST	[POP	P,(P)	; fixup stack
		 JRST	CMDERR ]; and tell user
	MOVEM	M,USRPTH+.PTPPN(T1)  ; Store in correct word in block
	XOR	M,['*     ']	; Was it a star?
	SKIPE	M		; Yep, skip
	 SETOM	M		; Nope, set M to -1 for next instr
	SETCAM	M,SFDFLG(T1)	; =0 if no star, -1 if star
	AOS	CMDLVL		; Bump path level by one
	CAIN	CH,","		; More to come?
	AOBJN	T1,FLPTH1	; Loop if we don't have too many
	POPJ	P,		; and go finish up
; Here to establish what preceeding argument was when it doesn't
; end in anything which gives automatic clue. (i.e., a colon tells
; us a dev probably predeeded, a dot says a file name, but a "[" or
; a "/" or line delimiter says nothing..

WHAT:	TXNE	F,.LBRKT!.BCHR	; Seen a "["
	 POPJ	P,		; Yes. To late to be a file name or ext.
	CAIE	P4,$CMBLK	; Block argument?
	 JRST	WHAT1		; No.
	MOVEM	M,BARG1		; Yes. Remember it
	SETOM	GOTWRD		; Also set flag for /ET
	MOVEI	T,1
	TXZE	F,.LBS		; Pound sign?
	 ORM	T,BARGFL	; Yes. Set BARG flag
	POPJ	P,
WHAT1:	TXNE	F,.DOT		; Seen a dot?
	 JRST	FDOT		; Yes.
	MOVEM	M,USRNAM	; No. Must be a file name
	POPJ	P,

FDOT:	MOVEM	M,USREXT	; Dot already seen, must be an extension here
	TXO	F,.EXT		; Remember it
	POPJ	P,


; Here when "(" recieved, input a relative block size

FILREL:	PUSHJ	P,WHAT		; Identify previous arg
	PUSHJ	P,RDATOM	; Read a number now
	CAIE	P4,$CMBLK	; Must be numeric
	 JRST	CMDERR
	MOVEM	M,BARG3		; Save it for relative file size
	CAIN	CH,")"
	 ILDB	CH,CMDB		; Allow closing paren
	JRST	PARSE2
; Here if "<" typed, input two block args

TWOARG:	CAIE	P4,$CMBLK	; Better be a block arg
	  JRST	CMDERR
	MOVEM	M,BARG1
	SETOM	GOTWRD		; Set flag for /ET
	MOVEI	T,1
	TXZE	F,.LBS
	 ORM	T,BARGFL
	PUSHJ	P,RDATOM	; Read next arg
	CAIE	P4,$CMBLK
	  JRST	CMDERR
	MOVEM	M,BARG2
	MOVEI	T,2
	TXZE	F,.LBS
	 ORM	T,BARGFL
	JRST	PARSE2



; Here on "==", /E edit args

NEWARG:	CAIE	P4,$CMBLK	; First is a number and should look like block arg
	  JRST	CMDERR
	MOVEM	M,BARG1
	PUSHJ	P,RDATOM	; Next can be any type of legal atom
	MOVEM	M,BARG2
	JRST	PARSE2


; Here when file name ended with "!" , do a RUN UUO to another program

RUNUUO:	PUSHJ	P,WHAT
	PUSHJ	P,KILL		; Fin all listing files
	SKIPN	T,USRSTR
	  MOVSI	T,DSYS		; Defaults to sys
	SKIPN	T1,USRNAM
	  JRST	CMDERR		; Must have a name!
	HLLZ	T2,USREXT
	MOVE	T4,USRPTH+.PTPPN
RUNCOM:	SETZB	T3,T4+1
	MOVEI	T
	RUN			; and run it
	HALT	RIPOFF		; Should never return here
; Here to take care of our many varieties of switches

SWIT:	PUSHJ	P,WHAT		; Establish file or extension
	MOVSI	T,'*  '
	CAME	T,USRNAM	; Is the file name a star?
	 SKIPN	USRNAM		; Or no name at all?
	  SKIPA			; Yes. Leave star bit set.
	TXZ	F,S.NAM		; No. Zero star bit
	TXNE	F,.DOT		; If no dot, cant have * ext.
	 CAMN	T,USREXT	; If dot, ext must be typed '*'
	  SKIPA			; If he typed a star, leave star bit
	TXZ	F,S.EXT		; He typed a dot and didnt follow star
	TXZ	F,<.COLON!.DEV!.DOT!.EXT!.LBRKT!.LBS!F.TTY>
	SKIPN	T,USRSTR	; If he typed a str, better check it.
	 JRST	SWT1
	PUSHJ	P,DEVTYP	; See if its AOK
	JUMPL	T1,NOSTR	; Not a str. Cmd error..
	MOVEM	T1,TTYTYP	; Remember the type he typed
	MOVEM	U,TTYDDB	;  and unit 0 address
SWT1:	MOVSI	T,'UFD'		; Zero above bits (no longer needed)
	CAME	T,USREXT	; Is extension a 'UFD'?
	 JRST	SWT4		; No.
	MOVE	T,MFDPPN	; Yes. Then make 1,1 the
	SKIPN	USRPTH+.PTPPN	;  PPN by default
	 MOVEM	T,USRPTH+.PTPPN
	TXZ	F,S.PROJ!S.PROG	;  and forget we ever saw a PPN
SWT4:	MOVI	USRPTH,USRPPN	; Setup pointer to path block
	TXOE	F,S.SFD		; If flag is zero, a path
	  JRST	SWT3		; was typed.  Loop through
	MOVEI	T,SFDLVL	; all levels to determine if
SWT2:	SKIPN	SFDFLG(T)	; they are all stars.  If so,
	  TXZA	F,S.SFD		; re-set the flag
	SOJG	T,SWT2
SWT3:	MOV	USRNAM,TTYNAM	; Set up TTYNAM,EXT,PPN
	MOV	USREXT,TTYEXT	;  so routines can retrieve
	MOV	USRPPN,TTYPPN	;  incase they destroy names.
	MOVPTH	USRPTH,TTYPTH
	JRST	RIPDON		; Don't try to restore core
;
;
; Return here when all done with a switch processing routine.
; 	RIPDN1	to restore the contents of .JBFF from .SVFF
;	RIPDON	in the normal case

RIPDN1:	PUSHJ	P,ZCORE		; Restore .JBFF from .SVFF
RIPDON:	OUTPUT	CMD,		; Flush the TTY buffer
	TXNN	F,F.TTY2	; Writing a listing file too?
	 OUTPUT	LST,		; Yes, flush that too
	PUSHJ	P,RLSDSK	; Release all channels
	SETOM	STRFLG		; Initialize for NXTSTR
	HRRZS	UNIDDB		; Kill links for current STR
; Here to read next switch char in CMD string and set options bits
;  in AC "SW". NXTSWT may be called at any time


NXTSWT:	AND	F,[STNDRD!F.TTY2] ; Zero all but inportant bits
	MOV	TTYNAM,USRNAM	; Make names right so
	MOV	TTYEXT,USREXT	;  anybody that screws them
	MOV	TTYPPN,USRPPN	;  wont hurt next routine.
	MOVPTH	TTYPTH,USRPTH
	SETZB	SW,P1		; Start with no options or switches
	JSP	M,CHRGET	; Get first switch char
	MOVE	P1,CH		;  and save it in P1
NXTSW0:	JSP	M,CHRGET	; Now read options
	CAIN	CH,"/"
	 JRST	SWITGO		; Done for now..
	CAIL	CH,"0"
	 CAILE	CH,"9"
	  JRST	NXTSW1
	SUBI	CH,"0"-^D26	; Char is numeric, goes in bits 26-35

NXTSW2:	MOVEI	T,1
	LSH	T,(CH)		; Make T=Bit for this switch
	ORM	T,SW		;  and add it to the list
	JRST	NXTSW0

NXTSW1:	CAIL	CH,"A"		; If not numeric, must be alphabetic
	 CAILE	CH,"Z"
	  JRST	BADSW		; Not either, hes a dummie
	SUBI	CH,"A"		; For alpha chars, A=Bit 35, B=34, etc
	JRST	NXTSW2

CHRGET:	ILDB	CH,CMDB		; Read a char
	JUMPE	CH,SWITGO
	CAIE	CH,.CHTAB	; Ignore tabs/spaces
	 CAIN	CH," "
	  JRST	CHRGET
	CAIE	CH,";"		; Ready for a comment?
	 JRST	(M)		; No. Return
	ILDB	CH,CMDB		; Yes. Ignore rest of CMD string
	JUMPN	CH,.-1
; Here to finally go dispatch to switch routines

SWITGO:	JUMPE	P1,SCAN		; No switches typed, ignore CMD
	CAIL	P1,"A"
	 CAILE	P1,"Z"
	  JRST	BADSW		; Switches may be alphabetic only
	SUBI	P1,"A"
	JUMPE	SW,SWITG1	; If no option, must be OK!
	HRRZ	T,SWTAB(P1)	; Address of legal options
	JUMPE	T,ERR001	; Unless zero
	MOVE	T1,SW		; T1=switches he gave us
	ANDCM	T1,(T)		; Turn off all legal switches
	JUMPE	T1,SWITG1	; Should leave us with nothing
	JRST	ERR001		; Bad option
SWITG1:	HLRZ	T,SWTAB(P1)	; Address of routine
	JRST	(T)		; Go!

; Table of switches and their legal options
; Format is:
;
;		XWD  Addr of routine,,Addr of legal switch bits
;

SWTAB:	SWT.A ,, [CH.X!CH.T!CH.M!CH.F!CH.E]
	BADSW ,,
	SWT.C ,, [CH.U!CH.T!CH.P!CH.D!CH.C!CH.B]
	SWT.D ,, [CH.A!CH.U!CH.T!CH.R!CH.N!CH.M!CH.B]
	SWT.E ,, [CH.7!CH.6!CH.W!CH.U!CH.T!CH.S!CH.R!CH.N!CH.L!CH.C!CH.A]
	SWT.F ,, [CH.2!CH.D!CH.E]
	BADSW ,,
	SWT.H ,, [-1]
	SWT.I ,, [CH.2!CH.X!CH.T!CH.S!CH.R!CH.P!CH.O!CH.F!CH.E!CH.D!CH.A]
	BADSW ,,
	BADSW ,,
	SWT.L ,, [CH.U]
	BADSW ,,
	BADSW ,,
	BADSW ,, 0
	SWT.P ,, [CH.6!CH.7!CH.V!CH.U!CH.S!CH.R!CH.Q!CH.P!CH.O!CH.L!CH.F!CH.E!CH.D!CH.B!CH.A]
	BADSW ,,
	SWT.R ,, 0
	SWT.S ,, [CH.W!CH.T!CH.R!CH.P!CH.M!CH.L!CH.F!CH.B]
	BADSW ,,
	SWT.U ,, 0
	SWT.V ,, [CH.Q!CH.F!CH.A]
	SWT.W ,, [CH.M!CH.S!CH.T!CH.W]
	SWT.X ,, [CH.Q]
	BADSW ,,
	BADSW ,,
	SUBTTL	Switch processing routines


REPEAT LOGIC,<

Switches are-

/A - 	Alphabatize UFD's (sort them by PPN if MFD, or files)
/C -	Convert disk parameters
/D -	Delete
/E -	Edit disk blocks
/F -	Find files
/H -	Help
/I -	Initialize UFD or files from RIBs only
/L -	Lock in core
/P -	Print according to format
/R -	Read verify blocks
/S -	Play with SATs, STRUUO's
/U -	Make a UFD/SFD
/V -	Verify files and fix SATs
/W -	Do word searches on disk
/X -	Close listing and exit

>
	SUBTTL	 /A -- Alphabatize UFD's/SFD's...

REPEAT LOGIC,<

/A Options include:

/AF -	Sort by file names and extensions (standard)
/AE -	Sort by extensions and names
/AT -	Sort by creation time and date (oldest first)
/AM -	Sort the MFD only (/AF,/AE,/AT will not sort MFD)
 X  -	X option OR'ed with above suppresses printout


>



SWT.A:	PUSHJ	P,NONAME	; Command is *[P,PN]/A
	 JRST	ERR002
	MOVSI	T,(CAMN T,0)	; On all sorts, we avoid the MFD
	TXNE	SW,CH.M		;  except on M option, in which case
	 MOVSI	T,(CAME T,0)	;  we avoid everything but the MFD
	HRRI	T,MFDPPN	; Make an instruction word
	MOVEM	T,ATEST		; XCT ATEST to decide whether to sort this guy.

	MOVEI	T,0		; Assume F option
	TXNE	SW,CH.E
	 MOVEI	T,1
	TXNE	SW,CH.T
	 MOVEI	T,2
	MOVEM	T,LHEAD+1	; This is key for sort.
	MOVEI	T,2
	TXNE	SW,CH.T
	 MOVEI	T,3		; 2 word entries for all but /AT
	MOVEM	T,LHEAD		;  which has 3. Store in LHEAD.
	TXNE	SW,CH.X		; Supress messages?
	 JRST	SWT.A0		; Yes. Supress them.
	MOVEI	M,[ASCIZ/
Directories sorted:
/]
	PUSHJ	P,MSGTTY	; Give him a heading
SWT.A0:	MOV	.JBFF,.SVFF	; Save core limits now
SWT.A1:	PUSHJ	P,NXTSTR	; Get next structure
	 JRST	RIPDN1		; No more, restore core and return
	 JRST	PNOMFD		; Tell of no MFD and quit
	TXNN	SW,CH.M		; /AM specified for this STR?
	 JRST	SWT.A2		; No
	PUSHJ	P,STRMNT	; This STR mounted?
	 JRST	ERR016		; Yes, can't do this
SWT.A2:	PUSHJ	P,NXTDIR	; Get next directory
	 JRST	SWT.A1		; None left, try next STR
	MOVE	T,USRPTH+.PTPPN	; Get PPN of candidate
	XCT	ATEST		; Shall we sort him?
	 JRST	SWT.A2		; No
	TXO	F,F.NULL	; Assume directory is null
SWT.A3:	PUSHJ	P,NXTFIL	; Get next file.
	 JRST	SWT.A5		; EOF, go sort directory
	TXZ	F,F.NULL	; No longer null
	TXNN	SW,CH.T		; Need to find creation time?
	 JRST	SWT.A4		; No. Good.
	PUSHJ	P,USRLOK	; Yes. Look up file
	 SKIPA	T3,ZERO		; Oh well, use zero
	PUSHJ	P,FILDAT	; Get date,,time in T3
	MOVE	P1,T3		;  and save time in P1
SWT.A4:	MOVE	T,LHEAD
	PUSHJ	P,CORGRB	; Get some core
	MOVE	T1,USRNAM
	MOVEM	T1,(T)		; Store name
	HLLZ	T1,USREXT	; Second word is EXT,,
	HRR	T1,USRCFP	;  CPF
	MOVEM	T1,1(T)
	TXNE	SW,CH.T		; Sort by time?
	 MOVEM	P1,2(T)		; Yes. Store time word too.
	JRST	SWT.A3		;  and repeat for all files
; Here when all files for the current level are in core.
;
SWT.A5:	TXNE	F,F.NULL	; Null directory?
	 JRST	SWT.A7		; Yes, sort is done
	MOVE	T,.SVFF		; Get address of 1st word to sort
	MOVE	T1,LHEAD+1	; Key for sort.
	MOVE	N,.JBFF		; Add of last word +1
	MOVEM	N,SORTOP	; Remember this for later
	SUBI	N,(T)		; # of words to sort
	MOVE	CH,LHEAD	; Length of entries
	IDIVI	N,(CH)		; N=# of entries
	PUSHJ	P,SORT		; Go sort it all


; Here when UFD sorted. Now get ready to write it back out.

	MOVE	P4,CURLVL	; Get current level
	MOVE	P4,CORBLK(P4)	; Point to correct core block
	MOVE	T,FNAME(P4)	; Get filename
	MOVE	T1,FEXT(P4)	;  and extension
	MOVE	T2,FCFP(P4)	; Get CFP
	MOVEI	T3,FPATH(P4)	; Point to path
	PUSHJ	P,ENTR		; Do an enter on his UFD/SFD
	  JRST	SWT.A9		; Shouldn't fail
; Here when the directory is sorted to write it back out
;
	MOVE	T,.SVFF		; Get address of first word
SWT.A6:	MOVE	CH,0(T)		; Get a word from new UFD
	PUSHJ	P,W.UFD		;  and write it back over old one
	 JRST	SWT.A9
	MOVE	CH,1(T)
	PUSHJ	P,W.UFD
	 JRST	SWT.A9
	ADD	T,LHEAD
	CAMGE	T,SORTOP	; Done?
	 JRST	SWT.A6		; No. Keep writing
	PUSHJ	P,C.UFD		; Done. Now close the file.
	MOV	.SVFF,.JBFF	; Restore core
SWT.A7:	TXNE	SW,CH.X
	 JRST	SWT.A2
	TTYON
	PUSHJ	P,CRLF
SWT.A8:	PUSHJ	P,UFDPNT	; Print success story
	JRST	SWT.A2		; and return


SWT.A9:	MOVEI	M,[ASCIZ/
Failure on sort of /]
	PUSHJ	P,MSGTTY
	JRST	SWT.A8


U(ATEST)	; CAMX T,MFDPPN
U(SORTOP)	; Top of core to sort
	SUBTTL	 /C -- Convert disk parameters
;
; Accept a block, cluster, CFP, or cylinder, surface, and sector
; and convert them to other pertinent values.  Options include:
;
;  /CB - Convert block number in structure
;  /CC - Convert cluster number in structure
;  /CD - Convert CFP
;  /CP - Convert cylinder, surface, and sector
;  /CT - Convert universal date/time (Not exactly a disk parameter
;	 but a useful conversion anyway)
;  /CU - Convert block number in unit


SWT.C:	TTYON			; All output goes to the TTY
	MOVE	T,TTYTYP	; Get device type specified
	CAIE	T,$DVSTR	; Must be a STR
	 TXNE	SW,CH.P!CH.U!CH.T ;  unless /CP or /CU or /CT specified
	  SKIPA			; All ok
	   JRST	ERR017		; Bad device
	PUSHJ	P,NXTSTR	; Setup for this structure
	 JRST	RIPDON		; Nothing there?
	  JFCL			; No MFD is OK
;
;  Here to process the /CC option.  Convert the cluster number to, and
;  print the corresponding block range and CFP in the structure, and
;  the unit number, block range, and physical position on the unit.
;
	TXNN	SW,CH.C		; /CC option specified
	 JRST	SWT.C1		; No
	MOVEI	M,[ASCIZ/Cluster /]
	PUSHJ	P,PREFIX	; Print prefix and cluster number
	PUSHJ	P,STRPFX	; Print structure line prefix
	MOVE	P1,BARG1	; Get the cluster number
	IMUL	P1,STRBPC	; Convert to block number
	MOVE	N,P1
	PUSHJ	P,CLSBLK	; Print range of blocks
	MOVE	N,P1		; Get block number back
	PUSHJ	P,CFPPFX	; Print CFP
	MOVE	P2,P1		; Don't destroy P1
	IDIV	P2,STRBPU	; Convert to unit, block on unit
	MOVE	N,P2		; Get unit number
	PUSHJ	P,UNIPFX	; Print unit
	MOVE	N,P3		; Get block on unit
	PUSHJ	P,CLSBLK	; Print range on unit
	PUSHJ	P,CRLF		; End the line
	PUSHJ	P,TAB2		; Followed by 2 tabs
	MOVE	T2,P3		; Get block on unit
	PUSHJ	P,PBNPRT	; Print disk address of first block
	MOVEI	M,[ASCIZ/ through
		/]
	PUSHJ	P,MSGTTY	; Put out separator
	MOVE	T2,P3		; Get first block back
	ADD	T2,STRBPC	; Compute last block+1
	SUBI	T2,1		; Compute last block
	PUSHJ	P,PBNPRT	; Print physical address of last block
	JRST	SWT.C5		; Go finish up
;
;  Here to process the /CB switch.  Convert the block number to the
;  cluster, relative block, and CFP in the structure, and the block,
;  and cylinder, surface, and sector on the unit.
;
SWT.C1:	TXNN	SW,CH.B		; Was /CB specified?
	 JRST	SWT.C2		; No
	MOVEI	M,[ASCIZ/Block /]
	PUSHJ	P,PREFIX	; Print prefix and block number
	PUSHJ	P,STRPFX	; Print structure prefix
	MOVE	P2,BARG1	; Get the block number
	IDIV	P2,STRBPC	; Convert to cluster, relative block
	MOVE	N,P2
	PUSHJ	P,CLSPFX	; Print the cluster number
	MOVE	N,P3		; Get the relative block in cluster
	PUSHJ	P,RLBPFX	; Print that also
	MOVE	N,BARG1		; Get the block number back
	PUSHJ	P,CFPPFX	; Print the CFP
	MOVE	P1,BARG1
	IDIV	P1,STRBPU	; Convert to unit, block on unit
	MOVE	N,P1
	PUSHJ	P,UNIPFX	; Print the unit
	MOVE	N,P2		; Get the block on unit
	PUSHJ	P,BLKPFX	; Print that also
	MOVEI	M,[ASCIZ/,  /]
	PUSHJ	P,MSGTTY	; Print separator
	MOVE	T2,P2		; Get block on unit
	PUSHJ	P,PBNPRT	; Print physical address
	JRST	SWT.C5		; Go finish up
;
;  Here to process the /CD option.  Convert the CFP to, and print,
;  the block and cluster on the structure, and the block and
;  cylinder, surface, and sector on the unit.
;
SWT.C2:	TXNN	SW,CH.D		; Was /CD specified?
	 JRST	SWT.C3		; No
	MOVEI	M,[ASCIZ/CFP /]
	PUSHJ	P,PREFIX	; Print prefix and CFP
	PUSHJ	P,STRPFX	; Print structure prefix
	MOVE	P1,BARG1	; Get the CFP
	IMUL	P1,HOMBSC(U)	; Convert to block number
	MOVE	N,P1
	PUSHJ	P,BLKPFX	; Print the block number
	MOVEI	M,[ASCIZ/,  /]
	PUSHJ	P,MSGTTY	; Output separator
	MOVE	N,P1		; Get the block back
	IDIV	N,STRBPC	; Convert to cluster number
	PUSHJ	P,CLSPFX	;  and print it
	IDIV	P1,STRBPU	; Convert to unit, block on unit
	MOVE	N,P1		; Get the unit number
	PUSHJ	P,UNIPFX	; Print the unit number
	MOVE	N,P2		; Get the block on the unit
	PUSHJ	P,BLKPFX	; Print that also
	MOVEI	M,[ASCIZ/,  /]
	PUSHJ	P,MSGTTY	; Print separator
	MOVE	T2,P2		; Get block on unit again
	PUSHJ	P,PBNPRT	; Print physical disk address
	JRST	SWT.C5		; Go finish up
;
;  Here to proces the /CU option.  Convert the block to the cylinder,
;  surface, and sector.
;
SWT.C3:	TXNN	SW,CH.U		; Was /CU specified?
	 JRST	SWT.C4		; No
	MOVEI	M,[ASCIZ/Block /]
	PUSHJ	P,PREFIX	; Print prefix and block number
	MOVEI	M,[ASCIZ/ on unit
    Unit:	/]
	PUSHJ	P,MSGTTY
	MOVE	T2,BARG1	; Get block on unit
	PUSHJ	P,PBNPRT	; Print physical disk address
	JRST	SWT.C5		; Go finish up
;
;
;  Here to process the /CP option.  Convert the cylinder, surface,
;  and sector to a block on the unit
;
SWT.C4:	TXNN	SW,CH.P		; Was /CP specified?
	 JRST	SWT.C6		; No
	MOVE	P1,BARG1	; Get cylinder
	IMUL	P1,BLKCYL(U)	; Compute offset to this cylinder
	MOVE	P2,BARG2	; Get surface
	IMUL	P2,BLKTRC(U)	; Compute offset from last cylinder
	ADD	P1,P2		; Compute address of start of surface
	ADD	P1,BARG3	; Add in sector address
	MOVE	T2,P1
	PUSHJ	P,PBNPRT	; Print the address
	MOVEI	M,[ASCIZ/
    Unit:	/]
	PUSHJ	P,MSGTTY
	MOVE	N,P1		; Get the block number
	PUSHJ	P,BLKPFX	; Print the block
SWT.C5:	PUSHJ	P,CRLF		; End with CRLF
	PJRST	RIPDON		; Go do next command
;
;
; Here to process the /CT option.  Print the universal date/time
; in a readable format.
;
SWT.C6:	TXNN	SW,CH.T		; Was /CT specified?
	 JRST	ERR001		; No, bad option
	MOVE	N,BARG1		; Get universal date/time
	PUSHJ	P,DATTIM	; Print it
	JRST	SWT.C5		; Go finish up
	SUBTTL	 /D -- Delete files.

; /D Options include:
; 
; /D	Delete specified files
; /DB	Delete file only if it is bad (according to monitor)
; /DT	Ask for time criteria; Only delete files created before specified
; 	 creation date, or not accessed since specified access date.
; /DU	Delete all files of given PPN and then delete UFD too
; 		(i.e., wipe him out)
; /DN	Delete all null directories within specified PPN's
; /DR	OR'ed with above options, but uses  RIPOFF delete
; 	(RIPFIL). SATs guaranteed to be messed up.
; 	Much faster however.
; /DA	OR'ed with above options causes RIPOFF to print filename
; 	and ask for confirmation of every file to be deleted.
; 	Does not apply to N or U options.
; /DM	OR'ed with above options causes RIPOFF to use only the monitor
;	RENAME when deleting files.

SWT.D:	SETCM	T,F
	TXNN	T,STNDRD	; *.*[*,*]/D ??
	 PUSHJ	P,ASK003	; More likely a mistake...!
	TXNN	SW,CH.U		; Was /DU specified?
	 JRST	SWT.D6		; No
	SKIPG	CMDLVL		; Skip if any SFD's typed in cmd string
	 TXO	F,S.SFD		; [p,pn]/DU implies [p,pn,*,*,*,*,*]/du
	TXNN	F,S.SFD		; If SFD's specified, were they all "*"?
	 JRST	ERR018		; No, can't do that
SWT.D6:	TTYON
	PUSHJ	P,CRLF
	TXNN	SW,CH.T		; Time options?
	 JRST	SWT.D4		; No. Skip this

	MOVEI	M,[ASCIZ/Delete if created before: /]
	PUSHJ	P,MSGTTY
	OUTPUT	CMD,
	PUSHJ	P,GTDATE	; Input time and date
	MOVEM	T3,BEFORE	;  and save in handy place
	MOVEI	M,[ASCIZ/and not accessed since: /]
	PUSHJ	P,MSGTTY
	OUTPUT	CMD,
	PUSHJ	P,GTDATE
	MOVEM	T3,AFTER	; Store.

	MSTIME	T1,		; Get current time
	DATE	T2,		;  and date
	PUSHJ	P,.CNVDT	;  in 36 bits
	MOVE	T4,AFTER
	TLNN	T4,-1		; Did he not give a date?
	 HLLM	T3,AFTER	; Use now
	MOVE	T4,BEFORE
	TLNN	T4,-1
	 HLLM	T3,BEFORE

SWT.D4:	TXNN	SW,<CH.U!CH.N>	; Can't specify filenames for /DU or /DN
	 JRST	SW.D4A		; None of these options
	PUSHJ	P,NONAME	; Check it out
	 JRST	ERR002		; Can't do that fella
; Here to start the search for files to be deleted

SW.D4A:	TXNE	SW,CH.M		; /DM specified?
	 TXOA	F,F.MDEL	; Yes, set flag for DELFIL
	  TXZ	F,F.MDEL	; Otherwise, clear the flag
	TXNN	SW,CH.U		; Now decide what header to type
	 SKIPA	M,[[ASCIZ/Files deleted:/]]
	  MOVEI	M,[ASCIZ/Deleting all files for users:/]
	TXNE	SW,CH.N
	 MOVEI	M,[ASCIZ/Deleting null directories, users:/]
	PUSHJ	P,MSGTTY
	PUSHJ	P,CRLF

SW.D0A:	PUSHJ	P,NXTSTR	; Get next STR
	 JRST	RIPDON		; When through
	 JRST	PNOMFD		; Gotta have an MFD

SWT.D0:	MOVEI	M,NXTDIR	; Default is to call NXTDIR
	TXNE	SW,CH.U		; Unlesss /DU specified
	 MOVEI	M,NXTPPN	; In which case, use NXTPPN
	PUSHJ	P,(M)		; Call one or the other
	 JRST	SW.D0A		; All done, try next STR
	TXZ	F,F.NULL	; Flag says first time through
SWT.D1:	PUSHJ	P,NXTFIL	; Get next file from directory
	 JRST	SWT.D2		; At end of directory
	TXNN	SW,CH.T		; /DT??
	 JRST	SWT.D5		; No, no need to LOOKUP file
	PUSHJ	P,USRLOK	; LOOKUP file to get dates
	 JRST	SWT.D1		; Ignore if cant
	PUSHJ	P,FILDAT	; Get T3 = creation date
	CAML	T3,BEFORE	; Created since input creation time
	 JRST	SWT.D1		; Yes. Ignore it
	PUSHJ	P,FILACD	; Get T3 = access date
	CAML	T3,AFTER	; Last access date before then?
	 JRST	SWT.D1		; Yes. Ignore it

SWT.D5:	TXNE	SW,CH.N		; Deleting null directories?
	 JRST	SWT.D0		; Yes. This ones not null, forget it.
	TXOE	F,F.NULL	; First file?
	 JRST	SWT.D3		; No
	PUSHJ	P,CHKPPN	; He important guy??
	 JRST	SWT.D0		; Hell yes!
	TXNE	SW,CH.U		; /DU??
	 JRST	SW.D3A		; Yes. Dont print every file
	MOVEI	M,[ASCIZ/
From /]
	PUSHJ	P,MSGTTY	; /D gets a header for each user
	MOVE	M,USRSTR	; Get structure name
	PUSHJ	P,PR6BIT	; Print it
	PUSHJ	P,COLON		; Followed by a colon
	PUSHJ	P,UFDPNT	; Print directory path
	PUSHJ	P,CRLF
; Here when a file found that matches the command string

SWT.D3:	TXNN	SW,CH.U		; /DU doesn't have ask mode
	 TXNN	SW,CH.A		; Ask mode?
	  JRST	SW.D3A		; No
	TXO	F,F.NOTB	; Print name with dot, not tab
	PUSHJ	P,FILPNT	; Print the filename
	MOVEI	M,ZERO		; No message for OPER
	PUSHJ	P,OPER		; Ask him
	 JRST	SWT.D1		; Doesn't want to delete this one
SW.D3A:	TXNE	SW,CH.B		; Only bad files?
	 TXOA	F,F.DBAD	; Yes. Set bit to tell DELFIL
	  TXZ	F,F.DBAD
	MOVEI	T,DELFIL	; Get set to delete the file
	TXNE	SW,CH.R		; Super delete?
	 MOVEI	T,RIPFIL	; Yes.
	PUSHJ	P,(T)		; Go delete this one.
	 JRST	SWT.D1		; Ignore it if cant
	TXNE	SW,CH.U
	 JRST	SWT.D1
	TTYON			; Print name of all files deleted
	TXO	F,F.NOTB	; Use dot instead of tab
	PUSHJ	P,FILPNT
	PUSHJ	P,TAB
	MOVSI	M,(SIXBIT .<>.)
	SKIPGE	UBLKCT		; Get number of blocks deleted
	 PUSHJ	P,PR6BIT	; Print <> if dont know
	SKIPL	N,UBLKCT
	 PUSHJ	P,DECPRT	; Otherwise, tell him
	PUSHJ	P,CRLF
	JRST	SWT.D1

; Here if no more files in current directory

SWT.D2:	TXNN	SW,<CH.U!CH.N>
	 JRST	SWT.D0		; Done if plain /D
	PUSHJ	P,CHKPPN	; Important guy again?
	 JRST	SWT.D0		; Yup.
	PUSHJ	P,DELUFD	; Otherwize, delete the UFD now.
	 JRST	SWT.D0
	TTYON
	MOVE	M,USRSTR	; Get structure name
	PUSHJ	P,PR6BIT	; Print it
	PUSHJ	P,COLON		;  followed by a colon
	PUSHJ	P,UFDPNT	; and finally the directory
	PUSHJ	P,CRLF
	JRST	SWT.D0
	SUBTTL	 /E -- Edit disk blocks


REPEAT LOGIC,<

/E options include C,L,N,R,S,W,T,A,6.

/ER -	Read given block into core
/EW -	Write core block out to given disk block
/EC -	Change core copy of block
/ET -	Type contents of given word in octal
/ETA or /ET7 - Type contents of given word in ASCII
/ET6-	" " in SIXBIT code
/ETU-   " " as a universal date/time word
/ERS OR 
/EWS-	S option OR'ed with W or R will read or write same STR
	and same block number as the last /E operation.
/ETL, /ETS, /ETN -
	L, S, or N option or'ed with the T option with no word
	specified will type the last, same, or next word
	(relative to the previous word).
>


SWT.E:	SKIPE	T,EBUF		; EBUF is ptr to data block
	  JRST	SWT.E1		; Have pointer, will process
	TXNN	SW,CH.R		; No ptr, better be reading
	  JRST	ERR005		; Write or edit what??
	MOVEI	T,BLKSIZ	; Need this much core for data block
	PUSHJ	P,CORGRB	; Grab enough core for our use
	MOVEM	T,EBUF		;  and remember where it is.


; Here to set up things for output or input

SWT.E1:	TXNN	SW,<CH.W!CH.R>  ; Skip if reading or writing
	  JRST	SWT.E3		; Go edit or type words
	SKIPE	USRSTR		; Did he specify a STR?
	 JRST	SWT.E6		; Yes. Use it.
	TXNN	SW,CH.S		; No. 'S' option?
	 JRST	NOSTR1		; No. Must specify a STR then.
	MOV	ESTR,USRSTR	; With S option, fake a  STR:
	PUSHJ	P,DEVTYP	; in the command string by doing
	JUMPL	T1,NOSTR	; the same thing scanner does
	MOVEM	T1,TTYTYP	; at SWIT:
	MOVEM	U,TTYDDB
	MOV	EBLK,BARG1	; Fake block number too
; Here to read or write the block specified by BARG1 on the structure
; specified by USRSTR.

SWT.E6:	PUSHJ	P,NXTSTR	; Go init device
	 JRST	NOSTR		; Can't?
	  JFCL			; Don't care if MFD or not
	MOVE	T,USRSTR	; Get STR name
	MOVE	T1,BARG1	;  and block number
	MOVEI	P1,STRRED	; Assume reading
	TXNN	SW,CH.W		; Writing?
	 JRST	SWT.E4		; No.
	MOVEI	P1,STRWRT	; Yes. Set for write.
	CAME	T,ESTR		; Same STR as before?
	 PUSHJ	P,ASK001	; No. Sure?
	CAME	T1,EBLK		; Same block?
	 PUSHJ	P,ASK002	; Check again.

SWT.E4:	MOVEM	T1,EBLK		; Remember last block
	MOVEM	T,ESTR		;  and last device
	HRLZI	T,-BLKSIZ
	HRR	T,EBUF		; T=IOWD to buffer for block
	SOJ	T,
	MOVEI	P4,DSK		; Read on DSK channel
	TTYON			; Enable TTY output
	PUSHJ	P,(P1)		; Go do it now.
	 JFCL			; Error. Forget it.
	JRST	RIPDON		;  and thats it..


; Here to edit the block (/EC)

SWT.E3:	TXNN	SW,CH.C		; Editing?
	 JRST	SWT.E7		; No, must be typing
	MOVE	N,BARG2		; Get new contents of word
	SKIPL	T,BARG1		; Make sure word to chage is in range
	 CAIL	T,BLKSIZ	;  i.e. (0-177)
	  JRST	ERR006		; No, tell him how big block is
	MOVEM	T,EWORD		; Save as last word accessed
	ADD	T,EBUF		; Make T pointer to word in core
	MOVEM	N,(T)		; Change the word
	JRST	RIPDON		; That's it
; Here to type the a word in the block in one of our several modes


SWT.E7:	TXNN	SW,CH.T		; Must be typing or bad option
	 JRST	ERR001		; No. Bad option
	TTYON			; Enable TTY output
	PUSHJ	P,CRLF		; To make it look good
	SKIPE	GOTWRD		; Word specified in command?
	 JRST	SWT.E8		; Yes, ignore /ETL, /ETS, and /ETN
	MOVE	T,EWORD		; Pick up last word used
	TXNE	SW,CH.L		; Last word wanted?
	 MOVEI	T,-1(T)		; Yes, decrement the pointer
	TXNE	SW,CH.N		; How about next one?
	 MOVEI	T,1(T)		; Then add one
	MOVEM	T,BARG1		; Save as word to use
SWT.E8:	SKIPL	T,BARG1		; T=which word of block to change
	 CAIL	T,BLKSIZ	;  which must be 0-177
	  JRST	ERR006		; Ill block arg
	MOVEM	T,EWORD		; Make this last word used
	ADD	T,EBUF		; Make T a real core pointer
	PUSH	P,T		; Save address for later
	MOVE	N,BARG1		; Get block index back
	MOVEI	T,6		; Field width to use
	PUSHJ	P,OCTZRO	; Print index as an octal number
	PUSHJ	P,SLASH		; Followed by a slash
	PUSHJ	P,TAB		; Followed by a TAB
	POP	P,T		; restore T
	MOVE	N,(T)		; Get old contents
	TXNN	SW,CH.A!CH.7	; Type in ASCII?
	 JRST	SWT.ES		; No.
	SETZ	N1,		; Yes. Make ASCIZ
	MOVEI	M,N		; M=Address of word
	PUSHJ	P,MSGTTY	; Type it
	JRST	SWT.E5		; Done.
SWT.ES:	TXNN	SW,CH.6		; SIXBIT?
	 JRST	SWT.EU		; No. Try universal date/time
	PUSHJ	P,NPR6BT	; Yes. Print it in SIXBIT.
	JRST	SWT.E5
SWT.EU:	TXNN	SW,CH.U		; universal date/time?
	 JRST	SWT.EO		; No, just octal
	PUSHJ	P,DATTIM	; Print it
	JRST	SWT.E5		; Go finish up
SWT.EO:	PUSHJ	P,OCTL12	; Type contents in octal
SWT.E5:	PUSHJ	P,CRLF		; End line with CRLF
	SKIPN	T,BARG3		; Have a non-zero increment?
	 MOVEI	T,1		; No, use default of 1
	ADDB	T,BARG1		; Bump index by increment
	CAMG	T,BARG2		; Larger than final value?
	 JRST	SWT.E8		; No, loop for more
	JRST	RIPDON
	SUBTTL	 /F -- Find files
; Find and print relative and logical block numbers of
;      the RIB of a file.
;
; /F options include:
;
;	/F  - Find files. Try directory search first then structure
;	      search
;	/FE - Find existing files, i.e., only do directory search
;	/FD - Find deleted files, i.e., only do structure search
;	/F2 - When OR'ed with /FD option, enables 2nd RIB searching

SWT.F:	TXNE	SW,CH.D		; D switch specified?
	  JRST	SWT.F8		; Yes, don't do lookups
	TXZ	F,F.MULT		; Clear files found flag
SWT.F1:	PUSHJ	P,NXTSTR	; Get next str
	  JRST	SWT.F4		; None left, do search
	  JRST	SWT.F1		;
SWT.F2:	PUSHJ	P,NXTPPN	; Get next PPN
	  JRST	SWT.F1		; None left
SWT.F3:	PUSHJ	P,NXTFIL	; Get next file
	  JRST	SWT.F2		; None left
	TXOE	F,F.MULT	; Seen any before?
	  JRST	SWT.F7		; Yep, don't print heading again
	MOVEI	M,[ASCIZ/Files found in directories:
/]
	PUSHJ	P,MSG		; Print it
SWT.F7:	MOVE	T,USRCFP	; Get CFP for this file
	PUSHJ	P,CFP2BK	; Convert to blocks
	PUSHJ	P,PRTFND	; Print the infor
	JRST	SWT.F3		; and get next one
;
;	Here to do a search on the file structure looking for
;	the RIBs of a file that matches the specifications.
;
SWT.F4:	TXZE	F,F.MULT	; See any files in directories?
	  JRST	SWT.F8		; Yep
	MOVEI	M,[ASCIZ/% No files found in directories
/]
	PUSHJ	P,MSG		;
SWT.F8:	TXNE	SW,CH.E		; E switch seen?
	  JRST	RIPDON		; Yep, we're done
	SETOM	STRFLG		; To reset NXTSTR
SWT.F5:	PUSHJ	P,NXTSTR	; Get next str
	  JRST	SWT.FD		; None left
	  JFCL			; No MFD is OK
	SETZM	SATFLG		; Search all blocks
	MOVN	T4,STRBPC	; Get negative blocks/cluster
	TXNE	SW,CH.2		; Unless second RIB recovery
	 MOVNI	T4,1		; In which case use -1
	MOVEM	T4,SETBLK	; This is starting block
	HLRZ	U,UNIDDB	; Setup U for SEARCH
SWT.F6:	MOVEI	P1,RIBCOD	; Keyword
	MOVEI	P2,CODRIB	; Contents of keyword
	MOVE	T4,STRBPC	; Search every cluster
	TXNE	SW,CH.2		; Unless second RIB recovery
	  MOVEI	T4,1		; is enabled
	PUSHJ	P,SEARCH	; Go find a block
	  JRST	SWT.F5		; None left on this str
	MOVE	T1,SETBLK	;
	TXO	F,F.RIB		; Tell RIBCHK not to check names
	PUSHJ	P,RIBCHK	; Is it a valid RIB?
	  JRST	SWT.F6		; Nope, ignore it
	PUSHJ	P,CHKMAT	; Is it ours?
	  JRST	SWT.F6		; Nope
;;[77] At SWT.F6 + 14 1/2
	MOVEM	T,USRNAM	;[77] Correct name in case of wildcards
	MOVEM	T1,USREXT	;[77] Correct extension in case of wildcards
	MOV	BUF+RIBPPN,USRPTH+.PTPPN;[77] Correct PPN in case of wildcards
	TXOE	F,F.MULT	; Seen any files yet?
	  JRST	SWT.F9		; Yep
	MOVEI	M,[ASCIZ/Files found via structure search:
/]
	PUSHJ	P,MSG		;
SWT.F9:	MOVE	T1,SETBLK	; Block in unit
	MOVE	T,HOMLUN(U)	; Get logical unit number
	IMUL	T,STRBPU	; Times blocks/unit
	ADD	T,T1		; Give block in str
	PUSHJ	P,PRTFND	; Print info
	JRST	SWT.F6		; and loop for next one

SWT.FD:	TXNE	F,F.MULT	; See any files on search?
	  JRST	RIPDON		; Yep
	MOVEI	M,[ASCIZ/% No files found via structure search
/]
	PUSHJ	P,MSG		;
	JRST	RIPDON		;
	SUBTTL	 /H -- Type the RIPOFF help file

SWT.H:	MOVEI	P1,MAXHLP-1

SWT.H1:	MOVEI	T,.IODMP	; Get it in dump mode
	MOVE	T1,HLPTAB(P1)	; on one of several devices
	SETZ	T2,
	OPEN	STR,T
	 JRST	SWT.H3
	MOVE	T,['RIPOFF']
	MOVSI	T1,'HLP'
	SETZB	T2,T3
	LOOKUP	STR,T
	 JRST	SWT.H3
SWT.H2:	IN	STR,IOW
	 SKIPA	M,[BUF]
	  JRST	RIPDON
	PUSHJ	P,MSGTTY
	JRST	SWT.H2


SWT.H3:	SOJGE	P1,SWT.H1	; Try another device
	JRST	ERR014		;  or give error message

HLPTAB:	SIXBIT	.DSK.
	SIXBIT	.SYS.
	SIXBIT	.HLP.
MAXHLP==.-HLPTAB
	SUBTTL	 /I -- Initialize UFD's from scratch

REPEAT LOGIC,<

	SEE DOCUMENTION FOR OPERATION OF THIS SWITCH.

	ONE PASS IS MADE OVER THE ENTIRE FILE STRUCTURE. THE
FIRST BLOCK OF EACH CLUSTER IS READ AND TESTED AS A RIB. ALL RIBS
FOUND MATCHING THE COMMAND STRING SPECIFICATIONS AS TO FILE NAMES AND
PPNS ARE REMEMBERED IN A CORE LINKED LIST. FOR EVERY PPN IS A
TWO WORD BLOCK WHICH CONTAINS:

	WORD 0: ADDRESS NEXT PPN BLOCK ,, ADDRESS FIRST FILE BLOCK
						FOR THIS PPN
	WORD 1: PROJECT ,, PROGRAMMER NUMBER

FOR EACH FILE IS KEPT A FOUR WORD BLOCK:

	WORD 0: FILE EXTENSION ,, ADDRESS NEXT FILE BLOCK THIS PPN

	WORD 1: FILE NAME

	WORD 2: CREATION DATE ,, CREATION TIME IN UNIVERSAL STANDARD
		(12 OR 15 BIT FORMATS CONVERTED TO UNIVERSAL STANDARD)

	WORD 3: BYTE (4) LOGICAL UNIT , BYTE (32) LOGICAL BLOCK NUMBER
			WITHIN UNIT OF FIRST RIB


	IF A FILE IS FOUND DUPLICATED ON THE STR (OLDER VERSIONS), THIS
LIST IS CHECKED AND TESTED AGAINST THE CREATION DATE
AND TIME. ONLY THE LATEST VERSION IS REMEMBERED.

	WHEN THE ENTIRE STR IS SEARCHED, THE TABLES ARE RESCANNED,
AND THE RIB IS RE-READ. THE RIB IS OUTPUT TO A SCRATCH DEVICE (MAGTAPE,
DECTAPE, OR SCRATCH PACK). THEN THE ENTIRE FILE IS READ AND OUTPUT
TO THE SCRATCH STORAGE. ALL FILES ARE THUS TRANSMITTED TO
THE AUXILLIARY DEVICE, ALONG WITH THEIR FIRST RIBS. THE SCRATCH
AREA IS WRITTEN AS ONE CONTIGIOUS FILE. NOTE: IF A SCRATCH PACK IS
USED, WRITING WILL BEGIN ON BLOCK ONE AND CONTINUE ON SUCCESSIVE
BLOCKS. THUS, THE PACK WILL BE DESTROYED FOR USE AS A FILE STRUCTURE,
AND WILL NEED TO BE REFRESHED AFTER USE. WHEN ALL FILES ARE TRANSMITTED
TO SCRATCH, THE DEVICE MAY BE REWOUND, AND THE FILES RESTORED TO THE
ORIGINAL STR AT LEISURE.

	THE COMMAND STRING *DEV:_STR:FILESPECS/IS  PERFORMS THE SAVE ONLY.
LATER, A *DEV:_STR:/IR  RESTORES IT FROM THE DEV TO THE STR (I KNOW THE
COMMAND STRING IS BACKWARD, SORRY PIP USERS...). /I WITH NO
OPTIONS IMPLIES BOTH, EXCEPT IN EXEC MODE OPERATION, IN WHICH CASE
ONLY A /IS IS DONE. THE RESTORE MUST BE DONE UNDER THE CONTROL
OF THE TIMESHARING MONITOR.

>

REPEAT LOGIC,<

/I OPTIONS:

R - RESTORE ONLY
S - SAVE ONLY
D - SAVE DELETED FILES ONLY (IGNORE BLOCKS MARKED IN SAT)
E - SAVE EXISTING FILES ONLY (IGNORE BLOCKS FREE FROM SAT)
A - SAME AS /IDE, SAVE ALL FILES, CHECK ALL BLOCKS.
2 - READ EVERY BLOCK EVEN IF NOT FIRST IN A CLUSTER
	(ALLOWS RECOVERY FROM 2ND RIBS)
T - TIME OPTIONS. ASKS BEFORE AND AFTER. ONLY FINDS FILES BETWEEN GIVEN DATES AND TIMES
O - OVERWRITTEN DATA ALLOWED (IF THE FILE HAS BEEN PARTIALLY OVERWRITTEN,
	NORMALLY, RIPOFF WILL DISCONTINUE THE RESTORE OF THAT FILE
	WHERE THO OVERWRITTEN DATA BEGINS. THERE IS NO (EASY) WAY
	TO TELL WHERE THE OVERWRITTEN DATA ENDS HOWEVER. IT IS
	POSSIBLE, FOR INSTANCE, TO HAVE A LARGE FILE (THAT WAS DELETED),
	AND HAVE A SMALL 1 BLOCK FILE OVERWRITE ONE LOUSY CLUSTER RIGHT
	IN THE MIDDLE. RESULTS: YOU GET ONLY HALF YOUR FILE BACK,
	BECAUSE RIPOFF MUST ASSUME THE ENTIRE REST OF THE FILE IS
	OVERWRITTEN (POSSIBLY). HOWEVER, WITH THE O OPTION, RIPOFF
	WILL RESTORE THE ENTIRE FILE, THAT IS ALL THOSE BLOCKS WHICH
	USED TO BE IN THE FILE. OF COURSE, SOME OF THESE BLOCKS
	WILL CONTAIN SOMEONE ELSES DATA. THIS IS OF COURSE, A
	SECURITY VIOLATION, AND SHOULD BE USED WITH CARE. HOWEVER,
	IN AN EMERGENCY SITUATION, IT IS WORTH HAVING AROUND. IT SHOULD
	NOT BE USED UNTIL A /I HAS BEEN TRYED WITHOUT IT
	AND COME UP WITH ONLY A PARTIAL RESTORE.
F - FAILSAFE. RIB SEARCH LOGIC NOT USED. SIMPLY READS FILES
	FROM DISK, WRITES TO AUX, AND BACK FOR RESTORE.
	D,E,A AND 2 OPTIONS ILLEGAL WITH F. S AND R CANNOT
	BOTH BE USED AT THE SAME TIME.

X - ADDED TO RESTORE OPTION OR PRINT OPTION, XLISTS OUTPUT OF
	FILE NAMES AND SIZES. ONLY UFD'S RESTORED ARE PRINTED.
P - PRINT ONLY. READS TAPE AND PRODUCES DIRECTORY.
>


SWT.I:	TXNN	SW,<CH.S!CH.R!CH.P>	;IF NO SWITCH OPTIONS,
	 TXO	SW,<CH.S!CH.R>		;ASSUME ALL OPTIONS.
	TXNE	SW,<CH.2!CH.D!CH.E!CH.A>
	TXNN	SW,CH.F		;/IF CANT CO-EXIST WITH ABOVE
	 SKIPA
	  PJRST	ERR011		;TELL HIM HE IS MISTAKEN.
	TXNE	SW,CH.R		;HE WANT A RESTORE?
	 TXZ	SW,CH.P		;YES. WE PRINT ANYWAY, SO KEEP ZERO.
	PUSHJ	P,NXTSTR	;GET A STR INIT'ED
	 JRST	RIPDON
	 JRST	.-2
	TXNN	SW,CH.S		;WANT TO SAVE?
	 JRST	SWT.IR		;NO. JUST A RESTORE NOW.
	PUSHJ	P,AUXINI	;MAKE SURE OUTPUT DEVICE IS THERE
	 JRST	ERR003		;ELSE ALL IS LOST WHEN ITS TOO LATE.
	PUSHJ	P,AUXENT	;ENTER SCRATCH FILE
	 JRST	ERR004		;JUST TO MAKE SURE...
	SETZM	LHEAD		;THE LIST HEADERS
	SETZM	LHEAD+1
	MOV	.JBFF,.SVFF	;TO REDUCE CORE LATER
	TXNN	SW,CH.T		;TIME OPTION??
	 JRST	SW.I30		;NO. SKIP THIS
	MOVEI	M,[ASCIZ/
After:/]
	PUSHJ	P,MSGTTY	;ASK QUESTION
	OUTPUT	CMD,		;REALLY ASK IT!
	PUSHJ	P,GTDATE	;LET HIM ANSWER IT
	MOVEM	T3,AFTER	;AND STORE HIS ANSWER..
	MOVEI	M,[ASCIZ/
Before:/]
	PUSHJ	P,MSGTTY
	OUTPUT	CMD,
	PUSHJ	P,GTDATE	;LET HIM ANSWER SECOND QUESTION
	MOVEM	T3,BEFORE	;AND STORE
	TLNE	T3,-1		;DID HE GIVE ZERO DATE?
	 JRST	SW.I30		;NO. AOK
	MSTIME	T1,		;YES. HE WANTS HERE AND NOW
	DATE	T2,
	PUSHJ	P,.CNVDT	;GET T3=NOW
	HRR	T3,BEFORE	;T3=NOW DATE ,, HIS TIME
	TRNN	T3,-1		;DID HE GIVE ZERO TIME TOO???
	 AOBJP	T3,.+1		;YES. FIX T3 = TOMORROW, 1 MS. PAST MIDNIGHT
	MOVEM	T3,BEFORE	;STORE.

SW.I30:	TXNE	SW,CH.F		;FAILSAFE?
	 JRST	FAILSA		;YES. GO DO IT NOW.
	SETOB	T,SATFLG	;IF HE SAYS NOTHING, ASSUME /ID
	TXNE	SW,CH.E		;SAVE ONLY EXISTING FILES
	 HRRZM	T,SATFLG	;YES. SATFLG .GT. 0, LOOK ONLY IN SATS.
	TXNE	SW,CH.D		;SAVE ONLY DELETED FILES?
	 SETOM	SATFLG		;YES. SATFLG .LT. 0, LOOK ONLY OUT OF SAT
	TXNE	SW,CH.A		;SAVE ALL?
	 SETZM	SATFLG		;YES.
	SKIPE	SATFLG		;IF ALL, DONT NEED TO READ SATS
	PUSHJ	P,RDSAT		;READ THEM
	 SETZM	SATFLG		;CANT, SO DONT
	MOVN	T4,STRBPC	; Get negative blocks/cluster
	TXNE	CH,CH.2		; Unless second RIB recovery
	 MOVNI	T4,1		; In which case use -1
	MOVEM	T4,SETBLK	; This is starting block
	HLRZ	U,UNIDDB	;ON LOGICAL UNIT ZERO.
SWT.I1:	MOVEI	P1,RIBCOD	;LOOK AT WORD 176 OF BLOCK
	MOVEI	P2,CODRIB	;TO SEE IF IT HAS A 777777 IN IT
	MOVE	T4,STRBPC	;READ ONLY ONE BLOCK/CLUSTER
	TXNE	CH,CH.2		;UNLESS HE SAYS OTHERWIZE.
	 MOVEI	T4,1
	PUSHJ	P,SEARCH	;GO LOOK FOR IT
	 JRST	SWT.I2		;ALL DONE!
	MOVE	T1,SETBLK
	TXO	F,F.RIB
	PUSHJ	P,RIBCHK	;SEE IF ITS REALLY A RIB
	 JRST	SWT.I1		;NOT SO IGNORE IT

;GOT A RIB. SEE IF ITS ONE OF OURS..

	PUSHJ	P,CHKMAT	;SEE IF WE MATCH.
	 JRST	SWT.I1		;NO. FORGET THIS FILE THEN.
	JRST	CHKMA1		;SKIP OVER WHAT USED TO BE INLINE CODE


CHKMAT:	TXNE	F,S.PROJ	;CHECKING PROJECTS?
	 JRST	.+5		;NO. *
	HLLZ	T,BUF+RIBPPN
	HLLZ	T4,USRPTH+.PTPPN ;
	CAME	T,T4		;MATCH?
	 POPJ	P,		;NO. FORGET FILE
	TXNE	F,S.PROG	;CHECKING PROGRAMMER NUMBERS?
	 JRST	.+5		;NOPE. *
	HRRZ	T,BUF+RIBPPN
	HRRZ	T4,USRPTH+.PTPPN ;
	CAIE	T,(T4)		;MATCH?
	 POPJ	P,		;NOPE.
	MOVE	T,BUF+RIBNAM
	TXNN	F,S.NAM		;CHECKING NAMES?
	CAMN	T,USRNAM	;YES. MATCH?
	 SKIPA			;YES. GOT IT.
	 POPJ	P,		;NO. FORGET
	HLLZ	T1,BUF+RIBEXT
	HLLZS	USREXT
	TXNN	F,S.EXT		;CHECKING EXTENSIONS?
	CAMN	T1,USREXT	;YES. MATCH?
	JRST	CPOPJ1		;YEP!
	POPJ	P,		;NO. NO MATCH AFTER ALL.
CHKMA1:

;OK. I GOT A GOOD RIB HERE. LETS PUT HIM IN THE TABLES.

	MOVE	T2,BUF+RIBSTS	;LOOK AT FILE STATUS
	TXNE	T2,RIPNFS	;NO BACKUP BIT?
	 JRST	SWT.I1		;YES. IGNORE IT. (CRASH.SAV,SAT.SYS, ETC)
	MOVE	T2,BUF+RIBPPN
	CAMN	T2,MFDPPN
	 JRST	SWT.I1		;CANT SAVE MFDPPN!
	MOVEI	P1,LHEAD
	PUSHJ	P,FILDAT	;GET FILES CREATION DATE,,TIME IN T3
	TXNN	SW,CH.T		;TIME OPTION?
	 JRST	SWT.I4		;NO. CONTINUE.
	CAML	T3,AFTER	;BEFORE AFTER??
	CAML	T3,BEFORE	;AFTER BEFORE?
	 JRST	SWT.I1		;YES TO EITHER. FORGET THIS FILE

SWT.I4:	HLRZ	P1,(P1)		;P1=NEXT UFD BLOCK
	JUMPE	P1,SWT.I3	;HIT END. MUST BE A NEW UFD
	CAME	T2,1(P1)	;SEEN HIM BEFORE?
	 JRST	SWT.I4		;NO. KEEP LOOKING


;HERE IF WE FOUND HIS UFD, NOW SEE IF THE FILE ALREADY
;BEEN SEEN TOO. P1=ADR OF PPN BLOCK.

	MOVE	P2,P1		;REMEMBER PPN BLOCK IN P2
SWT.I5:	HRRZ	P1,(P1)		;P1:=ADR NEXT FILE BLOCK
	JUMPE	P1,SWT.I6	;MUST BE A NEW FILE NAME
	CAME	T,1(P1)		;NAMES MATCH?
	 JRST	SWT.I5		;KEEP LOOKING.
	HLLZ	T4,(P1)
	CAME	T1,T4		;EXTENSIONS MATCH?
	 JRST	SWT.I5		;KEEP LOOKING.

;HERE WHEN FILE OCCURED PREVIOUSLY

	CAMG	T3,2(P1)	;CREATED LATER THAN FIRST ONE?
	 JRST	SWT.I1		;NO. FORGET FILE COMPLETELY

SWT.I9:				;THIS IS A LATER COPY OF THE FILE.
	MOVEM	T3,2(P1)	;STORE NEW DATE,,TIME WORD
	MOVE	T,SETBLK	;AND NEW RIB ADDRESS WORD
	MOVE	T1,HOMLUN(U)
	DPB	T1,[POINT 4,T,3]
	MOVEM	T,3(P1)
	JRST	SWT.I1		;AND GO BACK FOR MORE RIBS NOW.

;HERE IF A NEW UFD FOUND. CREATE HIM AN ENTRY

SWT.I3:	MOVEI	T,2		;WE WILL INSERT HIS PPN BLOCK
	PUSHJ	P,CORGRB	;INTO THE VERY BEGINNING OF THE LIST
				;SINCE THAT IS THE EASIEST WAY...
	HLRZ	T1,LHEAD	;T1=INITIAL PTR TO FIRST PPN
	HRLZM	T1,(T)		;POINT US THERE INSTEAD
	HRLM	T,LHEAD		;POINT INITIAL PTR TO US INSTEAD
	MOVEM	T2,1(T)		;REMEMBER PPN IN CORE
	MOVE	P2,T		;REMEMBER PPN ADDRESS IN P2
	PUSHJ	P,FILDAT	;GET UNIVERSAL DATE,,TIME INTO T3
				;AND FALL INTO .I6 TO CREAT FILE BLOCK ENTRY



;HERE WHEN NEW FILE NAME OCCURS. CREATE AN ENTRY FOR HIM.

SWT.I6:	MOVEI	T,4
	PUSHJ	P,CORGRB
	HRRZ	T1,(P2)		;T1=1ST FILE POINTED TO BY PPN
	HRRM	T1,(T)		;POINT ME THERE INSTEAD
	HRRM	T,(P2)		;POINT PPN TO ME INSTEAD
	MOVE	P1,T		;SET P1=PTR TO FILE BLOCK TOO.
	MOV	BUF+RIBNAM,1(P1) ;PUT IN MY NAME
	HLLZ	T1,BUF+RIBEXT
	HLLM	T1,0(P1)	;AND MY EXTENSION
	JRST	SWT.I9		;CONTINUE OVER THERE.

;HERE WHEN ALL FILES FOUND. NOW WRITE THEM TO SCRATCH AREA.


SWT.I2:	TXO	F,F.IO		;WE WILL BE WRITING ON SCRATCH.
	PUSHJ	P,AUXALC	;NOW ALLOCATE AUX BUFFERS.
	MOVEI	P1,LHEAD

SW.I0:	HLRZ	P1,(P1)		;MOVE UP TO NEXT PPN
	JUMPE	P1,SW.I4	;UNTIL DONE
	HRRZ	P2,(P1)		;P2=ADR OF FIRST FILE BLOCK
SW.I3:	JUMPE	P2,SW.I0	;IF NO MORE FILES, TRY NEXT PPN
	MOVE	T,1(P2)		;FILE NAME
	HLLZ	T1,0(P2)	;EXTENSION
	LDB	T2,[POINT 4,3(P2),3] ;LOGICAL UNIT # OF RIB
	IMUL	T2,STRBPU	;T2=BLOCK NUMBER OF FIRST BLOCK ON UNIT
	LDB	T3,[POINT 32,3(P2),35]
	ADD	T2,T3		;AND BLOCK ON UNIT TO IT, AND YOU GET
	MOVNS	T2		;-BLOCK IN STR OF FIRST RIB
	MOVE	T3,1(P1)	;T3=PPN
	MOVEI	P4,DSK
	PUSH	P,P1
	PUSH	P,P2
	PUSHJ	P,LOOKP		;LOOKUP FILE FILE NOW.
	 JRST	SW.I1		;WHAT?????
	MOVE	P1,IOW
	MOVEM	P1,XIOWD+DSK
	PUSHJ	P,AUXOUT	;WRITE IT TO SCRATCH
	 JFCL			;HMM.
	 JFCL			;CANT HAPPEN EITHER!
	POP	P,P2
	POP	P,P1
SW.I9:	PUSHJ	P,DMPIN		;READ A BLOCK OF THE FILE
	MOVE	T,DSK+IOSTS
	TXNE	T,IO.EOF		;EOF??
	 JRST	SW.I2		;YES. DONE
	TXO	F,F.RIB		;NO NAME CHECK
	PUSHJ	P,RIBCK0	;READING A RIB?
	 JRST	SW.I14		;NO. AOK
				;YES. FILE HAS BEEN OVERWRITTEN.
	TXNE SW,CH.O		;OVERWRITING ALLOWED?
	 JRST SW.I9		;YES. CONTINUE READING FILE, IGNORE THIS RIB
	JRST SW.I2		;NO. FILE IS DONE NOW.
SW.I14:	PUSH	P,P1
	MOVE	P1,IOW
	PUSHJ	P,AUXOUT	;NO. WRITE BLOCK TO SCRATCH
	 JFCL
	 JFCL
	POP	P,P1
	JRST	SW.I9
SW.I2:	HRRZ	P2,(P2)		;DONE. GET NEXT FILE NAME
	JRST	SW.I3		;AND CONTINUE
;HERE ON LOOKUP FAILURE. (WHICH IS REALLY IMPOSSIBLE, SINCE WE
;ALREADY VERIFIED RIB..)

SW.I1:	POP	P,P2
	POP	P,P1
	HRRZ	P2,(P2)		;GET NEXT FILE NAME
	JRST	SW.I3		;SIMPLY IGNORE THE FILE.




;HERE TO DO SIMPLE SAVES. NO LOGIC REQUIRED. JUST READ
;ALREAD EXISTING FILES AND PIP THEM TO AUX.

FAILSA:	TXNE	SW,CH.R		;IF SAYS R,
	TXNN	SW,CH.S		;THAN CANT SAY S
	 SKIPA
	 JRST	ERR011		;/IFSR. ILLEGAL
	TXNE	SW,CH.R		;SAY RESTORE?
	 JRST	SWT.IR		;YES. DO IT THEN.

	TXO	F,F.IO
	PUSHJ	P,AUXALC	;GET SOME BUFFERS
FAILS0:	PUSHJ	P,NXTPPN
	 JRST	SW.I4		;DONE WHEN MFD DONE.
	MOVE	T2,USRPTH+.PTPPN	;
	CAMN	T2,MFDPPN
	 JRST	FAILS0		;CANT SAVE MFD.
FAILS1:	PUSHJ	P,NXTFIL	;GET NEXT FILE IN UFD
	 JRST	FAILS0
	PUSHJ	P,USRLOK	;GET ITS RIB
	 JRST	FAILS1
	MOVE	T2,BUF+RIBSTS
	TXNE	T2,RIPNFS
	 JRST	FAILS1		;DONT SAVE CRASH.SAV, ETC
	TXNN	SW,CH.T		;WANT TIME OPTION?
	 JRST	FAILS2		;NO. FORGET CHECK
	PUSHJ	P,FILDAT	;YES. GET FILES CREATION DATE
	CAML	T3,AFTER	;BEFORE AFTER?
	CAML	T3,BEFORE	;AFTER BEFORE?
	 JRST	FAILS1		;YES TO EITHER. IGNORE THIS FILE
FAILS2:	MOVE	P1,IOW
	MOVEM	P1,XIOWD+DSK
	MOVEI	P4,DSK
	PUSHJ	P,AUXOUT	;WRITE SOME,
	 JFCL
	 JFCL
	PUSHJ	P,DMPIN		;THEN READ SOME.
	MOVE	T,DSK+IOSTS
	TXNN	T,IO.EOF	;UNTIL EOF ON DISK
	 JRST	FAILS2
	JRST	FAILS1		;IN WHICH CASE, GET NEXT FILE.

;HERE WHEN SAVE COMPLETED. NOW RESTORE IF POSSIBLE

SW.I4:	PUSHJ	P,AUXEOF	;WRITE EOF
	PUSHJ	P,AUXRLS	;RELEASE DEVICE
	PUSHJ	P,ZCORE		;REDUCE CORE BACK TO MINIMUM
SWT.IR:	TXNN	SW,CH.R!CH.P	;WANT TO READ TAPE AGAIN NOW?
	 JRST	RIPDON		;NO. FORGET IT.
	PUSHJ	P,AUXINI	;INITIALIZE SCRATCH AGAIN
	 JRST	ERR003
	PUSHJ	P,AUXLUK	;LOOKUP FILE JUST WRITTEN
	 JRST	ERR007
	TXZ	F,F.IO		;WE WILL BE READING ONLY
	MOV	.JBFF,.SVFF	;SAVE TO REDUCE LATER.
	PUSHJ	P,AUXALC	;NEED TO REALLOCATE BUFFERS.
	TXNE	SW,CH.P		;PRINTING ONLY?
	 JRST	SW.IR1		;YES. DONT BOTHER DISKS
	MOVEI	T,14		;AND SET UP OUR OWN STR TOO.
	MOVE	T1,USRSTR	;I AM DOING THIS INSTEAD OF CALLING
	MOVSI	T2,WH.STR	;INIDSK (WHICH INITS MODE 17) SO THAT
	OPEN	STR,T		;OUTPUT CANN BE BUFFERED. I BELIEVE
	 JRST	NOSTR		;THAT FASTER /IR OPERATION IS MORE
	MOVE	T,.JBREL	;IMPORTANT THAN EXEC MODE COMPATIBILITY
	OUTBUF	STR,20		;SET UP BUFFERS FOR THE OUTPUT
	CAME	T,.JBREL	;INCREASE A K?
	 PUSHJ	P,PNTCOR	;YES. TELL HIM SO.
SW.IR1:	TXZ	F,F.FAIL!F.RIP	;AOK SO FAR.
	TXNE	SW,CH.P
	 TXO	F,F.FAIL	;JUST IN CASE..
	SETOM	PASS

SW.I5:	MOVE	P1,IOW
	PUSHJ	P,AUXIN		;READ A BLOCK FROM SCRATCH
	 JRST	.-2		;JUST BETTER NOT HAPPEN!
	  JRST	SW.I10		;EOF. ALL DONE!!!!!
	TXO	F,F.RIB
	PUSHJ	P,RIBCK0	;RIB?
	 JRST	SW.I6		;NO. STILL READING DATA FILE
SW.I13:	TXZN	F,F.RIP		;WAS A RESTORE IN PROGRESS?
	 JRST	SW.I11		;NO.
	TXNN	SW,CH.P
	CLOSE	STR,		;YES. CLEAN UP ENDS OF LAST FILE
	TXNE	SW,CH.X
	 JRST	SW.I12+1
	TTYON
	PUSHJ	P,TAB
	MOVE	N,UBLKCT	;TELL HIM HOW MANY BLOCKS WE FOUND
	PUSHJ	P,DECPRT
	MOVE	N,UBLKCT	;AND ORIGINAL LENGTH
	CAMN	N,SETBLK	;IF DIFFERENT.
	 JRST	SW.I12
	MOVEI	M,[ASCIZ/ Original had:/]
	PUSHJ	P,MSGTTY
	MOVE	N,SETBLK
	PUSHJ	P,DECPRT
SW.I12:	PUSHJ	P,CRLF
	TXNN	F,S.PROG!S.PROJ!S.NAM!S.EXT ;IF NO STARS, THEN WE ARE
	 JRST	RIPDN1		;AFTER JUST ONE FILE!
;NOW WE HAVE FINISHED OFF THE LAST FILE. START PROCESSING THE
;NEXT ONE ON THE TAPE.

SW.I11:	SKIPN	BUF+RIBNAM	;DO WE HAVE A NEXT ONE ON TAPE?
	 JRST	RIPDN1		;NO. EOF (SEE SW.I10)
	PUSHJ	P,CHKMAT	;YES. ONE OF OUR BOYS?
	 JRST	NORESTORE	;NO. SKIP HIM.
	MOV	BUF+RIBNAM,USRNAM
	HLLZ	T,BUF+RIBEXT
	HLLZM	T,USREXT
	MOVE	T,BUF+RIBPPN	;GET HIS PPN
	AOSE	PASS		;IF NOT FIRST FILE,
	CAME	T,USRPTH+.PTPPN	; SAME AS LAST ONE?
	 TXOA	F,F.TMP		;NO. OK
	 TXZ	F,F.TMP		;YES. SUPRESS UFDPNT
	MOVEM	T,USRPTH+.PTPPN	;
	TTYON
	TXO	F,F.NOTB	; Use dot instead of tab
	TXNN	SW,CH.X
	PUSHJ	P,FILPNT	;TELL HIM NEW FILE NAME
	TXZN	F,F.TMP		;DID UFD CHANGE?
	 JRST	.+4		;NO. DONT TELL HIM AGAIN.
	PUSHJ	P,UFDPNT	;YES. TELL HIM NEW UFD
	TXNE	SW,CH.X		;SUPPRESSING FILES?
	 PUSHJ	P,CRLF		;YES. BETTER ADD A CR NOW.
	OUTPUT	CMD,		;MAKE SURE IT GETS OUT, MAY BE AWHILE TILL DONE.
;HERE TO DO ENTER AT LAST.

SW.I8:
;Following instruction removed to prevent the zeroing of the
;3 high-order bits of the creation date.  (U. of Texas)
;[75]	HLLZS	BUF+RIBEXT	;SET UP UUOBLK
	MOVI	RIBSTS,BUF+RIBFIR
	SETZM	UBLKCT		;ZERO FILE SIZE.
	TXO	F,F.RIP		;RESTORE ABOUT TO START NOW.
	MOVE	T,BUF+RIBSIZ	;SIZE ACCORDING TO RIB
	ADDI	T,BLKSIZ-1
	IDIVI	T,BLKSIZ
	MOVEM	T,SETBLK	;UBLKCT COUNTS OUTPUTS, SETBLK HOPEFULLY.
	TXNE	SW,CH.P
	 JRST	NORESTORE	;SKIP ENTER IF JUST PRINTING
	ENTER	STR,BUF		;USE STANDARD MONITOR ENTER
	 SKIPA
	JRST	SW.I5		;AND CONTINUE READING FILE



;HERE ON ENTER FAILURE. DO SOMETHING FAST!

	HRRZ	T,BUF+EXLERC
	CAIN	T,ERPOA%	;PARTIAL ALLOCATION ONLY?
	 JRST	SW.I5		;YES. THAT'S OK. (FILE NOT CONTIGOUS)
	CAIE	T,ERIPP%	;GUY GOT NO UFD YET?
	 JRST	SW.I7		;WORSE. OY VEY!
	MOVE	T,[BUF,,DSK+DATBUF]
	BLT	T,DSK+DATBUF+RIBSTS ;SAVE UUOBLK SOMEPLACE SAFE
	PUSHJ	P,MAKUF1	;GO MAKE HIM A UFD QUICK
	 TXOA	F,F.FAIL
	 TXZ	F,F.FAIL
	MOVS	T,[BUF,,DSK+DATBUF]
	BLT	T,BUF+RIBSTS	;RESTORE OUR FILE BLOCK
	TXNN	F,F.FAIL	;UFD THERE NOW?
	 JRST	SW.I8		;YES. TRY ENTER AGAIN..

;HERE ON HORRIBLE ERROR. CANT CREATE A FILE

SW.I7:	TXZ	F,F.RIP
	TXNN	SW,CH.X
	 JRST	SW.I7A
	TXO	F,F.NOTB	; Use dot instead of tab
	PUSHJ	P,FILPNT	;NEED TO TELL HIM NAME IF DIDNT BEFORE
	PUSHJ	P,UFDPNT
SW.I7A:	MOVEI	M,[ASCIZ/ ENTER failure code:/]
	PUSHJ	P,MSGTTY
	HRRZ	N,BUF+EXLERC
	PUSHJ	P,OCTPRT
	PUSHJ	P,CRLF
	SETSTS	STR,14
NORESTORE: TXO	F,F.FAIL
	JRST	SW.I5		;CONTINE READING FILE FROM AUX,
				;BUT F.FAIL TELLS NOT TO WRITE IT
				;(JUST PASS IT)
;HERE TO ACTUALLY RESTORE THE DAMN DATA

SW.I6:	AOS	UBLKCT		;COUNT BLOCK LENGTH ON TAPE
	TXNE	F,F.FAIL	;RESTORING?
	 JRST	SW.I5		;NO. JUST IGNORE THIS BLOCK
	MOVE	T,[-200,,BUF]
SW.I21:	SOSLE	WH.STR+2
	 JRST	SW.I20
	OUT	STR,
	 JRST	SW.I20
	MOVEI	M,[ASCIZ/ OUTPUT error/]
	PUSHJ	P,MSGTTY
	SETSTS	STR,.IODMP
	JRST	SW.I5

SW.I20:	MOVE	CH,(T)		;GET A WORD
	IDPB	CH,WH.STR+1	;PUT INTO BUFFER
	AOBJN	T,SW.I21	;AND LOOP FOR 200 WORDS
	JRST	SW.I5		;AND CONTINUE FOR REST OF FILE.



;HERE WHEN HIT EOF ON AUX DEVICE, CLOSE LAST FILE AND QUIT

SW.I10:	SETZM	BUF+RIBNAM	;SIMPLE FLAG TO SW.I11 CODE
	JRST	SW.I13		;GO CLEAN UP ENDS


UU(WH.STR,3)	;DISK OUTPUT BUFFER HEADER FOR RESTORE CODE.

	SUBTTL	 /L -- Lock job in core
;
; /L options include:
;
;	/L  - Lock job in core
;	/LU - Unlock job

SWT.L:	TXNE	SW,CH.U		; Want to unlock or lock?
	 JRST	UNLOCK		; Unlock
	SKIPL	%LOCK		; Lock. Are we already?
	 JRST	SWT.L1		; No. OK
	JSP	M,MSGDON	; Dont need to lock twice..
	ASCIZ/%Job already locked/

SWT.L1:	PUSHJ	P,LOCKUUO	; Go lock the job
	  JRST	NOLOCK		; Cant...
	SETOM	%LOCK
	JSP	M,MSGDON
	ASCIZ/Job locked/

UNLOCK:	AOSG	%LOCK		; Locked already?
	 JRST	UNLOK1
	JSP	M,MSGDON
	ASCIZ/%Job not locked/

UNLOK1:	MOVE	N,ONEONE
	UNLOK.	N,		; Unlock us please..
	 JRST	NOLOCK		; Hmm...
	JSP	M,MSGDON
	ASCIZ/Job unlocked/
NOLOCK:	TTYON
	MOVE	T,[3,,LOKERR]
	PUSHJ	P,ERRPNT	; Print the error code
	PUSHJ	P,CRLF
	JRST	RIPDON

LOKERR:	ERRMAC	?LOCK UUO gone! , ?Job not privilleged
	ERRMAC	?Another job would not be able to run, ?Can't guarantee CORMAX
	SUBTTL	 /P -- Print according to format


SWT.P:	TXNN	SW,<CH.7!CH.6!CH.R!CH.Q!CH.O!CH.D!CH.A>
	 JRST	DSKLST		; DSKLST if no print options
	JRST	DATLST		; Otherwise, DATLST to list blocks
	SUBTTL	 /R -- Read verify disk blocks
; Simply reads all given blocks.
; Any which might be hardware unreadable are diagnosed by BLKRED...
; Defaults are BARG1=0, BARG2=Largest in STR, BARG3=1 block at a time



SWT.R:	SKIPN	BARG3		; Zero increment?
	 AOS	BARG3		; Yes. Make it one

SWT.R0:	PUSHJ	P,NXTSTR
	 JRST	RIPDON
	  JFCL

	MOV	BARG1,BUF	; BUF=block to start on.
	MOV	BARG2,BUF+1	; BUF+1=Last block to try

	MOVE	T,STRHGH	; T=Highest log. block in STR
	CAMG	T,BARG2		; Which should be more than he wants
	 JRST	SWT.R2		; Not even RIPOFF can read non-ex blocks!
	SOS	T
	SKIPN	BARG2		; Ask for zero max?
	 MOVEM	T,BUF+1		; Yes. Assume maximum then
	MOV	BARG3,BUF+2	; BUF+2=block to increment by

	MOVE	T1,BUF
SWT.R1:	CAMLE	T1,BUF+1	; Done yet?
	 JRST	SWT.R0		; Yes. Get more disks
	MOVEM	T1,BUF		; Remember new block number
	MOVE	T,[IOWD BLKSIZ,DSK+DATBUF] ; No. T=IOWD
	MOVEI	P4,DSK
	PUSHJ	P,STRRED	; Go get it..
	 JFCL			; Thats one...
	MOVE	T1,BUF
	ADD	T1,BUF+2	; Try next block
	JRST	SWT.R1


; Here on illegal maximum arg

SWT.R2:	MOVEI	M,[ASCIZ/?Only /]
	PUSHJ	P,MSGTTY
	MOVE	N,T
	PUSHJ	P,OCTPRT	;
	MOVEI	M,[ASCIZ/ Blocks on STR/]
	PJRST	MSGDON
	SUBTTL	 /S -- Manipulate SAT blocks/STRUUO functions
; Options:
;  /SL	Lock up STR (.FSLOK, then .FSREM)
;  /SR	Read SATs (DSKSAT)
;  /SW	Write them back
;  /SF	Free cluster in SAT
;  /SM	Mark cluster in SAT
;  /SP	Print sat as now in core
;  /ST	Type a cluster, i.e., tell free or marked

SWT.S:
SWT.S0:	PUSHJ	P,NXTSTR	; Get next structure
	 JRST	RIPDON		; All done
	  JFCL			; Don't care about MFD
	TXNN	SW,<CH.W!CH.T!CH.P!CH.F!CH.M>
	 JRST	SWT.S1
	PUSHJ	P,SATINC	; SATs must be already be in core
	 JRST	ERR008
SWT.S1:	TXNN	SW,CH.L		; Want to lock the STR?
	 JRST	SWT.S2		; No. Continue on

; Here to lock out a STR.

	PUSHJ	P,LOKSTR	; Do .FSLOK
	 JRST	SWT.S0
	MOVEI	T,^D10
	CAMGE	T,BARG1		; If more then 10 seconds, tell him to
	PUSHJ	P,MSG001	;  'Wait plz...'
	SKIPN	T,BARG1		; Sleep BARG1 seconds
	 MOVEI	T,^D60		; Default is 1 min
	SLEEP	T,		; Wait a while
	PUSHJ	P,REMSTR	; Do .FSREM now.
	 JRST	SWT.S0
	MOVEI	T,[MOVEI T,.DCSTN ; For all units in STR, set pack-not
		   DPB T,[POINTR UNIDES(U),DC.STS] ; mounted status
		   POPJ  P, ]
	PUSHJ	P,DOALLU	; Do for all units
	JRST	SWT.S0		; Done. Try other STR's if so wanted.

SWT.S2:	TXNN	SW,<CH.W!CH.R!CH.P>
	 JRST	SWT.S5
; Here to read or write SATs

	TXNN	SW,CH.W		; Skip if writing SATs
	 JRST	SWT.S3
	PUSHJ	P,WTSAT		; Go write SATs then
	 JRST	ERR009
	JRST	SWT.S0		; Got em.

SWT.S3:	TXNN	SW,CH.R
	 JRST	SWT.S4
	PUSHJ	P,RDSAT		; Read SATs...
	 JRST	ERR009
	JRST	SWT.S0

SWT.S4:	SETZM	TOTSAT		; Here to print SATs.
	MOVEI	T,[PUSHJ P,PNTSAT ; Print each SAT
		   ADDM  N,TOTSAT ; Accumulate STR totals
		   POPJ  P,	  ; For each unit
		]
	PUSHJ	P,DOALLU
	PUSHJ	P,CRLF
	MOVE	N,TOTSAT
	PUSHJ	P,DECPRT	; Print STR total blocks free
	MOVEI	M,BLKMSG
	PUSHJ	P,MSG
	MOVEI	M,TOTMSG
	PUSHJ	P,MSG
	JRST	SWT.S0

; Here if /SM or /SF or /ST

SWT.S5:	MOVE	P1,BARG1
SWT.S6:	CAML	P1,STRHGH
	 JRST	SWT.S0
	MOVE	T,P1
	IDIV	T,STRBPU	; T=unit,T1=block on unit
	MOVE	U,STRUNI(T)	; U=UDB
	MOVE	T,DSKSAT(U)	; T=Addr of SAT table, T1=block within table
	IDIV	T1,STRBPC	; T1=Cluster within table
	TXNE	SW,CH.T		; Want me just to type this?
	 JRST	SWT.S7		; Yes. Go type
	MOVEI	T2,MRKZRO	; No. Set up to mark or free
	TXNE	SW,CH.M		; Decide to MRKONE or MRKZRO.
	 MOVEI	T2,MRKONE
	PUSHJ	P,(T2)		; Do one.
	 JFCL
SWT.S8:	ADD	P1,STRBPC	; On to next cluster
	CAMGE	P1,BARG2	; Within bounds?
	 JRST	SWT.S6		; Yes. Do it too.
	JRST	SWT.S0		; No. Done



; Here to type out a bit

SWT.S7:	MOVEI	P2,[ASCIZ/ marked/]
	PUSHJ	P,TSTONE	; See if marked
	 MOVEI	P2,[ASCIZ/ free/]
	MOVEI	M,[ASCIZ/Cluster /]
	PUSHJ	P,MSGTTY
	MOVE	N,P1
	IDIV	N,STRBPC	;
	PUSHJ	P,OCTPRT	;
	MOVE	M,P2
	PUSHJ	P,MSGTTY
	PUSHJ	P,CRLF
	JRST	SWT.S8		; Continue for more clusters if he wants
	SUBTTL	 /U -- Create new UFD/SFD
; Make a new UFD/SFD. Gives error messages if it already
; exists. Will not create over already existing one


SWT.U:	TTYON
SWT.U1:	PUSHJ	P,NXTSTR	; Get next STR
	 JRST	RIPDON		;  until done
	  JRST	SWT.U1		; Gotta have a MFD
	PUSHJ	P,RLSDSK
	PUSHJ	P,INIDSK	; Get us a disk
	SETOM	CURLVL		; Take running start at nesting
SWT.U2:	AOS	CURLVL		; Bump nesting level by one
	PUSHJ	P,SETUFD	; Setup for this one
	  JRST	SWT.U3		; None found so print error
	LOOKUP	STR,BUF		; Go!
	  SKIPA	P1,BUF+EXLERC	; Not there! Wonderful.
	JRST	SWT.U2		; There, so loop for next in path
	HRRZS	P1
	JUMPE	P1,SWT.U4	; Better be 0=file not found
	SKIPA			;
SWT.U3:	MOVEI	P1,ERAEF%	; Simulate error if already there
	MOVE	M,USRSTR	; Get current structure
	PUSHJ	P,PR6BIT	; and print it too
	PUSHJ	P,COLON		;
	PUSHJ	P,UFDPNT	; and current path
	HRRZ	N,P1		;
	SETZ	T,		;
	PUSHJ	P,ERRPNT	; Print error message
	PUSHJ	P,CRLF		; Tidy up
	JRST	SWT.U1		; Give up on this str


; Here when OK to make UFD/SFD

SWT.U4:	PUSHJ	P,MAKUFD	; Go make a UFD
	 JRST	SWT.U1		; Error or done
	MOVEI	M,[ASCIZ/Created /]	; Tell of success
	PUSHJ	P,MSG		; print it
	MOVE	M,USRSTR	; Get current str
	PUSHJ	P,PR6BIT	; and print it
	PUSHJ	P,COLON		;
	PUSHJ	P,UFDPNT	; and current path
	PUSHJ	P,CRLF		;
	AOS	CURLVL		; Bump SFD nesting level
	JRST	SWT.U4		; and try next level
	SUBTTL	 /V - Verify files and rebuild SATs
; File RIBs are checked, all blocks of the file are
;read (If A option), second RIBs are found and verified, and file is 
;checksummed and SAT bits are checked (DSKRAT)
;and compared against disk SATs to find multiply used, free and lost clusters


SWT.V:	SETCM	T,F
	TXNN	T,STNDRD	; Were all files specified?
	 TXOA	F,F.TRB		; Yes, tell routines to look for trouble
	  TXZ	F,F.TRB		; No, forget it
	SETOM	PASS		; Count passes
	PUSHJ	P,NXTSTR	; Get a STR
	 JRST	RIPDON		; If all done
	 JRST	.-3		; Must have a MFD
	MOVE	T,USRSTR	; Get specified str
	TXNE	F,F.TRB		; Looking for trouble?
	 CAME	T,LSTDEV	; and STR same as LST device?
	  SKIPA			; No to one
	   PUSHJ P,ASK005	; Yes, question his judgement
	TXNN	SW,CH.F		; Going to fix SATs?
	 JRST	SWT.VA		; Nope
	MOVE	T,TTYTYP	; Get original device type
	CAIE	T,$DVSTR	; and other than STR specified?
	 JRST	ERR015		; Gotta have STR to fix SATs
	PUSHJ	P,STRMNT	; Is this STR mounted?
	 JRST	ERR016		; Yes, can't do this
SWT.VA:	MOV	.JBFF,.SVFF	; Save current field length
	TXZE	F,F.TRB		; If looking for trouble,
	 PUSHJ	P,RDSAT		;  read SATs.
	  TXZA	F,F.TRB		; Can't do it, so don't look for trouble
	   TXO	F,F.TRB		; Got 'em, reset the flag
	MOVEI	T,[ PUSHJ P,SATADD ; Allocate space for trouble SAT on
		    MOVEM T,TRBSAT(U)  ; all units
		    POPJ  P, ]
	PUSHJ	P,DOALLU	; Do above code on all units
	TXNN	SW,CH.A		; Read all blocks?
	 TXZA	F,F.RALL	; No, make sure it doesn't happen
	  TXO	F,F.RALL	; Yes, tell input routines
SWT.V1:	TTYOFF			; Turn off TTY output
	MOV	.JBFF,TEMP3	; Remember core before OURSAT allocated
	TXNE	SW,CH.Q		; If quick wanted,
	 TXO	F,F.QUICK	; Let it be so.
	PUSHJ	P,BLDSAT	; Now go build a SAT from file
				; information, noticing troubles in TRBSAT
	PUSHJ	P,SETBAT	;SET BITS FOR BLOCKS POINTED TO BY BAT
	AOSE	PASS
	 JRST	SWT.V4		; Only make two passes
	PUSH	P,F		; Save flags for F.TRB
	TXZN	F,F.TRB		; Did we read SATs above??
	 PUSHJ P,RDSAT		; No. Read them now.
	  SKIPA	P4,[$PRLST]	; Yes. We looked for trbl before
	   MOVEI P4,$PRFRE	; No. Dont look for it now!
	PUSHJ	P,PRALL		; Print lost, free and mult clusters
	POP	P,T		; Unless only did a few files (F.TRB not set)
	AND	T,[F.TRB]	; In which case only free and mult.
	TDO	F,T		; Reset state of F.TRB in F..
	PUSHJ	P,FORM		; Form feed to output listing
	MOVEI	M,[ASCIZ/
End of pass 1 on /]
	PUSHJ	P,MSGTTY	; Tell of event
	MOVE	M,USRSTR	; Get STR we've been doing
	PUSHJ	P,PR6BIT	; Tell him which STR.
	TXNE	F,F.MULT	; Any multiply used clusters?
	 JRST	SWT.V2		; Yes.
	MOVEI	M,[ASCIZ/. No need for pass 2./] ; No.
	PUSHJ	P,MSG
	JRST	SWT.V4

SWT.V2:	MOVEI	M,[ASCIZ/. Beginning Pass 2./]
	PUSHJ	P,OPER		; Make sure he wants it
	 JRST	SWT.V4
	MOV	TEMP3,.JBFF	; Restore .JBFF to deallocate OURSAT
				; So that BLDSAT will start all over again.
	PUSHJ	P,REWSTR	; Rewind the str
	 JRST	DIE003		; Succeeded once!
	 JRST	DIE003
	JRST	SWT.V1		;  and go do it again
; Now, if /VA, read rest of str too...

SWT.V4:	TXNN	SW,CH.A		; Well?
	 JRST	SWT.V5		; Nope.
	TXNN	F,F.TRB		; Must have read in SATs to do this..
	 JRST	SWT.V0		; Forget it
	SETOB	P1,P2		; Test BUF(P1)=C(P2)
	SETZM	BUFHED		; BUF(P1)=zero, P2=-1, match is doubtfull..
	SETOM	SATFLG		; Read only if not in DSKSAT
	SETOM	SETBLK		; Begin at block 0
	MOVEI	T,[ MOV OURSAT(U),DSKSAT(U) ; Move SAT pointers
			POPJ P,	];  So that OURSAT becomes DSKSAT
	PUSHJ	P,DOALLU
	HLRZ	U,UNIDDB
	MOVEI	T4,1		; Increment by 1 block
	PUSHJ	P,SEARCH	; Search for a block that cannot be found
	 SKIPA			; Done...
	JRST	.-2		; If found, ignore it

; Now rewrite sats back out if /VF


SWT.V5:	TXNN	SW,CH.F		; Want it?
	 JRST	SWT.V0		; No. Done
	TXNN	F,F.TRB		; Do *.*[*,*]??
	 JRST	ERR010		; No. Cant do it.
	TXNE	CH,CH.A		; Go through /VA above?
	 JRST	SWT.V6		; Yes. Forget this
	MOVEI	T,[ MOV OURSAT(U),DSKSAT(U)	; No, Make DSKSAT=OURSAT
			POPJ P, ]
	PUSHJ	P,DOALLU

SWT.V6:	MOVEI	M,[ASCIZ/
Prepared to rewrite SATS/]
	PUSHJ	P,OPER		; Make sure he wants it
	 JRST	SWT.V0
	TXZ	F,F.TRB!F.OURS	; Dont look at bits again!
	PUSHJ	P,WTSAT		; Rewrite SATs then.....
	 JRST	ERR009		; Ohboy!

; Here when all done, deallocate core and continue

SWT.V0:	MOV	.SVFF,.JBFF	; Restore .JBFF
	JRST	SWT.V
	SUBTTL	 /W -- Do word searches

REPEAT LOGIC, <

/W options include:

/WM -	Set search mask to specified value
/WW -	Set search word to specified value
/WT -	Type current values of search mask and word
/WS -	Start word search for specified values

>

SWT.W:	TXNN	SW,CH.T		; Typing values?
	 JRST	SWT.W1		; No
	TTYON			; Enable TTY output
	PUSHJ	P,SWWPRT	; Type the values
	PJRST	RIPDON		; and finish up

SWT.W1:	TXNN	SW,CH.M		; Setting mask register?
	 JRST	SWT.W2		; No
	MOV	BARG1,WMASK	; Set new value
	PJRST	RIPDON		; and finish up

SWT.W2:	TXNN	SW,CH.W		; Setting search word?
	 JRST	SWT.W3		; No
	MOVE	T,BARG1		; Assume it looked like a block number
	SKIPN	GOTWRD		; Are we correct?
	 MOVE	T,USRNAM	; No, get something that looks like this
	MOVEM	T,WWORD		; Set new value
	PJRST	RIPDON		; and finish up
; Here to do the search for the specified word.  Note that one
; may search files or relative blocks.

SWT.W3:	TXNN	SW,CH.S		; Better be start of search
	 JRST	ERR001		; No, bad option
	PUSH	P,BARG1		; Save value for later
	SETOM	PASS		; Count number of matches

SWT.W4:	PUSHJ	P,NXTSTR	; Get next STR
	 JRST	[POP P,BARG1	; Restore BARG1
		 JRST RIPDON]	;  and finish up
	 JFCL			; Don't care about MFD
SWT.W5:	SKIPE	GOTWRD		; Skip if no block arg
	 JRST	SWT.W8		; Go process blocks
	PUSHJ	P,NXTPPN	; Get next PPN
	 JRST	SWT.W4		; If none left
SWT.W6:	PUSHJ	P,NXTFIL	; Get next file
	 JRST	SWT.W5		; If none left
	PUSHJ	P,USRLOK	; Lookup the file
	 JRST	SWT.W6		; Not there
	MOV	IOW,XIOWD+DSK	; Setup IOWD to read into BUF
SWT.W7:	MOVEI	P4,DSK		; Setup core block pointer
	PUSHJ	P,DMPIN		; Get the next block of the file
	MOVX	T,IO.EOF	; Get EOF flag
	TDNE	T,IOSTS+DSK	; Hit EOF?
	 JRST	SWT.W6		; Yes, try next file
	PUSHJ	P,WRDMAT	; Search this block and print matches
	JRST	SWT.W7		; and loop for rest of file
;
; Here to do block searches

SWT.W8:	MOVEI	P4,DSK		; Setup core block pointer
	MOVE	T1,BARG1	; Get next block to read
	MOVE	T,IOW		; Get IOWD to use
	PUSHJ	P,STRRED	; Read the block
	 JFCL			; Oh well, do the search anyway
	PUSHJ	P,WRDMAT	; Search this block
	AOS	T,BARG1		; Bump the block count
	CAMG	T,BARG2		; Done enough?
	 JRST	SWT.W8		; No, loop for more
	JRST	SWT.W4		; Try next structure
	SUBTTL	 /X -- Perform cleanup and exit
; Options are:
;  /XQ - Run QUEUE automatically after closing files
;

MSGXIT:	PUSHJ	P,MSGTTY	; Here to print msg and exit

SWT.X:	PUSHJ	P,KILL		; Close listing files
	TXNN	SW,CH.Q		; Want to run QUEUE too??
	 EXIT			; No. Forget everthing..
	MOVSI	T,DSYS		; Yes. Go get it!
	MOVE	T1,[SIXBIT .QUEUE.]
	SETZB	T2,T4
	OUTSTR	[ASCIZ/
.R QUEUE
/]
	JRST	RUNCOM		;  and go run it!!


; Here to CLOSE and RELEAS all listing files and devices

KILL:	OUTPUT	CMD,
	TXNE	F,F.TTY2
	 JRST	.+3
KILL1:	OUTPUT	LST,
	CLOSE	LST,
	PUSHJ	P,RLSDSK
	RELEAS	LST,
	POPJ	P,
	SUBTTL	^C INTERCEPT CODE
; No one seems to be able to remember to exit with a /X command
; after writing the listing to a file.  A ^C is used instead and
; if no CLOSE is done, the listing is lost.  To prevent this,
; the page contains the ^C intercept code.  If the user types
; a ^C when the listing is being written to a file, ask him
; if he wants to close the file.  Enter at CZEXIT to process
; a ^Z instead.



CCEXIT:	PUSH	P,INTBLK+.EROPC	; Save interupt PC
	SETZM	INTBLK+.EROPC	; Reenable intercept
CZEXIT:				; [075] Control-Z entry point
	TXNE	F,F.TTY2	; Output going to TTY?
	 JRST	CCEXT2		; Yes
	CLRBFO			; Clear output buffer
	PUSH	P,M		; Save M and TEMP
	PUSH	P,TEMP		;  (Used by OPER)
	MOVEI	M,[ASCIZ/
Close listing file before exiting?/]
	PUSHJ	P,OPER		; Ask user
	 JRST	CCEXT1		; He says no
	POP	P,TEMP		; Restore TEMP and
	POP	P,M		;  M
	PUSHJ	P,KILL1		; Clean up
	EXIT			;  and quit

CCEXT1:	POP	P,TEMP		; Restore TEMP and
	POP	P,M		;  M
CCEXT2:	MONRT.			; Exit quietly
	POPJ	P,		; Return if he says CONTINUE
	SUBTTL	SYSINI - RIPOFF once-only initialization code


; Subroutine to determine system disk configuration and build
;  a UNIDDB for all units.
; Called only once at program startup time

SYSINI:	MOVEI	U,UNIDDB	; Start at beginning
	SETOM	CTYPE		; Current controller type
SYSIN1:	AOS	T,CTYPE		; 0,1,2,3,4,5=FHA,FHB,DPA,DPB,RPA,RPB
	CAILE	T,TYPMAX	; Done all possible types?
	 JRST	SYSIN3		; Yes. Continue on
	SETOM	CUNIT		; No. Try all units here
SYSIN2:	AOS	T,CUNIT		; 0-7 units
	CAILE	T,MAXUNI	; Skip if still in range
	  JRST	SYSIN1		; Not, so try another controller
	MOVSS	T
	HRR	T,CTYPE		; T=XWD unit,, controller type
	PUSHJ	P,INIPHY	; INIT this unit. Return with T1=Unit name
	  JRST	SYSIN2		; Cant so forget it
	MOVEM	T1,USRSTR	; Remember its physical name
	PUSH	P,T		; Save DSKCHR bits
	MOVEI	T,UNIDDL	; Length of one UDB
	PUSHJ	P,CORGRB	; Grab the core
	MOVEM	T,(U)		; Save initial ptr in last UDB for link
	MOVE	U,T		; U=adr of this UDB now.
	POP	P,UNIDES(U)	; Store DSKCHR bits in UDB
; Now determine what brand of disk pack we have here..
	MOV	<[Z STR,T]>,XCHAN(U) ; Tell BLKRED how to look
	MOV	USRSTR,DRIVE(U)	;  And where to look
	MOV	BIGNUM,BLKUNI(U) ; Don't let IO.BKT get me
	MOVEI	P4,DSK		; Give it a channel data block
	MOVE	T,CTYPE		; Get controller type
	HRRZ	T4,KONADR(T)	; Get addr of AOBJN pointer
	MOVE	T4,(T4)		; Get pointer itself

SYSI8A:	MOVEM	T4,DSKPTR	; Save ptr to table
	MOVE	T1,1(T4)	; Get blocks / unit
	SOS	T1		; Try to read next to last block
	MOVE	T,IOW
	TXO	F,F.DERR	; Suppress error msg if any.
	PUSHJ	P,BLKRED	; ..
	 JFCL
	MOVE	T,DSK+IOSTS	; Get I/O status
	TXNN	T,IO.ERR	; Errors?
	 JRST	SYSI8B		; No. Got it
	MOVE	T4,DSKPTR	; Yes. Try smaller pack
	ADD	T4,[2,,2]	; Update pointer
	AOBJN	T4,SYSI8A	;  and loop.

; If none of the blocks read, must have a bad pack... Forget it

	SKIPA	M,[[ASCIZ/Can't establish unit type for unit /]]
SYSI8C:	MOVEI	M,[ASCIZ/Unit type inconsistency for unit /]
	PUSHJ	P,MSGTTY
	MOVE	M,USRSTR
	PUSHJ	P,PR6BIT
	MOVEI	M,[ASCIZ/, setting status = down
/]
	PUSHJ	P,MSGTTY
	JRST	SYSIN2		; and loop for more units



; Found unit type. Set up parameters for it

SYSI8B:	MOVE	T,1(T4)
	MOVEM	T,BLKUNI(U)	; Blocks/unit
	HRRZ	T,0(T4)
	MOVEM	T,BLKCYL(U)	; Blocks/cylinder
	HLRZ	T,0(T4)
	MOVEM	T,BLKTRC(U)	; Blocks/track
	JRST	SYSIN9		; Skip tables
; Following are the tables of disk parameters used by RIPOFF in the
; initialization code.
;
; To add a new controller type, add it's SIXBIT name to the table
; KONSIX and in the same relative position in KONADR, add the
; DSKCHR controller type code and the pointer to the appropriate
; AOBJN pointer to the unit tables.  To add a new type of disk
; drive, select the controller type on which it is to be used and
; determine the correct disk table from the pointer.  In that table,
; add the necessary attributes for the drive.  Note that the
; blocks/unit parameters in each table must be in strictly decreasing
; order.

	DEFINE DSKTAB(A,B,C,D)
<	XWD	A,B
	EXP	C
	EXP	D	>

;	BLKS/TRACK , BLKS/CYL , BLKS/UNIT , DSKCHR unit type

; Table for drives on RP controller

%RH10:	DSKTAB	^D20,	^D380,	^D307800,  .DCUR6	;RP06
	DSKTAB	^D20,	^D380,	^D154280,  .DCUR4	;RP04
%RHLEN==.-%RH10

; Table for FS drives on an RH10

%RHS10:	DSKTAB	^D32,	^D2048,	^D2048,	.DCUS4	; [076] RS04
%RSLEN==.-%RHS10				; [076]

; Table for drives on DP controller

%RP10:	DSKTAB	^D10,	^D200,	^D80000,   .DCUD3	;RP03
	DSKTAB	^D10,	^D200,	^D40000,   .DCUD2	;RP02
%RPLEN==.-%RP10

; Table for drives on FH controller

%RC10:	DSKTAB	^D20,	^D4000,	^D4000,    .DCUFD	;RD-10
	DSKTAB	^D30,	^D2700,	^D2700,    .DCUFM	;RM10-B
%RCLEN==.-%RC10
; Below is a table of controller types to look for.  The nth
; element of KONSIX contains the SIXBIT name of the controller
; and is indexed by CTYPE.  The corresponding entry in KONADR
; contains the controller DSKCHR bits and the pointer to the
; AOBJN word for the units associated with the controller.
;
; Table of controller names

KONSIX:	SIXBIT	.   FHA.
	SIXBIT	.   FHB.
	SIXBIT	.   DPA.
	SIXBIT	.   DPB.
	SIXBIT	.   DPC.
	SIXBIT	.   FSA.	; [076] In KONSIX table
	SIXBIT	.   FSB.	; [076]
	SIXBIT	.   RPA.
	SIXBIT	.   RPB.
	SIXBIT	.   RPC.
	SIXBIT	.   RPD.		;[APC]
TYPMAX==.-KONSIX-1
;
; Table of corresponding pointers to AOBJN words

KONADR:	.DCCFH,,FHPTR
	.DCCFH,,FHPTR
	.DCCDP,,DPPTR
	.DCCDP,,DPPTR
	.DCCDP,,DPPTR
	.DCCFS,,FSPTR		; [076] In KONADR before 1st RP entry
	.DCCFS,,FSPTR		; [076]
	.DCCRP,,RPPTR
	.DCCRP,,RPPTR
	.DCCRP,,RPPTR
	.DCCRP,,RPPTR		;[APC]
;
; AOBJN pointers to associated unit types

FHPTR:	-%RCLEN ,, %RC10
DPPTR:	-%RPLEN ,, %RP10
RPPTR:  -%RHLEN ,, %RH10
FSPTR:	-%RSLEN ,, %RHS10	; [076]

; End of disk tables
; Here when we know unit, set up home stuff

SYSIN9:	SETZM	(U)		; Incase this is the last UDB.
	HRLZ	T,CTYPE
	HRR	T,CUNIT
	MOVEM	T,DEVKON(U)	; Type,, unit
	HLRZS	T		; Get type in RH
	HLRZ	T,KONADR(T)	; Get DSKCHR controller type bits
	LDB	T1,[POINTR UNIDES(U),DC.CNT] ; Get type from monitor
	CAME	T,T1		; Better be the same
	 JRST	SYSI8C		; Otherwise, something's wrong
	LDB	T,[POINTR UNIDES(U),DC.UNT] ; Get monitor DSKCHR unit code
	CAME	T,2(T4)		; Better be the same as we found
	 JRST	SYSI8C		; Otherwise error
	PUSHJ	P,HOMCHK	; Attempt to read it
	 JRST	SYSIN2		; Quit if no home blocks
	SKIPN	BUF+HOMHID	; or if no ID.
	 JRST	SYSIN2
	HRRZI	T,1(U)		; Adr. of UDB+1
	HRLI	T,BUF+1		; Adr of disk block+1
	BLT	T,HOMEND-1(U)	; Zap block into UDB
	MOVE	T,BLKUNI(U)	; Blocks/unit
	IDIV	T,HOMBPC(U)	;  T=full clusters/unit
	SUBI	T,1		; T=(clusters/unit)-1
	IDIV	T,HOMSPU(U)	; T=(clusters/SAT)-1
	MOVEM	T,UNICPS(U)	; Store it
	AOS	UNICPS(U)	; clusters/SAT=(((clus/unit)-1)/(SAT/unit))+1
	IDIVI	T,^D36		; words/SAT=(((clus/SAT)-1)/(clus/word))+1
	ADDI	T,1
	MOVEM	T,UNIWPS(U)	; Words/SAT block
	HRRZI	T,P1
	HRRM	T,HOMCLP(U)	; Make all byte ptrs point to P1
	HRRM	T,HOMCNP(U)
	HRRM	T,HOMCKP(U)
	JRST	SYSIN2		; Loop for all units

; Here to set up STRTAB

REPEAT LOGIC,<

STRTAB:	BLOCK 1		; Initial ptr to following table

	SIXBIT .STR1.		; Table somewhere in core
	Z,,ADR. Unit 0 UDB
	Z,,ADR. Unit 1 UDB
	Z,,ADR. Unit N UDB
	SIXBIT .STR2.		; Note that all SIXBITs are negative
	Z,,ADR. Unit 0 UDB	; While addresses are positive
	Etc..
	Z,,Z			; Ends the list

>

SYSIN3:	MOVEI	T,<MAXSTR+1>*<MAXUNI+2>+1	;
	PUSHJ	P,CORGRB	; Get max core for the JOB
	MOVEM	T,STRTAB	; Initial ptr
	MOVEI	U,UNIDDB	; Adr. first UDB
SYSIN4:	HRRZ	U,(U)		; Adr. next UDB
	JUMPE	U,SYSIN7	; Until done.
	SKIPN	T,HOMSNM(U)	; See what STR this unit's on
	 JRST	SYSIN4		; None. Forget it
	SKIPL	T1,HOMLUN(U)	; If negative unit,
	 CAILE	T1,MAXUNI	;  or out of normal range,
	  JRST	SYSIN4		; Probably just random bulsht. Forget it
	SKIPA	P1,STRTAB	; Begin at STRTAB
SYSIN5:	ADDI	P1,MAXUNI+2	; Look at next entry
	SKIPN	T1,(P1)		; Is it zero?
	 JRST	SYSIN6		; Yes. Hit end without match.
				; This is a new STR. Add it to list
	CAME	T,T1		; No. Is this the same as
				; STR this unit's on?
	 JRST	SYSIN5		; No. Keep looking
	SKIPA			; Yes. STR already in table. Just
				;  UDB entry for this unit.

SYSIN6:	MOVEM	T,(P1)		; Put new STR in table
	MOVEI	T,1(P1)		; Adr. of entry for unit 0
	ADD	T,HOMLUN(U)	; Adr for unit N
	MOVEM	U,(T)		; Put UDB adr there
	JRST	SYSIN4		;  and continue for all units

; Here to compress STRTAB. Skip zero words

SYSIN7:	MOVNI	T,<MAXSTR+1>*<MAXUNI+2>	;
	HRL	T,STRTAB
	MOVSS	T		; IOWD to table for AOBJN
	MOVSI	P1,(POINT 36,0,35) ; P1=36 bit byte pointer
	HRRI	P1,-1(T)	;  to str table
	SKIPE	T1,(T)		; Is it zero?
	 IDPB	T1,P1		; No. Put it back in table
	AOBJN	T,.-2		; Loop for whole table
	SETZ	T,
	IDPB	T,P1		; End it with a zero
	ADDI	P1,1
	HRRZM	P1,.JBFF	; Conserve core not used now
	POPJ	P,		; That is it. System is initialized
; Subroutine to INIT a device on channel STR
; Call	T= XWD unit ,, controller type
; Ret+0	No such unit
; Ret+1	with T1=Device name.
;	     T = monitor DSKCHR bits
;     M,T,T2 destroyed

INIPHY:	PUSHJ	P,PHYNAM	; Construct physical name
	MOVEI	T,.IODMP	; Dump mode
	MOVE	T1,M		; Name
	SETZ	T2,
	OPEN	STR,T
	 POPJ	P,
	MOVE	T,[1,,M]
	DSKCHR	T,		; Do DSKCHR to see what monitor says
	 SETZ	T,		; No bits
	JSP	M,TTYOUT	; Turn on TTY now
	TXNE	T,DC.OFL	; Is it off-line?
	 PUSHJ	P,INI001	; Yup. So monitor tells me.
	TXNE	T,DC.HWP	; Write protected?
	 PUSHJ	P,INI002	; Uh-huh
	LDB	T2,[POINTR T,DC.STS] ; Get status bits (DC.STS field)
	JUMPE	T2,CPOPJ1	; Zero is OK
	CAIN	T2,.DCSTD
	 PUSHJ	P,INI003	; The unit is down
	CAIN	T2,.DCSTN
	 PUSHJ	P,INI004	; No pack mounted
	CAIN	T2,1
	 PUSHJ	P,INI005	; Reserved for future!
	JRST	CPOPJ1		; Thats all folks..

; Here to type error (warning actually) messages.
; Type unit name, message, and ask to ignore monitor status.

INI001:	JSP	M,INI000
	ASCIZ/ is off-line/
INI002:	JSP	M,INI000
	ASCIZ/ is write protected/
INI003:	JSP	M,INI000
	ASCIZ/ is down/
INI004:	JSP	M,INI000
	ASCIZ/ has no pack mounted/
INI005:	JSP	M,INI000
	ASCIZ/ has broken the time barrier/

INI000:	PUSH	P,M		; Save message address
	MOVE	M,ST$OPT	; Get the startup option
	CAIE	M,$OPLON	; Was it LONG?
	 JRST	[POP	P,(P)	; Get rid of message address
		 JRST	INI047 ];  and go simulate NO answer
	PUSH	P,T		; Save DSKCHR bits across calls
	MOVEI	M,[ASCIZ/
Unit /]
	PUSHJ	P,MSGTTY
	MOVE	M,T1		; Get unit name
	PUSHJ	P,PR6BIT
	POP	P,T		; Restore T
	POP	P,M		; Restore message address
	PUSHJ	P,MSG		;  and print it
	MOVEI	M,[ASCIZ/
Type YES to ignore error, NO to consider pack down/]
	PUSHJ	P,OPER		; Ask for confirmation
	 SKIPA
	POPJ	P,		; He says ignore. Return.
INI047:	POP	P,(P)		; He says no. POP return to INIPHY
	POPJ	P,		;  and make like INIT error, no such unit.
; Subroutine to construct physical device controller name.
; Call	T=XWD Unit ,, Controller type
; Ret	M=Name

PHYNAM:	HLRZ	M,T		; Unit number
	ADDI	M,'0'		; Make it SIXBIT
	LSH	M,^D12
	HRL	M,KONSIX(T)	; Put in controller name
	POPJ	P,		;  and exit
	SUBTTL	RIPUUO - File service routines for RIPOFF

; Subroutine to find  and initialize (INIT) next structure
;  Ret+0	No more structures
;  Ret+1	Next STR fixed up, but no MFD on STR
;  Ret+2	Next STR fixed up, and MFD OK on channel MFD



NXTSTR:	JSP	M,SAVE3		; Save a few AC's
	SETOM	CURLVL		; Set nesting level to -1 (MFD)
	TXZ	F,F.MFD!F.1UNI	; No MFD yet and not in pass 2
	MOVE	T,TTYTYP	; Get DEVTYP of original name
	CAIE	T,$DVCNT
	 CAIN	T,$DVCON
	  JRST	@NXTTAB(T)
	 JUMPN	T,.+2
	JRST	@NXTTAB(T)	; If 3,4 or 0 , process now

; Here if 1,2,5 or 6 - can only be called once

	AOSE	STRFLG		; Been here before?
	 JRST	NXTDON		; Yes. Clear bits and popj
	CAIE	T,$DVSTR	; No. Type 1?
	 TXO	F,F.1UNI	; No. Type 2,5,6 all have only one unit
	JRST	@NXTTAB(T)	;  and dispatch on DEVTYP

NXTTAB:	NXTST0
	NXTST1
	NXTST2
	NXTST3
	NXTST4
	NXTST5
	NXTST6

NXTDON:	SETOM	STRFLG
	HRRZS	UNIDDB
	TXZ	F,F.1UNI
 	POPJ	P,
; Here if type 0= DSK (Generic)
; Each call will return another structure in system linked in UDBs

NXTST0:	SKIPE	T,USRSTR	; Get last STR name
	PUSHJ	P,FNDSTR	; Find it in STRTAB 
	 MOVE	P1,STRTAB	; Not found so start with first one.
	SKIPLE	U,(P1)		; Find the next name in table
	 AOJA	P1,.-1
	 JUMPE	U,NXTDON	; Unless were at the end now
	MOVE	T,(P1)
	MOVEM	T,USRSTR	; OK. Got next one

; Here with U=Unit 0 UDB address, P1=Adr of STR name in STRTAB

NXTSTA:	MOVEI	U,UNIDDB	; Start with UNIDDB
NXTSTB:	SKIPG	T,1(P1)		; Look through table
	 JRST	NXTSTC		; Until next STR name
	HRLM	T,(U)		; Moving UDB addresses to UDB links
	MOVE	U,T
	AOJA	P1,NXTSTB

NXTSTC:	HRRZS	(U)		; End it all with a zero in LH link
	JRST	LNKDON		;  and we're done.


; Here if type 1 = specific structure name
; Return only once linking that STR


NXTST1:	MOVE	T,USRSTR	; Get its name
	PUSHJ	P,FNDSTR	; Find it in table
	 JRST	DIE004		; Gotta be there
	SOJA	P1,NXTSTA	;  and go link this STR now and return
; Here if type 2 =  specific unit in structure (DSKB3)
;  or type 5 = specific unit on a controller (DPA3)
;  or type 6 = specific home ID (PRV001)
;
; All return exactly one unit each call
NXTST2:
NXTST5:
NXTST6:	MOVE	U,TTYDDB	; UDB found in scanner
	HRLM	U,UNIDDB	; It is only link
	JRST	NXTSTC		; Go add a zero eol and continue



; Here if type 3 = controller type (DP)
;  or type 4 = specific controller (DPB)
; Return one unit on each call

NXTST3:
NXTST4:	MOVE	T,TTYSTR
	PUSHJ	P,MSKUNI	; Make mask in T1
	HLRZ	U,UNIDDB	; Get adr. of last unit found
	SKIPN	U		; None?
	 HRRZ	U,UNIDDB	; Well then use first unit
NXTSTD:	MOVE	U,(U)		; Go to next UDB in system
	JUMPE	U,NXTDON	; Unless no more
	MOVE	T2,DRIVE(U)
	AND	T2,T1		; Get units name to a few chars
	CAME	T,T2		; Match?
	 JRST	NXTSTD		; No. Keep trying
	HRLM	U,UNIDDB	; Yes. got one
	MOV	DRIVE(U),USRSTR	; Remember its name
	JRST	NXTSTC		; Add zero ptr and go home
; Here when structure units linked
; Now initialize STRUNI table, INIT units with monitor


LNKDON:	SETZM	HIGHU		; Highest unit in STR
	SETZM	STRBPU		; Highest blocks/unit in STR
	SETZM	STRSIZ		; Total number of blocks in the STR
	SETZM	STRUNI		; Table of units in STR
	MOVE	T,[STRUNI,,STRUNI+1]
	BLT	T,STRUNI+MAXUNI	; Clear out a few things first
	MOVEI	U,UNIDDB
	MOVEI	P1,FFCHAN	; P1=Channel to INIT unit on

NXTSTE:	HLRZ	U,(U)		; Get next unit in STR
	JUMPE	U,NXTSTF	; Until done
	MOVE	T,HOMLUN(U)
	TXNE	F,F.1UNI
	 MOVEI	T,0		; If not a STR, make it look like unit 0
	CAILE	T,MAXUNI
	 JRST	DIE004
	CAMLE	T,HIGHU
	MOVEM	T,HIGHU		; Calculate highest unit
	MOVEM	U,STRUNI(T)	;  and make table OK
	MOVE	T,BLKUNI(U)
	CAMLE	T,STRBPU
	 MOVEM	T,STRBPU	; Caculate highest blks/unit in STR
	ADDM	T,STRSIZ	; By counting total blocks in STR
	MOVEM	T,CURPOS(U)	; Impossible position, force positioning.
	MOVEI	T,T
	DPB	P1,[POINT 4,T,12]
	MOVEM	T,XCHAN(U)
	TLO	T,(RELEASE)
	XCT	T		; RELEASE CHAN,T

	MOVEI	T,.IODMP	; Dump mode INIT
	MOVE	T1,DRIVE(U)	; Physical name
	SETZ	T2,
	MOVE	T3,XCHAN(U)
	TLO	T3,(OPEN)
	XCT	T3		; OPEN CHAN,T
	 JRST	DIE006
	AOJA	P1,NXTSTE	; Loop for all units in STR
; Here when str all set up, release all channels not used
;  and see if we can find the MFD

NXTSTF:	MOVSI	T,(RELEASE)	; Set to release
	DPB	P1,[POINT 4,T,12]; All still unused channels
	XCT	T
	CAIGE	P1,17
	AOJA	P1,NXTSTF	; Loop for 17 channels

	HLRZ	U,UNIDDB	; Get a unit UDB ptr back
	HRLZI	N,HOMGRP(U)	; Save a few structure parameters
	HRRI	N,STRGRP	; For each structure.
	BLT	N,STRBPC	; From UDB to resident core
	MOVE	T,HIGHU		; Highest unit
	ADDI	T,1		; +1 for unit 0
	IMUL	T,STRBPU	; Times blks per unit
	MOVEM	T,STRHGH	; =highest blk on STR

	MOVE	T,BARGFL	; Get block arg flags
	MOVE	T1,STRBPC	; Blocks/cluster
	TRNE	T,1		; Block arg 1 # ?
	 IMULM	T1,BARG1	; Yes. Fix it
	TRNE	T,2		; BARG2?
	 IMULM	T1,BARG2	; IBID.
	TRNE	T,4
	 IMULM	T1,BARG2
	SETZM	BARGFL		;  and forget flags now

REWSTR:	HLRZ	U,UNIDDB
	MOVE	T,MFDPPN	; Get MFD now
	MOVSI	T1,'UFD'
	MOVN	T2,HOMMFD(U)
	MOVE	T3,MFDPPN
	MOVEI	P4,MFD
	AOS	(P)		; Set for at least single skip return
	MOVE	N,HOMUN1(U)	; Log unit where MFD starts
	TXNE	F,F.1UNI	; Only one unit 'structure'?
	CAMN	N,HOMLUN(U)	; Yes. Dont even try lookup if MFD not on this unit..
	 PUSHJ	P,LOOKP		; Look for it
	 PJRST	NOMFD		; Not there. Give non-fatal msg and skip return
	TXO	F,F.MFD		; Got it. Flag it.
	JRST	CPOPJ1		;  and give double skip ret.
; Subroutine to find the next PPN or directory in accordance with
; the command specs.
;
; RIPOFF contains two different tree search algorithms.  The combination
; of NXTPPN and NXTFIL perform a post-order tree traversal by processing
; the files in each SFD before processing the SFD itself.  This is
; done by enabling NXTFIL to scan for SFD's itself and dropping down
; one level when it finds one that matches the command string.  The
; combination of NXTDIR and NXTFIL perform a pre-order tree traversal
; by processing all files at a given level before trying to find any
; SFD's at a lower level.  In general, the NXTDIR/NXTFIL algorithm
; is used where a nice format is desired (/P), it is impossible to
; do it the other way (/A), or where speed is not important.  As
; a result, one will find, for example, that the /F, /W, and /V
; code use the NXTPPN/NXTFIL combination because they do not need
; the slower NXTDIR/NXTFIL combination.
;
; Both return CPOPJ if no more directories
;	      CPOPJ1 with the directory setup

NXTDIR:	TXZ	F,F.NPP!F.SCAN	; Flag entry as NXTDIR, disable scanning
	SKIPGE	T,CURLVL	; Skip if not first call for this STR
	 JRST	NXTPP1		; On first call, do a NXTPPN
	MOVE	P4,CORBLK(T)	; Point to core block for this level
	MOVE	T,FNAME(P4)	; Setup for LOOKP by getting values
	MOVE	T1,FEXT(P4)	;  current values from core block
	MOVE	T2,FCFP(P4)
	MOVEI	T3,FPATH(P4)
	PUSHJ	P,LOOKP		; LOOKUP directory, thus rewinding it
	 JRST	DIREOF		; Can't, fake EOF
;
; Here to reread the directory at the current level looking for
; lower level directories that match the command string
;
NXTDI1:	PUSHJ	P,R.UFD		; Read next entry from directory
	 JRST	DIREOF		; If no more entries
	MOVE	T,CH		; Save the filename
	PUSHJ	P,R.UFD		; Read ext,,cfp
	 JRST	DIREOF		; If no more entries
	JUMPE	T,NXTDI1	; Ignore if empty
	HRRM	CH,USRCFP	; Save the CFP
	HLRZS	CH		; Isolate extension in RH
	CAIN	CH,'SFD'	; This an SFD?
	 PUSHJ	P,CHKSFD	; Yes, check for command string match
	  JRST	NXTDI1		; No to one, ignore it
	PUSHJ	P,LOOKP		; LOOKUP the directory
	 JRST	DIREOF		; Can't, simulate EOF
	MOVE	T,CURLVL	; Get level back
	SKIPN	MATFLG(T)	; Can files be matched at this level?
	 JRST	NXTDI1		; No, avoid futile calls to NXTFIL
	AOS	(P)		; Bump return point
	POPJ	P,		;  and return with new directory
;
; Here when the current directory runs out
;
DIREOF:	SKIPN	CURLVL		; Done all directories in this PPN?
	 JRST	NXTPP1		; Yes, call NXTPPN again
	SOS	P4,CURLVL	; Decrement level
	MOVE	P4,CORBLK(P4)	; Point to next higher core block
	JRST	NXTDI1		;  and continue with that one
;
; Enter here to get the next PPN as opposed to the next directory
;
NXTPPN:	TXO	F,F.NPP!F.SCAN	; Flag NXTPPN entry and enable scanning
NXTPP1:	PUSHJ	P,R.MFD		; Read one word of the MFD
	  JRST	MFDEOF		; If MFD done, try next STR's MFD
	MOVE	T3,CH		; Save the word
	PUSHJ	P,R.MFD		; Read next entry
	  JRST	MFDEOF
	JUMPE	T3,NXTPP1	; Even MFD's have zeroes
	HRRZM	CH,UFDCFP	; Save CFP to the UFD
	HLRZS	CH
	CAIE	CH,'UFD'
	  JRST	NXTPP1		; MFD's also have files other than UFD's.
	TXNE	F,S.PROJ	; Looking for a particular project?
	  JRST	NXTPP2		; No. This one's OK. Try the programmer #
	HLRZ	T1,T3		; Proj # from MFD
	HLRZ	T2,USRPTH+.PTPPN ; Proj # from file specs
	CAME	T2,T1		; Do they match?
	 JRST	NXTPP1		; No. Try another entry
NXTPP2:	TXNE	F,S.PROG	; Looking for a particular programmer?
	 JRST	NXTPP3		; No. Continue on
	HRRZ	T1,T3		; Yes. Compare MFD programmer #
	HRRZ	T2,USRPTH+.PTPPN; to user programmer #
	CAME	T2,T1		; Do they match?
	 JRST	NXTPP1		; No. Try, try again
;
; Here when we have a PPN that matches the command string.
;
NXTPP3:	MOVEM	T3,USRPTH+.PTPPN; We have our number
NXTPP4:	MOVEI	P4,UFD		; Point to correct core block
	MOV	UFDCFP,FCFP(P4)	; Save CFP of this directory
	SETZB	T1,CURLVL	; Setup for CHKPTH and indicate top level
	PUSHJ	P,CHKPTH	; See if files are matchable in UFD
	MOVE	T,USRPTH+.PTPPN	;  get our number
	MOVSI	T1,'UFD'
	MOVE	T2,UFDCFP
	MOVE	T3,MFDPPN
	PUSHJ	P,LOOKP		; LOOKUP his UFD
	  JRST	NXTPP1		; Ignore bad UFD's
	TXNN	F,F.NPP		; Enter at NXTPPN
	 SKIPE	MATFLG+0	; No, match files on this level?
	  JRST	CPOPJ1		; Yes, return success
	   JRST	NXTDI1		; Avoid futile calls to NXTFIL
;
; Here when the MFD runs out
;
MFDEOF:	TXZ	F,F.MFD		; MFD no longer looked up
	 POPJ	P,		; Return
; Routine to return the next file from a given path in accordance
; with the command string.  If F.SCAN is set, NXTFIL will process
; the files in an SFD found at the current level that matches the
; command string.
;
; Returns CPOPJ on EOF on current level if F.SCAN is not set,
;		on EOF at top level if F.SCAN is set
; Returns CPOPJ1 if file found with USRNAM, USREXT, USRCFP, USRPTH,
;		and P4 setup

NXTFIL:	PUSHJ	P,R.UFD		; Read filename from current level
	 JRST	UFDEOF		; EOF on this level
	MOVE	T,CH		; Save the filename
	PUSHJ	P,R.UFD		; Get EXT,,CFP
	 JRST	UFDEOF		; EOF on this level
	JUMPE	T,NXTFIL	; If entry is empty
	HRRZM	CH,USRCFP	; Save CFP of file
	HLRZS	CH		; Move extension to right half
	CAIN	CH,'SFD'	; This an SFD?
	 TXNN	F,F.SCAN	;  and scanning enabled?
	  JRST	NXTFI2		; Nope, try it as a file
	PUSHJ	P,CHKSFD	; SFD match command string?
	 JRST	NXTFI2		; No, process as a file
	PUSHJ	P,LOOKP		; Lookup this SFD
	 JRST	UFDEOF		; Can't, simulate EOF
	PJRST	NXTFIL		; Go process files in SFD
;
;	Here when we have a possible candidate at a given level.
;	See if we match the filename and extension specified in
;	the command string.
;
NXTFI2:	MOVE	T1,CURLVL	; Get current level
	SKIPN	MATFLG(T1)	; Files matchable on this level?
	 JRST	NXTFIL		; No, continue
	HRLZS	CH		; Move ext back to left half
	TXNE	F,S.NAM		; Need to match name?
	 JRST	NXTFI3		; No
	CAME	T,USRNAM	; The same?
	 JRST	NXTFIL		; No dice, go get next one
NXTFI3:	TXNE	F,S.EXT		; Need to match extension?
	 JRST	NXTFI5		; No
	CAME	CH,USREXT	; Match?
	 JRST	NXTFIL		; Nope
NXTFI5:	MOVEM	T,USRNAM	; Save name and
	MOVEM	CH,USREXT	; extension
	AOS	(P)		; Set for skip return
	POPJ	P,		;  and return
;
; Here when we reach an EOF on the current level.  If scanning was
; enabled, back out one level and setup to process the SFD itself
; as a file.
;
UFDEOF:	TXNE	F,F.SCAN	; Scanning enabled?
	 SKIPN	P4,CURLVL	; Yes, backed out all the way already?
	  POPJ	P,		; Yes, really an EOF
	MOVE	P4,CORBLK(P4)	; Get current core block
	MOV	FCFP(P4),USRCFP	; Get CFP for the SFD
	MOVE	T,FNAME(P4)	;  and the filename
	MOVEI	CH,'SFD'	; to process the SFD as a file
	SOS	P4,CURLVL	; Decrement level
	MOVE	P4,CORBLK(P4)	; and point to new core block
	JRST	NXTFI2		; Go process SFD
; Routine to check for an SFD that matches the command string
; Call with T = SFD name
; Returns CPOPJ if no match
;	  CPOPJ1 if the SFD matches with
;		 T-T3 setup for LOOKP
;		 CURLVL incremented and P4 setup
;		 MATFLG setup for new level
;		 Path setup in TMPPTH

CHKSFD:	SKIPN	%FTSFD		; System have SFD's?
	 POPJ	P,		; No, so can't match them
	MOVE	T1,CURLVL	; Get current SFD level
	TXNN	F,S.SFD		; All SFD's stars?
	 SKIPE	SFDFLG+1(T1)	;  or just star at next level?
	  JRST	CHKSF1		; Yes, this is a match
	MOVE	T1,USRPTH+.PTPPN+1(T1) ; Get name at next level
	CAME	T,T1		; Match with this one?
	 POPJ	P,		; No, return
;
; Here if the SFD matches the command string.  Drop down one level and
; setup to process the files in the new SFD.
;
CHKSF1:	AOS	T1,CURLVL	; Bump current level
	PUSHJ	P,CHKPTH	; Setup MATFLG appropriately
	MOVEM	T,USRPTH+.PTPPN(T1) ; Save matching SFD name
	MOVE	T2,[USRPTH,,TMPPTH] ; Get BLT pointer to move path
	BLT	T2,TMPPTH+.PTPPN+1+SFDLVL+1-1 ; Move path to where we can diddle it
	SETZM	TMPPTH+.PTPPN+1(T1) ; Insure zero terminator at correct place
	MOVE	P4,CORBLK(T1)	; Point to new core block
	MOVSI	T1,'SFD'	; Extension is SFD
	MOVE	T2,USRCFP	; Get CFP of SFD
	MOVEM	T2,FCFP(P4)	; Save in core block
	MOVEI	T3,TMPPTH	; Point to path
	AOS	(P)		; Set for skip return
	POPJ	P,		;  and return
;
;
;
; Routine to see if files can be matched at a given level of nesting
; Call with T1 = level to check
; Returns CPOPJ always with MATFLG(T1) set appropriately
;
; Preserves T1

CHKPTH:	SETZM	MATFLG(T1)	; Assume files cannot be matched
	TXNE	F,S.SFD		; Stars on all levels?
	 JRST	CHKPT1		; Yes, files are matchable
	CAME	T1,CMDLVL	; Deepest level specified in command string?
	 SKIPE	SFDFLG+1(T1)	;  or next level a star?
CHKPT1:	  SETOM	MATFLG(T1)	; Yes, files are matchable
	POPJ	P,		; Return
PNOMFD:	PUSHJ	P,NOMFD		; Tell of no MFD on this STR
	JRST	RIPDON		; and continue

NOMFD:	MOVEI	M,[ASCIZ/

No MFD on /]
	PUSHJ	P,MSGTTY
	MOVE	M,USRSTR
	PUSHJ	P,PR6BIT
	TXZ	F,F.MFD
	PUSHJ	P,CRLF2
	TTYOFF
	POPJ	P,


NOSTR:	SKIPN	USRSTR
	JRST	NOSTR1		; Didnt type any STR
	MOVEI	M,[ASCIZ/
?No such STR - /]
	PUSHJ	P,MSGTTY
	MOVE	M,USRSTR
	PUSHJ	P,PR6BIT
	JRST	SCAN

NOSTR1:	MOVEI	M,[ASCIZ/?Must specify a STR/]
MSGDON:	PUSHJ	P,MSGTTY
	PUSHJ	P,CRLF2
	JRST	RIPDON
; Subroutine to find out what type of disk argument we have supplied
; in AC T.
;
; Return+0 always with T1=type code.
;
; Types are:

$DVGEN==0	; Generic disk (D,DS,DSK,ALL, or zero arg)
$DVSTR==1	; STR name (DSKA,DSKB)
$DVLUN==2	; Logical unit within a STR (DSKA3)
$DVCNT==3	; Controller type(DP,FH,MD)
$DVCON==4	; Controller (DPA,FHB)
$DVPHD==5	; Physical drive within controller (DPA3,FHA0)
$DVPID==6	; Pack ID (PRV006,LIB000)

; or T1=-1 if none of the above...
;
; U = Unit UDB address (unless type 0, U unspecified)
;
;
; Note that other types may be added. Program should not check for type
; 6 by CAIGE instruction.


DEVTYP:	JUMPE	T,DEVTY0	; Zero arg, return zero
	CAMN	T,[SIXBIT/ALL/]	; Was it ALL:?
	 JRST	DEVTY0		; Yes, return $DVGEN
	PUSHJ	P,MSKUNI	; Make T1=mask for as many chars as typed
	MOVSI	T2,'DSK'	; Look for generic
	AND	T2,T1		; Only as exact as he wants
	CAME	T,T2		; That it?
	 JRST	DEVTY3		; No. got to look at UDB's..

DEVTY0:	MOVEI	T1,$DVGEN	; Yes. Return zero code
	POPJ	P,		;  and exit

DEVTY3:	MOVEI	U,UNIDDB	; Look at UDBs
DEVTY1:	HRRZ	U,(U)		; Get next UDB
	JUMPE	U,DEVTY2	;  or zero if hit end
	CAME	T,HOMSNM(U)	; Is it a STR?
	 JRST	DEVTY4
	MOVEI	T1,$DVSTR	; Yep.
	POPJ	P,		; Return it

DEVTY4:	CAME	T,HOMLOG(U)	; How about a log unit within STR?
	 JRST	DEVTY5
	MOVEI	T1,$DVLUN	; Yup
	POPJ	P,
				CONT.
DEVTY5:	CAME	T,HOMHID(U)	; Would you believe a pack ID?
	 JRST	DEVTY6		; Nope.
	MOVEI	T1,$DVPID	; Uh-huh
	POPJ	P,

DEVTY6:	MOVE	T2,DRIVE(U)	; Now look at physical names
	AND	T2,T1		; Mask it
	CAME	T,T2		; Match?
	 JRST	DEVTY1		; No. No matches at all. Try next unit
	MOVE	T1,DRIVE(U)	; Yes. Get back drive name
	CAME	T,T1		; Exact match?
	 JRST	DEVTY7
	MOVEI	T1,$DVPHD	; Yes. Physical drive name
	POPJ	P,

DEVTY7:	TRZ	T1,-1		; Get rid of drive number
	CAME	T,T1		; Try again
	 JRST	DEVTY8
	MOVEI	T1,$DVCON	; Match. Controller
	POPJ	P,

DEVTY8:	TLZ	T,77		; Get rid of controller type
	CAME	T,T1
	 JRST	DEVTY1		; No match. Try another unit
	MOVEI	T1,$DVCNT	; Made it! Two letter cont. type
	POPJ	P,

; Here when done all units, and still no matches found

DEVTY2:	SETO	T1,		; Give error AC=-1
	POPJ	P,

; Subroutine to find a name in STRTAB
; Call	T=SIXBIT name
; Ret+0	Not found
; Ret+1	T unaltered
;	P1=Adr of match + 1
;	U=(P1)= Adr of first unit UDB.
;

FNDSTR:	MOVE	P1,STRTAB	; Start looking at STRTTAB
FNDST1:	SKIPLE	U,(P1)		; Look at entry
	 AOJA	P1,.-1		; Wait for negative or zero
	JUMPE	U,CPOPJ		; If zero, hit end with no match
	CAME	T,U		; Minus. Must be a STR name
	 AOJA	P1,FNDST1	; But must be our name..
	MOVE	U,(P1)		; Adr unit 0 UDB
	AOJA	P1,CPOPJ1	;  and quit



; Subroutine to execute a given subroutine
;  for U=each unit of STR.
; Call	T=Address of subroutine
;	Subroutine may destroy T..
;	Must CPOPJ always, no skip returns please

DOALLU:	MOVEI	U,UNIDDB	; Start at beginning
	HLRZ	U,(U)		;  and move up a unit
	JUMPE	U,DOALL1	; Until hit the end.
	PUSH	P,T		; Save one valuable AC
	PUSHJ	P,(T)		; Go do something
	POP	P,T		; Restore AC
	JRST	DOALLU+1	;  and loop for each unit

DOALL1:	HLRZ	U,UNIDDB	; Set U=Unit 0
	POPJ	P,		;  and return.



; Subroutine to determine if a structure is mounted
; Returns CPOPJ if it is,
;	  CPOPJ1 if it isn't

STRMNT:	PUSH	P,U		; Save current U
	MOVEI	U,UNIDDB	; Point at start of chain
STRMN1:	HLRZ	U,(U)		; Move to next unit
	JUMPE	U,UPOPJ1	; Return not mounted at end
	LDB	T,[POINTR UNIDES(U),DC.STS] ; Get status for this unit
	CAIE	T,.DCSTN	; "Pack not mounted"?
	 JRST	UPOPJ		; No, either mounted or down
	JRST	STRMN1		; Loop for all units
; Subroutine to actually INIT a disk channel on channel STR.
; This is actually against RIPOFF philosophy, since
; we don't like to ask the monitor for UUO's when we can do them ourselfes.
; However, in some instances it pays to ask for help, such as DELFIL
; which tries monitor DELETE/RENAME first, then RIPOFF RENAME
; if that fails. Also /U code creates UFD's with monitor ENTERS.


INIDSK:	TXOE	F,F.INI		; Already INITed?
	 POPJ	P,		; Yes. Forget it
	MOVEI	T,.IODMP
	MOVE	T1,USRSTR
	SETZ	T2,
	OPEN	STR,T
	 JRST	NOSTR
	POPJ	P,


; Subroutine to release the STR channel INIT'ed by INIDSK

RLSDSK:	TXZ	F,F.INI
	RELEAS	STR,
	POPJ	P,
; Subroutine to read and verify home blocks on a unit
; Call with U=UDB address
; Ret+0	Home block error. Appropriate message typed
;	on console.
; Ret+1	Home block in BUF

HOMCHK:	JSP	M,TTYOUT	; Turn on TTY I/O for this
	MOVEI	T1,LHOM1	; Log address of first home block
	MOVE	T,IOW		; IOWD to buffer
	MOVEI	P4,DSK		; Adr. for channel core block
	PUSHJ	P,BLKRED	; Read 1st home block
	  JRST	HOM3		; Read error
	MOVSI	T,'HOM'
	CAME	T,BUF+HOMNAM
	  JRST	HOM2		; 1st is not SIXBIT 'HOM'
	MOVEI	T,CODHOM
	CAME	T,BUF+HOMCOD
	  JRST	HOM2		; 1st does not have proper code
	MOVEI	T,LHOM1
	CAMN	T,BUF+HOMSLF
	JRST	CPOPJ1		; Looks OK now..
	JRST	HOM2		; Not OK. Try 2nd home block

HOM3:	SKIPA	M,[[ASCIZ/
IOERR reading first HOME block /]]

HOM2:	MOVEI	M,[ASCIZ .First HOME block consistency error on .]
	PUSHJ	P,MSG
	MOVE	M,DRIVE(U)
	PUSHJ	P,PR6BIT	; Print unit here
	PUSHJ	P,CRLF
	MOVEI	T1,LHOM2	; Try 2nd home block
	MOVE	T,IOW
	PUSHJ	P,BLKRED
	  JRST	HOM4		; IOERR
	MOVSI	T,'HOM'
	CAME	T,BUF+HOMNAM
	  JRST	HOM5		; 2nd fails too.
	MOVEI	T,CODHOM
	CAME	T,BUF+HOMCOD
	  JRST	HOM5
	MOVEI	T,LHOM2
	CAME	T,BUF+HOMSLF
	  JRST	HOM5
	MOVEI	M,[ASCIZ/Second HOME block is consistent. Error recovered/]
	AOS	(P)		; Give OK return
	PJRST	MSG

; Here if both home blocks in error.

HOM4:	MOVEI	M,[ASCIZ/IOERR 2nd HOME block/]
	PJRST	MSG

HOM5:	MOVEI	M,[ASCIZ/Second HOME block consistency error./]
	PJRST	MSGTTY
;Subroutine to read and verify BAT blocks on a unit
;Call with U=UDB address
;Ret+0	BAT block error. Appropriate message typed
;	on console.
;Ret+1	BAT block in BUF

BATCHK:	MOVEI	T1,LHOM1+1	;Log address of first BAT block
	PUSHJ	P,BAT9
	 CAIA
	JRST	CPOPJ1
	MOVEI	M,[ASCIZ /First BAT block is bad on /]
	PUSHJ	P,MSG
	MOVE	M,DRIVE(U)
	PUSHJ	P,PR6BIT	;Print unit here
	PUSHJ	P,CRLF
	MOVEI	T1,LHOM2+1	;Try 2nd BAT block
	PUSHJ	P,BAT9
	 JRST	BAT4
	MOVEI	M,[ASCIZ /Second BAT block is consistent. Error recovered/]
	AOS	(P)		;Give OK return
	PJRST	MSG

;Here if both BAT blocks in error.
BAT4:	MOVEI	M,[ASCIZ /Second BAT block is bad/]
	PJRST	MSG

;HERE TO READ BAT BLOCK
;T1 PASSES BLOCK NUMBER OF WHICH BAT TO READ
;NOSKIP IF ERROR OR INCONSISTANT
;SKIP IF OK
BAT9:	TXZ	F,F.CSUM+F.DERR	;JUST TO BE SURE
	SETZM	NOIO
	MOVE	T,IOW		;IOWD to buffer
	MOVEI	P4,DSK		;Adr. for channel core block
	PUSHJ	P,BLKRED	;Read BAT block
	  POPJ	P,		;Read error
	MOVS	T1,BUF+BAFNAM	;Test consistency
	MOVE	T2,BUF+BAFCOD
	CAIN	T1,'BAT'
	CAIE	T2,CODBAT
	POPJ	P,
	JRST	CPOPJ1		;Looks OK
; Subroutine to verify a RIB block in BUF.
; Call	T1=Log block in unit of RIB
;	If F.RIB not set in LH(F),
;		FNAME(P4)=File name
;		FEXT(P4)=Extension
;		FPPN(P4)=PPN
;	If F.RIB is set,
;		Check on file names not made,
;		name need not be set up (P4)
;
; Ret+0	RIB error
;


RIBCHK:	MOVE	T,T1
	IDIV	T,STRBPU
	CAME	T1,BUF+RIBSLF	; Must agree.
	  POPJ	P,
RIBCK0:	MOVEI	T,CODRIB
	CAME	T,BUF+RIBCOD	; Code word in RIBCOD
	  POPJ	P,
	TXZE	F,F.RIB		; Check file names??
	 JRST	RIBCK2		; No. Skip this
	MOVE	T,FPPN(P4)
	CAME	T,BUF+RIBPPN	; PPN's must match
	  POPJ	P,
	MOVE	T,FNAME(P4)
	CAME	T,BUF+RIBNAM	;  along with file names
	  POPJ	P,
	HLLZ	T,FEXT(P4)
	HLLZ	T1,BUF+RIBEXT
	CAME	T,T1		;  and file extensions.
	  POPJ	P,
RIBCK2:	HRRZ	T,BUF+RIBFIR	; # of retrvl ptrs. Must be valid
	CAIG	T,BLKSIZ-2
	SKIPL	BUF+RIBFIR	;  and must also be negative
	  POPJ	P,
	JRST	CPOPJ1		; Yup. This looks like a real RIB!
; Subroutine to set up a search mask for a name.
; Call	T=Name
; Return T unchanged,
;	 T1=mask


MSKUNI:	SKIPN	T1,T		; Get name
	POPJ	P,		; Not a name - Return mask=0
	MOVSI	T2,770000	; Set up one char mask
UNIMS1:	TDON	T1,T2		; This char zero?
	JRST	UNIMS2		; Yes. Have mask
	LSH	T2,-6		; No. Shift & try next char
	JUMPN	T2,UNIMS1
UNIMS2:	TDZ	T1,T2		; Zero the last byte
	POPJ	P,		;  and return mask in T1
	SUBTTL	LOCK UUO routines

; Subroutine to do LOCK UUO.
; Will try 8 times every 2 seconds...
; Ret+0	Failed in 16 seconds
; Ret+1	Made it... both segments locked

LOCKUUO: MOVEI	N1,10		; 8 tries
LOCKU1:	MOVE	N,ONEONE
	LOCK	N,		; Try to lock
	 SKIPA
	JRST	CPOPJ1		; Got it. Return
	SOJLE	N1,CPOPJ	; Too many failures, forget it
	HRRZS	N		; Get the error code
	TRNN	N,777776	; If it is 0 or 1,
	 POPJ	P,		; Then forget it
	MOVEI	N,2
	SLEEP	N,		; Sleep a while
	JRST	LOCKU1		;  and try again
; Subroutines to do STRUUO functions
; Call	PUSHJ	P,LOKSTR	; To lock USRSTR
;	PUSHJ	P,REMSTR	; To remove it... zap.
;
; Ret+0	UUO error. Can't do it. Error msg typed.
; Ret+1	Got it.


LOKSTR:	SKIPA	T,[.FSLOK]	; Set for lock
REMSTR:	MOVEI	T,.FSREM	; Set for remove

UUOSTR: MOVEM	T,UUOFNC
UUOST0:	MOVE	T,UUOFNC
	MOVE	T1,USRSTR
	MOVEI	N,T
	STRUUO	N,		; Attempt UUO
	 SKIPA
	JRST	CPOPJ1		; Got it!

	CAIE	N,FSUNC%	; Cant complete it?
	 JRST	.+4
	MOVEI	T,1		; No, sleep a second
	SLEEP	T,
	JRST	UUOST0		;  and try again

	JSP	M,TTYOUT	; Other error, report failure
	MOVEI	M,[ASCIZ/
STRUUO error on /]
	PUSHJ	P,MSG
	MOVE	M,USRSTR
	PUSHJ	P,PR6BIT
	MOVEI	M,[ASCIZ/ function /]
	PUSHJ	P,MSG
	MOVE	N,UUOFNC
	PUSHJ	P,OCTPRT
	SETO	T,
	PUSHJ	P,ERRPNT
	PJRST	CRLF

U(UUOFNC)
	SUBTTL	UUO level routines

; Subroutine to do a 'LOOKUP' or 'ENTER' UUO
; Call
;		T=File name
;		T1=File extension
;		T2= +CFP or -log. block in STR
;		T3=PPN or path pointer
;		P4=Channel block address
;
; Ret+0	Error code in T1 and BUF+EXLERC
; Ret+1	File found, RIB left in BUF
;

ENTR:	TLOA	P4,1		; Flag entry point
LOOKP:	TLZ	P4,1
	MOVEM	T,FNAME(P4)	; Store name,
	MOVEM	T1,FEXT(P4)	; Extension,
	MOVEM	T2,RIBLBN(P4)	; RIB address
	TLNN	T3,-1		; PPN or path pointer?
	 JRST	LOOKP2		; Path pointer
	MOVEM	T3,TMPPTH+.PTPPN; Save the PPN in temporary path block
	SETZM	TMPPTH+.PTPPN+1 ; Insure zero word terminator
	MOVEI	T3,TMPPTH	;  and point to the block
LOOKP2:	HRLZI	T3,(T3)		; Move path pointer to left half
	HRRI	T3,FPATH(P4)	; Make BLT pointer to FPATH
	BLT	T3,FPATH+.PTPPN+1+SFDLVL+1-1(P4) ; Move path to core block
	SKIPL	T,T2		; If RIB address positive,
	 PUSHJ	P,CFP2BK	;  must be CFP, not block
	SKIPGE	RIBLBN(P4)	; Block or CFP?
	MOVN	T,RIBLBN(P4)	; Block. Get it.
	MOVEM	T,RIBLBN(P4)	;  and store T=log block in STR of RIB
	MOVE	T1,T
	MOVE	T,IOW		; T1=Block now, and T=IOWD
	MOVX	T2,IO.FAC	; Set internal bits now
	MOVEM	T2,IOSTS(P4)
	PUSHJ	P,STRRED	; Go read the block
	  JRST	LKER6		; Can't read RIB??
	MOVE	T1,RIBLBN(P4)	; Get back RIB address
	PUSHJ	P,RIBCHK	; Validate RIB
	  PJRST	LKER6		; Not a good RIB..
	PUSHJ	P,PTRCPY	; Copy some retrieval ptrs
	SETOM	RIBFLG(P4)	; Set flag for reading first RIB
	MOVE	T,BUF+RIBSTS	; File status bits
	MOVEM	T,FILSTS(P4)	; Set channel file status
	PUSHJ	P,SETBUF	; Go fix up data buffers
	MOVE	T,BUF+RIBSIZ	; Size of file
	ADDI	T,BLKSIZ-1	; Pad up to next block
	IDIVI	T,BLKSIZ	; Convert to blocks
	MOVEM	T,FILEN(P4)	;  and remember so we know EOF...
LOOKP1:	TLZN	P4,1		; Is this an ENTER?
	 JRST	CPOPJ1		; No. LOOKUP is done.
	MOVX	T,IO.WRT	; Yes. Set writing bit
	ORM	T,IOSTS(P4)
	MOVI	BLKSIZ+1,WDCNT(P4); Change BUFRED logic a little. Blocks
				;  are empty after 200 words, not before.
	MOVI	DATBUF(P4),DATPTR(P4) ;  and set up pointer
	JRST	CPOPJ1		; OK. He's all set up now.
; Here on RIB error

LKER6:	PUSHJ	P,ECRLF
	MOVEI	M,[ASCIZ/File /]
	PUSHJ	P,MSG
	PUSHJ	P,CHNPNT
	MOVEI	M,[ASCIZ/ RIB error /]
	SETZM	ERRFL		; Dont need CONI bits and status
	PUSHJ	P,DEVER1	;  and complain
	HRRI	T1,ERTRN%	; Bad RIB!!
	HRRM	T1,BUF+EXLERC	; Ret error code in BUF too.
	POPJ	P,



; Subroutine to do LOOKUP UUO on USRNAM,USREXT,USRPPN


USRLOK:	MOVPTH	USRPTH,TMPPTH	; Move path to where we can diddle it
	MOVE	T,CURLVL	; Get current level of nesting
	SETZM	TMPPTH+.PTPPN+1(T)  ; Insure zero terminator
	MOVE	T,USRNAM	; Get filename
	HLLZ	T1,USREXT	;  and extension
	MOVE	T2,USRCFP	;  and CFP
	MOVEI	T3,TMPPTH	; Point to path block
	MOVEI	P4,DSK		; Point to DSK core block
	PJRST	LOOKP		; Do it



;	Subroutine to compute folded checksum of a word
;	Call with (T) = word for which to compute checksum,
;		  (M) = checksum byte pointer from HOM block
;	RET+0 always with (T2) = checksum

CHKSUM:	HRRI	M,T		; Make byte pointer point to T
	LDB	T1,[POINT 6,M,11] ; Get byte width from pointer
	MOVNS	T1		; T1 = -byte width of checksum
	TLZA	M,770000	; M = POINT width,T,35
CHKSU1:	ADD	T,T2		; Add byte into remainder of word
	LDB	T2,M		; Get next byte
	LSH	T,(T1)		; and shift it out
	JUMPN	T,CHKSU1	; Continue until done
	POPJ	P,		;
; Subroutine to try a RENAME UUO.
; Call	P4=Channel adr of level to be modified
;	C(BUF)= New RIB, BUF+RIBNAM=0 indicates delete, not rename
;	As in monitor RENAMEs, LOOKUP must have been
;	previously done to set up data..
;
; Ret+0	Couldn't delete it for some strange reason
; Ret+1	File RIPped OFF
;
; Most AC's guaranteed to be destroyed...



RENAM:	SKIPN	BUF+RIBNAM	; Deleting file?
	 JRST	RENAM0		; Yes. No need to change RIB
	MOVE	T,IOW		; Transfer word points to BUF
	MOVE	T1,RIBLBN(P4)	; Get block # of first RIB
	PUSHJ	P,STRWRT	; Go write over it
	 JFCL			; Well shit.


; Here to re-write a new UFD

RENAM0:	MOVEI	T,0		; Offset into core block table
RENAM3:	SKIPN	CORBLK(T)	; Hit end yet?
	 JRST	CPOPJ		; Yes, and no match, error
	CAME	P4,CORBLK(T)	; Pointing to this core block?
	 AOJA	T,RENAM3	; No, loop for rest
	MOVE	P1,DATPTR(P4)	; Pointer to data
	SUBI	P1,2		; -2=Ptr to this UFD
	SKIPE	T,BUF+RIBNAM	; Skip if deleting file
	 JRST	RENAM1
	HRLI	T,2(P1)
	HRRI	T,0(P1)
	BLT	T,DATBUF+BLKSIZ-3(P4) ; Move entire UFD down over this entry
	SETZM	DATBUF+BLKSIZ-2(P4) ; Clean up ends
	SETZM	DATBUF+BLKSIZ-1(P4)
	JRST	RENAM2		; and go write block

RENAM1:	MOVEM	T,(P1)		; Put new name in UFD
	HLLZ	T,BUF+RIBEXT
	HLLM	T,1(P1)		;  and new ext (leave CFP undisturbed)
	SKIPA			; Done. Change DATPRT if just rename
				;  (not delete)
RENAM2:	MOVEM	P1,DATPTR(P4)	; Restore possibly changed pointer
	MOVE	T,XIOWD(P4)	; IOWD for transfer
	MOVE	T1,THISBL(P4)	; Block to overwrite
	MOVE	U,THISU(P4)
	PJRST	BLKWRT
; Subroutine to delete a file.
; Monitor LOOKUP-RENAME tried first, if anything goes wrong,
; file gets RIPped-OFF!
; Returns value of UBLKCT=number of blocks in file, unless
; LOOKUP fails or RIPOFF RENAME called in, set to -1.
; If F.DBAD set, delete only if file has monitor LOOKUP/ENTER failure

DELFIL:	PUSHJ	P,INIDSK	; Make sure we got a disk
	MOVPTH	USRPTH,TMPPTH	; Move path to where we can diddle it
	MOVE	P4,CURLVL	; Get current level of nesting
	SETZM	TMPPTH+.PTPPN+1(P4) ; Insure correct zero terminator
	MOVE	T,USRNAM	; Get filename
	HLLZ	T1,USREXT	;  and ext
	SETZ	T2,		; Third word in LOOKUP is zero
	MOVEI	T3,TMPPTH	; Point to path block
	MOVE	P4,CORBLK(P4)	; Point to correct core block
	SETZM	BUF+RIBNAM	; Flag to RENAM in case of failure
	LOOKUP	STR,T		; First try a LOOKUP so monitor sets tables
	 JRST	DELFI1		; LOOKUP fails, definitely delete it
	TXZE	F,F.DBAD	; File OK. Delete only bad ones?
	  POPJ	P,		; Yes. this file ok. dont delete
	JRST	DELFI3		; Skip error checks
DELFI1:	HRRZ	T,T1		; Get error code from LOOKUP
	CAIN	T,ERFNF%	; File not found?
	  POPJ	P,		; Yes, can't delete what aint there
DELFI3:	HLRE	T,T3		; Get +blocks or -words
	JUMPGE	T,DELFI2	; Blocks. OK
	MOVMS	T		; + words
	ADDI	T,BLKSIZ-1	; Round up to next block
	IDIVI	T,BLKSIZ	; Convert to blocks
DELFI2:	MOVEM	T,UBLKCT	; Remember blocks length of file.
	SETZB	T,T1
	RENAME	STR,T		;  and try to delete it
	 SKIPA			; Can't
	JRST	CPOPJ1		; Excellent, excellent.
	SETOM	UBLKCT		; Don't know file size
DELFI4:	TXNE	F,F.MDEL	; Want only monitor RENAME?
	 POPJ	P,		; Yes, that's it
	PJRST	RENAM		; Go RIP it OFF



; Here to delete a UFD.. Same call as DELFIL.

DELUFD:	PUSHJ	P,INIDSK	; Get a disk
	PUSHJ	P,SETUFD	; Set up UUOBLK
	  POPJ	P,		; Path exhausted
	LOOKUP	STR,BUF		; Look for it
	 JFCL
	SETZM	BUF+RIBNAM
	MOVEI	P4,MFD
	RENAME	STR,BUF
	 JRST	DELFI4		; Setup and then call RENAM
	JRST	CPOPJ1		; Got it!
; Subroutine to delete a file. Exactly like DELFIL,
; except monitor LOOKUP/RENAME not even tried. File
; Gets RIPped OFF no matter what. SATs are not updated.
; Not really a recommended subroutine, however, much
; faster than DELFIL.. Much.


RIPFIL:	PUSHJ	P,USRLOK	; Look up file first
	 JRST	RIPFI1		; Not there. Bad.
	TXZE	F,F.DBAD	; OK. Only delete not OK ones?
	 POPJ	P,		; Yes. Better leave this one alone
	SKIPA	T,BUF+RIBALC	; No. T=# of blocks allocated
RIPFI1:	SETO	T,		;  or -1 on lookup failure
	MOVEM	T,UBLKCT
	MOVE	P4,CURLVL	; Get current level of nesting
	MOVE	P4,CORBLK(P4)	;  and pointer to core block
	SETZM	BUF+RIBNAM
	PJRST	RENAM		; Go zap this file too.
; Subroutine to do buffered input, binary mode (e.g., returns one word each call)
; or allow dump mode input, IOWD in XIOWD+CHN'BLK
; Call	DMPIN for dump, BUFRED for buffered
;	P4=Channel adr.
;	F.LEN set to ignore file length and give EOF return only
;	      when RIB pointers are exhausted
; Ret+0	EOF
; Ret+1	Word in AC 'CH'
;
; Note:	There are no INITs and a channel doing buffered I/O
;	 can switch to dump at any time. If the buffered
;	 I/O was in the middle of a block, that block is lost
;	 and I/O proceeds with the next block.



BUFRED:	TLZA	P4,1		; Flags dump I/O
DMPIN:	TLO	P4,1
	JSP	M,BUFSAV	; Save most AC's
	TLNE	P4,1		; Dump or buffered?
	 JRST	BUFRD5		; Ignore word count in dump mode
	SOSLE	WDCNT(P4)	; Any room left in core?
	 JRST	BUFRD2		; Yep.
BUFRD5:	SOSGE	FILEN(P4)	; File still got blocks left?
	 TXNE	F,F.LEN		; Ignore that fact?
	  JRST	.+2		; Yes don't give EOF return
	   JRST	BUFEOF		; No. Give EOF ret now
	TXZ	F,F.CSUM	; Assume not first block in group
IGNORE:	SOSLE	BLKCNT(P4)	; Another contigious block in group?
	 JRST	BUFRD3		; Yes.
	MOVE	U,THISU(P4)	; Get last unit
	PUSHJ	P,GETPTR	; No. Get next RIB pointer
	JUMPE	P1,BUFEOF	; Done if no more pointers
	TXZE	F,F.NEWR	; GETPTR find an extended RIB?
	 SETOM	RIBFLG(P4)	; Yes, flag it as such
	MOVEM	P2,CLSCNT	; Remember # of clusters here.
	IMUL	P2,STRBPC	; P2=# of contigious blocks
	MOVEM	P2,BLKCNT(P4)
	LDB	T1,STRCLP	; T1=cluster address
	MOVE	P2,T1		; Save it in P2 for CLSCHK
	IMUL	T1,STRBPC	; Convert to blocks
	MOVEM	T1,THISBL(P4)	; Remember block #
	MOVEM	U,THISU(P4)	;  and the unit it came from.
	SKIPLE	FILEN(P4)	; Don't checksum if no more blocks
	 TXO	F,F.CSUM	; Checksum first block in group.
	HRRZ	T,P4
	CAIN	T,DSK		; On channel DSK?
	 TXNN	F,F.OURS!F.TRB	; Yes. Need to check SATs?
	  JRST	BUFRD1		; No to either. Skip it.
BUFRD6:	MOVE	T,P2		; T=cluster number
	PUSHJ	P,CLSCHK	; Check it.
	 JFCL
	SOSLE	CLSCNT		; Loop for all clusters in group
	 AOJA	P2,BUFRD6

BUFRD1:	AOSG	RIBFLG(P4)	; Was this a RIB (set by LOOKP)?
	 JRST	IGNORE		; Yes. Ignore it
	MOVE	T1,THISBL(P4)	; No. Get back block number
; Here with T1=block on unit, U=unit

BUFRD4:	MOVE	T,IOSTS(P4)
	TXNE	T,IO.WRT	; Writing this file?
	 SETOM	NOIO		; Yes. Don't bother to read then
	MOVX	T,RIPABC
	TDNE	T,FILSTS(P4)	; File always have bad checksum?
	 TXZ	F,F.CSUM	; If yes, dont try to.
	MOVE	T,XIOWD(P4)	; T:=IOWD for moving data into core
	PUSHJ	P,BLKRED	; Go read block
	 JFCL			; Ignore error for now.
	MOVE	T,IOSTS(P4)	; Are we really reading?
	TXNN	T,IO.WRT	; ??
	 JRST	BUFRD7		; Yes. Keep what we got.
	PUSHJ	P,REWRITE	; No. Were really writing
	 JFCL


; Here when data in core, reset pointers

BUFRD7:	TLNE	P4,1
	 JRST	BUFRD2		; Ignore these in dump I/O
	MOVI	BLKSIZ,WDCNT(P4) ; Reset # of words left counter
	MOVI	DATBUF(P4),DATPTR(P4) ;  and pointer to data word


; Here if all ptrs OK, data in core.

BUFRD2:	TLZE	P4,1
	 POPJ	P,		; Thats all for dump I/O
	MOVE	CH,SAVECH	; Restore CH in case writing
				; (saved at entry by BUFSAV)
	MOVE	T,IOSTS(P4)	; Check status to see if
	TXNE	T,IO.WRT	; Reading or writing.
	 MOVEM	CH,@DATPTR(P4)	; Store CH if writing
	MOVE	CH,@DATPTR(P4)	; Load CH if reading
	AOS	DATPTR(P4)	; Increment pointer
	JRST	CPOPJ1		;  and return to caller


; Here if next block contigious, dont need to read RIB ptrs

BUFRD3:	AOS	T1,THISBL(P4)	; Set to read disk block after last
	MOVE	U,THISU(P4)	; On same unit
	JRST	BUFRD4



; Here on EOF (FILEN ran out or zero pointer)
; set a few bits

BUFEOF:	MOVE	T,IOSTS(P4)
	TXO	T,IO.EOF	; Set EOF bits
	TXZ	T,IO.FAC	;  and zero active bit
	MOVEM	T,IOSTS(P4)
	SETZM	NOIO		; In case he had set it
	POPJ	P,		;  and give error ret
; Subroutine to output (re-write) last block just read on channel
; by DMPIN (or current block by BUFRED).
; Call	P4=channel address...
;
; Ret+0	Didn't succeed...
; Ret+1	OK. Block ripped off.
;


REWRIT:	JSP	M,BUFSAV	; Save the AC's
	MOVE	T1,THISBL(P4)	; Get current (last) block
	MOVE	U,THISU(P4)	; and unit
	MOVE	T,XIOWD(P4)	; and new iowd to new data
	PJRST	BLKWRT		; Zap!
; Subroutine to get next real ptr from core block
; Call	P4=Addr of core block
;	U=Last unit (incase no change of unit pointer)
; Return+0 always with:
;	P1=Retrieval ptr or 0 if no more ptrs
;	P2=Cluster count
;	U=UDB address
;	F.NEWR set in RH(F) if RIB pointers are extended
;

GETPTR:	TXZ	F,F.NEWR	; Zero this flag on every entry
	MOVEI	P1,10		; Number of times to retry on ill unit
	MOVEM	P1,TEMP
GETPT1:	SETZ	P1,
	SKIPL	P2,SAVRIB+RIBFIR(P4)  ; P2:=Adr of next pointer
	 JRST	GETPT2		; No more pointers
	MOVE	P1,(P2)		; P1:=pointer
	AOBJN	P2,.+1
	MOVEM	P2,SAVRIB+RIBFIR(P4)  ; Adr of next pointer for next time
GETPT2:	LDB	P2,STRCNP	; P2:= Cluster count
	JUMPN	P2,CPOPJ	; Done if non-zero
	TXZN	P1,RIPNUB	; Skip if new unit ptr
	 JRST	GETPT4		; EOF pointer. Done now.
	HRRZ	U,P1		; Set U=new unit
	CAMLE	U,HIGHU		; Within bounds?
	 JRST	GETPT3		; Illegal unit
	MOVE	U,STRUNI(U)	; Set U:=New unit UDB
	JRST	GETPT1		;  and try again

; Here on EOF. All pointers done. Check for extended RIBs.

GETPT4:	SKIPN	SAVXRA(P4)	; Got an extended RIB?
	 JRST	GETPT5		; No. Set P2=0 and return
	LDB	U,DEYRBU	; Get unit number from RIBXRA
	MOVE	U,STRUNI(U)	; U=UDB for this unit
	LDB	T1,DEYRBA	; Get cluster address within unit
	IMUL	T1,STRBPC	; Convert to blocks
	MOVE	T,IOW		; T=IOWD to BUF, read extended RIB
	PUSHJ	P,BLKRED	; Go read a new RIB
	 JRST	GETPT5		; Hmm.
	PUSHJ	P,PTRCPY	; Copy them into core block
	TXO	F,F.NEWR	; Tell caller I extended ptrs
	JRST	GETPT1		;  and continue as if nothing happened.
; Here on illegal unit

GETPT3:	MOVEI	M,[ASCIZ/

Illegal unit in RIB pointer file /]
	PUSHJ	P,EMSG
	PUSHJ	P,CHNPNT
	MOVEI	M,[ASCIZ/
pointer = /]
	PUSHJ	P,EMSG
	TXO	P2,RIPNUB
	MOVE	N,P2
	PUSHJ	P,OCTL12
	MOVEI	M,[ASCIZ/ = unit /]
	PUSHJ	P,MSG
	MOVE	N,U
	PUSHJ	P,OCTPRT
	SOSLE	TEMP		; Tried 10 times already?
	 JRST	GETPT1		; No. Try to get another pointer
	MOVEI	M,[ASCIZ/

Too many illegal unit pointers, EOF exit taken
/]
	PUSHJ	P,EMSG
	PUSHJ	P,ECRLF
GETPT5:	SETZB	P1,P2		; Clear P1 and P2 and exit
	POPJ	P,


; Subroutine to copy retrieval ptrs into core block
; Arg	P4=Addr of core block


PTRCPY:	MOVE	T,BUF+RIBFIR
	MOVEM	T,SAVRIB+RIBFIR(P4) ; Store ptr to ptrs
	HRLZI	T1,BUF(T)	; T1=Address of ptrs in BUF ,, 0
	HRRI	T1,SAVRIB+1(P4)	; Set to transfer them to SAVRIB
	BLT	T1,SAVRIB+BLKSIZ-RIBENT-1(P4)
	MOVEI	T1,SAVRIB+1(P4)	; First ptr is now at SAVRIB+1
	HRRM	T1,SAVRIB+RIBFIR(P4) ; So make ptr to ptrs right
	SETZM	SAVXRA(P4)
	HRRZS	T		; First word in RIB had ptr to ptrs
	CAIG	T,RIBXRA	; Is this RIB old format?
	 POPJ	P,		; Yes. Before extended ribs.
	MOV	BUF+RIBXRA,SAVXRA(P4) ; No. Store XRA (may still be zero)
	POPJ	P,
; Subroutines to read one word from disk, UFD, MFD, or SFD
; Call	PUSHJ P,R.xxx
;	 EOF return
;	 Normal return here
;


R.MFD:	MOVEI	P4,MFD
	PJRST	BUFRED

R.UFD:	MOVE	P4,CURLVL	; Get current level
	SKIPA	P4,CORBLK(P4)	; Get core block to use
R.DSK:	MOVEI	P4,DSK
	PJRST	BUFRED

W.DSK==R.DSK		; To write, we use same code, but caller
W.UFD==R.UFD		; Sets IO.WRT bit first so we know.

	DEFINE	X (N),
	< EXP SFD'N >
;
;	The following table gives the core block addresses that
;	correspond to each level of nesting.
;
	EXP	MFD
CORBLK:	EXP	UFD

	I=1
	REPEAT	SFDLVL,
	< X (\I)
	  I=I+1 >

	EXP	0


; Subroutine to do CLOSE UUOs

C.DSK:	MOVEI	CH,0	; Write zeroes
	PUSHJ	P,W.DSK
	 POPJ	P,	; Until the EOF occurs
	JRST	C.DSK

C.UFD:	MOVEI	CH,0
	PUSHJ	P,W.UFD
	 POPJ	P,
	JRST	C.UFD
; Subroutine to convert a CFP in AC T
; Returns logical block number in T,
; Relative block in unit in T1,
; U=Unit UDB address
; T=-1 if illegal unit.

CFP2BK:	IDIV	T,HOMSCU(U)	; T=Unit,T1=Supercluster in unit
	CAMLE	T,HIGHU		; Above top?
	 JRST	CFP2B2
	MOVE	U,STRUNI(T)	; U=Unit UDB
	IMUL	T1,HOMBSC(U)	; T1=Block in unit
	IMUL	T,STRBPU	; T=# of first block on unit
	ADD	T,T1
	POPJ	P,

CFP2B2:	SETO	T,
	POPJ	P,
	SUBTTL	Lowest level disk I/O routines

; Subroutine to read or write one disk block
; Call	T=IOWD to data, T1=block on unit, U=Unit UDB address,
;	P4=Channel core block address
;
; Ret+0	I/O Errors. Full error diagnostic is printed at this level.
; Ret+1	Block read/written OK.
;
; Call with F.CSUM set to checksum block and compare to checksum
;	in retrieval pointer in P1. Checksum error does not
;	cause ret+0, but IO.CKS set in LH of IOSTS word.
;
; Call with F.DERR set if you expect to get hard read error. This
;	causes error message to be suppressed (error flags still return
;	error condition). Expressely for SYSINI to determine disk pack
;	type by trying to read too large a block for various packs.
;	Flag is reset to 0 every time.
;
; Call with NOIO = -1, and the actual I/O operation will be suppressed,
;	(both USETI/O and INPUT/OUTPUT - CURPOS left unchanged)
;
; T,T1 destroyed, F.IO reset to 0 if reading(BLKRED), 1 if writing(BLKWRT)


BLKRED:	TXZA	F,F.IO		; Set reading
BLKWRT:	TXO	F,F.IO		; Set writing
BLKRD0:	TXZ	F,F.TRY		; We try all I/O twice
BLKRD1:	MOVEM	T,TIOW		; Get an immidiate AC and save IOWD
	JUMPL	T1,TOBIG	; Negative blocks not nice.
	CAML	T1,BLKUNI(U)	; Must be on unit..
	 JRST	TOBIG		; Not. Fake IO.BKT...
	SKIPGE	NOIO		; Need real I/O?
	 JRST	BLKRD4		; No, skip USETX, I/O
	AOS	T,CURPOS(U)	; Bump last block positioned to
	CAMN	T,T1		; Trying to read last block+1?
	 JRST	BLKRD2		; Yes. No USETI/O required
	MOVEM	T1,CURPOS(U)	; No. Reset new position
	MOVE	T,XCHAN(U)	; Get proper channel
	SKIPN	%SUSET		; Use SUSET.?
	 JRST	BLKRD6		; No. Skip this
	HLLZS	T		; Clear right half (was Z CHN,T)
	IOR	T,T1		; Yes. Add in block number
	TXNE	F,F.IO		; Reading?
	 TXO	T,SU.SOT	; Writing. Set bit
	SUSET.	T,		; Do UUO.
	 JRST	DIE001		; God!!!!
	JRST	BLKRD2		; Skip USETI/O stuff
; Here to position using USETI/USETO

BLKRD6:				; Use super USETI/USETO
	TXNN	F,F.IO
	 TLOA	T,(USETI)	; Set for reading or writing
	  TLO	T,(USETO)
	HRRI	T,T1
	XCT	T		; USETx CHN,T1
;
; Here when unit in position, read block

BLKRD2:	MOVE	T,XCHAN(U)
	TXNN	F,F.IO
	 TLOA	T,(IN)		; Prepare for IN or OUT-put
	  TLOA	T,(OUT)
	   SKIPA
	PUSHJ	P,[ SKIPGE WENABLE
			POPJ P,
			MOVEI M,[ASCIZ/Write enable?/]
			PUSHJ P,OPER
			 JRST DIE002
			SETOM WENABLE
			POPJ P, ]
	HRRI	T,TIOW
	SETZM	TIOW+1
	XCT	T		; IN CHN,TIOW
	 TXZA	F,F.TMP		; Got it!
	  TXO	F,F.TMP		; Bad block..
	PUSHJ	P,GETUST	; Get units status now
	TXZN	F,F.TMP		; Read succeed??
	 JRST	BLKRD4		; Yes. Go process data.
; Here on error in I/O transfer. Print msg, reset status and exit
;  but always try twice before quitting (F.TRY)

	MOVE	T1,XCHAN(U)
	TLO	T1,(GETSTS)
	XCT	T1		; GETSTS CHN,T
	HRRM	T,IOSTS(P4)	; Save it
	TXZ	T,IO.ERR!IO.EOF	; Reset error flags
	HLL	T,XCHAN(U)
	TLO	T,(SETSTS)
	XCT	T		; SETSTS CHN,BITS
	TXON	F,F.TRY		; Tried once already?
	 JRST	BLKRD5		; No. Try again
	TXZE	F,F.DERR	; Yes. Expecting this?
	 POPJ	P,		; Yes. Return now
	SETOM	ERRFL		; Print entire error status and CONI
	SOS	ERRFL
	PJRST	DEVERR		; No. Go print error msg and return

BLKRD7:	TXO	F,F.CSUM	; Turn checksum bit back on
BLKRD5:	MOVE	T,TIOW		; Prepare to try again
	MOVE	T1,CURPOS(U)	; Set position request
	JRST	BLKRD1		;  and try one more time

; Here when we got the data, now process it before returning

BLKRD4:	TXZ	F,F.DERR	; Reset flag in case set
	MOVX	T,<IO.CKS!IO.ERR>
	ANDCAM	T,IOSTS(P4)	; Clear all error bits
	AOSLE	NOIO		; Supposed to read?
	 TXZN	F,F.CSUM	; Yes. Supposed to checksum it?
	  JRST	CPOPJ1		; No. Return to him now.
	MOVE	T,TIOW
	MOVE	T,1(T)		; T=Word to checksum
	SKIPN	M,STRCKP
	 JRST	CPOPJ1		; Might be a unit not in a STR.
	PUSHJ	P,CHKSUM	; Compute checksum
	LDB	T1,STRCKP	; Get checksum from ptr
	CAMN	T1,T2		; Equality?
	 JRST	CPOPJ1		; Yep. Got it now.
	MOVX	T,IO.CKS	; No. Light err bit
	ORM	T,IOSTS(P4)
	TXON	F,F.TRY		; Tried once already?
	 JRST	BLKRD7		; No. Try again
	SETOM	ERRFL		; Don't give CONI stuff
	AOS	(P)		; Yes. Give skip return anyway
	PJRST	DEVERR		;  and give error msg
; Subroutine to read or write a disk block relative to structure
; Call	Identical to BLKRED/WRT, except T1=block on STR

STRRED:	TXZA	F,F.IO
STRWRT:	TXO	F,F.IO
	CAML	T1,STRHGH	; Must be within STR...
	 JRST	TOBIG
	IDIV	T1,STRBPU
	MOVE	U,STRUNI(T1)	; Unit number within STR
	MOVE	T1,T2		; Remainder = block on unit
	JRST	BLKRD0		; Go read it.



; Here if block too large for unit, simulate IO.BKT error

TOBIG:	MOVEI	T,IO.BKT
	ORM	T,IOSTS(P4)	; Set IO.BKT bit in IOSTS
	PUSHJ	P,GETUST	; Reset unit status
	SETOM	ERRFL		; Print entire status plus CONI
	SOS	ERRFL
	PJRST	DEVERR



; Subroutine to get a unit's CONI status

GETUST:	LDB	T,[POINT 4,XCHAN(U),12]	; Get channel number
	DEVSTS	T,		; Ask monitor for CONI
	 SETZ	T,		; If error, use zero
	MOVEM	T,UNISTS(U)	; Set status
	POPJ	P,
	SUBTTL	Assorted disk support routines

; Subroutine to find a disk block.
; Call	P1=Relative address in block of key word
;	P2=Contents of key word
;	SETBLK=Block-increment to start search with, i.e.,
;	       SETBLK+T4 = First block to start search with
;	U=UDB first unit to begin search
;	T4=Number of blocks to increment SETBLK for each read
;
; If SATFLG = 0, every T4 blocks are read.
;	SATFLG >0, ignore blocks not set in DSKSAT
;		i.e., read only if marked in SAT
;	SATFLG <0, ignore blocks set in DSKSAT,
;		i.e., read only if free blocks
;
; Ret+0	Entire STR searched, no match found
; Ret+1	SETBLK=Address of block
;	U=Unit UDB
;

SEARCH:	ADDM	T4,SETBLK	; Increment SETBLK first thing
	MOVE	T1,SETBLK	; T1=New block to search
	CAML	T1,BLKUNI(U)	; Still in unit?
	 JRST	SRCH3		; No. Try next unit
	SKIPN	SATFLG		; Want to check SATs?
	 JRST	SRCH2		; No. Forget it
	PUSH	P,T1		; Save T1
	IDIV	T1,STRBPC	; Convert to clusters
	MOVE	T,DSKSAT(U)	; T=Address of SAT table
	PUSHJ	P,TSTONE	; See if set
	 SKIPA	T,[SKIPL SATFLG] ; Skip if want to read instn.
	MOVE	T,[SKIPG SATFLG] ; Also instn for skip if want to read
	POP	P,T1		; Restore T1
	XCT	T		; Well, do we read it?
	 JRST	SEARCH		; No. Ignore the block.

SRCH2:	MOVE	T,IOW		; Yes. Read it now
	PUSHJ	P,BLKRED	; Go read it
	 JRST	SEARCH		; Ignore it if cant
	CAMN	P2,BUF(P1)	; Match?
	 JRST	CPOPJ1		; Yes. Got it!
	JRST	SEARCH		; No match, try again

SRCH3:	HLRZ	U,(U)		; Try the next unit
	SETZM	SETBLK		; Start at block zero
	JUMPN	U,SEARCH	;  and try again.
	POPJ	P,		; Unless no more units, exit
; Subroutine to make a user UFD/SFD
; Call	USRPPN/USRPTH=Path to create one for
;
; Special kludge - Call MAKUF1 to create UFD/SFD in buffered mode.
; Will not change channel status with release or inits.
;	(this specifically for /I code to make UFD's with)
;
; Ret+0	Can't. Error message given
; Ret+1	Got it. STR INITed and not released.

MAKUFD:	PUSHJ	P,INIDSK	; Get a disk
MAKUF1:	PUSHJ	P,SETUFD	; Setup BUF for UUO
	  POPJ	P,		; Path exhausted, return
	MOV	BIGNUM,BUF+RIBQTF ; Set all quotas to infinity
	MOVEM	T,BUF+RIBQTO
	SETZM	BUF+RIBUSD	; No blocks used by user yet
	MOV	<[RIPLOG!RIPDIR]>,BUF+RIBSTS ; This is a directory bit
	MOV	UFDPRT,BUF+RIBPRV ; Set UFD privelliges
	CLOSE	STR,		; Just in case
	ENTER	STR,BUF		; Do it, mac!
	 JRST	MAKUF2		; ENTER failed. Forget it
	CLOSE	STR,
	STATO	STR,IO.ERR	; All ok?
	 JRST	CPOPJ1		; Yup. Got one now.

MAKUF2:	JSP	M,TTYOUT
	PUSHJ	P,CRLF
	PUSHJ	P,UFDPNT
	MOVEI	M,[ASCIZ/ UFD creation error: /]
	PUSHJ	P,MSG
	HRRZ	N,BUF+EXLERC
	PUSHJ	P,OCTPRT
	PJRST	CRLF2
; Subroutine to setup BUF for extended LOOKUP/ENTER on UFD/SFD
; Assumes that USRPPN/USRPTH/CURLVL point to current UFD/SFD
; Ret+0 if path exhausted
; Ret+1 if path setup in BUF

SETUFD:	PUSHJ	P,ZROBUF	; Zero entire UUO block
	MOVI	EXLLEN,BUF+RIBFIR ; Set arg length
	MOVE	T,USRPTH+.PTPPN	;  Get PPN
	SKIPE	CURLVL		; Still in PPN?
	  JRST	SETUF3		; Nope, handle path special
	MOVEM	T,BUF+RIBNAM	; Store PPN as name
	MOVSI	T,'UFD'
	MOVEM	T,BUF+RIBEXT	; Extension = 'UFD'
	MOV	MFDPPN,BUF+RIBPPN ; PPN=MFD
	JRST	CPOPJ1		; Good return

SETUF3:	MOVSI	T,USRPTH	; Get path from here
	HRRI	T,TMPPTH	;  and move it to here
	BLT	T,TMPPTH+.PTPPN+1+SFDLVL+1-1   ; Move path block
	MOVEI	T,TMPPTH
	MOVEM	T,BUF+RIBPPN	; Set up pointer to path block
	MOVSI	T,'SFD'		;
	MOVEM	T,BUF+RIBEXT	; and extension
	MOVE	T,CURLVL	; Get level of SFD nesting
	PUSH	P,TMPPTH+.PTPPN(T) ; Save current SFD name
	SETZM	TMPPTH+.PTPPN(T)   ;  and make this the last word of path
	POP	P,BUF+RIBNAM	; File to create
	SKIPE	BUF+RIBNAM	; Anything there?
	 AOS	(P)		; Yes, give good return
	  POPJ	P,		;  and return
; Here to set up core blocks for data I/O.
; Call	P4=Channel address

SETBUF:	SETZM	BLKFIR(P4)
	MOVSI	M,BLKFIR(P4)
	HRRI	M,BLKFIR+1(P4)
	BLT	M,BLKEND(P4)	; Zero entire data block
	MOVSI	M,-BLKSIZ
	HRRI	M,DATBUF-1(P4)
	MOVEM	M,XIOWD(P4)	; IOWD for dump
	POPJ	P,

; Subroutine to initialize BUF. Sets all words equal to contents
; of AC T. Ret+0 always...

ZROBUF:	SETZ	T,		; Here to zero BUF
BLTBUF:	MOVEM	T,BUF		; Set first word
	MOVE	T,[BUF,,BUF+1]	; Set up BLT
	BLT	T,BUF+BLKSIZ-1	; Zap into entire block
	POPJ	P,		;  and return.


	SUBTTL	Hard error listing

; Here on hard error. Prints summary of error.
; Call	P4=channel address (for IOSTS word)
;	U=UNIDDB (for unit, CURPOS, and UNISTS)
;	Prints:
; File XXX.XXX [XX,XX] [Read|Write] error on DPAx, block x
; Status = NNNNNN IO.IMP+IO.DTE+...
; CONI = nnnnnn  (device not ready)+(Search err)+(Etc...)+(PI channel=X)
;
;	Set ERRFL to -2 to print full message
;		     -1 to suppress just CONI
;		      0 to suppress extended status and CONI

DEVERR:	PUSHJ	P,CRLF
	PUSHJ	P,ECRLF
	PUSHJ	P,CHNPNT
	MOVEI	M,[ASCIZ/ Read/]
	TXNE	F,F.IO
	 MOVEI	M,[ASCIZ/ Write/]
	PUSHJ	P,MSG
	MOVEI	M,[ASCIZ/ error on /]
DEVER1:	PUSHJ	P,MSG
	MOVE	M,DRIVE(U)
	PUSHJ	P,PR6BIT	; Tell him where
	MOVEI	M,[ASCIZ/, block /]
	PUSHJ	P,MSG
	MOVE	N,CURPOS(U)
	PUSHJ	P,OCTPRT	; Print block currently being read
	PUSHJ	P,EQUAL
	MOVE	T2,CURPOS(U)
	PUSHJ	P,PBNPRT	; Print physical address
	MOVEI	M,[ASCIZ/
Status = /]
	PUSHJ	P,EMSG
	MOVE	N,IOSTS(P4)	; Status of this channel at last input
	PUSHJ	P,HALF8
	AOSLE	ERRFL		; Suppress extended status and CONI?
	 PJRST	CRLF2		; Yes
	MOVE	N,IOSTS(P4)
	PUSH	P,ZERO		; Start stack with zero
	TXZE	N,IO.ACT
	 PUSH	P,[SIXBIT /IO.ACT/]
	TXZE	N,IO.EOF
	 PUSH	P,[SIXBIT /IO.EOF/]
	TXZE	N,IO.BKT
	 PUSH	P,[SIXBIT /IO.BKT/]
	TXZE	N,IO.DTE
	 PUSH	P,[SIXBIT /IO.DTE/]
	TXZE	N,IO.DER
	 PUSH	P,[SIXBIT /IO.DER/]
	TXZE	N,IO.IMP
	 PUSH	P,[SIXBIT /IO.IMP/]
	TXZE	N,IO.CKS
	 PUSH	P,[SIXBIT /IO.CKS/]
	MOVEI	T2,SPC2
DEVER9:	POP	P,M
	JUMPE	M,DVER10
	PUSHJ	P,(T2)
	MOVEI	T2,PLUS
	PUSHJ	P,PR6BIT	; Print all bits set in IOSTS
	JRST	DEVER9
DVER10:	AOSLE	ERRFL		; Suppress the rest?
	 PJRST	CRLF2		; Yes
	MOVEI	M,[ASCIZ/
Coni = /]
	PUSHJ	P,EMSG
	MOVE	N,UNISTS(U)	; Get CONI word supplied by monitor
	PUSHJ	P,OCTPRT	; Print it
	PUSH	P,ZERO		; Start stack with zero word
	PUSHJ	P,SETKTP	; Get internal controller type
	SKIPL	T,EMSTBL(T)	; Get message table addr, skip for LH side
	 TXZA	F,F.TYPE	; Flag right side of message table
	  TXO	F,F.TYPE	; Ditto for left side
	MOVE	N,UNISTS(U)	; Get status back
	MOVX	T1,1B33		; T1 shifts bits, first is bit 32
DEVER2:	LSH	T1,1		; Increment to next bit
	JUMPE	T1,DEVER5	; Done after 33
	TDNN	N,T1		; This bit set in status?
	 AOJA	T,DEVER2	; No, try next
	TXNN	F,F.TYPE	; Skip if left hand table
	 SKIPA	T2,(T)		; Get RH of table and skip
	  HLRZ	T2,(T)		;  or LH
	TRNE	T2,-1		; Skip if place holder
	 PUSH	P,T2		; Save message address on stack
	AOJA	T,DEVER2	;  and loop for next
DEVER5:	MOVEI	M,[ASCIZ/ (/]
	PUSHJ	P,MSG

DEVER6:	POP	P,M		; Get a msg address to print
	JUMPE	M,DEVER7	; Until done..
	PUSHJ	P,MSG
	MOVEI	M,[ASCIZ/)+(/]
	PUSHJ	P,MSG
	JRST	DEVER6

DEVER7:	MOVEI	M,[ASCIZ/PI Channel=/]
	PUSHJ	P,MSG
	LDB	N,[POINT 3,UNISTS(U),35]
	PUSHJ	P,OCTPRT
	PUSHJ	P,RPAR
	PJRST	CRLF2		; CRLF & quit with EOF return
; Routine to return the internal controller type code used by
; DEVERR.  This is not too hard in general, but it is quite
; difficult to tell the difference between an RH10 and an RH20
; controller.  If this ever becomes easier, the following code
; should be rewritten.  Internal controller types are as follows:

$FHKON==0	; FH controller
$DPKON==1	; DP controller
$R1KON==2	; RH10 controller
$R2KON==3	; RH20 controller

; In addition, the following codes are defined from COMMOD and FILIO

DIAKUN==7	; DIAG. function to return controller type
UNIKON==6	; UDB offset of addr of KDB
UNISYS==3	; UDB offset of addr of next UDB in system
RPXDI2==71	; KDB offset of DATAI for controller
R20KON==540	; First RH20 device code


SETKTP:	LDB	T,[POINTR UNIDES(U),DC.CNT] ; Get monitor controller type
	CAIN	T,.DCCFH	; FH?
	 JRST	SETKT5		; Yes
	CAIN	T,.DCCDP	; DP?
	 JRST	SETKT6		; Yes
; [076] At SETKTP + 4 1/2
	CAIN	T,.DCCFS	; [076] FS?
	 JRST	SETKT1		; [076] Yes, that's on an RH10
	MOVE	T,CPUXX		; Get CPU type we're running on
	CAIE	T,2		; If not a KL, controller must be an
	 JRST	SETKT1		; RH10 since RH20 requires KL
	MOVE	T,[2,,T1]	; Setup for DIAG. UUO
	MOVEI	T1,DIAKUN	; Function to return controller type
	MOVE	T2,DRIVE(U)	; Physical unit in question
	DIAG.	T,		; Do it
	 JRST	SETKT2		; Gotta do it the hard way
	CAMGE	T,[R20KON,,0]	; All RH20's are > R20KON
SETKT1:	 SKIPA	T,[$R1KON]	; Must be an RH10
	  MOVEI	T,$R2KON	; RH20
	POPJ	P,		; Return
;
; Here when the DIAG. UUO failed to tell us anything.  We must now
; resort to looking around in core (GAK!!!)
;
SETKT2:	MOVX	T,%LDUNI	; Setup to look in the monitor
	GETTAB	T,		; Get address of first UDB
	 JRST	SETKT1		; Take a guess
SETKT3:	HLRZS	T1,T		; Isolate the address
	JUMPE	T,SETKT1	; Guess if at end of chain without match
	PEEK	T,		; Get UNINAM
	CAME	T,DRIVE(U)	; Match with this one?
	 JRST	SETKT4		; No, try next
	MOVEI	T,UNIKON(T1)	; Point at UNIKON
	PEEK	T,		; Get address of KDB
	MOVEI	T,RPXDI2(T)	; Point at RPXDI2 in KDB
	PEEK	T,		; Get it
	TDZ	T,[DATAI 7]	; If not DATAI or DATAO, we
	TDNE	T,[700077,,-1]	; can only guess
	 JRST	SETKT1
	CAMGE	T,[R20KON_6,,0]	; RH20?
	 SKIPA	T,[$R1KON]	; No, RH10
	  MOVEI	T,$R2KON	; RH20
	POPJ	P,		; Return

SETKT4:	MOVEI	T,UNISYS(T1)	; Point at UNISYS for current UDB
	PEEK	T,		; Get new address
	JRST	SETKT3		; and look

SETKT5:	SKIPA	T,[$FHKON]	; An FH controller
SETKT6:	MOVEI	T,$DPKON	;  or a DP
	POPJ	P,		; Return
; The CONI bit tables have one entry for every bit in the
; CONI word (minus PI assignment bits) and point to the message
; for that bit.  To save space, one controller uses one half
; of the table and another uses the other half.  These tables
; are in turn pointed to by entries in EMSTBL which is indexed
; by the internally defined controller type number (see SETKTP).
; If bit 0 of EMSTBL is set for an entry, the corresponding
; controller message table is in the left half.

EMSTBL:	XWD	400000,FHEMS	; Pointer to FH controller CONI bits
	XWD	     0,DPEMS	; Pointer to DP controller CONI bits
	XWD	400000,RH1EMS	; Pointer to RP (RH10) controller CONI bits
	XWD	     0,RH2EMS	; Pointer to RP (RH20) controller CONI bits
;
;
; Table for FH,,DP CONI bits

FHEMS:
DPEMS:	EM27,,EM21		; Bit 32
	EM20,,EM20		; Bit 31
	EM19,,EM19		; Bit 30
	EM11,,EM18		; Bit 29
	EM15,,EM17		; Bit 28
	EM12,,EM16		; Bit 27
	EM26,,EM15		; Bit 26
	EM25,,EM14		; Bit 25
	EM24,,EM13		; Bit 24
	EM9 ,,EM12		; Bit 23
	EM14,,EM11		; Bit 22
	EM23,,EM10		; Bit 21
	EM22,,EM9		; Bit 20
	EM10,,EM8		; Bit 19
	EM7 ,,EM7		; Bit 18
	   0,,EM3		; Bit 17
	   0,,EM2		; Bit 16
	   0,,EM1		; Bit 15
	   0,,EM0		; Bit 14
	   0,,0			; Bit 13
	   0,,0			; Bit 12
	   0,,0			; Bit 11
	   0,,0			; Bit 10
	   0,,0			; Bit 9
	   0,,0			; Bit 8
	   0,,0			; Bit 7
	EM6 ,,0			; Bit 6
	EM5 ,,0			; Bit 5
	EM4 ,,0			; Bit 4
	   0,,0			; Bit 3
	   0,,0			; Bit 2
	   0,,0			; Bit 1
	   0,,0			; Bit 0
; Table for RH10,,RH20 CONI bits

RH1EMS:
RH2EMS:	EM27,,EM27		; Bit 32
	EM20,,EM40		; Bit 31
	EM28,,EM41		; Bit 30
	EM29,,EM42		; Bit 29
	EM30,,EM28		; Bit 28
	   0,,EM43		; Bit 27
	   0,,EM44		; Bit 26
	EM9 ,,EM45		; Bit 25
	EM31,,EM29		; Bit 24
	EM32,,EM32		; Bit 23
	EM33,,EM35		; Bit 22
	EM19,,EM46		; Bit 21
	EM35,,EM47		; Bit 20
	EM36,,EM36		; Bit 19
	EM37,,EM37		; Bit 18
	EM12,,0			; Bit 17
	EM26,,0			; Bit 16
	EM2 ,,0			; Bit 15
	   0,,0			; Bit 14
	   0,,0			; Bit 13
	   0,,0			; Bit 12
	   0,,0			; Bit 11
	EM38,,0			; Bit 10
	EM39,,0			; Bit 9
	   0,,0			; Bit 8
	   0,,0			; Bit 7
	EM48,,0			; Bit 6
	EM49,,0			; Bit 5
	EM50,,0			; Bit 4
	EM51,,0			; Bit 3
	   0,,0			; Bit 2
	EM52,,0			; Bit 1
	EM53,,0			; Bit 0

; and the error messages themselves:

EM0:	ASCIZ/*Cntrl wd par err*/
EM1:	ASCIZ/*Sector par err*/
EM2:	ASCIZ/*Chn data par err*/
EM3:	ASCIZ/*Disk wd par err*/
EM4:	ASCIZ/Unit is a drum/
EM5:	ASCIZ/Sector 80/
EM6:	ASCIZ/Low safe area/
EM7:	ASCIZ/Search done/
EM8:	ASCIZ/*End of cylinder*/
EM9:	ASCIZ/*Pwr failure*/
EM10:	ASCIZ/*Search err*/
EM11:	ASCIZ/*Data late*/
EM12:	ASCIZ/*No such memory*/
EM13:	ASCIZ/*Par err*/
EM14:	ASCIZ/*Not ready*/
EM15:	ASCIZ/*Ill write*/
EM16:	ASCIZ/Ill DATAO/
EM17:	ASCIZ/*Sector addr err*/
EM18:	ASCIZ/*Surface addr err*/
EM19:	ASCIZ/Cntrl wd written/
EM20:	ASCIZ/Busy/
EM21:	ASCIZ/*Interrupt*/
EM22:	ASCIZ/*Unit err*/
EM23:	ASCIZ/*Track-sector err*/
EM24:	ASCIZ/*Dev par err*/
EM25:	ASCIZ/*Data par err*/
EM26:	ASCIZ/*Cntrl wd par err*/
EM27:	ASCIZ/*Done*/
EM28:	ASCIZ/Attention/
EM29:	ASCIZ/Reg access err/
EM30:	ASCIZ/Cont bus overrun/
EM31:	ASCIZ/Ill cmd/
EM32:	ASCIZ/Drive response err/
EM33:	ASCIZ/DTC overrun/
EM35:	ASCIZ/Chn error/
EM36:	ASCIZ/Exception/
EM37:	ASCIZ/Data bus par err/
EM38:	ASCIZ/SD reg access err/
EM39:	ASCIZ/Ill fnc code/
EM40:	ASCIZ/PCR full/
EM41:	ASCIZ/Attention interupt enabled/
EM42:	ASCIZ/SCR full/
EM43:	ASCIZ/Massbus enabled/
EM44:	ASCIZ/Data overrun/
EM45:	ASCIZ/Chn ready/
EM46:	ASCIZ/Short wd cnt/
EM47:	ASCIZ/Long wd cnt/
EM48:	ASCIZ/22 bit chn/
EM49:	ASCIZ/Chn pulse/
EM50:	ASCIZ/Chn active/
EM51:	ASCIZ/CC inhibit/
EM52:	ASCIZ/CB full/
EM53:	ASCIZ/AR full/
	SUBTTL	SAT block I/O processing routines


; Subroutine to read/write disk SATs (DSKSAT)
; Ret+0	Error
; Ret+1	Got 'em
;
; Each SAT block on a unit is physically located near the clusters
; which it represents.  Therefore, only the first block of each
; group of SAT.SYS  contains the SAT; the rest of the blocks in each
; group are unused (and are usually -1).  Furthermore, each group
; in SAT.SYS contains precisely one cluster.
;
; The SATs are read in such that the unused words in each SAT
; block are compressed, i.e., the first word of the second SAT
; is adjacent to the last word of the first SAT in core.  No
; attempt is made to compress the unused bits in the last word
; of each SAT.

RDSAT:	TDZA	T,T
WTSAT:	SETO	T,
	MOVEM	T,WTFLAG	; 0 if reading, -1 if writing
	JUMPE	T,RDSAT4	; Jump if reading
	PUSHJ	P,STRMNT	; Is STR mounted?
	 JRST	ERR016		; Yes, can't do this
RDSAT4:	MOVSI	T,'SAT'		; Filename to lookup
	MOVSI	T1,'SYS'	;  and extension
	HLRZ	U,UNIDDB	; Point to UDB for first unit
	MOVN	T2,HOMSAT(U)	; Get -block number of RIB
	MOVE	T3,SYSPPN	;  and PPN ([1,4])
	MOVEI	P4,DSK		; Point to core block to use
	PUSHJ	P,LOOKP		; LOOKUP SAT.SYS
	 POPJ	P,		; Propagate error to caller
	MOVEI	U,UNIDDB	; Setup for reading SATs from each unit

RDSAT0:	HLRZ	U,(U)		; Get next unit in structure
	JUMPE	U,CPOPJ1	; Return at end of list
	SKIPE	WTFLAG		; If reading, allocate core first
	 JRST	RDSAT2
	PUSHJ	P,SATADD	; Allocate core for all SATs on unit
	MOVEM	T,DSKSAT(U)	; Remember where it starts
RDSAT2:	MOVE	P1,HOMSPU(U)	; P1 counts SATs on unit
	MOVE	T,DSKSAT(U)	; Get address of start of SATs
	SOJ	T,
	MOVN	T1,UNIWPS(U)
	HRL	T,T1		; T=-WPS,,Address of SAT-1 (IOWD)
;
;	Here to actually read all SATs for this unit into core.
;	By setting NOIO for all but every (blocks/cluster) blocks,
;	we effectively skip all but the first block in every
;	group (=1 cluster) thus reading in the correct block as
;	the SAT.
;
RDSAT1:	MOVEM	T,XIOWD+DSK	; Store for input routines
	MOVE	T1,HOMBPC(U)	; T1=Blocks/cluster
RDSAT3:	CAIN	T1,1		; At the 1st block of next cluster yet?
	 SKIPE	WTFLAG		; Yes. Writing??
	  SETOM	NOIO		; No to either. Dont bother disks
	PUSHJ	P,DMPIN		; Read blocks
	SOJG	T1,RDSAT3	; Loop until next real SAT is read
	SKIPE	WTFLAG		; Writing?
	PUSHJ	P,REWRIT	; Yes. Write over last block (the SAT..)
	 JFCL
	SOJE	P1,RDSAT0	; For HOMSPU times, then go to next unit
	ADD	T,UNIWPS(U)	; Inc to next SAT on this unit
	JRST	RDSAT1		;  and read it.
;SUBROUTINE TO SET IN OURSAT THE BITS FOR BLOCKS POINTED TO BY BAT
SETBAT:	JSP	M,SAVE3			;SAVE P1-P3
	MOVEI	T,SETBTU		;CALL SETBTU ONCE FOR EACH UNIT IN STR
	PJRST	DOALLU

;HERE WITH U=UDB
SETBTU:	PUSHJ	P,BATCHK		;READ BAT BLOCK
	 POPJ	P,
	LDB	P1,BAYNBR		;REGIONS FOUND BY MAPPER
	ADD	P1,BUF+BAFCNT		;PLUS REGIONS FOUND BY MONITOR
	HRRZ	P2,BUF+BAFFIR		;POINT TO FIRST PAIR +1
	ADDI	P2,BUF+1
STBTU2:	LDB	P3,BAYNBB		;NUMBER OF BLOCKS IN REGION
	ADDI	P3,1
	LDB	P4,BAYELB		;GET THE BLOCK NUMBER
	MOVE	T1,-1(P2)		;OLD STYLE BAT OR NEW?
	TRNN	T1,BAPNTP
	HRRZ	P4,(P2)			;OLD, OOPS WE DID IT WRONG
STBTU1:	MOVE	T1,BLKUNI(U)		;BLOCKS ON THIS UNIT
	IDIV	T1,STRBPC		;CLUSTERS ON THIS UNIT
	MOVE	T1,BLKUNI(U)		;T2=NUMBER OF BLOCKS NOT IN ANY CLUSTER
	SUBI	T1,1(T2)		;T1=LAST BLOCK OF LAST REAL CLUSTER
	CAMLE	P4,T1			;SKIP IF BLOCK IS WITHIN A REAL CLUSTER
	JRST	STBTU9			;NO, NEVER MIND
	MOVE	T1,P4			;CONVERT BLOCK TO CLUSTER
	IDIV	T1,STRBPC
	HRRZ	T,OURSAT(U)		;POINT TO IN-CORE SAT
	PUSHJ	P,MRKONE		;SET THE BIT
	 JFCL				;IGNORE IF ALREADY SET
	ADDI	P4,1			;BUMP BLOCK NUMBER
	SOJG	P3,STBTU1		;LOOP FOR EACH BLOCK IN REGION
STBTU9:	ADDI	P2,2			;POINT TO NEXT PAIR
	SOJG	P1,STBTU2		;LOOP FOR EACH PAIR
	POPJ	P,
; Subroutine to build a SAT in core (OURSAT)
;  by reading all files on the disk.
; Call with UNIDDB INIT'ed to structure
;	    F.RALL set in LH(F) to read all blocks
;	    F.QUICK set in RH(F) to go quickly, sets NOIO to BLKRED
;
;RET+0	always


BLDSAT:	MOVEI	T,[PUSHJ P,SATADD	; Allocate core for units SAT
		   MOVEM T,OURSAT(U)	; Remember where it starts
		   PUSHJ P,MRKSAT	; Mark unused bits at end of SATs
		   POPJ P, ]
	PUSHJ	P,DOALLU	; Allocate all units
	TXO	F,F.OURS	; Tell DMPIN to be setting bits in OURSAT


; Now read all files

BLDST3:	PUSHJ	P,NXTPPN	; Get next PPN
	 JRST	BLDST1		; None left, return
BLDST4:	TXZ	F,F.LEN		; Use length
	PUSHJ	P,NXTFIL	; Get next file
	 JRST	BLDST3		; None left, try next PPN
	PUSHJ	P,USRLOK	; Lookup the file
	 JRST	BLDST4		; Ignore bad files
	TXO	F,F.LEN		; Don't trust file length; wait for last ptr

BLDST5:	MOVEI	P4,DSK		; Always do reads on channel DSK
	TXNE	F,F.QUICK	; Quick form?
	 SETOM	NOIO		; Yes. Fix SATs, but dont actually
				;  read blocks or checksum them.
	PUSHJ	P,DMPIN		; Read a block of the file
	MOVE	T,IOSTS+DSK	; Get status after read
	TXNE	T,IO.EOF	; Hit end?
	 JRST	BLDST4		; Yes. Get next file
	TXNN	F,F.QUICK	; If quick mode,
	 TXNN	F,F.RALL	;  or if not reading all blocks
	  JRST	.+2		; Force another cluster group
	   JRST	BLDST5		; Otherwise skip it
	SOSGE	T1,BLKCNT+DSK	; Compute number blocks remaining
	 MOVEI	T1,0		; If negative, use zero
	SUB	T1,FILEN+DSK	; Subtract number from file length
	MOVNM	T1,FILEN+DSK	; But that makes it negative
	SETZM	BLKCNT+DSK	; Zero blocks remaining in current group
	JRST	BLDST5		;  and loop for rest of file


BLDST1:	TXZ	F,F.OURS
	POPJ	P,
; Routine to mark the unused bits in the last word of every SAT
; for this unit.
;
; Call with T = address of first SAT
;	    U = UDB address for this unit

MRKSAT:	PUSHJ	P,SAVALL	; Save 'em all for safety
	MOVEI	P1,-1(T)	; Save addr-1 of first SAT
	MOVE	P2,BLKUNI(U)	; Get blocks/unit
	IDIV	P2,HOMBPC(U)	; Compute number of full clusters on unit
	SUBI	P2,1		; Compute last cluster address
	SETOM	P4		; Pointer to last cluster in SAT

MRKST1:	CAML	P4,P2		; Done all SATs yet?
	 POPJ	P,		; Yes, all finished
	MOVE	T,P1		; Addr-1 of this SAT for MRKEND
	MOVE	T1,UNICPS(U)	; Assume full SAT (not last)
	ADD	P4,T1		; Compute last cluster in this SAT
	CAMG	P4,P2		; Larger than last cluster?
	 JRST	MRKST2		; No, no correction necessary
	ADD	T1,P2		; Compute real number of clusters by
	SUB	T1,P4		; Subtracting difference between P2 and P4
	MOVE	P4,P2		; Setup for next time around loop
MRKST2:	PUSHJ	P,MRKEND	; Mark bits in end of this SAT
	ADD	P1,UNIWPS(U)	; Point to start of next SAT
	JRST	MRKST1		;  and loop for next one
; Routine to mark the unused bits in the last word of a SAT
;
; Call with T = address of SAT - 1
;	    T1 = Actual number of clusters in this SAT
;	    U = UDB address of this unit

MRKEND:	PUSH	P,T		; Save addr of start of SAT
	IDIVI	T1,^D36		; Compute word index and remainder
	ADDI	T,(T1)		; Point to last full word in SAT
	JUMPE	T2,MRKEN1	; Done if SAT ends on a word boundary
	MOVEI	T,1(T)		; Partial word requires correction
	MOVNI	T2,-1(T2)	; Compute -number containing bits
	MOVX	T1,1B0		; Set the sign bit
	ASH	T1,(T2)		; Form mask for used bits in last word
	SETCAM	T1,(T)		; Set unused bits in last word
MRKEN1:	POP	P,T1		; Retrieve addr-1 of SAT
	ADD	T1,UNIWPS(U)	; Compute addr of last word of SAT block
MRKEN2:	CAML	T,T1		; Need to fill rest of block?
	 POPJ	P,		; No, return now
	MOVEI	T,1(T)		; Bump address by one
	SETOM	(T)		; Fill word with ones
	JRST	MRKEN2		;  and loop for rest of block
; Subroutine to count free blocks in a SAT
; Call	U=Unit UDB
;
; Ret+0	Always, N=Number of free blocks

CNTSAT:	JSP	M,SAVE3
	SETZB	P1,P2		; P1 counts SATs within unit
	MOVN	P3,UNIWPS(U)	; P2 counts free blocks
	HRL	P3,DSKSAT(U)
	MOVSS	P3		; P3=AOBJN ptr to SAT

CNTST1:	CAML	P1,HOMSPU(U)	; Finished all SATs on unit?
	 JRST	PNTST2		; Yes. Quit
	MOVE	N,P3		; Set N = AOBJN ptr
	PUSHJ	P,ZBITS		; Count zero bits
	IMUL	N,STRBPC	; 1 bit = BPC blocks
	ADDM	N,P2		; Tally blocks
	ADD	P3,UNIWPS(U)	; Point to next SAT now
	AOJA	P1,CNTST1	; To next SAT and go.

; Subroutine to see if all SATs for a STR are in core
;
; Ret+0	NOPE..
; Ret+1	Yup, I hope (at least core has been allocated for them..)
;

SATINC:	MOVEI	U,UNIDDB
	HLRZ	U,(U)
	JUMPE	U,CPOPJ1	; Made it all the way through, OK
	SKIPN	T,DSKSAT(U)
	 POPJ	P,
	MOVE	T1,UNIWPS(U)
	IMUL	T1,HOMSPU(U)
	ADD	T,T1
	CAMLE	T,.JBFF
	 POPJ	P,
	JRST	SATINC+1	; Loop for all SATs.


; Subroutine to allocate core for a SAT on a unit
; Ret+0	with T=Address of SAT

SATADD:	MOVE	T,UNIWPS(U)	; Words needed for one SAT
	IMUL	T,HOMSPU(U)	; Times SATs on unit
	PJRST	CORGRB		; Get core for unit SATs and return
; Subroutine to set a bit in a SAT table (and SAT)
; Call	T=Adr of SAT table
;	T1=Cluster number within unit
;	U=UDB
;
; Ret+0	If bit already set
; Ret+1	If bit not already set

MRKONE:	PUSHJ	P,TSTONE	; Set if already set
	  AOS	(P)		; No. Set for skip return
	MOVNS	T3		; -Number of places to shift
	ROT	T1,(T3)
	MOVEM	T1,(T)
	POPJ	P,


; Subroutine to zero a bit in a SAT table
; Call	T=Adr of SAT table
;	T1=Cluster number within unit
;	U=UDB
;
; Ret+0	If bit already zero
; Ret+1	If bit was one, now it is zero

MRKZRO:	PUSHJ	P,TSTONE	; See if already set
	 SKIPA			; Not, which is not what we expect
	  AOS	(P)		; Already set. Give skip return
	MOVNS	T3		; -number of places to shift
	TLZ	T1,400000	; Make sure bit is zero
	ROT	T1,(T3)		; Rotate it back to normal position
	MOVEM	T1,(T)		; Put bit back into table
	POPJ	P,		; and return
; Subroutine to count zero bits in a table
; Call	N=AOBJN pointer to table
; Ret+0	Always, N=Number of zero bits

ZBITS:	JSP	M,SAVE3		; Get three AC's
	SETZ	P1,		; Zero one to count zero bits
ZBITS1:	MOVE	P2,(N)		; Get some data into P2
	SETCA	P2,		; Complement word
	JUMPE	P2,ZBITS0	; Must have been all ones.

ZBITS2:	SETCA	P2,		; Back to normal
	JFFO	P2,.+3		; Count leading zeroes
	ADDI	P1,^D36		; Must have been all zeroes
	JRST	ZBITS0
	SETCA	P2,		; Complement word again
	ADDI	P1,(P3)		; Cound leading zeroes
	LSH	P2,(P3)		; Shift them right off the end
	JFFO	P2,.+2		; Now cound leading ones
	 JRST	ZBITS0
	LSH	P2,(P3)		; and shift them out too
	JRST	ZBITS2		; Loop for all bits

ZBITS0:	AOBJN	N,ZBITS1	; Go to next word
	MOVE	N,P1		; Until done. Put answer into N
	POPJ	P,		;  and return
; Subroutine to determine if a bit set in a SAT table
; Call	T=Adr of table
;	T1=Cluster within unit
;	U=UDB Adr
;
; Ret+0	Bit not set
; Ret+1	Bit is set
;
; Always T1=word contining bit with bit rotated to sign bit
;	 T3=Number of bits rotated

TSTONE:	IDIV	T1,UNICPS(U)	; T1=SAT number, T2=Index of cluster in SAT
	IMUL	T1,UNIWPS(U)	; T1=# of words to this SAT from beg.
	ADD	T,T1		; T=Beginning of the SAT we want
	IDIVI	T2,^D36		; T2=Index in SAT, T3=Pos in word
	ADD	T,T2		; T=Adr of word containing bit
	MOVE	T1,(T)		; T1=word
	ROT	T1,(T3)		; Rotate desired bit into sign bit
	TLOE	T1,400000	; Skip if not set and set for caller
	AOS	(P)		; Give skip return
	POPJ	P,
; Subroutine to print summary of number of cluster which are
; lost, free, or multiply used.
; Call with P4 set to one of the following values:

$PRLST==2	; Print lost, free, and multiply used clusters
$PRFRE==1	; Print free and multiply used clusters
$PRMLT==0	; Print only multiply used clusters


PRALL:	SETOM	TEMP		; TEMP counts clusters
	MOVEI	U,UNIDDB	; Setup for all units
PRALL1:	HLRZ	U,(U)		; Move to next unit in str
	JUMPE	U,PRALL5	; At end of chain
	MOVE	T1,HOMSPU(U)	; SATs per unit
	MOVEM	T1,TEMP2	; Save for later check
	SETZM	T1		; T1 is cluster offset for this sat
;
;	Here to setup for each SAT on a unit
;
PRALL2:	PUSHJ	P,BLDPTR	; Build byte pointer for this SAT
PRALL3:	PUSHJ	P,GETCLS	; Get cluster for this unit,SAT
	  JRST	PRALL4		; If no more in this SAT
	PUSHJ	P,PRTCLS	; Print the one we found
	JRST	PRALL3		;  and loop for next one
;
;	Here at end of current SAT.  If more on unit, do them, else
;	move to next unit
;
PRALL4:	ADDI	T1,1		; Bump T1 by 1
	CAMGE	T1,TEMP2	; Done all SATs for this unit?
	  JRST	PRALL2		; Nope, loop for next one
	JRST	PRALL1		; Move to next unit
;
;	Here when all units done.  Print totals and loop for next
;	type, if any.
;
PRALL5:	AOSG	N,TEMP		; Increment count (start at -1)
	  JRST	PRALL6		; If none found
	MOVEI	M,[ASCIZ/

Total number = /]		;
	PUSHJ	P,MSG		;
	PUSHJ	P,DECPRT	; Print number found
	JRST	PRALL7		;
PRALL6:	MOVEI	M,[ASCIZ/
There are no /]
	PUSHJ	P,MSG		;
	MOVE	M,HEDMSG(P4)	; Get type message
	PUSHJ	P,MSG		;
PRALL7:	PUSHJ	P,CRLF3		;
	SOJGE	P4,PRALL	; Loop for next type, if any
	POPJ	P,		;
;	Routine to setup OURPTR, DSKPTR, TRBPTR, and CLSCNT for this
;	SAT.  Call with (T1) = SAT number
;	RET+0 always with pointers setup

BLDPTR:	PUSH	P,T1		; Save T1
	IMUL	T1,UNIWPS(U)	; Compute word offset
	MOVSI	T,(POINT 1,0)	;
	HRR	T,OURSAT(U)	;
	ADDI	T,(T1)		; POINT 1,OURSAT+SAT offset
	MOVEM	T,OURPTR	;
	HRR	T,DSKSAT(U)	;
	ADDI	T,(T1)		; POINT 1,DSKSAT+SAT offset
	MOVEM	T,DSKPTR	;
	HRR	T,TRBSAT(U)	;
	ADDI	T,(T1)		; POINT 1,TRBSAT+SAT offset
	MOVEM	T,TRBPTR	;
	MOVE	T,UNICPS(U)	; Get clusters/SAT
	MOVEM	T,CLSCNT	; CLSCNT counts sats
	MOVEM	T,TEMP1		;
	SOS	TEMP1		; TEMP1 = CLSCNT-1 for comparison
	POP	P,T1		; Restore T1
	POPJ	P,		;


;	Routine to find the next cluster in error of specified type.
;	Call with (P4) = type to do, (T1) = SAT number
;	SAT.
;	RET+0 if no more clusters in this SAT
;	RET+1 with cluster in T

GETCLS:	PUSH	P,T1		; Save T1 across call
	PUSHJ	P,@ROUTIN(P4)	; Get cluster of proper type
	  JRST	T1POPJ		; Restore T1 and return
	POP	P,T1		; Restore T1
	MOVE	T,TEMP1		; # clusters/SAT - 1
	SUB	T,CLSCNT	; T = cluster offset in this SAT
	MOVE	N,T1		;
	IMUL	N,UNICPS(U)	; Compute cluseter offset for this SAT
	ADD	T,N		; T = cluster offset in this unit
	MOVE	N,HOMLUN(U)	; Get logical unit
	IMUL	N,STRBPU	;
	IDIV	N,STRBPC	; N = cluster # 0 on this unit
	ADD	T,N		; T = cluster on this unit
	JRST	CPOPJ1		; Return success
;	Routine to print the cluster number in T
;	Call with (T) = cluster number, (P4) =type of cluster
;	RET+0 always

PRTCLS:	AOSE	TEMP		; Count bad clusters
	  JRST	PRTCL1		; If some already seen
	MOVEI	M,[ASCIZ/
The following are /]		;
	PUSHJ	P,MSG		; Print start of header
	MOVE	M,HEDMSG(P4)	; Get rest of message
	PUSHJ	P,MSG		;
	PUSHJ	P,CRLF2		;

PRTCL1:	MOVEI	N,(T)		;
	MOVEI	T,6		;
	PUSHJ	P,OCTZRO	; Print as zero filled octal
	PUSHJ	P,SPC2		;
	MOVE	T2,TEMP		; Get number found so far
	ADDI	T2,1		;
	IDIVI	T2,^D15		; Print 15 per line
	JUMPN	T3,CPOPJ	;
	PJRST	CRLF		; Print CRLF and return
; Routines to find the next cluster of the specified type. Called
; via PUSHJ through the dispatch table ROUTIN indexed by type
; of cluster to find.
;
; Free = set in OUTSAT but not in DSKSAT

DFREE:	SOSGE	CLSCNT		; More left?
	 POPJ	P,		; No. Try another unit
	ILDB	T,OURPTR
	ILDB	T1,DSKPTR
	JUMPE	T,DFREE		; Forget it if not in OURSAT
	JUMPN	T1,DFREE	; Set in DSKSAT? Should be
	JRST	CPOPJ1		;  Nope. Got one


; Lost = Set in DSKSAT but not in OURSAT

DLOST:	SOSGE	CLSCNT		; More left?
	 POPJ	P,		; No. Try another unit
	ILDB	T,OURPTR
	ILDB	T1,DSKPTR
	JUMPE	T1,DLOST	; Forget it if not in DSKSAT
	JUMPN	T,DLOST		; Set in OURSAT? Should be
	JRST	CPOPJ1		; Nope. Got one


; Mult = Set in TRBSAT

DMULT:	SOSGE	CLSCNT		; More left?
	 POPJ	P,		; No. Try another unit
	ILDB	T,TRBPTR
	JUMPE	T,DMULT		; Forget it if not set in TRBSAT
	JRST	CPOPJ1		; Got one


; Dispatch table to routines to find the proper type of cluster.
; Must be in the same order as the values of $PRLST, $PRFRE, $PRMLT.

ROUTIN:	DMULT
	DFREE
	DLOST

; Table of messages associated with each type of cluster.  Order is the
; same as that of ROUTIN.

HEDMSG:	[ASCIZ/multiply used clusters (belonging to more than one file)/]
	[ASCIZ/free clusters (not marked in use, but in some file)/]
	[ASCIZ/lost clusters (marked in use, but in no file)/]
; Subroutine to set bit in our SAT and check other SATs
; Call	T=Cluster within unit
;	U=UDB address
; If F.TRB set in LH(F), will look for trouble, otherwise, will just
; mark bits in OURSAT and return.
;


CLSCHK:	JSP	M,SAVE3		; Save P1,P2,P3
	MOVE	P1,T
	TXNN	F,F.TRB		; Looking for trouble?
	 JRST	MARKIT		; No. Just mark OURSAT
	HRRZ	T,TRBSAT(U)	; T=Adr of 1st trouble SAT on this unit
	MOVE	T1,P1		; T1=cluster within unit
	PUSHJ	P,TSTONE	; See if bit set in trouble SAT
	  JRST	NOTRB		; No..
	PUSHJ	P,MULT		; Yes. Print multiply used and set trouble bit
MARKIT:	HRRZ	T,OURSAT(U)
	MOVE	T1,P1
	PUSHJ	P,MRKONE	; Set our SAT, but dont care if already set
	  JFCL
	TXNN	F,F.TRB		; Looking for trouble?
	 JRST	CPOPJ1		; No. Just marking, done.
	JRST	LKFREE		; See if cluster is free
NOTRB:	MOVE	T1,P1
	HRRZ	T,OURSAT(U)
	PUSHJ	P,MRKONE	; Set bits in our SAT
	  PUSHJ	P,MULT		; Already set, print and set trouble bit
LKFREE:	MOVE	T1,P1
	HRRZ	T,DSKSAT(U)
	PUSHJ	P,TSTONE	; See if bit set in disk SAT
	  PUSHJ	P,FREE		; No. Cluster is free
	JRST	CPOPJ1		; Yes. All is ok now..
MULT:	MOVE	T1,P1
	HRRZ	T,TRBSAT(U)
	PUSHJ	P,MRKONE
	  JFCL
	TXO	F,F.MULT	; Remember this
	SKIPA	M,[[ASCIZ/multiply-used cluster/]]

FREE:	MOVEI	M,[ASCIZ/used but not marked in SAT/]
	PUSH	P,M
	PUSHJ	P,ECRLF
	PUSHJ	P,CHNPNT
	MOVEI	M,[ASCIZ/ cluster /]
	PUSHJ	P,MSG
	MOVE	N,HOMLUN(U)
	IMUL	N,STRBPU
	IDIV	N,STRBPC
	ADD	N,P1		; N=Cluster number
	PUSH	P,N
	PUSHJ	P,OCTPRT	;
	MOVEI	M,[ASCIZ . = block .]
	PUSHJ	P,MSG
	POP	P,N
	IMUL	N,STRBPC
	PUSHJ	P,OCTPRT	;
	PUSHJ	P,SPC2
	POP	P,M
	PUSHJ	P,EMSG
	PJRST	CRLF
; Subroutine to print a units SAT blocks
; Just like CNTSAT, but prints them too.
; Call	U=Unit
;
; Ret+0	always, N= number of blocks free on unit
;

PNTSAT:	JSP	M,SAVE3
	PUSHJ	P,FORM
	MOVEI	M,[ASCIZ/SAT blocks for /]
	PUSHJ	P,MSG
	SKIPN	M,HOMLOG(U)
	 MOVE	M,DRIVE(U)
	PUSHJ	P,PR6BIT
	PUSHJ	P,CRLF
	SETZB	P1,P2		; P1=Relative SAT in unit,
	MOVN	P3,UNIWPS(U)	; P2= Blocks free tally
	HRL	P3,DSKSAT(U)
	MOVSS	P3		; P3=AOBJN pointer

PNTST1:	CAML	P1,HOMSPU(U)
	 JRST	PNTST2
	MOVEI	M,SATMSG
	PUSHJ	P,MSG
	MOVE	N,P1
	PUSHJ	P,OCTPRT	; Print relative SAT
	PUSHJ	P,SPC2
	MOVE	N,P3
	PUSHJ	P,ZBITS		; Count zero bits
	IMUL	N,STRBPC
	ADDM	N,P2		; Tally blocks
	PUSHJ	P,DECPRT
	MOVEI	M,FREMSG	; Print free blocks this SAT
	PUSHJ	P,MSG
	PUSHJ	P,CRLF
	PUSHJ	P,PNTST3	; Now print SAT block itself
	ADD	P3,UNIWPS(U)
	AOJA	P1,PNTST1

PNTST2:	MOVE	N,P2		; Set N=answer
	POPJ	P,		; Return.


PNTST3:	JSP	M,SAVE3		; Otherwise BLKPNT destroys all..
	MOVE	P2,UNIWPS(U)	; # of words to print
	MOVE	P1,P3		; Make P1=AOBJN ptr to data
	PJRST	BLKPN1		; Print block and return
	SUBTTL	SCRATCH AREA ROUTINES

;ROUTINE TO INIT THE SCRATCH DEVICE.
;CALL	OUTDEV=DEVICE NAME

AUXINI:	MOVEI	T,14
	MOVE	T1,AUXDEV
	MOVE	T2,[AUXOB,,AUXIB]
	OPEN	AUX,T
	 POPJ	P,
	MOVEI	T2,T
	DEVSIZ	T2,		;FIND OUT HOW BIG ITS BUFFERS ARE
	 MOVEI	T2,205		;ASSUME 205 WORDS (DISK)
	HRRZM	T2,AUXSIZ	;AND REMEMBER THIS FOR ALLOCATION.
	MOVE	T,AUXDEV
	DEVCHR	T,		;GET DEVCHR WORD FOR THIS DEVICE
	MOVEM	T,AUXCHR	;AND REMEMBER IT TOO.
	JRST	CPOPJ1		;AND EXIT+1


;SUBROUTINE TO WRITE AN END OF FILE ON AUX DEVICE

AUXEOF:	PUSHJ	P,ZROBUF
	MOVSI	T,'EOF'
	MOVEM	T,BUF+EOFNAM
	MOVI	CODEOF,BUF+EOFCOD
	MOVE	P1,IOW
	PUSHJ	P,AUXOUT		;WRITE EOF BLOCK TO DEVICE
	 JFCL
	 JFCL
	CLOSE	AUX,
	MTWAT.	AUX,			;WAIT FOR ALL TO FINISH
	MTEOF.	AUX,			;WRITE AN EXTRA EOF
	POPJ	P,


;SUBROUTINE TO RELEASE THE SCRATCH DEVICE

AUXRLS:	MTREW.	AUX,		;REWIND IF A TAPE.
	POPJ	P,
;SUBROUTINE TO DO 'ENTER' OR 'LOOKUP' ON SRCATCH DEVICE
;CALL	OUTDEV=DEVICE
;	AUXNAM,AUXEXT,AUXPPN=NAME.EXT[PPN]
;
;RET+0	ERROR
;RET+1	AOK


AUXLUK:	TXZA	F,F.IO		;0 IF READING,
AUXENT:	TXO	F,F.IO		;1 IF WRITING
	MTREW.	AUX,
	MOVE	T,AUXNAM
	HLLZ	T1,AUXEXT
	SETZ	T2,
	MOVE	T3,AUXPPN
	MOVE	M,[LOOKUP AUX,T]
	TXZE	F,F.IO
	 MOVE	M,[ENTER AUX,T]
	XCT	M
	 POPJ	P,
	JRST	CPOPJ1		;AT LAST!
;SUBROUTINE TO ALLOCATE BUFFERS FOR AUX DEVICE.
;TRYS FOR 15 BUFFERS (ABOUT 2K), WILL SETTLE FOR LESS.
;IF CONTENTS OF AUXTRY NON-ZERO, WILL TRY FOR THAT MANY INSTEAD.
;SET AUXTRY TO INFINITY TO GRAB ALL OF AVAILABLE CORE...
;
;CALL WITH F.IO SET TO WRITE, ZERO TO READ



AUXALC:	JSP	M,SAVE3		;SAVE SOME DATA
	SKIPN	P1,AUXTRY	;WANT A PARTICULAR AMOUNT?
	 MOVEI	P1,^D15		;NO. TRY FOR 15
	MOVE	P2,.JBMAX
	SUB	P2,.JBFF
	IDIV	P2,AUXSIZ	;P2=# OF BUFFERS AVAILABLE
	CAILE	P1,(P2)		;WANT MOREN WE GOT?
	 MOVEI	P1,(P2)		;YES. SETTLE FOR ALL WE GOT.
		OINSTN==OUTBUF AUX,0(P1)
		IINSTN==INBUF  AUX,0(P1)
		OINSTN==OINSTN_<-^D18>
		IINSTN==IINSTN_<-^D18>
	MOVSI	P2,OINSTN	;MACRO WONT TAKE IT DIRECTLY..
	TXNN	F,F.IO
	 MOVSI	P2,IINSTN
	MOVE	P3,.JBREL
	XCT	P2		;DO INBUF OR OUTBUF UUO
	CAME	P3,.JBREL	;INCREASE CORE?
	 PUSHJ	P,PNTCOR	;YES. INFORM HIM.
	POPJ	P,		;*********  EXIT  *******
;SUBROUTINE TO OUTPUT OR INPUT FROM SCRATCH AREA
;CALL	P1= IOWD TO DATA
;
;
;RET+0	HARDWARE EOF OR HORRIBLE ERROR
;RET+1	SOFTWARE EOF (THIS IS THE EOF WE LOOK FOR)
;RET+2	AOK. DATA TRANSFERRED.
;

AUXIN:	TXZA	F,F.IO
AUXOUT:	TXO	F,F.IO
	JSP	M,SAVE3
	HRRI	P1,1(P1)	;CHANGE IOWD TO AOBJN PTR
	MOVE	P3,P1
	MOVEI	P2,W.AUX
	TXNN	F,F.IO
	 MOVEI	P2,R.AUX	;P2=ADDRESS OF BINARY OUTPUT SUBROUTINE
	MOVE	CH,(P1)		;GET A WORD
	PUSHJ	P,@P2		;GO OUTPUT IT
	 POPJ	P,		;YIKES!!!!!!!!!!  BETTER NOT HAPPEN!
	MOVEM	CH,(P1)		;IN CASE READING
	AOBJN	P1,.-4		;AND LOOP FOR ALL WORDS.
	AOS	(P)		;SET FOR SKIP RETURN NOW AT LEAST
	TXNE	F,F.IO
	 JRST	CPOPJ1		;ALL IS WELL IF WRITING
	MOVEI	P1,CODEOF
	CAME	P1,EOFCOD(P3)	;THIS AN EOF BLOCK??
	 JRST	CPOPJ1		;NO. DATA
	MOVSI	P1,'EOF'
	CAME	P1,EOFNAM(P3)
	 JRST	CPOPJ1
	POPJ	P,		;YES. GIVE SOFT EOF RETURN.
;SUBROUTINE TO WRITE ONE WORD TO THE AUX DEVICE.
;CALL	CH=WORD
;RET+0	HORRIBLE ERROR
;RET+1	AOK.

W.AUX:	JSP	M,SAVE3
	MOVI	^D10,AUXTRY	;RETRY UP TO 10 TIMES ON ERRORS
W.AUXX:	SOSLE	AUXOB+2
	 JRST	W.AUX1
	OUT	AUX,
	 JRST	W.AUX1
	GETSTS	AUX,P1
	SETSTS	AUX,14
	TXNN	P1,IO.BKT!IO.EOF!IO.EOT
	 JRST	W.AUX2
	MOVE	P2,AUXCHR	;SEE WHAT WERE WRITING ON
	TXNN	P2,DV.MTA	;A MAG TAPE?
	 JRST	W.AUX4		;NO. SKIP THIS STUFF
	MTEOF.	AUX,		;AT EOT, WRITE TWO EOF MARKS
	MTWAT.	AUX,		;SO THAT WE WILL BE ABLE TO READ
	MTEOF.	AUX,		;THIS TAPE BACK WITHOUT GOING
	MTWAT.	AUX,		;OFF THE END OF THE REEL!
	MTUNL.	AUX,		;OF COURSE, IF NOT A TAPE, IGNORE THIS..
W.AUX4:	MOVEI	M,EOFMSG
W.AUX0:	PUSHJ	P,OPER
	 JRST	DIE005
	JRST	W.AUXX

W.AUX1:	IDPB	CH,AUXOB+1
	JRST	CPOPJ1		;SUCESFULL ******** EXIT **********

W.AUX2:	TXNN	P1,IO.IMP	;TAPE WRITE-LOCK ERROR?
	 JRST	W.AUX3		;NO. WORSE YET.
	MOVEI	M,[ASCIZ/
%AUX unit write-locked. Please fix and proceed./]
	JRST	W.AUX0

W.AUX3:	SOSLE	AUXTRY		;TRY UP TO 10 TIMES
	 JRST	W.AUXX
	MOVEI	M,ERRMSG	;THEN GIVE UP AND TELL HIM WE DID.
	PJRST	MSGTTY
R.AUX:	JSP	M,SAVE3
R.AUXX:	SOSLE	AUXIB+2
	 JRST	R.AUX1
	IN	AUX,
	 JRST	R.AUX1
	GETSTS	AUX,P1
	SETSTS	AUX,14
	TXNN	P1,IO.EOF!IO.BKT!IO.EOT   ;DONE?
	 JRST	R.AUX2
	MOVEI	M,EOFMSG
	MTUNL.	AUX,
	PUSHJ	P,OPER
	 JRST	DIE005
	JRST	R.AUXX


R.AUX1:	ILDB	CH,AUXIB+1
	JRST	CPOPJ1


R.AUX2:	MOVEI	M,ERRMSG
	PJRST	MSGTTY

EOFMSG:	ASCIZ/
%EOF on AUX unit. Please mount another/
ERRMSG:	ASCIZ/
%AUX unit data error/
	SUBTTL	Register save routines

; Here to save AC's P1,P2,T,T1
; Call with JSP M,BUFSAV

BUFSAV:	MOVEM	CH,SAVECH
	PUSH	P,T1
	PUSH	P,T
	PUSH	P,P1
	PUSH	P,P2
	PUSHJ	P,(M)
	  SKIPA
	AOS	-4(P)
	POP	P,P2
	POP	P,P1
	POP	P,T
	POP	P,T1
	POPJ	P,


; Here to save P1 & P2 & P3
; Call with JSP M,SAVE3

SAVE3:	PUSH	P,P1
	PUSH	P,P2
	PUSH	P,P3
	PUSHJ	P,(M)
	 JRST	.+5		; POPJ return
	AOSA	-3(P)		; CPOPJ1 return
	 AOSA	-3(P)		; CPOPJ2 return
	  SKIPA
	   AOS	-3(P)
	POP	P,P3
	POP	P,P2
	POP	P,P1
	POPJ	P,


; Here to save all AC's. Watch pushdown level!
; Call with PUSHJ P,SAVALL (P not saved)

SAVALL:	MOVEM	16,17(P)
	MOVEI	16,1(P)
	BLT	16,16(P)
	MOVE	16,17(P)
	ADD	P,[17,,17]
	PUSHJ	P,@-17(P)
	 SKIPA
	AOS	-20(P)
	MOVSI	16,-16(P)
	BLT	16,16
	SUB	P,[20,,20]
	POPJ	P,
	SUBTTL	Information printing routines

; Subroutine to calculate the CFP given a block in the structure.
;  Call with N = Block in STR,
;	     U = UDB address

CFPPFX:	MOVEI	M,[ASCIZ/,  CFP /]
	PUSHJ	P,MSGTTY	; Print prefix
	IDIV	N,HOMBSC(U)	; Convert to supercluster number
	PJRST	OCTPRT		; Print it and return
;
;
; Subroutine to print the first and last block in a cluster
;  Call with N = first block in cluster

CLSBLK:	MOVEI	M,[ASCIZ/Blocks /]
	PUSHJ	P,MSGTTY	; Put out prefix
	PUSH	P,N		; Save block number
	PUSHJ	P,OCTPRT	; Print first block
	MOVEI	M,[ASCIZ/ through /]
	PUSHJ	P,MSGTTY	; Print separator
	POP	P,N		; Restore first block
	ADD	N,STRBPC	; Compute last block+1
	SUBI	N,1		; Make it last block
	PJRST	OCTPRT		; Print it and return
;
;
; Subroutine to print a block/cluster number
;  Call with N = number to print

BLKPFX:	SKIPA	M,[[ASCIZ/Block /]]
CLSPFX:	MOVEI	M,[ASCIZ/Cluster /]
	PUSHJ	P,MSGTTY	; Put out correct prefix
	PJRST	OCTPRT		; Print number and return
;
;
; Subroutine to print relative block/Number in BARG1
;  Call RLBPFX with N = relative block,
;	PREFIX with M = message address, number to print in N

RLBPFX:	SKIPA	M,[[ASCIZ/,  Relative block /]]
PREFIX:	MOVE	N,BARG1		; Load number for PREFIX call
	PUSHJ	P,MSGTTY	; Print the message
	PJRST	OCTPRT		; Print the number and return
;
;
; Subroutine to print a unit number
;  Call with N = unit number

UNIPFX:	MOVEI	M,[ASCIZ/
    Unit /]
	PUSHJ	P,MSGTTY	; Print prefix
	PUSHJ	P,OCTPRT	; Print the unit number
	PUSHJ	P,COLON		; Add a colon
	PJRST	TAB		; End with a tab and return
;
;
; Subroutine to print a prefix for the /C code

STRPFX:	PJSP	M,MSGTTY	; Print message and return
	ASCIZ/
    Structure:	/
; Subroutine to compute and print physical disk address of
; logical block in AC 'T2'

PBNPRT:	MOVEI	M,[ASCIZ .Cylinder .]
	PUSHJ	P,MSG
	IDIV	T2,BLKCYL(U)	; T2=Cyl, T3=remainder
	MOVE	N,T2
	PUSHJ	P,OCTPRT	; Print CYL in octal
	MOVEI	M,[ASCIZ \  surface \]
	PUSHJ	P,MSG
	MOVE	T2,T3
	IDIV	T2,BLKTRC(U)	; T2=Surface, T3=Sector(track)
	MOVE	N,T2
	PUSHJ	P,OCTPRT	;
	MOVEI	M,[ASCIZ \  sector \]
	PUSHJ	P,MSG
	MOVE	N,T3
	PJRST	OCTPRT		;
; Subroutine to print file information for the /F code.  The line
; produced is of the form:
;
; DSKB0 (RPA1) FOO  BAZ [10,7] Block in unit = nnn, Block in str = nnn
;
; Call with T = block in str,
;	    T1 = block in unit

PRTFND:	PUSH	P,T		; Save T and T1 for later
	PUSH	P,T1
	MOVE	M,HOMLOG(U)	; Get logical unit name
	PUSHJ	P,PR6BIT	; and print it
	MOVEI	M,[ASCIZ/ (/]	;
	PUSHJ	P,MSG		;
	MOVE	M,DRIVE(U)	; Get drive it's on
	PUSHJ	P,PR6BIT	; and print it
	MOVEI	M,[ASCIZ/) /]	;
	PUSHJ	P,MSG		;
	TXO	F,F.NOTB	; Use dot instead of tab
	PUSHJ	P,FILPNT	; Print the file and ext
	PUSHJ	P,SPC		;
	PUSHJ	P,UFDPNT	; and the path
	MOVEI	M,[ASCIZ/ Block in unit = /]
	PUSHJ	P,MSG		;
	POP	P,N		; Get back value
	PUSHJ	P,OCTPRT	; and print it
	MOVEI	M,[ASCIZ/, Block in str = /]
	PUSHJ	P,MSG		;
	POP	P,N		;
	PUSHJ	P,OCTPRT	;
	PJRST	CRLF		; End with CRLF and return
; Routine to tell the user that we found a match in the /WS code.
; The line produced is of the form:
;
;  RPA0 (DSKB0) Block = n, Relative word = n, Matched word = n
;
; Call with T = AOBJN ponter to relative word in BUF,
;	    U = UDB address of unit

PRTMAT:	PUSH	P,T		; Save the pointer
	AOSE	PASS		; Been here before?
	 JRST	PRTMT1		; Yes, skip the header
	PUSHJ	P,SWWPRT	; Type values of mask and search word
	PUSHJ	P,CRLF2		;  and a couple of CRLFs

PRTMT1:	MOVE	M,DRIVE(U)	; Get physical unit name
	PUSHJ	P,PR6BIT	;  and print it in SIXBIT
	MOVEI	M,[ASCIZ/ (/]
	PUSHJ	P,MSG		; Separate fields
	MOVE	M,HOMLOG(U)	; Get logical name
	PUSHJ	P,PR6BIT	;  and print it in SIXBIT too
	MOVEI	M,[ASCIZ/) Block = /]
	PUSHJ	P,MSG		; Header for next field
	MOVE	N,CURPOS(U)	; Get current block number
	PUSHJ	P,OCTPRT	;  and print it in octal
	MOVEI	M,[ASCIZ/, Relative word = /]
	PUSHJ	P,MSG		; Another header
	HRRZ	N,(P)		; Get relative word in block
	PUSHJ	P,OCTPRT	;  and print it in octal
	MOVEI	M,[ASCIZ/, Matched word = /]
	PUSHJ	P,MSG		; Final header
	HRRZ	N,(P)		; Get relative word in block again
	MOVE	N,BUF(N)	; Get word that we matched
	PUSHJ	P,OCTL12	;  and print it in octal
	POP	P,T		; Restore T
	PJRST	CRLF		; Print final CRLF and return
; Routine to search the block in BUF for a match with a specified
; word.
;
; Call with WMASK = search mask to use,
;	    WWORD = search word to find

WRDMAT:	MOVSI	T,-BLKSIZ	; Make AOBJN pointer
WRDMT1:	MOVE	T1,BUF(T)	; Get next word in BUF
	XOR	T1,WWORD	; Exclusive OR with search word
	AND	T1,WMASK	; Mask only those interesting bits
	JUMPN	T1,.+2		; No match if word non-zero
	 PUSHJ	P,PRTMAT	; Tell user of match
	AOBJN	T,WRDMT1	; Loop for all words
	POPJ	P,		;  and return
;
;
; Routine to type the contents of the search mask and word.
; Call with TTY output enabled if desired.

SWWPRT:	MOVEI	M,[ASCIZ/
Mask word = /]
	PUSHJ	P,MSG		; Type explanation
	MOVE	N,WMASK		; Get the mask word
	PUSHJ	P,OCTL12	; Type as 12 digits of octal
	MOVEI	M,[ASCIZ/,  Search word = /]
	PUSHJ	P,MSG		; One more label
	MOVE	N,WWORD		; Get search word
	PUSHJ	P,OCTL12	; Type this as 12 digits octal also
	PJRST	CRLF		; End with CRLF and return
	SUBTTL	Disk list routines


; Here to process most /P switches. Most of this code was
; slightly lifted from DSKLST originally...
; At first I wanted to simulate DSKLST output exactly. Since
; then I have changed the output format a bit.


DSKLST:	TTYOFF
	TXNN	SW,<CH.S!CH.U!CH.V!CH.F!CH.B!CH.E!CH.P>
	TXO	SW,<CH.S!CH.U!CH.V!CH.F!CH.B!CH.E!CH.P>

	SKIPN	BARG3		; BARG3
	 TXNE	SW,CH.L		;  or /PL
	  SKIPA			;  implies F and not all else..
	JRST	ANOTHR
	TXO	SW,CH.F		; L implies F and not all else
	TXZ	SW,<CH.U!CH.V!CH.S!CH.B!CH.E!CH.P>
ANOTHR:	PUSHJ	P,NXTSTR	; Initialize first STR
	 JRST	RIPDON
	 JFCL
	TXNE	SW,CH.L
	 JRST	NOKEY		; Skip all this for /L
	SETZM	TBLKCT		; Clear total blocks used on STR
	SETZM	NULUFD		; Count of null UFD's
	SETZM	UFDCNT		; Total blocks used in UFD's
	SETZM	WASTEB		; Wasted blocks due to cluster allocation
	SETZM	TFILCT		; Total number of files
	SETOM	TEMP3		; Set flag for first time through on STR
	TXNN	SW,CH.U!CH.V	; Doing /PU or /PV?
	 JRST	NOCLS		; Skip units if not wanted
	MOVEI	U,UNIDDB
NXTU:	HLRZ	U,(U)		; Next unit
	JUMPE	U,NOCLS		; Until done
	TXNN	SW,CH.V		; Doing /PV?
	 AOSG	TEMP3		;  or not first time on /PU?
	  SKIPA			; Yes to one, print header
	   JRST	NXTU1
	PUSHJ	P,CRLF2
	MOVEI	M,UHED
	PUSHJ	P,MSG
NXTU1:	MOVE	M,DRIVE(U)
	PUSHJ	P,PR6BIT	; Physical device
	PUSHJ	P,TAB
	MOVE	M,HOMHID(U)
	PUSHJ	P,PR6BIT	; System id
	PUSHJ	P,TAB
	MOVE	M,HOMLOG(U)
	PUSHJ	P,PR6BIT	; Log. unit in STR
	PUSHJ	P,CRLF		; End line with CRLF
	TXNN	SW,CH.V		; Doing /PV?
	 JRST	NXTU		; No, skip rest of stuff
	PUSHJ	P,PNTHOM	; Print home block
	HRLZI	T,UNITAB
	HRRI	T,HOMHID(U)
	PUSHJ	P,LSTPNT	; Print the entire UDB
	PUSHJ	P,FORM		; Eject the page
	JRST	NXTU		;  and repeat for all units
NOCLS:	TXNN	SW,CH.F
	 JRST	NOHEAD
	MOVEI	M,[ASCIZ/
Key for error bits:

	Bit	Meaning

/]
	PUSHJ	P,MSG			; Print key for error bits
	HRLZI	P1,-KEYLEN
PNTKEY:	PUSHJ	P,TAB
	HLRZ	N,KEYS(P1)
	PUSHJ	P,OCTPRT
	PUSHJ	P,TAB
	HRRZ	M,KEYS(P1)
	PUSHJ	P,MSG
	PUSHJ	P,CRLF
	AOBJN	P1,PNTKEY

	PUSHJ	P,CRLF2
	JRST	NOKEY


	DEFINE	KEYMAC	(X,Y)

<	XWD X , [ASCIZ/Y/]	>


KEYS:	KEYMAC  RIPBDA ,Error found by damage assessment program
	KEYMAC  RIPCRH ,Partially written file closed after monitor stop
	KEYMAC  RIPBFA ,Error found by BACKUP
	KEYMAC  RIPHRE ,Hardware data read error
	KEYMAC	RIPHWE ,Hardware data write error
	KEYMAC	RIPSCE ,Software checksum or redundancy error
KEYLEN== .-KEYS
NOKEY:	MOVEI	M,HED1		; Print DSKLST header
	PUSHJ	P,MSG

NOHEAD:	MOVE	T,[TBLKCT,,TBLKCT+1]
	BLT	T,HISTO+TOPHIS+1	; Clear all counters
	TXNN	SW,CH.F!CH.E!CH.P	; Do files if F or E or P
	 JRST	DSAT
	MOVE	T,[HISTOR,,HISTOR+1]
	SETZM	HISTOR
	BLT	T,HISTOR+TOPHIS
RML:	PUSHJ	P,NXTDIR	; Get next directory
	  JRST	FINIS
	TXZ	F,F.NULL	; Assume non-null UFD
	PUSHJ	P,NXTFIL	; Any files for this user?
	 TXOA	F,F.NULL	; no. Remember this
	  JRST	RML1		; Yes. Go process
	SETCM	T,F		; No. We want a ufdmsg only if:
	TXNN	T,S.NAM!S.EXT	; Both name and ext were stars,
	 TXNE	SW,CH.L		;  and /L not in progress
	  JRST	RML		; Otherwize, ignore null UFD's
	AOS	NULUFD		; Count number of them...
RML1:	TXNN	SW,CH.F
	 JRST	RML2		; Not printing files - still must allocate
	PUSHJ	P,CRLF2		; To make it look good
	MOVE	M,HOMSNM(U)	; Get device name
	PUSHJ	P,PR6BIT	; Type it
	PUSHJ	P,COLON		; of course
	PUSHJ	P,UFDPNT	; and the path
	PUSHJ	P,CRLF2
RML2:	SETZM	UBLKCT
	SETZM	UFILCT
	TXZE	F,F.NULL	; Was this a null UFD?
	 JRST	DONEU		; Yes. Dont attempt to read files
	JRST	RUL1
RUL:	PUSHJ	P,NXTFIL	; Get next user file name
	  JRST	DONEU
RUL1:	PUSHJ	P,USRLOK	; LOOKUP this file
	  JRST	RUL		; No good. Ignore it
	PUSHJ	P,CNTBLK	; Go count blocks allocated
	TXNE	SW,CH.L
	 JRST	RUL3
	MOVE	T,BUF+RIBSTS
	TXNN	T,RIPHRE!RIPHWE!RIPSCE!RIPBDA!RIPBFA!RIPCRH
	 JRST	RUL3		; No errors. Why check?
	TXNE	T,RIPHWE
	 AOS	FERR		; File has had hard write error
	TXNE	T,RIPHRE
	 AOS	FERR+1		; File has had hard read error
	TXNE	T,RIPSCE
	 AOS	FERR+2		; File has had software checksum error
	TXNE	T,RIPBDA
	 AOS	FERR+3		; File found bad by damage assement program
	TXNE	T,RIPBFA
	 AOS	FERR+4		; File found bad by BACKUP
	TXNE	T,RIPCRH
	 AOS	FERR+5		; File closed after a crash
RUL3:	AOS	UFILCT		; Count user files
	TXNN	SW,CH.F
	 JRST	RULA
	SKIPN	N,BARG3		; File size specified?
	 JRST	RUL3A		; No
	CAML	N,BUF+RIBALC	; Smaller than allocated blocks for this file?
	 JRST	RUL		; No, ignore it
RUL3A:	PUSHJ	P,FILPNT
	MOVE	N,DSK+RIBLBN	; Give block number of 1st rib
	MOVEI	T,7
	PUSHJ	P,OCTSPC
	PUSHJ	P,SPC2
	PUSHJ	P,DIRLST	; Print file attributes
RULA:	MOVE	T,BUF+RIBSIZ	; Words written
	ADDI	T,BLKSIZ-1
	LSH	T,-7		; Convert to blocks written
	TXNN	SW,CH.P		; Doing histogram
	  JRST	RULA1		; Nope
	CAILE	T,TOPHIS+1	; Skip if within histogram
	MOVEI	T,TOPHIS+1	; Note off top
	AOS	HISTO(T)	; Count # of files of this length
RULA1:	MOVEI	P4,DSK
	PUSHJ	P,PTRCPY	; Copy ptrs into UDB so can count them
	SETZM	TEMP2		; TEMP2 = count of real ptrs
	SETOM	TEMP3		; TEMP3 = flag, set zero if extra RIB
RUL1C:	PUSHJ	P,GETPTR	; Get a ptr
	JUMPE	P1,RUL1B	; Quit if done
	AOS	TEMP2		; Inc count
	TXNE	F,F.NEWR	; RIB extended?
	 SETZM	TEMP3		; Yes. flag it
	JRST	RUL1C		;  and loop
RUL1B:	MOVE	N,TEMP2
	TXNN	SW,CH.P		; Doing histogram?
	  JRST	RULB		; Nope
	CAILE	N,TOPHIS+1
	 MOVEI	N,TOPHIS+1
	AOS	HISTOR(N)	; Historgram # of RIB ptrs

RULB:	TXNN	SW,CH.F
	 JRST	RUL
	MOVE	N,BUF+RIBSIZ
	MOVEI	T,6
	PUSHJ	P,DECSPC	; Print words written
	PUSHJ	P,SPC
	MOVE	N,BUF+RIBALC	; Blocks allocated
	MOVEI	T,7
	PUSHJ	P,DECSPC
	LDB	N,EXLERB	; Get error bits
	MOVEI	T,5
	PUSHJ	P,OCTSPC
	PUSHJ	P,TAB
	MOVE	N,TEMP2
	MOVEI	T,5
	PUSHJ	P,DECSPC	; Print number of real pointers
	MOVEI	CH," "
	SKIPN	TEMP3
	 MOVEI	CH,"*"
	PUSHJ	P,W.LST		; Print * if extended
	PUSHJ	P,CRLF
	JRST	RUL		;  and loop for more files
; Subroutine to list file attributes.
; Prints access data, creation time,date, protection code, and mode

DIRLST:	PUSHJ	P,FILACD	; Get T3=date last accessed
	PUSHJ	P,PRDATE	;  and print it
	PUSHJ	P,FILDAT	; Get universal date,,time
	PUSH	P,T3		;  and save it for a while
	PUSHJ	P,PRTIM1	; Print as hh:mm
	POP	P,T3		; Get back creation date,,time
	PUSHJ	P,PRDATE	; Print the date.
	LDB	N,EXLPRV	; Access privileges
	MOVEI	T,3
	PUSHJ	P,OCTZRO
	LDB	N,EXLMOD	; Mode
	MOVEI	T,3
	PUSHJ	P,OCTSPC
	PJRST	SPC2
; Here to total user's allocated blocks and words,
;  and count blocks and words wasted


CNTBLK:	MOVE	T,BUF+RIBALC	; Blocks allocated for file
	ADDM	T,UBLKCT	; Count users blocks
	MOVE	T1,BUF+RIBSIZ	; Words written
	ADDI	T1,BLKSIZ-1
	IDIVI	T1,BLKSIZ	; T1=blocks written
	SUB	T,T1		; T=blocks alloc. but not written
	SUBI	T,2		; -2 for RIBs
	ADDM	T,WASTEB	; Gives # of wasted blocks
	POPJ	P,



; Subroutine to print K for swapping on unit
; Called from LSTPNT with N=words

K4SPNT:	PUSH	P,N
	PUSHJ	P,DECPR1
	MOVEI	M,[ASCIZ/K = /]
	PUSHJ	P,MSG
	POP	P,N
	LSH	N,3		; Blocks = K * 8
	PUSHJ	P,DECPRT
	MOVEI	M,[ASCIZ/ blocks/]
	PJRST	MSG
DONEU:
	MOVE	T,USRPTH+.PTPPN
	MOVE	N,UFILCT	; Number of user files
	CAMN	T,MFDPPN
	 MOVEM	N,MFDCT		; Count number of UFDs
	ADDM	N,TFILCT	; Total number of files
	MOVE	N,UBLKCT	; Add user's blocks to total for str
	CAMN	T,MFDPPN	; If this is the MFD,
	 MOVEM	N,UFDCNT	; Remember total blocks devoted to UFDs.
	ADDM	N,TBLKCT
	TXNN	SW,CH.F
	 JRST	RML		; If not printing files, on to next user
DONEU1:	PUSHJ	P,CRLF
	PUSHJ	P,TAB
	PUSHJ	P,DECPRT	; Print number of blocks allocated
	MOVEI	M,BLKMSG
	PUSHJ	P,MSG
	MOVEI	M,UBLKMG
	PUSHJ	P,MSG
	MOVEI	M,AVEMSG	; Now get average file size
	PUSHJ	P,MSG
	MOVE	N,UFILCT
	PUSHJ	P,DECPRT
	MOVEI	M,AVEMS1
	PUSHJ	P,MSG
	MOVE	N,UBLKCT	; Blocks allocated
	IDIV	N,UFILCT	; Compute average file size
	PUSHJ	P,DECPRT	;  and print
	MOVEI	M,UBLK1
	PUSHJ	P,MSG
	JRST	RML
FINIS:
	TXNN	SW,CH.F		; If not printing files, move on
	 JRST	DSAT
	PUSHJ	P,CRLF3
	PUSHJ	P,TAB
	MOVE	N,TBLKCT	; Total number of blocks allocated on STR
	PUSHJ	P,DECPRT
	MOVEI	M,BLKMSG
	PUSHJ	P,MSG
	MOVEI	M,TBLKMG
	PUSHJ	P,MSG
	MOVEI	M,AVEMSG	; Now get average file size
	PUSHJ	P,MSG
	MOVE	N,TFILCT	; Number of files
	PUSHJ	P,DECPRT	;  and print
	MOVEI	M,AVEMS1
	PUSHJ	P,MSG
	MOVE	N,TBLKCT
	IDIV	N,TFILCT	; Compute average file size
	PUSHJ	P,DECPRT
	MOVEI	M,UBLK1
	PUSHJ	P,MSG
	TXNE	SW,CH.L
	 JRST	NOPERF

; Here to compute & print SAT blocks

DSAT:	MOV	.JBFF,.SVFF	; Save so we can restore core
	PUSHJ	P,RDSAT		; Read disk SATS
	 JRST	DSAT3
	SETZM	TOTSAT		; clear tally of free blocks
	MOV	USRSTR,BUF	; Set BUF=STR name
	MOVE	T,[.DCFCT+1,,BUF]
	DSKCHR	T,		; Ask monitor what it thinks.
	 SETZM	BUF+.DCFCT	; It doesnt.
	MOV	BUF+.DCFCT,TOTDSK  ; Remember what monitor thought free was.
	MOVEI	U,UNIDDB

DSAT1:	HLRZ	U,(U)
	JUMPE	U,DSAT2
	TXNE	SW,CH.S
	 PUSHJ	P,PNTSAT	; Print SAT if he wants it
	TXNN	SW,CH.S
	 PUSHJ	P,CNTSAT	; But must at least count zbits
	ADDM	N,TOTSAT	; Tally free blocks
	JRST	DSAT1		; Loop for all units

DSAT2:	TXNN	SW,CH.S
	 JRST	DSAT3
	PUSHJ	P,CRLF2
	MOVE	N,TOTSAT
	PUSHJ	P,DECPRT	; Print total blocks free on str
	MOVEI	M,BLKMSG
	PUSHJ	P,MSG
	MOVEI	M,TOTMSG
	PUSHJ	P,MSG
DSAT3:	PUSHJ	P,ZCORE		; Return core
	TXNN	SW,CH.B		; Skip if BAT blocks wanted
	  JRST	ESUM		; No, move on

; Here to compute & print BAT blocks..

	MOVEI	U,UNIDDB
BATB:	HLRZ	U,(U)		; Get next logical unit in STR
	JUMPE	U,ESUM		; Until done.
	PUSHJ	P,FORM		; Eject page for neatness
	MOVEI	M,BATHED
	PUSHJ	P,MSG
	MOVE	M,HOMLOG(U)	; M=Unit ID
	PUSHJ	P,PR6BIT	; Print log unit
	MOVEI	CH,"("
	PUSHJ	P,W.LST
	MOVE	M,HOMHID(U)
	PUSHJ	P,PR6BIT	; Print unit ID
	MOVEI	M,[ASCIZ .) Currently on .]
	PUSHJ	P,MSG
	MOVE	M,DRIVE(U)
	PUSHJ	P,PR6BIT
	PUSHJ	P,CRLF

	PUSHJ	P,BATCHK	; Read BAT block
	 JRST	BATB
	SETZM	OTHERK
	MOVEI	M,[ASCIZ /
Number bad blocks (MAP) = /]
	PUSHJ	P,MSG
	LDB	N,BAYNBS	; Get number of bad sectors
	PUSHJ	P,DECPRT
	MOVEI	M,[ASCIZ /  Number bad regions (MAP) = /]
	PUSHJ	P,MSG
	LDB	N,BAYNBR	; Bad regions found by MAP program
	PUSHJ	P,DECPRT
	MOVEI	M,[ASCIZ /  Number bad regions (MON) = /]
	PUSHJ	P,MSG
	HRRZ	N,BUF+BAFCNT	; Bad regions found by monitor
	PUSHJ	P,DECPRT
	MOVEI	M,[ASCIZ \	Controller  device code (MAP) = \]
	PUSHJ	P,MSG
	LDB	N,BAYKDC
	LSH	N,2
	PUSHJ	P,OCTPRT
	PUSHJ	P,BLKPRT	; Now zap out the whole block
	HRRZ	P2,BUF+BAFFIR	; Get relative offset of 1st pair
	HLRE	T,BUF+BAFFIR	; Get -number free words
	MOVNS	T		; Make it positive
	ADDI	P2,BUF-1(T)	; Point to last word pair
	HRLI	P2,-2(T)	; Move count to LH
BATB3:	SKIPE	-1(P2)		; Skip if this pair unused
	  JRST	BATB4		; Start processing loop
	SUB	P2,[2,,2]	; Decrement count and pointer
	JUMPL	P2,BATB		; Done when count < 0
	JRST	BATB3		; Else just loop

BATB4:	MOVEI	M,[ASCIZ .Bad regions listed most recently found first:

.]
	PUSHJ	P,MSG
BATB5:	LDB	T2,BAYELB	; Get first block in region (new entry)
	MOVX	M,BAPNTP	; Get new entry bit
	TDNN	M,-1(P2)	; Is this a new type entry?
	 HRRZ	T2,(P2)		; No, only RH is block adr
	PUSH	P,T2		; Save it for later
	PUSHJ	P,PBNPRT	; Print physical disk address
	MOVEI	M,[ASCIZ \ = block \]
	PUSHJ	P,MSG
	MOVE	N,(P)		; Get block number back
	PUSHJ	P,OCTPRT	;
	LDB	T2,BAYNBB	; # bad blocks this region
	JUMPE	T2,ONLY1	; Jump if only 1 block
	MOVEI	M,[ASCIZ . through
.]
	PUSHJ	P,MSG
	MOVE	T3,(P)		; T3 is block no. of first bad block
	ADD	T2,T3		; T2=last block #
	PUSHJ	P,PBNPRT
	MOVEI	M,[ASCIZ \ = \]
	PUSHJ	P,MSG
	LDB	T2,BAYNBB	; Get number of bad blocks
	MOVEI	N,1(T2)		;  and tell him
	PUSHJ	P,DECPRT
	MOVEI	M,[ASCIZ \ Bad blocks\]
	PUSHJ	P,MSG
ONLY1:	POP	P,(P)		; Discard block adr
	MOVEI	M,[ASCIZ .
Found on .]
	PUSHJ	P,MSG
	MOVX	M,BAPOTH
	TDNN	M,-1(P2)	; Skip if found on another kontroller
	  JRST	ONLY1F		; No
	MOVEI	CH,"*"
	PUSHJ	P,W.LST
	SETOM	OTHERK
ONLY1F:	HLLZ	M,DRIVE(U)	; Device name
	TLZ	M,77		; Make it controller type (DP, RP, etc.)
	PUSHJ	P,PR6BIT
	LDB	CH,BAYKNM	; Get logical controller number
	ADDI	CH,"A"		; Make it ASCII
	PUSHJ	P,W.LST
	MOVEI	M,[ASCIZ . unit(s) .]
	PUSHJ	P,MSG
	SETO	P1,		; P1=unit number
	LDB	T2,BAYPUB	; T2=bits 10-17 of BAF word
				; Bit 17-N=unit number
	MOVEI	T3,1		; Start looking at bit 35(unit 0)
	TXOA	F,F.TMP		; Set bit for first time through
BADU1:	LSH	T3,1		; Try the next bit
	AOS	N,P1		; Which means next unit.
	JUMPE	T2,BADU2	; Done if no more bits set
	TRZN	T2,(T3)		; Look at this bit, zero it if set
	  JRST	BADU1		; Not set, try next bits
	TXZN	F,F.TMP		; Skip if this is the first time
	 PUSHJ	P,COMMA		;  cause first unit doesn't get comma
	PUSHJ	P,OCTPRT	; Print unit number
	JRST	BADU1		;  and loop for more units
BADU2:	MOVEI	M,[ASCIZ/	Processor /]
	PUSHJ	P,MSG
	LDB	N,BAYAPN	; Serial number of arithmetic processor
	PUSHJ	P,DECPR1

	MOVX	M,BAPNTP	; Get new type entry bit
	TDNN	M,-1(P2)	; Is this a new type entry?
	  JRST	BATB6		; No, do it the old way
	MOVEI	M,[ASCIZ\.
Error bits = \]
	PUSHJ	P,MSG		; Start of message
	LDB	N,BAYERR	; Get the error bits
	PUSHJ	P,OCTPRT	;  and print in octal
	JRST	BATB7		; Skip the old style stuff

BATB6:	MOVEI	M,[ASCIZ \.
Bits 12-29 of CONI = \]
	PUSHJ	P,MSG
	HLRZ	N,(P2)		; Get CONI bits
	MOVEI	T,6
	PUSHJ	P,OCTZRO	; Print as 6 octal digits
BATB7:	PUSHJ	P,CRLF2		; End entry with 2 CRLF's
	SUB	P2,[2,,2]	; Decrement counter and pointer
	JUMPGE	P2,BATB5	; Loop if not done
	MOVEI	M,[ASCIZ \
* Also found on some other controller of processor
\]
	SKIPE	OTHERK		; Skip if no regions found bad on another kontroller
	 PUSHJ	P,MSG
	JRST	BATB
ESUM:	TXNN	SW,CH.E
	 JRST	NOSUM		; Don't want error summary
	MOVEI	M,[ASCIZ/
Error summary for /]
	PUSHJ	P,MSG
	MOVE	M,USRSTR
	PUSHJ	P,PR6BIT
	MOVEI	M,WASMSG	; 'blocks wasted in unwritten but allocated blocks
	PUSHJ	P,MSG
	MOVE	N,WASTEB
	PUSHJ	P,DECPRT
	PUSHJ	P,SLASH
	MOVE	N,TBLKCT	; Get total # of blocks written
	PUSHJ	P,DECPRT
	PUSHJ	P,EQUAL
	MOVE	N,WASTEB
	IMULI	N,^D100		; Now express as a percentage
	IDIV	N,TBLKCT 
	PUSHJ	P,DECPRT
	PUSHJ	P,%CRLF
	MOVEI	M,MSGRIB	; 'number of blocks used for ribs ='
	PUSHJ	P,MSG
	MOVE	N,TFILCT
	LSH	N,1
	MOVE	U,N
	PUSHJ	P,DECPRT
	MOVEI	M,[ASCIZ/
Plus /]
	PUSHJ	P,MSG
	MOVE	N,UFDCNT	; 'plus xxx blocks in ufds'
	PUSHJ	P,DECPRT
	MOVEI	M,[ASCIZ/ blocks in UFDs = /]
	PUSHJ	P,MSG
	ADD	U,UFDCNT
	SUB	U,MFDCT		; Subtract blocks in MFD ribs
	MOVE	N,U		;  which are counted twice

	PUSHJ	P,DECPRT
	PUSHJ	P,SLASH
	MOVE	N,TBLKCT
	PUSHJ	P,DECPRT
	PUSHJ	P,EQUAL
	MOVE	N,U
	IMULI	N,^D100		; Again as a percentage
	IDIV	N,TBLKCT
	PUSHJ	P,DECPRT
	MOVEI	M,[ASCIZ/% system overhead for retrieval information/]
	PUSHJ	P,MSG
	MOVEI	M,NULMSG	; 'number of null ufds ='
	PUSHJ	P,MSG
	MOVE	N,NULUFD
	PUSHJ	P,DECPRT
	PUSHJ	P,CRLF2
	SETCM	T,F
	TXNE	T,STNDRD
	  JRST	ALLMAT		; Not doing all files, dont print discrepancies.
	MOVE	N,STRSIZ	; Total blocks on STR
	SUB	N,TBLKCT	; Computed free = total - used
	CAMN	N,TOTSAT	; Compare with SAT 0 bits
	 JRST	ALLMAT		; If no discrepancy, dont print
	MOVEI	M,MISMSG
	PUSHJ	P,MSG
	PUSHJ	P,DECPRT	; Print computed free blocks
	PUSHJ	P,TAB2
	MOVE	N,TOTSAT	; Print computed from SAT
	PUSHJ	P,DECPRT
	PUSHJ	P,TAB2
	MOVE	N,TOTDSK	; Computed from DSKCHR by monitor
	PUSHJ	P,DECPRT
	PUSHJ	P,CRLF
ALLMAT:	MOVEI	M,ERRHED
	PUSHJ	P,MSG
	HRLZI	P1,-6
	MOVE	N,FERR(P1)	; Print each file error counter
	PUSHJ	P,DECPRT
	PUSHJ	P,TAB
	AOBJN	P1,.-3
	PUSHJ	P,CRLF
NOSUM:	TXNN	SW,CH.P		; Skip if performance statistics desired
	 JRST	NOPERF
	PUSHJ	P,FORM
	MOVEI	M,HISHED	; Histogram header
	PUSHJ	P,MSG
	SETZ	T,		; start at beginning
HISLOP:	PUSHJ	P,HISLIN	; Print length of file & number of files
	CAIE	T,TOPHIS	; See if reached top
	AOJA	T,HISLOP	; No, keep going
	MOVEI	M,[ASCIZ .GE .]
	PUSHJ	P,MSG
	ADDI	T,1
	PUSHJ	P,HISLIN
NOPERF:	PUSHJ	P,FORM
	JRST	ANOTHR		;  and continue
HISLIN:	MOVE	N,T		; Number of blocks written
	PUSHJ	P,DECPR1
	PUSHJ	P,TAB2
	MOVE	N,HISTO(T)	; Number of files of that length
	PUSHJ	P,DECPR1
	PUSHJ	P,TAB2
	MOVE	N,HISTOR(T)	; Number of RIBs of that length
	PUSHJ	P,DECPR1
	PJRST	CRLF
; Here on /P followed by A,O,7,6,R,D or Q
; Print data in file or blocks in ASCII, octal, SIXBIT, RIB,
; directory, or quick format
;
; /PA lists file or blocks like type command
; /PO dumps in octal
; /P7 dumps file is ASCII with block header
; /P6 dumps file in SIXBIT
; /PR prints the RIB of the file specified, or the block specified if
;	it is a RIB
; /PD prints the block of file like it was a UFD
; /PQ is like a DIR/F

DATLST:	PUSH	P,BARG1		; Save all block args
	PUSH	P,BARG2
	PUSH	P,BARG3
DATL0:	PUSHJ	P,NXTSTR	; Get next STR
	  JRST	DATL3		; When done
	  JFCL			; Don't care about MFD
DATL1:	SKIPE	GOTWRD		; Numeric argument?
	 JRST	DATL5		; Yes. List blocks, not files
	PUSHJ	P,NXTDIR	; Get next directory
	 JRST	DATL0
DATL2:	PUSHJ	P,NXTFIL	; Get next file
	 JRST	DATL1		; No more files
	TXNN	SW,CH.Q		; No form if /PQ
	 PUSHJ	P,FORM
	TXNE	SW,CH.R		; Printing RIBs?
	 JRST	DATL7		; Yes. Slightly different
	TXO	F,F.NOTB	; Use dot instead of tab
	PUSHJ	P,FILPNT	; Print file name,ext etc..
	PUSHJ	P,UFDPNT	;  and path
	TXNE	SW,CH.Q		; If /PQ
	 JRST	[PUSHJ P,CRLF	;  then we're done
		  JRST DATL2]
	PUSHJ	P,TAB
	PUSHJ	P,USRLOK	; LOOKUP the file
	 JRST	DATL2		; Not there..
	MOV	IOW,XIOWD+DSK
	PUSHJ	P,NOW		; Print time now
	PUSHJ	P,CRLF3
DATL4:	MOVEI	P4,DSK
	PUSHJ	P,DMPIN		; Get a block
	MOVE	T,IOSTS+DSK	; Get status
	TXNE	T,IO.EOF	; EOF?
	 JRST	DATL2		; Yes. Go back for more files
	TXNN	SW,CH.A		; /PA?
	 PUSHJ	P,CRLF		; No, print crlf between blocks
	PUSHJ	P,DATL6		; Go to various printing routines
	JRST	DATL4		;  and try remaining blocks
; Here to print given blocks.

DATL5:	MOVEI	P4,DSK
	MOVE	T1,BARG1
	MOVE	T,IOW
	PUSHJ	P,STRRED	; Go read blocks
	 JFCL			; Error, but print block anyway
	PUSHJ	P,DATL6		; Go print the block
	AOS	T,BARG1
	CAMGE	T,BARG2		; Done all blocks requested?
	 JRST	DATL5		; No. Get more
	TXNN	SW,CH.R		; Printing RIBs?
	 JRST	DATL0		; No. Done
	SKIPL	BARG2		; Yes. Did he give blocks or files?
	 JRST	DATL0		; Blocks. Done
	SETZM	BARG1		; Files. Get next one
	JRST	DATL2



; Here on /PR - Print RIBs

DATL7:	MOVE	T,USRCFP
	PUSHJ	P,CFP2BK	; Find block # of first RIB
	MOVEM	T,BARG1		;  and make it look like thats what he typed
	SETOM	BARG2		; Set -1 as flag saying file typed, not block
	JRST	DATL5


DATL3:	POP	P,BARG3		; Restore block args
	POP	P,BARG2
	POP	P,BARG1
	JRST	RIPDON		;  and finish up


; Here to dispatch to printing...

DATL6:	TXNE	SW,CH.R		; RIBs?
	 PUSHJ	P,RIBPNT
	TXNE	SW,CH.D		; UFDs?
	 PUSHJ	P,DIRPRT
	TXNE	SW,CH.O		; Octal?
	 PUSHJ	P,BLKPRT
	TXO	F,F.CRLF
	TXNE	SW,CH.A		; ASCII?
	 PUSHJ	P,ASCOUT	; Yes. Print it, no carriage rets.
	TXZ	F,F.CRLF
	TXNE	SW,CH.7		; 7-Bit ASCII?
	 PUSHJ	P,ASCOUT	; Yes. One block at a time.
	TXNE	SW,CH.6		; SIXBIT?
	 PUSHJ	P,SIXOUT
	POPJ	P,
	SUBTTL	SORT - Shell sort routine, optimized for RIPOFF use


REPEAT LOGIC,<

CALL:
	T	ADDRESS OF VECTOR
	N	NUMBER OF ENTRIES TO SORT
	T1	KEY FOR SORT
		KEY=0, SORT 2 WORD ENTRIES ON BOTH WORDS (/AF)
		KEY=1, SORT 2 WORD ENTRIES ON LEFT HALF OF SECOND WORD,
			THEN FIRST WORD (/AE)
		KEY=2, SORT 3 WORD ENTRIES ON THIRD WORD (/AT)

	ALL AC'S PRESERVED. SORT IS IN PLACE, DOES NOT REQUIRE
	ANY EXTRA CORE.

THE SORT ALGORITHM IS AS FOLLOWS:

	N=NUMBER OF ENTRIES, V=VECTOR

SORT:	M=N
SORT1:	M=M/2
	IF M=0, RETURN
	J=1
SORT2:I=J
SORT4:	IF V(I) .LE. V(I+M) , GOTO SORT3
		SWITCH V(I) WITH V(I+M)
		I=I-M
		IF I .GE. 1 , GOTO SORT4
SORT3:	J=J+1
	IF J .GT. N-M , GOTO SORT1
	GOTO SORT2

GIVEN N ENTRIES TO SORT, ALGORITHM WILL COMPARE EXACTLY

	[LOG2(N)]*[N/2]

WHERE [X] DENOTES GREATEST INTEGER FUNCTION OF X, LOG2(X) IS LOG BASE TWO.

>

;DEFINE SOME AC'S FOR MY USE HERE
KEY==T1		;KEY FOR SORT
TMP==KEY	;A GENERAL PURPOSE REGISTER TOO..
N==N		;N STAYS THE SAME
V1==T		;ADDRESS OF VECTOR
V2==T2		;ADDRESS OF VECTOR+1
V3==T3		;ADDRESS OF VECTOR+2
INDEX==P1	;INDEX INTO V REGISTERS
I==P4		;I IN DO LOOPS
J==N1		;J IN DO LOOPS
LEN==CH		;LENGTH OF ENTRIES
DAT1==P		;DATA AC
DAT2==F		; ..
DAT3==P2		; ..
DAT4==P3		; ..
IC==T4		;SAME AS I, BUT CORRECTED
IMC==U		;HOLDS I+M, BUT CORRECTED

;ALL AC'S SAVED.

SORT:	PUSHJ	P,SAVALL	;MAKE IT OK TO USE THEM ALL
	MOVEM	P,TEMP1
	MOVE	LEN,LENGTH(KEY)	;SET UP CORRECT LENGTH
	MOVE	DAT1,TEST(KEY)	;GET ADDRESS OF RIGHT TEST ROUTINE
	MOVEM	DAT1,TESTX	;THIS FREES UP KEY AS ANOTHER GP AC
	HRLI	V1,INDEX	;PUT INDEX INTO V1
	SUBI	V1,(LEN)
	MOVE	V2,V1
	AOS	V3,V2		;V2=V1+1
	ADDI	V3,1		;V3=V1+2


	HRRZ	M,N		;M=N
SORT1:	LSH	M,-1		;M=M/2
	JUMPE	M,PPOPJ		;IF M=0, RETURN
	MOVEI	J,1		;J=1
SORT2:	HRRZ	I,J		;I=J
SORT4:	HRRZ	IC,I
	IMULI	IC,(LEN)	;IC=I, CORRECTED
	HRRZ	IMC,I
	ADDI	IMC,(M)
	IMULI	IMC,(LEN)	;IMC=I+M, CORRECTED
	HRRZ	INDEX,IC
	MOVE	DAT1,@V1	;DAT1 = V1(I)
	MOVE	DAT3,@V2	;DAT3 = V2(I)
	HRRZ	INDEX,IMC
	MOVE	DAT2,@V1	;DAT2 = V1(I+M)
	MOVE	DAT4,@V2	;DAT4 = V2(I+M)
	JRST	@TESTX		;GO COMPARE THESE TWO ENTRIES
				;IF V(I) .LE. V(I+M) GOTO SORT3
				;ELSE, RETURN HERE AT SORT4A

SORT4A:	SUBI	I,(M)		;I=I-M
	CAIL	I,1		;IF I .GE. 1,
	 JRST	SORT4		;		GOTO SORT4

SORT3:	;ADDI	J,1		;ALGORITHM SAYS DO THIS HERE, BUT WONT
				;CAUSE WILL BE TRICKY
	HRRZ	DAT1,N
	SUBI	DAT1,1(M)	;DAT1=N-M (ACTUALLY N-M-1, THATS THE TRICK)
	CAILE	J,(DAT1)	;J .GT. N-M??
	 AOJA	J,SORT1		;YES. GOTO SORT1
	AOJA	J,SORT2		;NO. GOTO SORT2


PPOPJ:	MOVE	P,TEMP1		;RESTORE P
	POPJ	P,		;AND GO HOME...

TEST:	TEST0
	TEST1
	TEST2
U(TESTX)

LENGTH:	2
	2
	3


;HERE IF KEY=0, SORT 2 WORD ENTRIES ON BOTH WORDS (/AF)

TEST0:	CAMGE	DAT1,DAT2	;V1(I) .LT. V1(I+M) ??
	 JRST	SORT3		;DEFINITELY YES. GOTO SORT3
	CAME	DAT1,DAT2	;IF EQUAL, MUST TEST SECOND WORD
	 JRST	FLIP		;NOT EQUAL. GO FLIP THEM.
	CAMG	DAT3,DAT4	;V2(I) .LT. V2(I+M)??
	 JRST	SORT3		;FIRST HALF EQUAL, SECOND HALF V(I) IS
				; .LE. , SO ENTIRE ENTRY IS .LE., GOTO SORT3

;HERE TO SWITCH THE TWO ENTRIES

FLIP:	MOVEM	DAT1,@V1	;STORE V1(I) INTO V1(I+M)
	MOVEM	DAT3,@V2	;STORE V2(I) INTO V2(I+M)
	HRRZ	INDEX,IC
	MOVEM	DAT2,@V1	;STORE V1(I+M) INTO V1(I)
	MOVEM	DAT4,@V2	;STORE V2(I+M) INTO V2(I)
	JRST	SORT4A		;AND CONTINUE IN MAINSTREAM OF PROGRAM


;HERE ON KEY=1, SORT 2 WORD ENTRIES ON LEFT HALF OF SECOND WORD AND
;WHOLE FIRST WORD (/AE)

TEST1:	MOVEM	DAT3,TEMP2
	HLRZS	DAT3		;ZERO CFP'S
	HLRZS	DAT4
	CAIGE	DAT3,(DAT4)	;EXT(I) .LT. EXT(I+M) ???
	 JRST	SORT3		;DEFINITELY YES. GOTO SORT3
	CAIE	DAT3,(DAT4)	;EQUAL EXTENSIONS?
	 JRST	.+3		;NO. EXT(I) .GT. EXT(I+M), SO SWITCH THEM
	CAMG	DAT1,DAT2	;EXTENSIONS EQUAL. COMPARE FILENAMES
	 JRST	SORT3		;NAME(I) .LE. NAME(I+M). GOTO SORT3

;HERE IF MUST SWITCH THE TWO ENTRIES

	MOVE	DAT4,@V2	;GET BACK DAT4
	MOVE	DAT3,TEMP2	;GET BACK DAT3
	JRST	FLIP		;AND GO SWITCH THEM.

;HERE ON KEY=2, SORT THREE WORD ENTRIES ON THIRD WORD (/AT)

TEST2:	MOVE	TMP,@V3		;TMP=V3(I+M)
	HRRZ	INDEX,IC
	CAML	TMP,@V3		;IS V3(I) .GE. V3(I+M)?
	 JRST	SORT3		;YES. NO SWITCH

;HERE TO SWITCH THREE ENTRIES

	EXCH	TMP,@V3		;STORE V3(I+M) INTO V3(I)
	HRRZ	INDEX,IMC
	MOVEM	TMP,@V3		;STORE V3(I) INTO V3(I+M)
	JRST	FLIP		;AND GO SWITCH THE OTHER TWO ENTRIES



	SUBTTL	Core allocation routine
; Subroutine to allocate core.
; Call	T=Number of words needed
; Ret+0	always with T=address of first location of new core
;		C(.JBFF)=Adr. of last new loc + 1



CORGRB:	JSP	M,SAVE3
	JSP	M,TTYOUT
	MOVE	P1,T
	ADD	T,.JBFF		; P1=Highest core needed
	CAMG	T,.JBREL	; Already have it?
	 JRST	CORGR2		; Yes. Don't need UUO
CORGR1:
	SKIPL	%LOCK		; Locked in core?
	 JRST	.+4		; No. No problem
	MOVE	N,ONEONE
	UNLOK.	N,		; Yes. Unlock us for a while...
	 JFCL
	CORE	T,		; Ask for core now
	 JRST	NOCORE
	SKIPL	%LOCK		; We locked?
	 JRST	CORGR4
	PUSHJ	P,LOCKUUO	; Yes. Re-lock us with new core now..
	 SKIPA
	JRST	CORGR4
	SETZM	%LOCK
	MOVEI	M,[ASCIZ/Cannot remain locked in core. Continuing unlocked!/]
	PUSHJ	P,MSGTTY
	PUSHJ	P,CRLF
CORGR4:
	TXOA	F,F.TMP		; Remember that we did UUO
CORGR2:	TXZ	F,F.TMP		; We didnt do UUO
	MOVE	P2,.JBFF	; Save first adr in P2
	ADDM	P1,.JBFF	; Increment to new .JBFF
	TXZE	F,F.TMP		; Did we do UUO??
	 PUSHJ	P,PNTCOR	; Yes. Tell him
	MOVEI	T,1(P2)		; Restore T and inc it one
	HRLI	T,(P2)		; T=adr of new core,, adr+1
	SETZM	(P2)
	BLT	T,@.JBFF	; Clear all new core
	MOVEI	T,(P2)		; Restore T
	POPJ	P,		;  and give normal return

; Here if core not available... back up 5 yards and punt


NOCORE:	MOVEI	M,[ASCIZ/

	can't get core, change CORMAX and then try

^C
.CONTINUE

	to resume operation.
/]
	PUSHJ	P,MSG
	MONRT.			; Exit, allow continue
	MOVE	T,P1		; To continue here
	ADD	T,.JBFF
	JRST	CORGR1		; and try more
				; (He can try core command)



; Subroutine to print size of core now

PNTCOR:	JSP	M,TTYOUT
	PUSHJ	P,CRLF
	MOVEI	CH,"["
	PUSHJ	P,W.CMD
	MOVE	N,.JBREL
	ADD	N,COREXX
	SUBI	N,1
	IDIV	N,COREXX
	PUSHJ	P,DECPR1	; Print decimal without dot
IFN PURESW,<
	MOVEI	CH,"+"
	PUSHJ	P,W.LST
	MOVEI	N,RIPEND-400000-1
	ADD	N,COREXX
	IDIV	N,COREXX
	PUSHJ	P,DECPR1
> ;END IFN PURESW
	MOVEI	CH,"K"
	MOVEI	N,^D512
	CAMN	N,COREXX
	 MOVEI	CH,"P"
	PUSHJ	P,W.LST
	MOVEI	M,[ASCIZ . core]
.]
	PJRST	MSG		; And return
; Subroutine to reduce core to minimum.
; Call	before increasing core (calling CORGRB)
;	Do	MOV .JBFF,.SFVV  to save .JBFF
;	Then call ZCORE which restores it to .SVFF
;

ZCORE:	MOVE	T1,.JBREL
	MOV	.SVFF,.JBFF
	CORE	T,
	 JFCL
	CAME	T1,.JBREL	; Has .JBREL changed?
	 PUSHJ	P,PNTCOR	; Yes. Tell him
	POPJ	P,
	SUBTTL	Block printing routines

; Subroutine to print a home block
; Call	U=UDB address of unit
; Ret+0	always with
;	home block in BUF, printed to listing file too...

PNTHOM:	PUSHJ	P,HOMCHK	; Go read home blocks
	 JRST	DIE004		; Just can't happen
	MOVEI	M,[ASCIZ/

HOME block
/]
	PUSHJ	P,MSG
	PJRST	BLKPRT
;SUBROUTINE TO LOOK AT 'USRPPN' AND SEE IF IT IS ANY OF
;THE IMPORTANT PPN'S (EG, 1,1 1,4 OR 1,2).


CHKPPN:	JSP	M,SAVE3
	MOVE	P1,USRPTH+.PTPPN	;
	MOVEI	P2,NUMPPN-1	;4 PPNS TO LOOK AT
CHKPP1:	MOVE	P3,VIPPNS(P2)	;GET ADR OF PPN
	MOVE	P3,(P3)		;GET PPN
	CAMN	P3,P1		;IS IT ONE?
	 JRST	CHKPP2		;HELL YES.
	SOJGE	P2,CHKPP1	;REPEAT FOR EACH ONE.
	JRST	CPOPJ1		;AOK..

CHKPP2:	MOVEI	M,[ASCIZ/
Access files from /]
	PUSHJ	P,MSGTTY	;INFORM HIM THIS IS A NO NO.
	PUSHJ	P,UFDPNT	; Print offending path
	MOVEI	M,[ASCIZ/?/]
	PJRST	OPER		;AND CHECK WITH THE DODO

VIPPNS:	QUEPPN
	MFDPPN
	SYSPPN
	FSFPPN
	CRSPPN
NUMPPN==.-VIPPNS
;SUBROUTINE TO PRINT A BLOCK OF 200 WORDS IN BUF
;CALL	BLKPRT TO PRINT BUFSIZ=200 WORDS IN BUF
;	BLKPN1 TO PRINT C(P2) WORDS WITH P1=AOBJN PTR TO THOSE WORDS


BLKPRT:	JSP	M,SAVE3
	MOVEI	P2,BLKSIZ	;P2 HAS #  OF WORDS TO BE PRINTED
	MOVN	P1,P2
	HRLZS	P1
	HRRI	P1,BUF		;P1 IS AOBJN PTR TO BUF
	PUSHJ	P,HEDBLK
BLKPN1:	HRLM	P1,(P)		;SAVE ADDRESS OF FIRST WORD
	SETZ	P3,		;ZERO COUNTER.
BLKPN3:	TRNN	P3,7
	PUSHJ	P,CRLF		;CRLF EVERY 8 WORDS
	MOVE	N,(P1)
	PUSHJ	P,OCTL12
	PUSHJ	P,SPC
	ADDI	P3,1		;INC COUNT FOR EVERY 8 WORDS TEST
	AOBJN	P1,BLKPN3
	HLRZ	P2,(P)		;GET BACK ADDRESS OF FIRST WORD
	SUB	P2,P1		;SUBTRACT LAST WORD ADDRESS+1
	ADDI	P2,BLKSIZ	;P2=BLKSIZ-# OF WORDS PRINTED
				;=NUMBER OF WORDS OF DOTS TO PRINT
	JUMPLE	P2,CRLF2	;DONE ALREADY. FORGET DOTS
BLKPN2:	TRNN	P3,7
	PUSHJ	P,CRLF
	MOVEI	M,^D12
	MOVEI	CH,"."
	PUSHJ	P,W.LST		;WRITE 12 DOTS FOR REMAINING WORDS
	SOJG	M,.-1
	PUSHJ	P,SPC
	ADDI	P3,1
	SOJG	P2,BLKPN2
	PJRST	CRLF2		;AND FINISH OFF WITH CRLF

;SUBROUTINE TO PRINT 200 WORD BLOCK IN BUFF IN ASCII FORMAT

ASCOUT:	TXNE	F,F.CRLF	;SUPPRESS CRLF??
	JRST	.+3		;YES.
	PUSHJ	P,HEDBLK	;HEADER FOR BLOCK
	PUSHJ	P,CRLF2
	MOVE	T,[POINT 7,BUF]
	HLRE	T1,IOW
	IMULI	T1,5		;5 CHARS/WORD
	HRLZS	T1		;T1 COUNTS CHARS
	ILDB	CH,T		;GET A CHAR
	PUSHJ	P,W.LST		;WRITE IT
	AOBJN	T1,.-2		;AND CONTINUE
	TXNN	F,F.CRLF
	PJRST	CRLF2		;UNTIL DONE
	POPJ	P,
;SAME ROUTINE AS ABOVE, ONLY SIXBIT INSTEAD OF ASCII...

SIXOUT:	PUSHJ	P,HEDBLK
	PUSHJ	P,CRLF2
	MOVE	T,[POINT 6,BUF]
	HLRE	T1,IOW
	IMULI	T1,6
	HRLZS	T1
	ILDB	CH,T
	ADDI	CH,40	;SIXBITIZE
	PUSHJ	P,W.LST
	AOBJN	T1,.-3
	PJRST	CRLF2

;SUBROUTINE TO PRINT 200 WORD BUFFER AS IF IT WAS A DIRECTORY
;PRINTS FILE,EXT,LOG BLOCK IN STR, REL BLOCK IN UNIT, UNIT


DIRPRT:	PUSHJ	P,HEDBLK
	MOVEI	M,DIRPM		;PRINT HEADER
	PUSHJ	P,MSG
	MOVE	T2,IOW		;T1 COUNTS WORDS
DIRP1:	MOVE	T,1(T2)		;FILE NAME
	HLLZ	T1,2(T2)	;AND EXTENSION
	JUMPE	T,DIRP2		;IGNORE NULL FILE NAMES
	PUSHJ	P,NAMPNT	;GO PRINT THEM
	HRRZ	T,2(T2)		;AND THE CFP
	PUSHJ	P,CFP2BK	;CONVERT TO LOG BLOCKS
	MOVE	N,T1		;N=REL BLOCK ON UNIT
	PUSHJ	P,OCTPRT	;
	PUSHJ	P,TAB
	MOVE	N,T		;GET LOG BLOCK IN STR AGAIN
	PUSHJ	P,OCTPRT	; PRINT LOG BLOCK
	PUSHJ	P,TAB
	MOVE	N,HOMLUN(U)
	PUSHJ	P,OCTPRT	;AND UNIT #
	PUSHJ	P,CRLF
DIRP2:	AOBJN	T2,.+1
	AOBJN	T2,DIRP1
	POPJ	P,		;DONE..
;HERE ON /PR - PRINT BUF AS A RIB

RIBPNT:	TXZ	F,F.NEWR	;SET BY GETPTR IF READS NEW RIB
	HRRZ	T,BUF+RIBCOD	;CHECK CODE WORD
	CAIE	T,CODRIB
	JRST	RIBPN1		;NOT A RIB!
	MOV	BUF+RIBNAM,USRNAM
	MOVE	T,BUF+RIBEXT
	HLLZM	T,USREXT
	MOV	BUF+RIBPPN,USRPTH+.PTPPN ;
RIBPN0:	PUSHJ	P,CRLF
	PUSHJ	P,FILPNT	;PRINT FILE NAME,EXT,PPN
	PUSHJ	P,UFDPNT
	PUSHJ	P,TAB
	PUSHJ	P,DIRLST	;(CREATION & ACCESS TIMES, DATE,MODE)
	PUSHJ	P,CRLF2
	PUSHJ	P,HEDBLK	;TELL HIM WHAT BLOCK THIS IS
	PUSHJ	P,CRLF
	MOVE	T,[RIBTAB,,BUF+RIBSIZ]
	TXO	F,F.TMP		;SUPPRESS PRINTING ZERO WORDS
	PUSHJ	P,LSTPNT	;PRINT RIBSIZ THROUGH RIBTIM
	MOVE	T,[RIBTB1,,BUF+RIBLAD]	;
	HRRZ	T1,BUF+RIBFIR	;RIBFIR HAS RELATIVE ADDRESS OF PTRS
	CAIL	T1,RIBACT	; Earlier than 603?
	 PUSHJ	P,LSTPNT	; Nope, print info
	MOVEI	M,RIBHED
	PUSHJ	P,MSG
	TXZE	F,F.NEWR
	 JRST	[POP P,P1		;IF FLAG SET, SKIP COPY
		 JRST RIBPN4]		;CAUSE GETPTR HAS ALREADY DONE SO
	MOVEI	P4,DSK
	PUSHJ	P,PTRCPY		;PUT RIB INTO DSK BLOCK
RIBPN2:	PUSHJ	P,GETPTR		;GET A POINTER
	JUMPE	P1,RIBPN3		;DONE IF NO POINTER
	TXNE	F,F.NEWR	;WE JUST READ A NEW RIB?
	 JRST	[PUSH P,P1	;YES. SAVE PTR
		 PUSHJ P,CRLF3	;PRINT ANOTHER HEADER
		 JRST RIBPN0]
RIBPN4:	MOVE	N,P1
	PUSHJ	P,OCTL12	;PRINT POINTER
	PUSHJ	P,TAB
	LDB	N,STRCLP
	IMUL	N,STRBPC
	MOVE	T1,N
	PUSHJ	P,OCTPRT	; PRINT BLOCK ADR
	PUSHJ	P,TAB
	MOVE	N,HOMLUN(U)
	IMUL	N,STRBPU
	ADD	N,T1
	PUSHJ	P,OCTPRT	; REL BLOCK IN STR
	PUSHJ	P,TAB
	MOVE	N,P2
	IMUL	N,STRBPC
	PUSHJ	P,DECPRT	;PRINT # OF CONTIGIOUS BLOCKS
	PUSHJ	P,TAB
	PUSHJ	P,SPC2
	MOVE	N,HOMLUN(U)
	PUSHJ	P,OCTPRT	;PRINT UNIT
	PUSHJ	P,TAB		;
	PUSHJ	P,SPC2		;
	LDB	N,STRCKP	; Get checksum from pointer
	PUSHJ	P,OCTPRT	; and print it
	PUSHJ	P,CRLF
	JRST	RIBPN2		;CONTINUE FOR ALL POINTERS


RIBPN1:	MOVEI	M,[ASCIZ/Specified block is not a RIB/]
	PJRST	MSGTTY


RIBPN3:	POP	P,BUF+RIBFIR
	POPJ	P,
RIBTAB:	DEFINE	TABMAC	(X,Y)
<	XWD [ASCIZ\X\] , Y	>

	TABMAC	Words written, DECPRT
	TABMAC	Version, HALF8
	TABMAC	Spooled dev, NPR6BT
	TABMAC	Est. block length, DECPRT
	TABMAC	Blocks allocated, DECPRT
	TABMAC	Logical block in STR of last group, OCTPRT
	TABMAC	Future arg for DEC, OCTL12
	TABMAC	Non-priv customer arg, OCTL12
	TABMAC	Tape label, NPR6BT
	TABMAC	Structure, NPR6BT
	TABMAC	Status bits, HALF8
	TABMAC	First block bad region, OCTPRT
	TABMAC	RIBEUN,HALF8
	TABMAC	FCFS quota, DECPRT
	TABMAC	Logged out quota, DECPRT
	TABMAC	Reserved quota, DECPRT
	TABMAC	No. blocks used when last logged out, DECPRT
	TABMAC	Author, OCTPPN
	TABMAC	Next STR, NPR6BT
	TABMAC	Prev. STR, NPR6BT
	TABMAC	Privileged customer arg, OCTL12
	TABMAC	UFD block with ptr to this RIB, OCTPRT
	TABMAC	First logical block in RIB, OCTPRT
	TABMAC	Extended RIB address, OCTL12
	TABMAC	<Internal creation date,time>,DATTIM
	Z		;ENDS THE LIST!
RIBTB1:	TABMAC	Last accounting date, DATTIM
	TABMAC	Directory expiration date, DATTIM
	TABMAC	AOBJN pointer to accounting string, OCTL12
	Z		; Ends the list
; The following table is for printing the unit UDB'S
; used in /PV code.


UNITAB:
TABMAC System ID , NPR6BT                         ;HOMHID=1
TABMAC Physical address of HOME blocks , HALF8    ;HOMPHY=2
TABMAC Position of STR in SYS search list , OCTPRT ;HOMSRC=3
TABMAC Structure name , NPR6BT                    ;HOMSNM=4
TABMAC ID next unit in STR , NPR6BT               ;HOMNXT=5
TABMAC ID previous unit in STR , NPR6BT           ;HOMPRV=6
TABMAC Logical unit in STR , NPR6BT               ;HOMLOG=7
TABMAC Unit in STR , OCTPRT                       ;HOMLUN=10
TABMAC PPN which refreshed STR , OCTPPN           ;HOMPPN=11
XWD	Z , CPOPJ				  ;HOMHOM=12
TABMAC Number of blocks/group to try for on output , DECPRT ;HOMGRP=13
TABMAC Blocks/supercluster , DECPRT               ;HOMBSC=14
TABMAC Superclusters/unit , DECPRT                ;HOMSCU=15
TABMAC RIB byte pointer for cluster count , BYTPNT ;HOMCNP=16
TABMAC RIB pointer for checksum , BYTPNT	  ;HOMCKP=17

TABMAC RIB pointer for cluster address , BYTPNT   ;HOMCLP=20
TABMAC Blocks per cluster , DECPRT                ;HOMBPC=21
TABMAC K for swapping on unit , K4SPNT ;HOMK4S=22
TABMAC HOMREF (non-zero if refresh needed) , OCTPRT ;HOMREF=23
TABMAC Number of SAT blocks in core , DECPRT      ;HOMSIC=24
TABMAC Unit ID of next unit in active swapping list , NPR6BT ;HIMSID=25
TABMAC Logical unit # in active swapping list , OCTPRT ;HOMSUN=26
TABMAC First log block number for swapping on unit , OCTPRT ;HOMSLB=27
TABMAC Swapping class , OCTPRT                    ;HOMCFS=30
TABMAC Number of SAT blocks/unit , DECPRT         ;HOMSPU=31
TABMAC Blocks reserved for overdraw per user , DECPRT  ;HOMOVR=32
TABMAC Sum of blocks guarenteed to users , DECPRT ;HOMGGAR=33
TABMAC <Logical block in STR of first RIB for files:
	SAT.SYS> , OCTPRT
TABMAC <	HOME.SYS> , OCTPRT
TABMAC <	SWAP.SYS> , OCTPRT
TABMAC <	MAINT.SYS> , OCTPRT
TABMAC <	BADBLK.SYS> , OCTPRT
TABMAC <	CRASH.SAV> , OCTPRT
TABMAC <	SNAP.SAV> , OCTPRT
TABMAC <	RECOV.SYS> , OCTPRT
TABMAC <	SYS UFD> , OCTPRT
TABMAC <	QUEUE UFD> , OCTPRT
TABMAC <	MFD > , OCTPRT
TABMAC First retrieval ptr for MFD , OCTL12
TABMAC Logical unit where MFD starts , OCTPRT
TABMAC <Table of lengths of files created by refresh:
	CRASH.SAV> , DECPRT
TABMAC <	SNAP.SAV> , DECPRT
TABMAC <	RECOV.SYS> , DECPRT
TABMAC <	SYS UFD> , DECPRT
TABMAC <	QUEUE UFD> , DECPRT
TABMAC <	MFD> , DECPRT


; The following words defined in the UDB alone, not from home blocks

TABMAC Words/SAT , DECPRT
TABMAC Clusters/SAT , DECPRT
TABMAC Physical unit name (drive) , NPR6BT
TABMAC <Controller type,,unit within controller> , HALF8
TABMAC Blocks/cylinder , DECPRT
TABMAC Blocks/track , DECPRT
TABMAC Blocks on unit , DECPRT
	Z		;ENDS THE LIST!!!
;SUBROUTINE TO PRINT A BLOCK OF DATA WITH MESSAGES FOR EACH WORD
;CALL	F.TMP = 1 TO SUPRESS LISTING ZERO WORDS
;	LH(T) = ADR. OF TABLE
;	RH(T) = ADR OF DATA
;
;TABLE ENTRIES ARE OF FORMAT:
;	LH - [ASCIZ\ARBITRARY MESSAGE\]
;	RH - ROUTINE TO PRINT DATA IN AC N
;
;IF LH = Z, RH=Z MEANS END OF LIST, RH=NON-ZERO MEANS SKIP WORD.
;IE,	XWD	Z , CPOPJ	;SKIP WORD
;		Z		;END OF LIST

LSTPN1:	AOBJN	T,.+1		;POINT TO NEXT ENTRY
LSTPNT:	HLRZ	T1,T		;T1=ADR OF TABLE
	HLRZ	M,(T1)		;M=ADR OF MESSAGE TO PRINT
	JUMPE	M,LSTPN2	;OR ZERO IF END OF LIST OR SKIP WORD
	SKIPN	N,(T)		;N=WORD TO PRINT. ZERO??
	TXNN	F,F.TMP		;YES. ARE WE TO SUPRESS ZEROES?
	 SKIPA			;NO TO EITHER. PRINT IT
	 JRST	LSTPN1		;YES TO BOTH. IGNORE THIS WORD
	PUSHJ	P,MSG		;PRINT MSG
	PUSHJ	P,EQUAL
	HRRZ	T1,(T1)		;ADR. OF WHERE TO GO
	PUSH	P,T		;SAVE OUR ONE IMPORTANT AC
	PUSHJ	P,(T1)		;GO THERE AND PRINT
	POP	P,T
	PUSHJ	P,CRLF
	JRST	LSTPN1


;HERE IF ZERO LEFT HALF

LSTPN2:	SKIPN	(T1)		;WHOLE WORD ZERO?
	 POPJ	P,		;YES. DONE
	JRST	LSTPN1		;NO. JUST IGNORE IT
HEDBLK:	MOVEI	M,[ASCIZ/
[Logical block /]
	PUSHJ	P,MSG
	MOVE	N,CURPOS(U)	;CURRENT BLOCK JUST READ
	PUSHJ	P,OCTPRT	;
	MOVEI	M,[ASCIZ/ on /]
	PUSHJ	P,MSG
	SKIPN	M,HOMLOG(U)
	 MOVE	M,DRIVE(U)
	PUSHJ	P,PR6BIT
	PUSHJ	P,RBRKT		;CLOSING BRACKET
	PJRST	CRLF



;SUBROUTINE TO PRINT A BYTE POINTER. PRINTS A
;12 DIGIT OCTAL NUMBER WITH ONES IN THE BYTE POSITION.
;EG, POINT 4,XYZ,8 PRINTS 017000000000

BYTPNT:	HRRI	N,N1		;MAKE PTR POINT TO N1
	SETO	N1,		;N1:=ALL ONES
	LDB	N1,N		;N1:=AS MANY ONES AS BYTE LENGTH
	LDB	N,[POINT 6,N,5]	;N:=BYTE POSITION=35-RIGHTMOST BIT
	LSH	N1,(N)		;SHIFT N1 OVER TO BYTE POSITION
	MOVE	N,N1		;AND PUT IT INTO N FOR PRINTING
	PJRST	OCTL12		;AND PRINT IT
	SUBTTL	Error processing routines

; Here for various command string error messages


CMDERR:	JSP	M,CMDER1
	ASCIZ/?Command error/
CMDER1:	MOV	<[POINT 1,ZERO]> , CMDB
	PJRST	ERR000
BADMON:	JSP	M,MSGXIT
	ASCIZ	/?Must be level D or later/
BADBOY:	OUTSTR	[ASCIZ/?Job not privilleged/]
	EXIT
NOTTY:	OUTSTR	[ASCIZ/?Can't OPEN TTY/]
	EXIT
NOLPT:	JSP	M,MSGXIT
	ASCIZ	/?Can't INIT listing device/
EFAIL:	JSP	M,MSGXIT
	ASCIZ	/?Listing file ENTER failed/
BADSW:	JSP	M,CMDER1
	ASCIZ/?Bad switch/
BADCFG:	JSP	M,MSGXIT
	ASCIZ/?SFD configuration error - check SFDLVL parameter/
; Various error messages.  JRST RIPDON when done

ERR000:	PUSHJ	P,MSGTTY
	PUSHJ	P,CRLF
	OUTPUT	CMD,
	JRST	RIPDON

ERR001:	JSP	M,ERR000
	ASCIZ /?Bad option/
ERR002:	JSP	M,ERR000
	ASCIZ /?File name arg illegal/
ERR003:	JSP	M,ERR000
	ASCIZ/?INIT failure on scratch device/
ERR004:	JSP	M,ERR000
	ASCIZ/?ENTER failure on scratch file/
ERR005:	JSP	M,ERR000
	ASCIZ/?No data input yet/
ERR006:	JSP	M,ERR000
	ASCIZ/?Word must be 0-177/
ERR007:	JSP	M,ERR000
	ASCIZ/?LOOKUP failure on scratch file/
; Various error messages continued

ERR008:	JSP	M,ERR000
	ASCIZ/?SAT's not in core/
ERR009:	JSP	M,ERR000
	ASCIZ/?SAT IOERR/
ERR010:	JSP	M,ERR000
	ASCIZ/
Cannot rewrite SATS unless all files specified/
ERR011:	JSP	M,ERR000
	ASCIZ\ /IF may only have one of S or R options\
ERR014:	JSP	M,ERR000
	ASCIZ/?Can't find RIPOFF.HLP/
ERR015:	JSP	M,ERR000
	ASCIZ\?Device must be a structure to fix SATs\
ERR016:	JSP	M,ERR000
	ASCIZ\?Function illegal when structure is mounted\
ERR017:	JSP	M,ERR000
	ASCIZ/?Device must be a structure/
ERR018:	JSP	M,ERR000
	ASCIZ\?Cannot specify non-star SFD's with /DU\
; Catastrophic error messages.

DIE000:	CLOSE	LST,		; Close output file
	RELEAS	LST,		; and release it
	RESET			; Stop the world the hard way
	OUTSTR	(M)		; Type message
	EXIT			;  and die
	JRST	.-1		; No restart

DIE001:	JSP	M,DIE000
	ASCIZ/? SUSET. UUO failed/
DIE002:	JSP	M,DIE000
	ASCIZ/[User abort]/
DIE003:	JSP	M,DIE000
	ASCIZ/? REWSTR failed/
DIE004:	JSP	M,DIE000
	ASCIZ/? Internal UDB's messed up/
DIE005:	JSP	M,DIE000
	ASCIZ/[AUX device abort]/
DIE006:	JSP	M,DIE000
	ASCIZ/? NXTSTR OPEN failed/
; Questionable operation messages.  POPJ when done

MSG000:	PUSH	P,F
	PUSHJ	P,MSGTTY
	PUSHJ	P,CRLF
	OUTPUT	CMD,		; Yes. Make sure message gets out
	POP	P,F
	POPJ	P,		; and return

MSG001:	JSP	M,MSG000
	ASCIZ/Wait plz.../


; Various operator questions. If answer is yes, return+0.
; If answer no, JRST RIPDON.. Flags preserved, AC's M,CH destroyed.
; All others preserved.

ASK000:	PUSHJ	P,OPER
	 JRST	RIPDON
	POPJ	P,

ASK001:	JSP	M,ASK000
	ASCIZ/Not same STR/
ASK002:	JSP	M,ASK000
	ASCIZ/Not same block/
ASK003:	JSP	M,ASK000
	ASCIZ/Wipe out all files? Are you sure? /
ASK004:	JSP	M,ASK000	;
	ASCIZ /Device is not a structure/
ASK005:	JSP	M,ASK000	;
	ASCIZ\Write listing to same structure on which /V is being done?
If no, type:
	^C
	ASSIGN dev LST
	RUN RIPOFF\
	SUBTTL	I/O routines for operator communication

;SUBROUTINE TO ASK OPERATOR TO CONTINUE OR NOT.
;RET+0 IF NOT,
;RET+1 IF HE SAYS YES


OPER:	PUSHJ	P,SAVALL
	MOVEM	M,TEMP
	JSP	M,TTYOUT
OPER2:	MOVE	M,TEMP
	PUSHJ	P,MSGTTY
	MOVEI	M,[ASCIZ/
Proceed? /]
	PUSHJ	P,MSG
	OUTPUT	CMD,
	SETZM	RH.CMD+2	;NO TYPEAHEAD.
	MOV	<[POINT 1,ZERO]> , CMDB
	CLRBFI
	PUSHJ	P,R.CMD
	SETZM	RH.CMD+2	; Clear all typeahead
	CLRBFI
	CAIN	CH,"Y"
	JRST	CPOPJ1
	CAIE	CH,"N"
	JRST	OPER2		;MUST SAY ONE OR OTHER
	POPJ	P,



;SUBROUTINE TO CHECK THAT BOTH NAME AND EXT ARE STARS.
;RET+0 IF EITHER NOT STAR.
;RET+1 IF ALL STARS

NONAME:	TXNN	F,S.NAM
	  POPJ	P,
	TXNN	F,S.EXT
	  POPJ	P,
	JRST	CPOPJ1
;PRINT A "FILE.EXT"

FILPNT:	MOVE	T,USRNAM
	HLLZ	T1,USREXT


;ROUTINE TO PRINT A FILE.EXT WITH FILE NAME IN T AND EXT IN T1.
; Call with F.FNOTB set to print with dot between filename and
; extension instead of TAB.

NAMPNT:	LDB	M,[POINT 6,T,5]	;GET FIRST 6 BIT CHAR
	PUSHJ	P,NAMTST	;SKIP IF SIXBIT
	 JRST	NAMP1		;NOT SIXBIT. LOOK CLOSER.
NAM6BT:	MOVE	M,T		;PRINT IT AS SIXBIT.
	TXZE	F,F.NOTB	; Print with dot?
	  JRST	NAM6B1		; Yep, go do it
	PUSHJ	P,PR6ALL
NAMEXT:	PUSHJ	P,TAB
	HLLZ	M,T1		;EXTENSION WILL ALWAYS BE SIXBIT
	PJRST	PR6ALL

NAM6B1:	PUSHJ	P,PR6BIT	; Print as SIXBIT
NAMEX1:	PUSHJ	P,DOT		; Followed by dot
	HLLZ	M,T1		; Get ext
	PJRST	PR6BIT		; And print in SIXBIT also

NAMP1:	CAIE	M,'.'		;THE ONLY SIXBIT CHAR WHICH IS NOT
				;A-Z,0-9 AND STILL IN FILENAMES.
	 JRST	NAMOCT		;NOT A DOT, PRINT IT IN OCTAL
	LDB	M,[POINT 6,T,11];TRY SECOND CHAR THEN.
	PUSHJ	P,NAMTST
	 SKIPA			;NOT A-Z,0-9. REALLY OCTAL THEN
	JRST	NAM6BT		;AOK. PRINT 6BIT

NAMOCT:	MOVE	N,T
	PUSHJ	P,HALF8
	TXZN	F,F.NOTB	; Print dot or tab?
	 JRST	NAMEXT		; tab
	 JRST	NAMEX1		; dot

NAMTST:	CAIL	M,'0'
	CAILE	M,'Z'
	 POPJ	P,
	CAIGE	M,'A'
	CAIG	M,'9'
	JRST	CPOPJ1
	 POPJ	P,
; Routine to print the current path from USRPTH.  Stops on a zero
; word or the nesting specified by CURLVL, whichever comes first.

UFDPNT:	MOVEI	CH,"["
	PUSHJ	P,W.LST		; Start with "["
	PUSH	P,P1		; Get a pointer to use
	PUSH	P,P2		; Plus limit word
	MOVE	P2,CURLVL	; Get current level of nesting
	ADDI	P2,USRPTH+.PTPPN ; Compute max offset
	MOVEI	P1,USRPTH+.PTPPN; Get pointer to start of path
	MOVE	N,(P1)		; Get PPN
	PUSHJ	P,OCTPPN	; and print in octal
UFDPN2:	CAML	P1,P2		; Done yet?
	  JRST	UFDPN3		; Yep
	MOVE	M,1(P1)		; Get next SFD name
	JUMPE	M,UFDPN3	; If we have reached the end
	PUSHJ	P,COMMA		; Make it look good
	PUSHJ	P,PR6BIT	; Type name
	AOJA	P1,UFDPN2	; Loop for all
UFDPN3:	POP	P,P2		; Restore P2
	POP	P,P1		; Restore P1
	PJRST	RBRKT		; Finish off with right bracket
; Routine to print FILE.EXE[path] of file LOOKed UP
; on channel (P4). Set at LOOKP.

CHNPNT:	MOVX	T,IO.FAC
	TDNN	T,IOSTS(P4)	; File active on this channel?
	 POPJ	P,		; No. Forget it
	MOVE	T,FNAME(P4)
	HLLZ	T1,FEXT(P4)
	TXO	F,F.NOTB	; Use dot instead of tab
	PUSHJ	P,NAMPNT	; Print name.ext
	MOVEI	CH,"["
	PUSHJ	P,W.LST
	MOVE	N,FPATH+.PTPPN(P4)
	PUSHJ	P,OCTPPN	; Print [P,PN]
	PUSH	P,P1		; Get an index to use
	MOVEI	P1,FPATH+.PTPPN+1(P4) ; Point to first SFD word
CHNPN1:	SKIPN	M,(P1)		; Skip if next SFD is non-null
	 JRST	CHNPN2		; At end of path if null SFD
	PUSHJ	P,COMMA		; Print a comma
	PUSHJ	P,PR6BIT	; Print the SFD name
	AOJA	P1,CHNPN1	;  and loop for all
CHNPN2:	POP	P,P1		; Restore P1
	MOVEI	CH,"]"
	PJRST	W.LST


; Subroutine to set TTY I/O and reset flags after return to lower
; level of pushdown. Call  JSP M,TTYOUT

TTYOUT:	PUSH	P,F		; Put flags onto stack
	ANDI	F,F.TTY!F.TTY2	; F:=State of TTY flags only
	EXCH	F,(P)		; Get back flags, stack TTY state
	TTYON			; Turn on TTY I/O
	PUSHJ	P,(M)		; Return to caller
	 SKIPA
	 AOS	-1(P)
	TTYOFF			; Shut off TTY now.
	TDO	F,(P)		; Reset TTY state before call
	SUB	P,ONEONE	; Reset pushdown depth
	POPJ	P,		;  and return to higher caller
;ROUTINE TO PRINT AN ERROR CODE IN AC N ALONG WITH ANY MESSAGE
;CALL:	RH(T) = ADR. OF MESSAGE TABLE
;	LH(T) = NUMBER OF HIGHEST ERROR IN TABLE
;
;	MESSAGE TABLE SHOULD LOOK LIKE:
;	XWD [ASCIZ/MSG1/] , [ASCIZ/MSG2/]
;


ERRPNT:	MOVEI	M,[ASCIZ/   (/]
	PUSHJ	P,MSG			;GIVE OPENING PAREN
	MOVE	P1,N			;SAVE ERROR CODE
	PUSHJ	P,OCTPRT		;AND PRINT IT
	HLRZ	T1,T			;GET MAX # OF ERRORS
	CAMG	P1,T1			;CAN WE PRINT A SPECIFIC MESSAGE?
	JRST	ERRPN1			;YES. GO DO IT.
ERRPN2:	MOVEI	M,[ASCIZ/) error code /];NO. JUST SAY IT IS AN ERROR
	MOVE	N,P1			;RESTORE N
	PJRST	MSG			;AND RETURN

ERRPN1:	MOVEI	M,[ASCIZ/) /]		;CLOSING PAREN
	PUSHJ	P,MSG
	MOVE	N,P1			;RESTORE N
	HRRZS	T			;T=ERROR TABLE ADR.
	IDIVI	P1,2
	ADDI	P1,(T)			;P1=ADR. OF THIS ERROR MESSAGE
	SKIPE	P2			;IF N WAS ODD,
	SKIPA	M,(P1)			;USE RH OF TABLE ENTRY.
	HLRZ	M,(P1)			;IF N EVEN, USE LH OF TABLE
	JUMPE	M,ERRPN2		;IF ZERO, GIVE GENERAL MESSAGE ONLY
	PJRST	MSG			;PRINT IT AND RETURN TO CALLER
;ROUTINE TO PRINT ASCIZ MESSAGES POINTED TO IN "M"

EMSG:	TXOA	F,F.ERRM	;SET FOR ERROR MESSAGES
MSGTTY:	TTYON			;FORCE TTY MESSAGES
MSG:	HRLI	M,(POINT 7,0)
MSGL:	ILDB	CH,M
	JUMPE	CH,CPOPJ
	PUSHJ	P,W.LST
	JRST	MSGL
CPOPJ1:	AOSA	(P)		;GIVE SKIP RETURN
T1POPJ:	POP	P,T1		;
CPOPJ:	POPJ	P,
UPOPJ1:	AOS	-1(P)		; Bump return point
UPOPJ:	POP	P,U		; Restore U
	POPJ	P,		;  and return

;ROUTINES TO PRINT SPECIAL CHARACTERS

EQUAL:	JSP	M,MSG
	ASCIZ/ = /
ECRLF:	TXO	F,F.ERRM
	PJRST	CRLF
CRLF3:	PUSHJ	P,CRLF
CRLF2:	PUSHJ	P,CRLF
CRLF:	JSP	M,MSG
	ASCIZ/
/
%CRLF:	JSP	M,MSG
	ASCIZ	/%
/

SPC2:	PUSHJ	P,SPC
SPC:	SKIPA	CH,[" "]
FORM:	MOVEI	CH,.CHFFD
	PJRST	W.LST
COMMA:	SKIPA	CH,[","]
DOT:	MOVEI	CH,"."
	PJRST	W.LST
TAB2:	PUSHJ	P,TAB
TAB:	SKIPA	CH,[.CHTAB]
SLASH:	MOVEI	CH,"/"
	PJRST	W.LST
RPAR:	SKIPA	CH,[")"]
DASH:	MOVEI	CH,"-"
	PJRST	W.LST
PLUS:	SKIPA	CH,["+"]
RBRKT:	MOVEI	CH,"]"
	PJRST	W.LST
COLON:	SKIPA	CH,[":"]
LPAR:	MOVEI	CH,"("
	PJRST	W.LST
; Print SIXBIT word in AC "N"

NPR6BT:	MOVE	M,N		; and fall into PR6BIT

; Print SIXBIT word in AC "M"
; PR6BIT quits on first blank, PR6ALL prints all

PR6ALL:	TDZA	T,T
PR6BIT:	SETO	T,
	HRLM	T,(P)		; Remember entry
	MOVE	T,[POINT 6,M]
PR6BT1:	ILDB	CH,T
	SKIPGE	(P)		; Skip test if entry at PR6ALL
	 JUMPE	CH,CPOPJ	; Otherwize test.
	ADDI	CH," "
	PUSHJ	P,W.LST
	TLNE	T,770000
	JRST	PR6BT1
	POPJ	P,


; Here to print AC N as a 12 digit octal number

OCTL12:	MOVEI	M,^D12
OCTLL:	MOVEI	N1,6
	ROTC	N,3
	MOVEI	CH,(N1)
	PUSHJ	P,W.LST
	SOJG	M,OCTLL
	POPJ	P,


; Here to print AC "N" as halfword octal


OCTPPN:	TDZA	T,T		; Flag entry point
HALF8:	SETOM	T		; Same here
	HRR	T,N		; Save prog number for later
	PUSH	P,T		; Save flag and prog number on stack
	HLRZS	N		; Isolate proj number
	PUSHJ	P,OCTPRT	; Print it
	PUSHJ	P,COMMA		; Followed by comma
	SKIPGE	(P)		; Skip second comma if entry at OCTPPN
	 PUSHJ	P,COMMA
	POP	P,N		; Restore prog number
	HRRZS	N		;  and isolate it
	PJRST	OCTPRT
; Routines to print right-justified integers
; Field width in AC "T"
; Number in AC "N"


DECSPC:	SKIPA	CH,[" "]	; Decimal with leading spaces
DECZRO:	MOVEI	CH,"0"		; Decimal with leading zeroes
	MOVEI	M,^D10
	JRST	RJRDXP
OCTSPC:	SKIPA	CH,[" "]	; Octal with leading spaces
OCTZRO:	MOVEI	CH,"0"		; Octal with leading zeroes
	MOVEI	M,^D8
RJRDXP:	MOVE	N1,M
	JUMPL	N,RDXPRT+1
JUSTFY:	SOJLE	T,RDXPRT	; Right justify
	CAMGE	N,N1
	PUSHJ	P,W.LST
	IMUL	N1,M
	JRST	JUSTFY

OCTPRT:	SKIPGE	N		; Number have sign bit set?
	 PJRST	OCTL12		; Yes, print all 12 digits
	MOVEI	M,^D8		; Get radix
	JRST	RDXPR1		; and print as octal
DECPRT:	PUSH	P,[DOT]		; Print dot at end of dec. number
DECPR1:	MOVEI	M,^D10		; Here to print decimal numbers
RDXPRT:	SKIPGE	N		; Number negative?
	 PUSHJ	P,DASH		; Yes, print minus
	MOVMS	N		; Get absolute value
RDXPR1:	IDIVI	N,(M)		; Divide by radix
	HRLM	N1,(P)		; Save remainder
	SKIPE	N		; Done?
	 PUSHJ	P,RDXPR1	; No, call ourselves
	HLRZ	CH,(P)		; Get number from stack
	ADDI	CH,"0"		; Convert to ASCII
	JRST	W.LST		; Print and return to caller
	SUBTTL	Date routines for internal conversion


; Routine to set T3=Universal standard creation Date.Time word of a  file.
; Uses RIBTIM if exists, else gets 12 or 15 bit old format and converts.


FILDAT:	JSP	M,SAVE3		; Save some AC's
	SKIPN	T3,BUF+RIBTIM	; Got a universal date already?
	 JRST	FILDT0		; No. Got to build one.
	HRRZ	P1,BUF+RIBFIR
	CAILE	P1,RIBTIM	; This an old style RIB?
	 POPJ	P,		; No. Date is valid.

; Here if not new style RIB, must build date.time word


FILDT0:	PUSH	P,T1		; Save T1,T2
	PUSH	P,T2
	LDB	T2,EXLLCD	; Get 12 low order bits of creation date
	LDB	T1,EXLHCD	;  plus 3 high order bits
	DPB	T1,[POINT 3,T2,23] ; Make 15 bit date
	LDB	T1,EXLCRT	; Get time
	IMULI	T1,^D60*^D1000	; T1=Time in milliseconds, T2=15 bit date
FILDT1:	PUSHJ	P,.CNVDT	; Convert T1,T2 to universal date.time in T3
	POP	P,T2
	POP	P,T1
	POPJ	P,		; Restore AC's and return.



; Here to return T3=universal file access date ,, 0 time

FILACD:	JSP	M,SAVE3		; Save AC's
	SETZ	T1,		; Set zero time
	LDB	T2,EXLACD	; Get 15 bit date
	PUSH	P,T1
	PUSH	P,T2
	JRST	FILDT1		;  and continue like FILDAT


; Here to print a universal date/time as dd-mmm-yy  hh:mm:ss
; Call with date/time in N

DATTIM:	MOVE	T3,N		; Where PRDATE and PRTIME wants it
	PUSH	P,T3		; Save it
	PUSHJ	P,PRDATE	; Print the date
	POP	P,T3		; Restore the word
	PJRST	PRTIME		; Print time and return


;SUBROUTINES TO CONVERT DATES FROM 15 BIT TO UNIVERSAL AND BACK.
;STOLEN FROM SCAN.MAC, COPYRIGHT DEC....
;



;SUBROUTINE TO CONVERT FROM UNIVERSAL DATE.TIME WORD IN T3 TO 15 BIT
;RETURNS T1=MILLISECOND TIME (SINCE MIDNIGHT), T2= 15 BIT DATE.
;

.CNTDT:	MOVE	T1,T3		;DEC VERSION NEEDS IT IN T1, RIPOFF CALLS
				;IT FROM T3
	PUSH	P,T1		;SAVE TIME FOR LATER
	JUMPL	T1,CNTDT6	;DEFEND AGAINST JUNK INPUT
	HLRZ	T1,T1		;GET DATE PORTION (DAYS SINCE 1858)

	RADIX	10		;**** NOTE WELL ****
	ADDI	T1,365*400+24*4-<2001-1859>*365-<2001-1859>/4-31-30+17	;MAKE INTO DAYS SINCE JAN 1, 1601

	IDIVI	T1,365*400+24*4+1  ;SEPARATE UNITS OF 400
	LSH	T1,2		;MULT ANSWER BY 4
	IDIVI	T2,365*100+24	;SEPARATE CENTURIES
	CAIN	T2,4		;SEE IF LAST ONE
	SOSA	T2		;YES--BACK OFF
	JRST	.+2		;CONTINUE SKIP
	MOVEI	T3,365*100+24	;SET TO FULL (LEAP) CENTURY
	ADD	T1,T2		;INCLUDE CENTURIES IN RESULT
	IMULI	T1,25		;MULT ANSWER BY 25
	IDIVI	T3,365*4+1	;SEPARATE UNITS OF 4
	ADD	T1,T3		;INCLUDE IN ANSWER
	LSH	T1,2		;MULT ANSWER BY 4
	MOVE	T3,T4		;PROMOTE AC
	IDIVI	T3,365		;SEPARATE YEARS
	CAIN	T3,4		;SEE IF END OF LEAP YEAR
	SOSA	T3		;YES--BACK OFF YEAR
	JRST	.+2		;CONTINUE SKIP
	MOVEI	T4,365		;SET FOR END OF YEAR
	ADDI	T1,1601(T3)	;GET REAL YEAR
				;T1 HAS YEAR, T4 HAS DAY IN YEAR

	MOVE	T2,T1		;COPY YEAR TO SEE IF LEAP YEAR
	IDIVI	T2,400		;SEE IF MULT OF 400
	JUMPE	T3,CNTDT1	;YES--PROCEED
	MOVE	T2,T1		;GET NEW COPY
	IDIVI	T2,100		;SEE IF MULT OF 100
	JUMPE	T3,[MOVEI T3,1	;YES--FLAG AS NO L.Y.
		    JRST  CNTDT1] ;AND PROCEED
	MOVE	T2,T1		;GET NEW COPY
	IDIVI	T2,4		;SEE IF MULT OF 4
				;T3 IS 0 IF LEAP YEAR
	;UNDER RADIX 10 **** NOTE WELL ****

CNTDT1:	SUBI	T1,1964		;SET TO SYSTEM ORIGIN
	IMULI	T1,31*12	;CHANGE TO SYSTEM PSEUDO DAYS
	JUMPN	T3,CNTDT2	;IF NOT LEAP YEAR, PROCEED
	CAIGE	T4,31+29	;LEAP YEAR--SEE IF BEYOND FEB 29
	JRST	CNTDT5		;NO--JUST INCLUDE IN ANSWER
	SOS	T4		;YES--BACK OFF ONE DAY
CNTDT2:	MOVSI	T2,-11		;LOOP FOR 11 MONTHS

CNTDT3:	CAMGE	T4,.MNTAB+1(T2)	;SEE IF BEYOND THIS MONTH
	JRST	CNTDT4		;YES--GO FINISH UP
	ADDI	T1,31		;NO--COUNT SYSTEM MONTH
	AOBJN	T2,CNTDT3	;LOOP THROUGH NOVEMBER

CNTDT4:	SUB	T4,.MNTAB(T2)	;GET DAYS IN THIS MONTH
CNTDT5:	ADD	T1,T4		;INCLUDE IN FINAL RESULT

CNTDT6:	EXCH	T1,(P)		;SAVE ANSWER, GET TIME
	TLZ	T1,-1		;CLEAR DATE
	MUL	T1,[24*60*60*1000]	;CONVERT TO MILLI-SEC.
	ASHC	T1,17		;POSITION RESULT
	POP	P,T2		;RECOVER DATE
	POPJ	P,		;RETURN

	;UNDER RADIX 10 **** NOTE WELL ****

;.CNVDT -- CONVERT 12 OR 15 BIT DATE TO UNIVERSAL DATE
;CALL:	MOVE	T1,TIME IN MILLISEC.
;	MOVE	T2,DATE IN 12 OR 15 BIT FORMAT
;	PUSHJ	P,.CNVDT
;RETURNS WITH RESULT IN T3 (.GT.0; OR -1 IF BEYOND SEPT. 27,2217)

.CNVDT:	PUSH	P,T1		;SAVE TIME FOR LATER
	IDIVI	T2,12*31	;T2=YEARS-1964
	CAILE	T2,2217-1964	;SEE IF BEYOND 2217
	JRST	GETNW2		;YES--RETURN -1
	IDIVI	T3,31		;T3=MONTHS-JAN, T4=DAYS-1
	ADD	T4,.MNTAB(T3)	;T4=DAYS-JAN 1
	MOVEI	P1,0		;LEAP YEAR ADDITIVE IF JAN, FEB
	CAIL	T3,2		;CHECK MONTH
	MOVEI	P1,1		;ADDITIVE IF MAR-DEC
	MOVE	T1,T2		;SAVE YEARS FOR REUSE
	ADDI	T2,3		;OFFSET SINCE LEAP YEAR DOES NOT GET COUNTED
	IDIVI	T2,4		;HANDLE REGULAR LEAP YEARS
	CAIE	T3,3		;SEE IF THIS IS LEAP YEAR
	MOVEI	P1,0		;NO--WIPE OUT ADDITIVE
	ADDI	T4,<1964-1859>*365+<1964-1859>/4+<31-18>+31(T2)
				;T4=DAYS BEFORE JAN 1,1964 +SINCE JAN 1
				; +ALLOWANCE FOR ALL LEAP YEARS SINCE 64
	MOVE	T2,T1		;RESTORE YEARS SINCE 1964
	IMULI	T2,365		;DAYS SINCE 1964
	ADD	T4,T2		;T4=DAYS EXCEPT FOR 100 YR. FUDGE
	HRREI	T2,64-100-1(T1)	;T2=YEARS SINCE 2001
	JUMPLE	T2,GETNW1	;ALL DONE IF NOT YET 2001
	IDIVI	T2,100		;GET CENTURIES SINCE 2001
	SUB	T4,T2		;ALLOW FOR LOST LEAP YEARS
	CAIE	T3,99		;SEE IF THIS IS A LOST L.Y.
GETNW1:	ADD	T4,P1		;ALLOW FOR LEAP YEAR THIS YEAR
	CAILE	T4,^O377777	;SEE IF TOO BIG
GETNW2:	SETOM	T4		;YES--SET -1

	POP	P,T1		;GET MILLISEC TIME
	MOVEI	T2,0		;CLEAR OTHER HALF
	ASHC	T1,-17		;POSITION
	DIV	T1,[24*60*60*1000]  ;CONVERT TO 1/2**18 DAYS
	HRL	T1,T4		;INCLUDE DATE
	MOVE	T3,T1		;DEC VERSION RETURNS NOW, DATE,,TIME IN T1
				;RIPOFF NEEDS IT IN T3..
	POPJ	P,		;RETURN
	;UNDER RADIX 10 **** NOTE WELL ****

.MNTAB:	EXP	0,31,59,90,120,151,181,212,243,273,304,334,365
	RADIX	8
	SUBTTL	Input routines for command scanner
;
;
; RDATOM reads one command name of any type and returns it in AC 'M'.
; AC 'CH' returns with the next char after the atom, i.e.,
; the break character. AC 'P4' returns the arg type, i.e.:
;
$CMBRK==0	; No args read (first char scanned was a break char)
$CMBLK==1	; M is a block argument
$CMFIL==2	; M is a file name

RDATOM:	SETZB	P4,M		; Start with no arg type, no arg
	TXZ	F,.LBS
	ILDB	CH,CMDB		; Get a char from CMD string
	CAIN	CH,"^"
	  JRST	RDXCNG		; ^D or ^O sets radix
	CAIN	CH,"#"
	  JRST	CLUS		; # means clusters follow
	CAIN	CH,"$"
	  JRST	RDATM4		; $ means octal file name
	CAIN	CH,"'"
	  JRST	SIXBRD		; Single quote means SIXBIT
	CAIN	CH,""""
	  JRST	ASCIRD		; Double quote reads ASCII name
	CAIL	CH,"0"		; Between 0-9?
	 CAILE	CH,"9"
	  JRST	RDATM3		; No. Must be file name
	IBP	CMDB		; Yes. Must back up byte ptr
	IBP	CMDB		; So RDNUMR reads whole thing
	IBP	CMDB
	IBP	CMDB
	SOS	CMDB		; Really do need DBP (Dec. Byt. Ptr.) instn
	JRST	BLKS		;  and go read block number
RDWORD:	SETZB	P4,M		; Alternate entry to always read name
RDATM4:	ILDB	CH,CMDB		; Name is SIXBIT (even though numeric)

RDATM3:	MOVEI	P4,$CMFIL	; Must be SIXBIT file name
	MOVE	T,[POINT 6,M]
RDATM1:	CAIL	CH,"A"		; File names are alphabetic
	 CAILE	CH,"Z"
	  SKIPA
	   JRST RDATM2
	CAIN	CH,"*"		;  or stars
	  JRST	RDATM2
	CAIL	CH,"0"		;  or numbers
	 CAILE	CH,"9"
	  POPJ	P,		; None of these, done.
RDATM2:	TRC	CH,40		; SIXBITize it
	TLNE	T,770000
	 IDPB	CH,T
	ILDB	CH,CMDB		;  and get next char
	JRST	RDATM1
; Here on up-arrow, change radix

RDXCNG:	ILDB	CH,CMDB		; Get next character
	SETZ	T,
	CAIN	CH,"D"		; Was it ^D?
	 MOVEI	T,^D10		; Yes, set radix
	CAIN	CH,"O"		; How 'bout ^O?
	 MOVEI	T,^D8		; Use appropriate radix
	CAIN	CH,"B"		; Last chance is ^B
	 MOVEI	T,2		; Yes, use 2 as radix
	JUMPE	T,CMDERR	; If none of the above, command error
	MOVEM	T,RADIX		; Save for posterity
	PUSH	P,[RDXCN2]	; Return here after reading number
	MOVE	T1,CMDB		; Get command string byte pointer
	ILDB	CH,T1		; Lookahead one character
	CAIE	CH,"#"		; Start of cluster arg?
	 JRST	RDXCN1		; No
	MOVEM	T1,CMDB		; Advance pointer across #
	TXO	F,.LBS		; Flag cluster argument
RDXCN1:	MOVE	T1,CMDB		; Get possibly changed pointer back
	ILDB	CH,T1		; Get next character
	CAIL	CH,"0"		; Make sure a number is next
	 CAILE	CH,"0"-1(T)	;  (of the correct radix)
	  JRST	CMDERR		; Nope, error
	JRST	BLKS		; Go read it, return at RDXCN2
RDXCN2:	MOVI	^D8,RADIX	; Restore radix
	POPJ	P,		;  and return


; Here if block arg indicated (numeric or preceeding #)

CLUS:	TXO	F,.LBS		; Tell SCAN we saw pound sign
BLKS:	MOVEI	P4,$CMBLK	; Indicate block arg
	PJRST	RDNUMR		;  and go read a number
; Subroutine to read a number. May be half word octal delimited by comma,
; May contain arithmetic operators +-*' (with no imbedded spaces and
; please no parenthetical expressions!)


RDNUMR:	MOVE	T,CMDB
	ILDB	CH,T
	CAIE	CH,"*"		; See if first char is star
	 JRST	RDNUM1
	IBP	CMDB		; Yes. Inc past it since a lone
	ILDB	CH,CMDB		;  star means 'ALL' , not multiplication!
	SKIPA	M,[EXP 400000]	;  and flag star in answer
RDNUM1:	PUSHJ	P,NUMIN		; Go read a number
	CAIE	CH,","		; End in a comma?
	 POPJ	P,		; No. done
	HRLZM	M,N		; Yes. save this half of number
	MOVE	T,CMDB		; Test again for lone star/other comma
	ILDB	CH,T
	CAIE	CH,","		; Have two commas between halfwords?
	 JRST	RDNUM3		; Nope
	ILDB	CH,T		; Get next character to test
	IBP	CMDB		;  and adjust CMD string BP also
RDNUM3:	CAIE	CH,"*"
	 JRST	RDNUM2
	IBP	CMDB
	ILDB	CH,CMDB
	SKIPA	M,[EXP 400000]
RDNUM2:	PUSHJ	P,NUMIN
	HLL	M,N		; Retrieve first half of number
	POPJ	P,		;  and thats all..
; Here to read in a simple little number

NUMIN:	SETZM	NUMB		; Start with no number
	SETZM	TERMCH		;  and no preceeding character
	MOVE	N1,RADIX	;  and get current radix
NUMIN0:	SETZ	M,		; Here for next number
NUMINL:	ILDB	CH,CMDB		; Read a digit
	CAIL	CH,"0"		; Or is it a digit?
	 CAILE	CH,"0"-1(N1)	; That's hairy
	  JRST	NUMIN1		; On the other hand, thats not a digit.
	IMULI	M,(N1)		; Digit. Increase running sum radix-fold
	ADDI	M,-"0"(CH)	; Add in this newest digit
	JRST	NUMINL		; Loop for remaining digits.

NUMIN1:	EXCH	CH,TERMCH	; Get term char of last number
	CAIE	CH,"+"		; Add??
	  JRST	NUMIN2
NUMIN5:	ADDM	M,NUMB
	JRST	NUMIN9

NUMIN2:	CAIE	CH,"-"		; Subtract?
	  JRST	NUMIN3
	SUBM	M,NUMB
	MOVNS	NUMB
	JRST	NUMIN9

NUMIN3:	CAIE	CH,"*"		; Multiply?
	  JRST	NUMIN4
	IMULM	M,NUMB
	JRST	NUMIN9

NUMIN4:	CAIE	CH,"'"		; Divide?
	  JRST	NUMIN5		;NO NONE OF THESE..
	EXCH	M,NUMB
	IDIVM	M,NUMB

NUMIN9:	MOVE	CH,TERMCH
	CAIE	CH,"+"
	CAIN	CH,"-"
	  JRST	NUMIN0
	CAIE	CH,"*"
	CAIN	CH,"'"
	  JRST	NUMIN0
	MOVE	M,NUMB		; All done. make M=number
	POPJ	P,
; Here to read SIXBIT and ASCII names between delimiters

SIXBRD:	SETZ	M,		; Start with no name
	ILDB	P1,CMDB		; Read the delimiter
	MOVE	T,[POINT 6,M]	; SIXBIT pointer
	MOVEI	T1,770000	; Non-zero bits in a SIXBIT pointer


ANYBRD:	MOVEI	P4,$CMFIL	; Flag this as a name
	ILDB	CH,CMDB		; Get next char
	CAIL	CH,40
	CAIL	CH,175
	  JRST	CMDERR		; Can not be a line delimiter!
	CAIN	CH,(P1)		; Repeat of first delimiter yet?
	 JRST	RDPOPJ		; Shoor'nuf
	CAIN	T1,770000	; Processing ASCII or SIXBIT?
	 TRC	CH,40		; SIXBIT....
	TLNE	T,(T1)		; Reached end of word yet?
	 IDPB	CH,T		; No. Put in this char
	JRST	ANYBRD+1	;  and continue


ASCIRD:	ILDB	P1,CMDB		; Read ASCII delimiter
	MOVE	T,[POINT 7,M]	; ASCII pointer
	MOVEI	T1,760000	; Non-zero ASCII ptr bits
	JRST	ANYBRD

RDPOPJ:	ILDB	CH,CMDB		; Read char after last delimiter
	POPJ	P,		;  and ret it
;	Routine to get the startup option from the user.
;	Returns CPOPJ always with the startup option in ST$OPT.

STUERR:	MOVEI	M,[ASCIZ/Quick, Long, Help
/]
	PUSHJ	P,MSGTTY	; Message to type on error

STRTUP:	MOVEI	M,[ASCIZ/Startup option: /]
	PUSHJ	P,MSGTTY	; Ask the user
	OUTPUT	CMD,		; Make sure he sees it
	PUSHJ	P,GETCMD	; Read the option into CMDBUF
	PUSHJ	P,RDWORD	; Get the answer in M
	MOVE	T,[-STULEN,,STUTBL] ; Get AOBJN pointer to table
	JUMPN	CH,STUERR	; Terminating char better be a break
	SKIPE	M		; Value better be non-null
	 PUSHJ	P,FNDMAT	; It does, go find a match
	  JRST	STUERR		; Bad option
	PJRST	@STUDSP(T)	; Go process it
;
;	Here for Quick and Long options.  Store value and return
;
STUQUI:	SKIPA	T,[$OPQUI]	; Get code for Quick option and skip
STULON:	MOVEI	T,$OPLON	; Same for Long option
	MOVEM	T,ST$OPT	; Save for later
	POPJ	P,		; and return
;
;	Here for Help option.  Give more detailed help message
;
STUHEL:	MOVEI	M,[ASCIZ/
Quick - Do not ask about off-line devices
Long  - Full startup dialog
Help  - Type this text
/]
	PUSHJ	P,MSGTTY	; Tell user
	PJRST	STRTUP		; and try again
;
;	Generate the tables of correct responses.  STUTBL contains
;	the SIXBIT names of the valid options as defined by the
;	OPTIONS macro.  STUDSP contains the corresponding dispatch
;	addresses for these options.
;
DEFINE	OPTIONS, <
	X	QUICK
	X	LONG
	X	HELP
		 >

DEFINE	X (OPT), <
	$OP'OPT==.-STUTBL
	SIXBIT/OPT/
		 >

STUTBL:	OPTIONS
STULEN==.-STUTBL

DEFINE	X (OPT), <
	EXP	STU'OPT
		 >

STUDSP:	OPTIONS
;	Routine to find a match in a table of SIXBIT names.
;	Originally stolen from COMCON.
;	Call with T = AOBJN pointer to table, M = SIXBIT name to match
;	Returns CPOPJ if no (or ambiguous) match
;		CPOPJ1 for unique match with T = index in table

FNDMAT:	MOVN	T1,M		; Find the rightmost
	AND	T1,M		; non-zero bit in the name
	JFFO	T1,.+1		; and its cardinality
	IDIVI	T2,6		; Find where in SIXBIT byte this bit is
	LSH	T1,-5(T3)	; Right-justify the bit within the byte
	SOJ	T1,		; Make mask of trailing blanks
	SETZB	T4,T2		; Initialize match pointer and count
	MOVE	T3,T		; Save pointer to table
FNDMT2:	MOVE	N,(T)		; Get next candidate
	XOR	N,M		; Compare with one user gave
	JUMPE	N,FNDMT4	; Jump if exact match
	ANDCM	N,T1		; Mask table entry
	JUMPN	N,FNDMT3	; No partial match either
	MOVE	T4,T		; Partial match--save pointer
	MOVEI	T2,1(T2)	; Count partial matches
FNDMT3:	AOBJN	T,FNDMT2	; Loop for all entries
	MOVE	T,T4		; Restore address of possible match
	SOJN	T2,CPOPJ	; More than one means error
FNDMT4:	SUB	T,T3		; Compute table index of match
	TLZ	T,-1		; Clear junk
	JRST	CPOPJ1		; and return success
; Subroutine to input a date,,time word from the cmd TTY
REPEAT LOGIC,<

Type-in format is :
	Date , Time	or
	Time , Date

	Where date = dd-mmm-yy or dd-mmm-yyyy
	and time = hh:mm:ss or hh:mm

	Blanks or tabs may occur anywhere, comma must seperate the two.
	Also, either time or date or both may be left out, zero returned

Returns T3=Universal date,,time word

>



GTDT5:	POP	P,RADIX		; Restore original radix
	MOVEI	M,[ASCIZ!
%Type date as dd-mmm-yy, time as hh:mm or hh:mm:ss
seperated by a comma
!]
	PUSHJ	P,MSGTTY

GTDATE:	PUSHJ	P,GETCMD	; Get the command string
	PUSH	P,RADIX		; Save old radix
	MOVI	^D10,RADIX	; Implied radix ten here
	SETZB	P1,TTIME	; Clear junk
	SETZM	TDATE		;  and lets read some stuff....

GTDT4:	PUSHJ	P,GTDNUM	; Read a number
	CAIN	CH,":"		; End in a colon?
	 JRST	GTDT10		; Yes. Go process time
	CAIN	CH,"-"		; How about a slash?
	 JRST	GTDT20		; Go process.
	JUMPN	CH,GTDT5	; Anything else is err, unless EOL

; Here on EOL. Done

	MOVE	T1,TTIME	; Get time
	IMULI	T1,^D1000	; in milliseconds
	MOVE	T2,TDATE
	PUSHJ	P,.CNVDT	; Convert to universal
	SKIPN	TDATE		; Special kludge **
				; Did he give me a zero date??
	 HRRZS	T3		; Yes. So return zero date
				; Note- He can never do
				; a /IT before Jan-1-64, since that is zero
	POP	P,RADIX		; Restore old radix and
	POPJ	P,		;  return
; Here to process time

GTDT10:	IMULI	M,^D3600	; Convert hours to seconds
	MOVE	P1,M		; Store in P1
	PUSHJ	P,GTDNUM	; Read minites
	IMULI	M,^D60		; Convert to seconds
	ADD	P1,M		; Add into running total
	CAIN	CH,","		; Done here?
	 JRST	GTDT11		; Yes. Go process more
	JUMPE	CH,GTDT11
	CAIE	CH,":"		; More to come?
	 JRST	GTDT5		; No. Illegal
	PUSHJ	P,GTDNUM	; Read seconds
	ADD	P1,M		; Add them in there
GTDT11:	MOVEM	P1,TTIME	; Store time
	JRST	GTDT4		;  and loop


; Here to process date type-in

GTDT20:	CAILE	M,^D31		; Day can't be > 31
	 JRST	GTDT5		; Else it's an error
	MOVEI	P1,-1(M)	; Day-1 to P1
	SETZM	N		; Setup to accumulate month
GTDT30:	ILDB	N1,CMDB		; Get next char
	JUMPE	N1,GTDT5	; EOL is illegal here
	CAIN	N1,"-"		; Find end of month?
	 JRST	GTDT40		; Yes
	ROT	N1,-7		; Left justify character
	LSHC	N,7		;  and accumulate it in N
	JRST	GTDT30		; Loop for more
GTDT40:	LSH	N,7+1		; Make it 0MMM0
	TDO	N,[BYTE (7)"-",0," "," ","-"] ; Make it -Mmm-
	HRLZI	T1,-^D12	; Make AOBJN pointer for MONTAB
GTDT50:	CAME	N,MONTAB(T1)	; Find match in MONTAB?
	 AOBJN	T1,GTDT50	; No, try next
	TLZN	T1,-1		; Clear LH and check for match
	 JRST	GTDT5		; No match, error
	IMULI	T1,^D31		; T1=(mon-1)*31
	ADD	P1,T1		; P1=(mon-1)*31+day-1
	PUSHJ	P,GTDNUM	; Get year
	CAIG	M,^D99		; Allow 1978
	 ADDI	M,^D1900	; Convert from 78 to 1978
	SUBI	M,^D1964	; Subtract zero year
	IMULI	M,^D31*^D12	; M=(year-1964)*31*12
	ADD	P1,M		; P1=((yy-1964)*12+(mm-1))*31+dd-1
	MOVEM	P1,TDATE	; Save in core
	JRST	GTDT4		; and see what's left

; Here to read a decimal number from the command string for date/time
; Returns number in M, terminator in CH

GTDNUM:	SETZ	M,		; Clear number
GTDNM1:	ILDB	CH,CMDB		; Get next char from command string
	CAIL	CH,"0"		; Is it a digit?
	 CAILE	CH,"9"
	  POPJ	P,		; No, that's it
	IMULI	M,^D10		; Make room for next digit
	ADDI	M,-"0"(CH)	; Convert to binary and add to total
	JRST	GTDNM1		; Loop for more
;ROUTINE TO PRINT THE EXACT TIME NOW..

NOW:	MSTIME	T1,		;TIME IN MILLISECONDS
	IDIVI	T1,^D60000
	MOVE	T3,T2
	IDIVI	T3,^D1000	;SECONDS IN T3
	IDIVI	T1,^D60		;HOURS IN T1, MINITES IN T2
	MOVNI	T4,2
	SKIPA	CH,[40]
NOWLUP:	MOVEI	CH,":"
	PUSHJ	P,W.LST
	MOVEI	T,2
	MOVE	N,T3(T4)	;GETS HOURS, THEN MIN, THE SECONDS
	PUSHJ	P,DECZRO
	AOJLE	T4,NOWLUP
	PUSHJ	P,SPC2
	DATE	T1,		;GET DATE AND HIT PRDT1
	JRST	PRDT1		;GO PRINT IT.


;ROUTINE TO PRINT THE DATE, DATE IN T3 IN UNIVERSAL STANDARD

PRDATE:	JSP	M,SAVE3		;SAVE P1
	PUSHJ	P,.CNTDT	;GET T1=MS TIME, T2=DATE IN 15 BIT
	MOVE	T1,T2		;15 BIT DATE TO T1

PRDT1:	IDIVI	T1,^D31
	MOVEI	N,1(T2)		;DAY
	MOVEI	T,2
	PUSHJ	P,DECZRO
	IDIVI	T1,^D12
	MOVE	T2,MONTAB(T2)	;MONTH
	SETZ	T3,
	MOVEI	M,T2
	PUSHJ	P,MSG
	MOVEI	N,^D64(T1)	;YEAR
	PUSHJ	P,DECPR1		;
	PJRST	SPC2		;AND TWO SPACES


MONTAB:	DEFINE MONMAC(X) <IRP X,<ASCII /-X-/ >>

	MONMAC<Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec>
; Routine to print the time.  Call with universal date/time
; in T3.  PRTIME prints as hh:mm:ss, PRTIM1 prints as hhmm

PRTIME:	TLOA	T3,-1		; Flag entry
PRTIM1:	TLZ	T3,-1		; Ditto
	JSP	M,SAVE3		; Get some registers to use
	HLRE	P3,T3		; Move entry flag to P3
	HRRZ	P1,T3		; Move universal time to P1
	IMULI	P1,^D60*^D60*^D24 ; Convert to seconds
	HLRZS	P1		; Compute seconds since midnight
	IDIVI	P1,^D60*^D60	; P1=hours, P2=seconds into hour
	MOVEI	T,2		; Field width
	MOVE	N,P1
	PUSHJ	P,DECZRO	; Print hours as two digits
	SKIPE	P3		; Skip if entry at PRTIM1
	 PUSHJ	P,COLON		; Print a colon
	MOVE	P1,P2		; Get seconds back
	IDIVI	P1,^D60		; P1=minutes, P2=seconds
	MOVEI	T,2		; Field width
	MOVE	N,P1		; Get minutes
	PUSHJ	P,DECZRO	; Print as two digits
	SKIPN	P3		; Skip if entry at PRTIME
	 PJRST	SPC2		; End with 2 spaces if entry at PRTIM1
	PUSHJ	P,COLON		; Print colon
	MOVEI	T,2		; Field width
	MOVE	N,P2		; Get seconds
	PUSHJ	P,DECZRO	; Print as two digits
	PJRST	SPC2		; End with space and return
;HERE TO WRITE TO THE LPT

W.LST:	TXNE	F,F.TTY!F.TTY2	;TTY OUTPUT INSTEAD?
	JRST	W.CMD		;YES. WRITE TTY
	SKIPN	PAGES		;FIRST PAGE??
	 JRST	W.LST0		;YES. DO SPECIAL THINGS
	CAIN	CH,.CHLFD	;THIS A LINE FEED?
	JRST	.+4		;YES.GO FIX LINE COUNT
	CAIE	CH,.CHFFD	;HOW ABOUT A FORM FEED?
	JRST	W.LST2		;NEITHER. JUST GO TYPE IT
	JRST	PHED		;FORM FEED. GO PRINT NEW HEADER
	AOS	CH,LINES	;LINE FEED. INC LINE COUNT
	CAILE	CH,PAGSIZ	;DO A FREE FF YET??
	JRST	PHED		;YES.
	MOVEI	CH,.CHLFD
	PUSHJ	P,W.LST2	;NO. JUST TYPE A LF
	MOVEI	CH,.CHTAB	;AND A TAB
	TXZN	F,F.ERRM	;UNLESS THIS IS AN ERROR MESSAGE
	JRST	W.LST2
	POPJ	P,		;IN WHICH CASE WE IGNORE THE TAB

PHED:	MOVEM	F,PHEDF		;SAVE FLAGS SO CAN TEST F.ERRM LATER
	PUSHJ	P,SAVALL	;SAVE AC'S
	MOVEI	CH,.CHFFD
	PUSHJ	P,W.LST2	;BEGIN WITH A FORM FEED
	SETZM	LINES		;RESET LINE COUNT
	SKIPN	PAGES
	 SETOM	PAGES		;TO STOP INFINITE LOOP AT W.LST+2
	MOVEI	M,IDRIP
	PUSHJ	P,EMSG		;RIPOFF V
	LDB	N,VERPTR
	PUSHJ	P,OCTPRT	;VERSION NUMBER
	PUSHJ	P,LPAR
	HRRZ	N,.JBVER
	PUSHJ	P,OCTPRT	;EDIT NUMBER
	MOVEI	M,[ASCIZ/)  /]
	PUSHJ	P,MSG
	PUSHJ	P,NOW		;PRINT TIME AND DATE
	MOVEI	M,[ASCIZ/   */]
	PUSHJ	P,MSG
	MOVE	M,[POINT 7,CMDBUF]
	MOVEI	P1,MAXCMD
PHED1:	ILDB	CH,M		;GET A CMD STRING CHAR
	JUMPE	CH,PHED2
	SOJLE	P1,PHED3	;TO MANY CHARS, IGNORE REST
	PUSHJ	P,W.LST2	;PRINT IT
	JRST	PHED1		;LOOP FOR ALL CHARS
PHED2:	MOVEI	CH," "
	PUSHJ	P,W.LST2
	SOJG	P1,PHED2
PHED3:	MOVEI	M,[ASCIZ/ Page /]
	PUSHJ	P,MSG
	AOSG	N,PAGES		;NOW GIVE PAGE COUNT
	 AOS	N,PAGES
	PUSHJ	P,DECPRT
	PUSHJ	P,CRLF2
	MOVE	F,PHEDF		;RESTORE ORIGINAL FLAGS
	PJRST	CRLF		;ONE MORE CR BEFORE EXIT (FOR F.ERRM)

U(PHEDF)

W.LST2:	SOSG	WH.LST+2
	OUTPUT	LST,0
	IDPB	CH,WH.LST+1
	POPJ	P,


W.LST0:	PUSH	P,CH		;HERE IF VERY FIRST CHAR OUTPUT
	PUSHJ	P,PHED		;SINCE COMMAND STRING. PRINT HEADER
	POP	P,CH
	CAIE	CH,.CHLFD
	CAIN	CH,.CHFFD
	 POPJ	P,
	PJRST	W.LST2		;AND PRINT FIRST CHAR IF NOT LF OR FF
;	Routine to read a command from the TTY and store it in CMDBUF.
;	Returns CPOPJ always with ASCIZ command in CMDBUF and byte
;	pointer to start of command in CMDB.

GETCMD:	JSP	M,SAVE3		; Get some registers to use
	MOVE	P1,[POINT 7,CMDBUF] ; Get byte pointer to buffer
	MOVEM	P1,CMDB		; Save for calling routine
	MOVEI	P2,MAXCMD	; Max # of chars to input
GTCMD1:	PUSHJ	P,R.CMD		; Read a character
	CAIE	CH,.CHCNZ	; [075] ^Z typed?
	 JRST	GTCMD4		; [075] No.
	CLOSE	CMD,CL.OUT	; [075] Close input side of TTY
	MOVEI	CH,0		; [075] Change character to a null
	PUSH	P,[GTCMD4]	; [075] Push return address from CZEXIT
	PJRST	CZEXIT		; [075] and go simulate a ^C
GTCMD4:				; [075]
 	CAIE	CH,.CHTAB	; Ignore tabs and spaces
	CAIN	CH," "
	 JRST	GTCMD1		; [075]
	CAIL	CH," "		; Line delimeter?
	CAIL	CH,.CHALT
	 JRST	GTCMD3		; Yes, done
GTCMD2:	SOJLE	P2,GTCMD1	; Too many chars, ignore the rest
	IDPB	CH,P1		; Put character into CMDBUF
	JRST	GTCMD1		; and continue scan
GTCMD3:	SETZ	CH,		; Make sure parser finds the end of
	IDPB	CH,P1		;  the string
	IDPB	CH,P1
	POPJ	P,
;GET A CMD STRING CHAR

R.CMD:
	SOSG	RH.CMD+2
	INPUT	CMD,
	ILDB	CH,RH.CMD+1
	JUMPE	CH,R.CMD	;IGNORE NULLS
	CAIE	CH,.CHDEL	;DELETE, AND
	CAIN	CH,.CHCRT	;CARRIAGE RETURN
	JRST	R.CMD
	CAIL	CH,.CHALT	;MAKE ALL ALTIMODES STANDARD
	MOVEI	CH,.CHESC
	CAIL	CH,"A"+40	;AND CONVERT LOWER TO UPPER CASE
	TRZ	CH,40
	POPJ	P,



;HERE TO WRITE A CHARACTER TO THE TELETYPE


W.CMD:
	SOSG	WH.CMD+2
	OUTPUT	CMD,
	IDPB	CH,WH.CMD+1
	CAIG	CH,.CHCRT	;IF CARRIAGE RET OR LINE FEED,
	OUTPUT	CMD,		;FORCE OUTPUT
	POPJ	P,
;TEMPORY STORAGE

PDP:	IOWD	PDLSIZ,PLIST

VERPTR:	POINT 9,.JBVER,11	;POINTER TO MAJOR VERSION IN .JBVER

ONEONE:	1,,1			;A COMMON CONSTANT..
BIGNUM:	EXP -1_<-1>		;THE LARGEST POSITIVE 36 BIT NUMBER.
IDRIP:	ASCIZ/Ripoff V./
HED1:	ASCIZ	/File	Ext  Log block  Access     Creation      Prv  Mode   Words  Blocks  Err    Number
Name          1st RIB    Date     Time    Date       Written Written Alloc  Bits   Ptrs/
BLKMSG:	ASCIZ	/ blocks/
UBLKMG:	ASCIZ	/ total disk space allocated to this user.
/
AVEMSG:	ASCIZ	/	Average file size for /
AVEMS1:	ASCIZ	/ files = /
UBLK1:	ASCIZ	/ blocks
/
UHED:	ASCIZ	/
Unit	Unit ID Log unit in STR
/
SATMSG:	ASCIZ	/
SAT block /
FREMSG:	ASCIZ	/ free blocks left in this SAT block/
TOTMSG:	ASCIZ	/ total disk space remaining.

/
TBLKMG:	ASCIZ	/ total disk space used by all user's files.
/
BATHED:	ASCIZ	/BAT block for unit /
WASMSG:	ASCIZ/
Blocks wasted in totally unwritten yet allocated blocks = /
MSGRIB:	ASCIZ/
Number of blocks used for RIBS = /
NULMSG:	ASCIZ/

Number of null UFDs = /
MISMSG:	ASCIZ	/
Discrepancies in number of free blocks
Computed	SAT blocks	DSKCHR
/
ERRHED:	ASCIZ	/
Number of files with each type of error

Hard	Hard	Soft	Damage	Backup  Crash
write	read	check	assess
/
HISHED:	ASCIZ	!File size and RIB length Histogram

N		Files		Rib ptrs

!
RIBHED:	ASCIZ/

Retrieval pointers:

Pointer		Block in	# of	Unit	Checksum
		unit	STR	blocks

/
DIRPM:	ASCIZ/
File	Ext	 Block in	Unit
Name		unit	STR	 #
/


	XLIST	;LITERALS UNDER XLIST
	LIT
	VAR
	LIST


	SUBTTL	Low segment storage definitions


REPEAT LOGIC,<

;****************** Note *****************

All locations from ZROBEG through ZROEND are zeroed on every major
restart (i.e., all low segment cleared on 'START' or 'RUN' command).

All locations from CMDBEG through ZROEND are zeroed on every
command string (a star typed).
>




U(ZROBEG)	; ********* From here to ZROEND cleared on START
U(MFDPPN)	; Five PPNs from GETTAB
U(SYSPPN)
U(FSFPPN)
U(HELPPN)
U(QUEPPN)
U(CRSPPN)	; Crash PPN [10,1]
VIPS==MFDPPN	; First GETTAB PPN needed

U(WMASK)	; Search mask for /W code
U(WWORD)	; Search word for /W code
U(QUESTR)	; Queing STR
U(STNPRT)	; System standard file protection
U(UFDPRT)	; Standard UFD protection
U(DEVOPR)	; SIXBIT name of OPR TTY
U(%LOCK)	; -1 if job locked in core
U(CPUXX)	; 0=KA,1=KI,2=KL processor type.
U(COREXX)	; Number of words per core unit, ie, 512 or 1024 on KA.
U(STRTAB)	; Ptr to table of structures in system
U(UNIDDB)	; Initial ptr to UDB tables
U(RADIX)	; Current input radix
UU(PLIST,PDLSIZ) ; Pushdown stack.
U(EBUF)		; Pointer to disk read/edit/write buffer
U(ESTR)		; STR above block read in by
U(EBLK)		; Block in STR of above block
U(EWORD)	; Last word diddled in /EC or /ET
U(%FTSFD)	; =-1 if monitor has SFD'S, 0 otherwise
U(LSTDEV)	; Physical name of list device
UU(IOW,2)	; IOWD to BUF kept here
ZERO=IOW+1	; Always will be a zero here

U(CMDBEG)	; ********* From here to ZROEND zeroed every '*'
U(.SVFF)	; For saving .JBFF
U(GOTWRD)	; Non-zero if word specified in /ET or /EC
U(CMDLVL)	; Deepest level of path specified in CMD string
U(CURLVL)	; Current level of SFD nesting
U(PTHFLG)	; Non-zero if path specified in cmd
UU(SFDFLG,SFDLVL+1) ; If SFDFLG(I) is non-zero, a star was
		    ; seen in the command string at level I
UU(MATFLG,SFDLVL+1) ; If MATFLG(I) is non-zero, files in the directory
		    ; at level I may be matched, i.e., the path at
		    ; level I matches the command string and allows
		    ; files to be matched within the directory
UU(TMPPTH,.PTPPN+1+SFDLVL+1)	; Temporary path specs built here
U(USRSTR)	; Structure
U(USRNAM)	; File name
U(USREXT)	; File extension
U(USRPPN)	;  and PPN
UU(USRPTH,.PTPPN+1+SFDLVL+1)	; Path specification
U(USRCFP)	; CFP to file
U(UFDCFP)	; CFP to file's UFD
U(TTYNAM)	; The name typed in by the user
U(TTYEXT)	; The actual chars typed in for ext
U(TTYPPN)
UU(TTYPTH,.PTPPN+1+SFDLVL+1)	; Path specification
U(TTYSTR)
U(TTYTYP)
U(TTYDDB)
U(AUXDEV)	; Scratch output device
U(AUXNAM)	; Scratch file name
U(AUXEXT)	;..
U(AUXPPN)	;..
UU(AUXPTH,.PTPPN+1+SFDLVL+1)	; Path specification
U(AUXCHR)	; DEVCHR on aux channel
U(AUXTRY)	; Amount of buffer space to try for by AUXALC
U(AUXSIZ)	; Size of aux buffers (DEVSIZ UUO)
UU(AUXOB,3)
UU(AUXIB,3)

U(UFILCT)	; User file count
U(UBLKCT)	; User block count

U(UFDCNT)	; Total blocks devoted to UFDs
U(MFDCT)	; Total number of files in MFDPPN
U(NULUFD)	; Total number of null UFDs
U(TOTDSK)	; Total free blocks according to DSKCHR UUO
U(WASTEB)	; Wasted blocks
U(TBLKCT)	; Total # of blocks allocated to users on STR
U(TFILCT)	; Total # of files on STR
UU(FERR,6)	; Counters for hard file errors
UU(HISTO,TOPHIS+2); Histogram counters

UU(HISTOR,TOPHIS+2); Histogram for # of RIB ptrs
U(TOTSAT)	; Total free blocks according to SAT table
U(CTYPE)	; Current controller type
U(CUNIT)	; Current unit in controller
UU(STRUNI,MAXUNI+1) ; Table of unit UDB address in STR
U(SETBLK)	; Used to save block arguments
U(HIGHU)	; Highest unit in STR
U(STRBPU)	; Highest BLKUNI in str

U(TEMP)		; Extremely tempory storage
U(TEMP1)	; IBID
U(TEMP2)	;..
U(TEMP3)	;..
UU(LHEAD,2)	; List headers for /I code


U(STRGRP)	; First location transferred from UNIDDB's at init time
U(STRBSC)	; Blocks/supercluster
U(STRSCU)	; Superclusters/unit
U(STRCNP)	; HOMCNP
U(STRCKP)	; HOMCKP
U(STRCLP)	; HOMCLP
U(STRBPC)	; HOMBPC
U(STRSIZ)	; Total blocks on STR
U(STRHGH)	; Highest logical block on STR +1

U(CLSCNT)	; Cluster count used at NOCHEK+3
U(NUMB)		; Numbers built here in RDNUMR
U(TERMCH)	; Terminating character
U(STRFLG)	; Flag counting passes through NXTSTR
U(PASS)		; Pass counter for /V code
U(TTIME)	; Time for GTDATE routine
U(TDATE)	; Date for GTDATE routine
U(AFTER)	; In /I, only get file after this date
U(BEFORE)	;  and before this one...
U(OTHERK)	; Flag used by dsklst BAT block processor
U(WENABLE)	; Write enables units for BLKWRT for debugging
U(NOIO)		; -1 tells BLKRED/WRT not to do I/O.
U(SAVECH)	; BUFSAV saves AC CH here
U(ERRFL)	; -1 suppresses extended errors in DEVERR.
U(SATFLG)	; At SEARCH, if -1, ignore blocks set in SATs
U(WTFLAG)	; 0=reading,-1=writing at RD/WT-SAT

UU(CMDBUF,<MAXCMD+4>/5) ; ASCII CMD string kept here
U(CMDB)		; Byte pointer to above CMD string
U(PAGES)	; Page count
U(LINES)	; Line count
U(BUFHED)	; Must be BUF-1. Is a word before BUF...
UU(BUF,BLKSIZ)	; Jack-of-all-trades buffer
BUFIOW=BUF-1	; For DDT in IOWDS to BUF..
UU(TIOW,2)	; Tempory IOWD's kept here
U(BARG1)	; Blocksize argument
U(BARG2)	; Blocksize upper limit.
U(BARG3)	; Relative block arg
U(BARGFL)	; Bit 35-n=1 if barg'N is clusters, not blocks
U(DSKPTR)	; Pointer to DSKSAT
U(OURPTR)	; Ptr to OURSAT
U(TRBPTR)	; Ptr to TRBSAT


	DEFINE	UUU(NAME,LEN)
<	NAME==CRBSIZ
	CRBSIZ==LEN+CRBSIZ		>

CRBSIZ==0

BLKFIR==0		; First entry in core block to zero on INBUF
UUU(XIOWD,1)		; IOWD to datbuf
UUU(WDCNT,1)		; Word count of data left in DATBUF
UUU(BLKCNT,1)		; # of blocks left this group
UUU(FILEN,1)		; # of blocks left in file. decremented to find eof
UUU(THISBL,1)		; Block on unit we're reading now
UUU(THISU,1)		; Unit for above block
UUU(DATBUF,BLKSIZ)	; Buffer for data to be transferred to
UUU(DATPTR,1)		; Pointer to above data
BLKEND==DATPTR		; Zero block on INBUF to here only
UUU(SAVRIB,BLKSIZ-RIBENT) ; RIB copyied into here
UUU(FNAME,1)		; File name looked up on channel
UUU(FEXT,1)		; Extension
UUU(RIBLBN,1)		; Logical block in STR of first RIB
UUU(FPATH,.PTPPN+1+SFDLVL+1)	; Path of file looked up on channel
FPPN==FPATH+.PTPPN	; Allow references to the PPN
UUU(FCFP,1)		; CFP of this SFD/UFD
UUU(RIBFLG,1)		; Flag says reading first RIB
UUU(FILSTS,1)		; Copy of RIBSTS word in RIB
UUU(SAVXRA,1)		; Copy of RIBXRA, extended RIB address
UUU(IOSTS,1)		; LH=internal bits, RH=GETSTS word
			; is contained

UU(MFD,CRBSIZ)		; Core block for MFD
UU(UFD,CRBSIZ)		; UFD,
UU(DSK,CRBSIZ)		;  and disk


IFG SFDLVL, <
	DEFINE	X (N), <
UU(SFD'N,CRBSIZ)
	>

	I=1
	REPEAT SFDLVL, <
	X (\I)
	I=I+1
	>
	>


U(ZROEND)	; ******** Last location zeroed ********

;*********** From here on, locations never zeroed..

UU(INTBLK,.ERCCL+1) ; ^C intercept block
U(OURPPN)	; PPN running RIPOFF now.
U(%SUSET)	; -1 if can do SUSET. UUO. 0 if Super USETI/O
U(.JBMAX)	; Cormax minus hiseg (amount of core free to lowseg)
U(ST$OPT)	; Startup option ($OPQUI, $OPLON)
UU(RH.CMD,HEDNUM)	; TTY and LPT buffer headers
UU(WH.CMD,HEDNUM)
UU(WH.LST,HEDNUM)

U(LOWSIZ)		; Highest loc in low segment

RIPEND:	Z		; Th..th..th..that's all folks

IFN PURESW,< RELOC 0	; Must have all UU(DATA) begin in low seg
	BLOCK	LOWSIZ-140	; Give it all room..
>
	END	RIPOFF