Google
 

Trailing-Edge - PDP-10 Archives - BB-F493Z-DD_1986 - 10,7/credir.mac
There are 4 other files named credir.mac in the archive. Click here to see a list.
	TITLE	CREDIR -- ROUTINE TO CREATE A DIRECTORY  %3A(110)
	SUBTTL	P.F.CONKLIN			5-SEP-85



CRRWHO==0		;DEC DEVELOPMENT
CRRVER==3		;MAJOR VERSION
CRRMIN==1		;MINOR VERSION
CRREDT==110		;EDIT NUMBER


;+
;.AUTOPARAGRAPH;.FLAG INDEX;.FLAG CAPITAL;.LOWER CASE
;.TITLE ^PROGRAM ^LOGIC ^MANUAL FOR ^^CREDIR\\
;.SKIP 5;.CENTER;^^CREDIR\\
;.SKIP 1;.CENTER;^PROGRAM ^LOGIC ^MANUAL
;.SKIP 1;.CENTER;^VERSION 1
;.SKIP 5;^^



;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973,1974,1984,1986.
;ALL RIGHTS RESERVED.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
;.SKIP 5;.CENTER;ABSTRACT\\
;.SKIP 1

;<CREDIR IS A PROGRAM WHICH CAN BE USED TO CREATE ANY DIRECTORY
;UNDER <TOPS-10.  ^IT CAN GENERATE EITHER A <UFD (IF THE USER
;HAS FULL-FILE ACCESS PRIVILEGE), OR AN <SFD. 
;-
;&.CH GENERAL INFORMATION

	SEARCH	MACTEN,UUOSYM,SCNMAC	;SET FOR UNIVERSALS
	.REQUEST	REL:SCAN,REL:HELPER,REL:WILD
	SALL		;CLEAN ASSEMBLY LISTINGS

	TWOSEG

	LOC	137
	VRSN.	CRR
	RELOC	400000

COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1973,1986. ALL RIGHTS RESERVED.
\;END COPYRIGHT MACRO



;+
;.HL1 DEFAULTS
;-

ND LN.PDL,200	;PUSH DOWN LIST LENGTH
	SUBTTL	REVISION HISTORY

;ORIGINAL PROGRAM CREATED 18-NOV-73 AS EDIT 33

;34	ADD SFD CREATION AND PROTECTION SWITCH
;35	ADD STRUCTURE SEARCHING
;36	CREATE INTERMEDIATE DIRECTORIES IF NEEDED
;37	SUPPORT OPTION FILE
;40	SUPPORT /MESSAGE
;41	ADD DIALOG MODE
;42	CONVERT TO USE .QSCAN
;43	ACCEPT ERSATZ DEVICES WHICH FORCE DIRECTORY
;44	USE SCAN'S ERROR PRINTER
;45	OUTPUT TO DIRECTORIES WHEN CREATED
;46	USETO 2 TO DIRECTORIES WHEN CREATED
;47	GET SYS: PROTECTION FROM DISK
;50	FIX UFD CREATION IF SFD SPECIFIED
;%1(50) JUNE 74

;101	DATE-75 FIX
;102	(10-14,113) SET .RBSPL AND ADD /NAME:
;103	(10-13,898) BETTER MESSAGE IS CREATE UFD AND NOT [1,2]
;104	ADD /ALLOCATE: TO CREATE DIRECTORIES WHICH WILL CONTAIN A LARGE NUMBER OF FILES
;105	SEARCH MACTEN, UUOSYM, AND SCNMAC AND REQUEST SCAN, HELPER, WILD
;%3(105) NOVEMBER 82

;106	(10-35032) IF /ALLOCATE: NOT SPECIFIED, DON'T USE CL.DLL WHEN
;	CLOSING DIRECTORY.  PREVENTS ALLOCATING UNIGRP BLOCKS TO DIR.
;107	(10-35248) SWITCH NAME DEFINITION OF /ALLOCATE CONTAINS ONLY
;	FIVE CHARACTERS.  PREVENTS SAYING "/ALLOCATE:".  CHANGE IT
;	TO HAVE THE FULL SWITCH NAME IN THE DEFINITION.  ALSO USE THE
;	VRSN. MACRO TO DEFINE CREDIR'S VERSION NUMBER.
;110	Do Copyrights./Leo
;
	SUBTTL	DEFINITIONS

;AC'S

T1=1	;TEMP
T2=2
T3=3
T4=4
P1=5	;PRESERVED
P2=6
P3=7
P4=10

P=17	;STACK

;MACRO'S

	DEFINE	ERR$(COD,MESS),<
	JSP	T1,ERROR
	''COD'',,[ASCIZ \MESS\]
>

;CHANNEL'S

UFD==1		;FOR UFD
	SUBTTL	INITIALIZATION

;+
;.AUTOPARAGRAPH;.FLAGS
;.CH COMMAND SCANNING
;
;^FIRST SAVE A 0 OR 1 TO REMEMBER WHETHER WE WERE CALLED
;AT THE NORMAL OR <CCL STARTING ADDRESS RESPECTIVELY.
;^THEN CLEAR ^I/^O AND GENERALLY RESET THE SYSTEM.  ^ALSO
;SAVE AWAY THE ORIGINAL VALUES OF OUR CORE USAGE FOR
;SUBSEQUENT RESETING. ^FINALLY, CLEAR OUT ALL IMPURE STORAGE,
;SPECIFICALLY, THE ACCUMULATORS AND LOW SEGMENT.
;^THEN INITIALIZE THE PUSH-DOWN STACK.
;-

CREDIR:	TDZA	T1,T1		;NOT CCL START
	MOVEI	T1,1		;CCL START
	MOVEM	T1,OFFSET	;STORE IT

	RESET			;RESET ANY EXTERNAL I/O
	HRRZ	T1,.JBREL	;GET FIRST-TIME CORE SIZE
	HRL	T1,.JBFF	;GET FIRST-TIME FREE CORE
	MOVEM	T1,ORGFF	;SAVE

	STORE	17,0,16,0	;CLEAR AC'S
	STORE	17,ZCOR,EZCOR,0	;CLEAR IMPURE STORAGE
	MOVE	P,[IOWD LN.PDL,PDLST]  ;ESTABLISH PUSH-DOWN LIST

	MOVX	T1,%LDFFA	;GET FULL FILE ACCESS PPN	[103]
	GETTAB	T1,		; FROM MONITOR			[103]
	  MOVE	T1,[1,,2]	;(LEV C?)			[103]
	MOVEM	T1,FFAPPN	;STORE FOR LATER		[103]

;+
;^NEXT GO INITIALIZE THE COMMAND SCANNER.  ^IN
;PARTICULAR, LOOK FOR A COMMAND ON THE SAME LINE OR A <CCL
;FILE FULL OF COMMANDS.
;-

	MOVE	T1,[ 2,,[IOWD  1,['CREDIR']
			OFFSET,,'CRR']]
	PUSHJ	P,.ISCAN##	;INITIALIZE COMMAND SCANNER

	MOVSI	T1,'SYS'	;SEE IF PHYSICAL-ONLY
	DEVCHR	T1,UU.PHY	; CALLI'S ARE IMPLEMENTED
	TRNN	T1,-1		; ..
	SETOM	PHYPOS		;NO--FLAG NOT POSSIBLE
	SUBTTL	MAIN LOOP

;+
;.PAGE;.SUBTITLE ^MAIN ^LOOP
;.CENTER;^MAIN ^LOOP
;
;^EACH PASS, WHETHER SUCCESSFUL OR NOT, ALWAYS
;ENDS BY RETURNING TO THE LABEL <MAINLP.  ^THIS CAUSES THE
;PROGRAM TO START OVER AGAIN.  ^IT CAN BE EXITED BY THE
;USER BY EITHER A _^^C OR A _^^Z.  ^IF THE PROGRAM HAD BEEN
;INVOKED BY  A COMMAND OR <CCL CALL, THEN <SCAN WILL
;SIMULATE THE _^^Z WHEN APPROPRIATE TO EXIT.
;-

MAINLP:	PUSHJ	P,.RUNCM##	;HANDLE /RUN IF SET
	MOVE	T1,ORGFF	;GET ORIGINAL CORE USAGE
	HLRZM	T1,.JBFF	;RESTORE .JBFF
	TLZ	T1,-1		;CLEAR TO ORIGINAL .JBREL
	CAME	T1,.JBREL	;UNLESS OK,
	CORE	T1,		; RESTORE THAT
	  JFCL			;(IGNORE ERROR)
	STORE	T1,ZLCOR,EZCOR,0  ;CLEAR LOW CORE
	SETOM	QTAIN		;DEFAULT QUOTA IN
	SETOM	QTAOUT		;DEFAULT QUOTA OUT
	SETOM	SPLNAM		;DEFAULT NAME			[102]
	SETOM	DALLOC		;DEFAULT ALLOCATION

	MOVE	T1,[ 4,,[IOWD SWTL,SWTN
			 SWTD,,SWTM
			 0,,SWTP
			 -1	]]
	PUSHJ	P,.PSCAN##	;INVOKE P-MODE SCANNER
	  OUTSTR [ASCIZ \Create directory: \]

;+
;^NOW SEE IF USER TYPED AN END OF FILE.
;^IF SO, FIRST SEE IF INDIRECT FILE.  ^THEN SEE IF STILL
;AT EOF; THIS COULD HAPPEN IF INVOKED FROM RUN COMMAND
;ON THE SAME LINE.
;-

	CAMG	P4,[.CHEOF]	;SEE IF EOF
	JRST	[PUSHJ P,.ALDON##  ;YES--HANDLE NORMAL CASES
		 CAMG  P4,[.CHEOF] ;THEN CHECK AGAIN
		 PUSHJ P,.MNRET##  ;YES--RETURN TO MONITOR
		 JRST  MAINLP]	;THEN START OVER AGAIN
;+
;^HAVING INITIALIZED THE COMMAND SCAN FOR THIS LINE,
;NOW GET A FILE SPECIFICATION, WHICH MUST INCLUDE
;THE STRUCTURE AND DIRECTORY AND EXCLUDE THE FILE NAME AND
;EXTENSION.
;-

	PUSHJ	P,.FILIN##	;GET FILE SPEC
	JUMPN	T1,GETOPT	;JUMP IF SOMETHING INPUT

;+
;^HERE IF NOTHING TYPED BEFORE THE SEPARATOR.  ^THE ONLY
;LEGAL CASES ARE /<RUN AND INDIRECT.
;-

	CAIN	P4,"@"		;SEE IF INDIRECT
	PUSHJ	P,.GTIND##	;YES--SETUP INDIRECT
	JUMPLE	P4,MAINLP	;IF END OF LINE, GO DO MORE
	PJRST	E.ILSC##	;OTHERWISE, GIVE ERROR

;+
;^NOW CHECK OPTION FILE TO SEE IF ANY DEFAULT SWITCHES.
;-

GETOPT:	JUMPG	P4,E.INCL##	;ERROR IF MORE ON LINE
	MOVEI	T1,SPEC		;POINT TO SPEC AREA
	MOVEI	T2,.FXLEN	; ..
	PUSHJ	P,.GTSPC##	;COPY TO US

	MOVE	T1,[ 4,,[IOWD SWTL,SWTN
			 SWTD,,SWTM
			 0,,SWTP
			 -1	]]
	PUSHJ	P,.OSCAN##	;HANDLE OPTION FILE
	JRST	GOTSOM		;THEN PROCEED
;DEFINE SWITCH TABLE

DEFINE	SWTCHS,<
SP IN,QTAIN,.SWDEC##,QTA,FS.LRG
SP NAME,SPLNAM,SIXQWW,NUL,
SP OUT,QTAOUT,.SWDEC##,QTA,FS.LRG
SP ALLOCATE,DALLOC,.SWDEC##,ALC,FS.LRG	;[107]
>

DM NUL,1,0,0
DM QTA,.INFIN,.INFIN,.INFIN
DM ALC,.INFIN,.INFIN,.INFIN

	DOSCAN	(SWT)

;+
;^ROUTINE TO INPUT ONE WORD IN SIXBIT POSSIBLY QUOTED
;-

SIXQWW:	PUSHJ	P,.SIXQW##	;GET STRING			[102]
	MOVE	P3,.NMUL##	;GET FIRST WORD			[102]
	POPJ	P,		;RETURN RESULT			[102]
;+
;^JUMP TO LOCATION <GOTSOM WHEN SOMETHING WAS
;TYPED BY THE USER.  ^FIRST CHECK THAT THE USER
;GAVE NOTHING EXTRA.  ^THEN
;CHECK THAT HE GAVE WHAT WAS NEEDED.
;^IF THE DEVICE WAS NOT SPECIFIED AND WE WERE IN DIALOGUE
;MODE LAST TIME, REMEMBER THE PREVIOUS DEVICE.
;-

GOTSOM:	SKIPE	T1,FLDIAL	;SEE IF DIALOG
	SKIPL	SPEC+.FXMOD	;SEE IF DEVICE THIS TIME
	SKIPA			;OK--DO NOTHING
	MOVEM	T1,SPEC+.FXDEV	;LAZY--DEFAULT HIS DEVICE

;+
;^IF NO DIRECTORY TYPED, THEN USER WANTS DIALOGUE MODE,
;SO SAVE HIS DEVICE FOR SUBSEQUENT INPUTS AND TRY AGAIN TO
;GET THE DIRECTORY. ^LATER ON, FLDIAL WILL BE USED TO SEE IF
;PROTECTION AND QUOTAS SHOULD BE DIALOGUED FOR.
;-

	MOVX	T1,FX.DIR	;GET DIRECTORY BIT
	TDNE	T1,SPEC+.FXMOM	;SEE IF USER SPECIFIED
	SKIPE	FLDIAL		;OR PREVIOUSLY WAS DIALOG
	SKIPA			;NO--DIALOG
	JRST	GOTDIR		;YES--JUST CONTINUE
	MOVE	T1,[3,,T2]	;SET FOR PATH UUO
	MOVE	T2,SPEC+.FXDEV	; TO SEE IF IT'S ERSATZ
	SETZB	T3,T4		; ..
	PATH.	T1,		;ASK THE MONITOR
	  JRST	SETDIA		;NO--SET DIALOG MODE
	TXNE	T2+.PTSWT,PT.IPP  ;SEE IF IGNORE USER PPN
	JRST	[MOVEM T2+.PTPPN,ERSATZ  ;YES--INDICATE ERSATZ
		 SKIPN SPLNAM	;SEE IF /NAME SET		[102]
		 MOVEM T2,SPLNAM ; NO--SET ERSATZ NAME		[102]
		 JRST  GOTDIR]	; ASSUME WE GOT IT

SETDIA:	MOVE	T1,SPEC+.FXDEV	;DIALOG--GET DEVICE
	SKIPGE	SPEC+.FXMOD	;UNLESS DEFAULT TYPEIN
	SKIPN	FLDIAL		; AND ALREADY SET
	MOVEM	T1,FLDIAL	;SAVE FOR LATER
;+
;^IF NO DIRECTORY SPECIFIED, THEN LOOP BACK TO GET THE DIRECTORY.
;-

	MOVX	T1,FX.DIR	;GET DIRECTORY BIT
	TDNN	T1,SPEC+.FXMOM	;SEE IF SET
	JRST	MAINLP		;NO--TRY AGAIN

;H+
;^ARRIVE AT <GOTDIR WHEN WE HAVE A DIRECTORY.  ^IF DIALOGUE
;MODE, THEN SEE IF NEED TO DIALOG FOR PROTECTION.
;-

GOTDIR:	MOVX	T1,FX.PRO	;GET PROTECTION MASK
	TDNN	T1,SPEC+.FXMOM	;SEE IF USER SET IT
	SKIPN	FLDIAL		;OR NOT IN DIALOG
	JRST	GOTDR1		;ALL OK--PROCEED

	MOVE	T1,[ 4,,[0
			 0
			 0
			 -1	]]
	PUSHJ	P,.QSCAN##	;INVOKE P-MODE SCANNER
	  OUTSTR [ASCIZ \Protection: \]
	PUSHJ	P,.OCTNW##	;GET OCTAL VALUE
	DPB	P3,[POINTR (SPEC+.FXMOD,FX.PRO)]
	JUMPG	P4,E.INCL##	;ERROR IF MORE ON LINE

GOTDR1:	SKIPGE	SPLNAM		;SEE IF /NAME			[102]
	SKIPN	FLDIAL		;NO--SEE IF DIALOGUE		[102]
	JRST	GOTDR2		;YES--PROCEED			[102]
	MOVE	T1,[ 4,,[0
			 0
			 0
			 -1	]]
	PUSHJ	P,.QSCAN##	;INVOKE P-MODE SCANNER		[102]
	  OUTSTR [ASCIZ \Name: \]
	PUSHJ	P,SIXQWW	;GET SIXBIT NAME		[102]
	JUMPG	P4,E.INCL##	;ERROR IF THAT'S NOT ALL	[102]
	MOVEM	P3,SPLNAM	;SET NAME
GOTDR2:	SKIPGE	DALLOC		;SEE IF /ALLOCA
	SKIPN	FLDIAL		;NO--SEE IF DIALOGUE
	JRST	GOTDR3		;YES--PROCEED
	MOVE	T1,[ 4,,[0
			 0
			 0
			 -1	]]
	PUSHJ	P,.QSCAN##	;INVOKE P-MODE SCANNER
	  OUTSTR [ASCIZ \Allocation: \]
	PUSHJ	P,.DECNW##	;GET DECIMAL VALUE
	JUMPG	P4,E.INCL##	;ERROR IF THAT'S NOT ALL
	SKIPLE	P3		;SEE IF REASONABLE
	MOVEM	P3,DALLOC	;SET ALLOCATION
GOTDR3:	MOVS	T2,SPEC+.FXEXT	;GET EXTENSION
	TLC	T1,-1		;MASK SHOULD BE -1
	CAIE	T1,'UFD'	;SEE IF UFD
	CAIN	T1,'SFD'	; OR SFD
	SETZB	T1,SPEC+.FXEXT	;YES--CLEAR OUT
	SKIPN	SPEC+.FXNAM	;SEE IF FILE NAME
	SKIPE	SPEC+.FXEXT	; OR EXTENSION
	JRST	E$$FNI		;YES--FILE NAME ILLEGAL

	MOVEI	T1,SPEC		;POINT TO SCANNED SPEC
	MOVEI	T2,OPNBLK	;POINT TO AN OPEN BLOCK
	MOVEI	T3,ENTBLK	;POINT TO AN ENTER BLOCK
	PUSHJ	P,.STOPN##	;CONVERT SCAN'S SPEC
	  JRST	E$$WCI		;WILD CARDS ARE ILLEGAL
	JRST	DEVOK		;PROCEED

E$$DND:	ERR$	DND,<Device not a disk>
E$$FNI:	ERR$	FNI,<File name illegal>
E$$WCI:	ERR$	WCI,<Wild-card illegal>
E$$DOF:	ERR$	DOF,<Device OPEN failure>
;+
;^HERE WHEN WE HAVE VERIFIED THAT THE DEVICE IS LEGITIMATE
;AND IT IS TIME TO CHECK THE DIRECTORY.
;-

DEVOK:	MOVX	T1,FX.DIR	;GET DIRECTORY BIT
	TDNN	T1,SPEC+.FXMOM	;SEE IF SET
	SKIPE	ERSATZ		; OR ERSATZ DEVICE
	JRST	DIROK		;YES--DIRECTORY OK
E$$DMS:	ERR$	DMS,<Directory must be specified>

;+
;^WHEN THE SCAN HAS BEEN VALIDATED, ARRIVE AT
;LOCATION <DIROK TO ACTUALLY DO THE WORK.
;-

DIROK:	MOVX	T1,.IODMP	;SET TO
	IORM	T1,OPNBLK+.OPMOD	; DUMP MODE
	MOVE	T1,OPNBLK+.OPDEV ;GET DEVICE NAME
	MOVE	T2,OPNBLK+.OPMOD ;GET /PHYSICAL
	PUSHJ	P,.INSTR##	;INITIALIZE STR SEARCHER
	  JRST	E$$DND		;ERROR IF NOT A DISK
	IORM	T1,OPNBLK	;SET /PHYSICAL IF NEEDED
	SETOM	DVLPFL		;SET FLAG IN DEVICE LOOP
	JUMPGE	T1,DODEV	;IF NOT MULTI-STRS, JUMP AHEAD
DEVLP:	PUSHJ	P,.NXSTR##	;GET NEXT STRUCTURE
	JUMPE	T1,MAINLP	;EXIT WHEN DONE
	MOVEM	T1,OPNBLK+.OPDEV ;STORE AS DEVICE
DODEV:	OPEN	UFD,OPNBLK	;OPEN THIS STRUCTURE
	  JRST	E$$DOF		;ERROR IF CAN'T
	STORE	T1,UFDENT,UFDENT+UFDENL,0 ;CLEAR DIRECTORY	[101]
	MOVEI	T1,UFDENL	;SET LENGTH OF UFD ENTER
	MOVEM	T1,UFDENT+.RBCNT  ; FOR UUO
	MOVE	T1,ENTBLK+.RBPRV  ;GET /PROTECTION
	TXNN	T1,RB.PRV	;SEE IF PROTECTION SET
	SKIPN	ERSATZ		;NO--SEE IF ERSATZ
	SKIPA			;LEAVE ALONE
	PUSHJ	P,GTSYSP	;IF NOT SET AND ERSATZ, GET SYS: PROTECTION
	MOVEM	T1,UFDENT+.RBPRV  ; FOR UUO
	MOVEI	T1,RP.DIR	;SET TO
	MOVEM	T1,UFDENT+.RBSTS  ; DIRECTORY STATUS
	SKIPE	T1,ERSATZ	;GET FORCED ERSATZ DIRECTORY
	JRST	GOTDD		;YES--GO FORCE IT
	SKIPE	T1,ENTBLK+.RBPPN  ;GET DIRECTORY
	JRST	NOTDD		;PROCEED UNLESS DEFAULT DIRECTORY
	MOVX	T1,.PTFRD	;READ DEFAULT
	MOVEM	T1,DPTBLK+.PTFCN  ;  PATH
	MOVE	T1,[3+.FXLND,,DPTBLK]  ;POINT TO BLOCK
	PATH.	T1,		;ASK MONITOR
	  JRST	[GETPPN  T1,	;NO PATH, GET LOGGED IN
		   JFCL		;  NUMBER (IGNORING JACCT)
		 JRST    GOTDD]	;AND CONTINUE
	MOVEI	T1,DPTBLK	;DEFAULT TO CURRENT DIR.
	SKIPN	DPTBLK+.PTPPN+1	;SEE IF ANY SFD
	MOVE	T1,DPTBLK+.PTPPN  ;NO--DEFAULT TO UFD
GOTDD:	MOVEM	T1,ENTBLK+.RBPPN  ;STORE DEFAULT AS IF TYPED
NOTDD:	MOVEI	P4,0		;PRESET TO UFD ONLY
	TLNE	T1,-1		;SEE IF SFD
	JRST	NOTDDS		;NO--NO SCAN NEEDED
	MOVEI	P4,5		;FIND LAST SFD
	SOS	T1		;BACK UP DIRECTORY POINTER
	SKIPN	.PTPPN+6(T1)	; DIRECTORY
	SOJG	P4,.-2		; IN LIST
NOTDDS:	MOVE	P3,P4		;MAKE A COPY
;LOOP UP SFD'S FINDING ONE TO CREATE

XFDLP:	MOVX	T1,RB.PRV	;MASK FOR PROTECTION		[101]
	ANDM	T1,UFDENT+.RBPRV ;CLEAR REST OF DATES		[101]
	MOVE	T1,SPLNAM	;GET /NAME			[102]
	CAMN	P3,P4		;IF AT BOTTOM LEVEL		[102]
	CAMN	T1,[-1]		; OR NOT SET			[102]
	MOVEI	T1,0		; CLEAR				[102]
	MOVEM	T1,UFDENT+.RBSPL ;SET AS SPOOL NAME		[102]
	MOVE	T1,ENTBLK+.RBPPN  ;GET DIRECTORY
	TLNN	T1,-1		;SEE IF UFD
	CAIG	P3,0		;NO--SEE IF NO SFD'S
	JRST	DOUFD		;YES--GO HANDLE THAT
	HRLZS	T1		;COPY FROM CURRENT
	HRRI	T1,PTHBLK	; TO OUR BLOCK
	BLT	T1,PTHBLK+.FXLND+2  ; ALL THE WAY
	MOVE	T1,PTHBLK+.PTPPN(P3) ;GET LAST DIRECTORY
	MOVEM	T1,UFDENT+.RBNAM  ;SAVE AS NAME
	SETZM	PTHBLK+.PTPPN(P3)  ;CLEAR IT OUT
	MOVSI	T1,'SFD'	;SET SFD
	MOVEM	T1,UFDENT+.RBEXT  ;AS EXTENSION
	MOVEI	T1,PTHBLK	;POINT TO SFD LIST
	SKIPN	PTHBLK+.PTPPN+1  ;SEE IF SFD'S ALREADY
	MOVE	T1,PTHBLK+.PTPPN  ;NO--GET DIRECTORY
	MOVEM	T1,UFDENT+.RBPPN  ;SET AS DIRECTORY
	SKIPGE	T1,DALLOC	;ALLOCATION SPECIFIED?
	SETZ	T1,		;NO
	MOVEM	T1,UFDENT+.RBEST  ;SET AS ALLOCATION
	JRST	TRYIT		;DONE UFD SETUP--GO TRY IT
;HERE IF UFD BEING CREATED

DOUFD:	TLNN	T1,-1		;SEE IF PATH POINTER
	MOVE	T1,.PTPPN(T1)	;YES--GET UFD
	MOVEM	T1,UFDENT+.RBNAM ;STORE UFD AS NAME
	MOVSI	T2,'UFD'	;GET EXTENSION
	MOVEM	T2,UFDENT+.RBEXT  ;STORE

	SKIPGE	QTAIN		;SEE IF OMITTED QUOTA
	SKIPN	FLDIAL		;  AND IF DIALOG
	JRST	DOUFD1		;NO--JUST PROCEED

	MOVE	T1,[ 4,,[0
			 0
			 0
			 -1	]]
	PUSHJ	P,.QSCAN##	;INVOKE P-MODE SCANNER
	  OUTSTR [ASCIZ \Quota in: \]
	PUSHJ	P,.DECNW##	;GET DECIMAL VALUE
	JUMPG	P4,E.INCL##	;ERROR IF MORE ON LINE
	SKIPLE	P3		;SEE IF REASONABLE
	MOVEM	P3,QTAIN	;YES--STORE

DOUFD1:	SKIPGE	T3,QTAIN	;GET FCFS QUOTA
	HRLOI	T3,377777	;NOT SPECIFIED, SET TO INFINITY
	MOVEM	T3,UFDENT+.RBQTF  ; QUOTAS

	SKIPGE	QTAOUT		;SEE IF OMITTED QUOTA
	SKIPN	FLDIAL		;  AND IF DIALOG
	JRST	DOUFD2		;NO--JUST PROCEED

	MOVE	T1,[ 4,,[0
			 0
			 0
			 -1	]]
	PUSHJ	P,.QSCAN##	;INVOKE P-MODE SCANNER
	  OUTSTR [ASCIZ \Quota out: \]
	PUSHJ	P,.DECNW##	;GET DECIMAL VALUE
	JUMPG	P4,E.INCL##	;ERROR IF MORE ON LINE
	SKIPLE	P3		;SEE IF REASONABLE
	MOVEM	P3,QTAOUT	;YES--STORE

DOUFD2:	SKIPGE	T3,QTAOUT	;GET LOGGED OUT QUOTA
	HRLOI	T3,377777	;NOT SPECIFIED, SET TO INFINITE
	MOVEM	T3,UFDENT+.RBQTO  ;  ..
	SKIPGE	T3,DALLOC	;GET ALLOCATION
	SETZ	T3,		;NONE SPECIFIED, LET MONITOR DECIDE
	MOVEM	T3,UFDENT+.RBEST  ;SET FOR ENTER
	MOVX	T4,%LDMFD	;IDENTIFY MFD
	GETTAB	T4,		; FROM MONITOR
	  MOVE	T1,[1,,1]
	MOVEM	T4,UFDENT+.RBPPN  ;SET FOR ENTER
TRYIT:	SETZM	UFDENT+.RBDEV	;CLEAR UNIT NAME
	ENTER	UFD,UFDENT	;DO THE ENTER
	  JRST	UFDERR		;GO ANALYZE THE ERROR
	USETO	UFD,2		;POINT BEYOND FIRST BLOCK FOR FILSER
				; (NEEDED FOR PRE 5.07 MONITORS)
	MOVE	T1,[IOWD 1,ZERO] ;SET TO
	MOVEI	T2,0		; OUTPUT ONE
	OUTPUT	UFD,T1		; WORD ON ZEROES
	SKIPG	DALLOC		;[106] USER SPECIFY /ALLOCATE:?
	TDZA	T1,T1		;[106] NO, DEALLOCATE UNUSED BLOCKS
	MOVX	T1,CL.DLL	;[106] YES, DON'T DEALLOCATE
	CLOSE	UFD,(T1)	;[106] COMPLETE IT

;+
;^HERE WHEN WE SUCCEEDED, TELL THE USER SO HE IS HAPPY.
;-

	MOVEI	T1,[ASCIZ /  Created /]
	PUSHJ	P,.TSTRG##
	PUSHJ	P,TYPFIL	;TYPE CURRENT DIRECTORY
	LDB	P1,[POINTR (UFDENT+.RBPRV,RB.PRV)]
	JUMPE	P1,TYPEOL	;IF PROTECTION UNKNOWN, SKIP
	MOVEI	T1,[ASCIZ \/PROTECTION:\]
	PUSHJ	P,.TSTRG##	;TYPE SWITCH
	MOVEI	T4,0		;CLEAR ACCUMULATOR
	LSH	P1,ALIGN.(RB.PRV) ;POSITION PROT
	LSHC	T4,3		;EXPAND PROTECTION
	LSH	T4,3
	LSHC	T4,3
	LSH	T4,3
	LSHC	T4,3
	ADDI	T4,'000'	;CONVERT TO SIXBIT
	HRLZ	T1,T4		;POSITION
	PUSHJ	P,.TSIXN##	;TYPE IT
TYPEOL:	PUSHJ	P,.TCRLF##	;AND END LINE
	CAMGE	P3,P4		;SEE IF AT END
	AOJA	P3,XFDLP	;NO--TRY NEXT DOWN
	RELEAS	UFD,		;YES--FREE CHANNEL
	JRST	DEVLP		;ALL DONE WITH THIS STRUCTURE
;+
;^HERE IF COULD NOT ENTER THE DIRECTORY.
;^IDENTIFY THE REASON AND THEN GIVE UP.
;-

UFDERR:	HRRZ	T1,UFDENT+.RBEXT  ;GET ERROR CODE
	CAIE	T1,ERIPP%	;SEE IF UFD MISSING
	CAIN	T1,ERSNF%	; OR IF SFD MISSING
	SOJGE	P3,XFDLP	;YES--GO UP AND TRY AGAIN
	CAIN	T1,ERPRT%	;IF PROTECTION FAILURE,		[103]
	JRST	UFDPRT		; HANDLE SPECIAL		[103]
	CAIE	T1,ERCSD%	;SEE IF ALREADY THERE
	JRST	E$$DEE		;NO--DIRECTORY ENTER ERROR
E$$DAE:	MOVE	T1,['DAE',,[ASCIZ /Directory /]]
	PUSHJ	P,ERRORW	;ISSUE PREFIX
	  JRST	ERRORX		;GIVE UP IF THAT'S ALL
	PUSHJ	P,TYPFIL	;TYPE CURRENT DIRECTORY
	MOVEI	T1,[ASCIZ / already exists/]
	PUSHJ	P,.TSTRG##
	RELEAS	UFD,		;FREE UP CHANNEL
	JRST	ERRORX		;AND DO NEXT ONE
UFDPRT:	JUMPN	P3,E$$DEE	;IF NOT UFD, USE REGULAR MESSAGE [103]
	MOVE	T1,.MYPPN##	;GET THIS USER			[103]
	CAMN	T1,FFAPPN	;SEE IF NOT [1,2]		[103]
	JRST	E$$DEE		;NO--[1,2] GETS REGULAR MESSAGE	[103]
	SETZM	DVLPFL		;CLEAR DEVICE LOOP		[103]
	ERR$	(MBC,<Must be [1,2] to create a UFD>)
E$$DEE:	MOVE	T1,['DEE',,[ASCIZ /ENTER /]]
	PUSHJ	P,ERRORQ	;ISSUE IT
	  JRST	ERRORX		;FINISH IF NO MORE MESSAGE NEEDED
	HRRZ	T1,UFDENT+.RBEXT  ;GET ERROR
	MOVEI	T3,0		;CLEAR PROTECTION
	PUSHJ	P,.LKERR##	;ISSUE DESCRIPTION
	MOVEI	T1,[ASCIZ \ on \]
	PUSHJ	P,.TSTRG##	;ISSUE TEXT
	PUSHJ	P,TYPFIL	;ISSUE CURRENT DIRECTORY
	JRST	ERRORX		;AND FINISH ERROR HANDLER
	SUBTTL	SUBROUTINES

;+
;.PAGE;.SUBTITLE ^SUBROUTINES
;.CENTER;^SUBROUTINES

;<ERROR HANDLES ERROR MESSAGES WHICH ARE FATAL.
;-

ERROR:	HRRZI	T3,1(T1)	;GET ERROR LOCATION
	MOVE	T1,(T1)		;GET ARGUMENTS
	PUSHJ	P,ERRORR	;ISSUE ERROR
	  JFCL
ERRORX:	PUSHJ	P,.TCRLF##	;ISSUE END OF LINE
	RELEAS	UFD,		;RELEASE CHANNEL
	SKIPE	DVLPFL		;SEE IF IN DEVICE LOOP
	JRST	DEVLP		;YES--TRY NEXT DEVICE
	JRST	MAINLP		;GO START OVER

ERRORW:	HRRZ	T3,(P)		;GET ERROR LOCATION
	MOVSI	T2,"%"		;INDICATE WARNING
	JRST	ERRORP		;ISSUE PREFIX
ERRORQ:	HRRZ	T3,(P)		;GET ERROR LOCATION
ERRORR:	MOVSI	T2,"?"		;INDICATE
ERRORP:	SUBI	T3,2		;BACK ADDRESS TO ERROR LOCATION
	HRR	T2,T1		;GET TEXT
	HLRZS	T1		;POSITION ERROR INDICATOR
	HRLI	T1,'CRR'	;ADD OUR PREFIX
	PUSHJ	P,.ERMSA##	;ISSUE ERROR MESSAGE HEADING
	TXNE	T1,JWW.FL	;SEE IF /MESSAGE:FIRST
	AOS	(P)		;YES--ADVANCE RETURN
	POPJ	P,		;RETURN
;+
;<TYPFIL TYPES THE FILE SPECIFICATION OF THE CURRENT DIRECTORY.
;THIS IS USED FOR BOTH REPORTS AND ERROR MESSAGES.
;-

TYPFIL:	SKIPN	T1,UFDENT+.RBDEV ;GET UNIT
	MOVE	T1,OPNBLK+.OPDEV ;USE DEVICE IF UNKNOWN
	PUSHJ	P,.TSIXN##	;TYPE IT
	PUSHJ	P,.TCOLN##	;TYPE SEPARATOR
	MOVE	P1,ENTBLK+.RBPPN ;GET ADDRESS
	ADDI	P1,.PTPPN+1(P3)	;GET LOC OF WORD BEYOND THIS LEVEL
	TLNE	P1,-1		;SEE IF SFD
	MOVEI	P1,T1		;NO--MAKE INNOCUOUS
	PUSH	P,(P1)		;SAVE IT	
	SETZM	(P1)		;CLEAR IT TO STOP PRINTER
	MOVEI	T1,ENTBLK+.RBPPN ;GET DIRECTORY
	PUSHJ	P,.TDIRB##	;TYPE THAT
	POP	P,(P1)		;RESTORE IT
	MOVEI	T1,"."		;GET A PERIOD
	PUSHJ	P,.TCHAR##	;TYPE IT
	HLLZ	T1,UFDENT+.RBEXT  ;GET EXTENSION
	PJRST	.TSIXN##	;TYPE THAT AND RETURN


;+
;<GTSYSP IS CALLED TO FIND THE PROTECTION OF THE
;<SYS: <UFD SO THAT ALL ERSATZ DEVICES GET THE
;SAME PROTECTION.  ^IT IS CALLED WITH THE STRUCTURE
;<OPEN ON CHANNEL <UFD AND RETURNS THE PROTECTION
;LEFT ADJUSTED IN <T1 WITH THE REST OF T1 ZERO.
;-

GTSYSP:	MOVX	T1,%LDSYS	;POINT TO SYS PPN
	GETTAB	T1,		; ACCORDING TO THE MONITOR
	  MOVE	T1,[1,,1]	;(MUST BE LEVEL C!)
	MOVSI	T2,'UFD'	;INDICATE UFD
	MOVEI	T3,0		;CLEAR JUNK
	MOVX	T4,%LDMFD	;POINT TO MFD
	GETTAB	T4		; ACCORDING TO THE MONITOR
	  MOVE	T4,[1,,1]
	LOOKUP	UFD,T1		;LOOK AT SYS UFD
	  MOVSI	T3,775000	;IF CAN'T, USE STANDARD VALUE
	CLOSE	UFD,		;FREE CHANNEL
	MOVE	T1,T3		;MOVE TO CORRECT AC
	ANDX	T1,RB.PRV	;CLEAN OUT JUNK
	POPJ	P,		;RETURN
	SUBTTL	STORAGE

	XLIST	;LITERALS
	LIT
	LIST

;+
;.PAGE;.SUBTITLE ^IMPURE ^STORAGE
;.CENTER;^IMPURE ^STORAGE
;
;^FIRST, THE LOCATIONS SETUP BEFORE THE INITIAL CLEARING
;OF STORAGE, <OFFSET CONTAINS THE START OFFSET FOR THE
;COMMAND SCANNER AND <ORGFF CONTAINS THE INITIAL SETTINGS
;OF .<JBFF AND .<JBREL.
;-

	RELOC

OFFSET:	BLOCK	1		;STARTING OFFSET
ORGFF:	BLOCK	1		;ORIGINAL .JBFF,,.JBREL

;+
;^THE REMAINDER OF LOW STORAGE IS CLEARED ON INITIAL
;STARTUP.
;-

ZCOR:!			;START OF AREA TO ZERO ON INITIAL LOAD
ZERO:	BLOCK	1		;ALWAYS ZERO
PDLST:	BLOCK	LN.PDL+1	;PUSH DOWN LIST
PHYPOS:	BLOCK	1		;-1 IF /PHYS NOT POSSIBLE
FFAPPN:	BLOCK	1		;PPN WITH FULL FILE ACCESS
FLDIAL:	BLOCK	1		;DIALOG FLAG--HOLDS LAST DEVICE

ZLCOR:!			;START OF AREA TO ZERO ON EACH PASS
ERSATZ:	BLOCK	1		;FLAG ERSATZ DEVICE
DVLPFL:	BLOCK	1		;FLAG IN DEVICE LOOP
QTAIN:	BLOCK	1		;FCFS QUOTA
QTAOUT:	BLOCK	1		;LOGGED OUT QUOTA
SPLNAM:	BLOCK	1		;NAME
DALLOC:	BLOCK	1		;DIRECTORY ALLOCATION
SPEC:	BLOCK	.FXLEN		;INPUT SPECIFICATION
OPNBLK:	BLOCK	3		;OPEN BLOCK
ENTBLK:	BLOCK	6		;ENTER BLOCK
UFDENT:	BLOCK	40		;DIRECTORY ENTER BLOCK
UFDENL==.-UFDENT-1
PTHBLK:	BLOCK	3+.FXLND	;FOR PATH UUO
DPTBLK:	BLOCK	3+.FXLND	;FOR DEFAULT PATH UUO
EZCOR==.-1		;END OF AREA TO ZERO ON INITIAL LOAD

	END	CREDIR