Google
 

Trailing-Edge - PDP-10 Archives - BB-Y393T-SM - monitor-sources/lognam.mac
There are 52 other files named lognam.mac in the archive. Click here to see a list.
; *** Edit 7418 to LOGNAM.MAC by RASPUZZI on 24-Feb-87, for SPR #21535
; Make sure that RELATR attempts to release free space properly by only using
; the right half of LNATR(T1) and not the fullword
; UPD ID= 179, FARK:<4-1-WORKING-SOURCES.MONITOR>LOGNAM.MAC.2,  28-Sep-82 15:42:10 by MOSER
;EDIT 2821 - PREVENT HUNG JOBS/SYSTEM UNLOCK AFTER FAILING ASGJFR
;<4-1-FIELD-IMAGE.MONITOR>LOGNAM.MAC.2, 25-Feb-82 20:29:04, EDIT BY DONAHUE
;UPDATE COPYRIGHT DATE
; UPD ID= 113, FARK:<4-WORKING-SOURCES.MONITOR>LOGNAM.MAC.5,   2-Jul-80 14:41:51 by SCHMITT
;Edit 1755 - Remove edit 1718 because 1754 makes it redundant
; UPD ID= 110, FARK:<4-WORKING-SOURCES.MONITOR>LOGNAM.MAC.4,   2-Jul-80 14:27:32 by SANICHARA
;EDIT 1754 - Do range checking for dispatch into CCTAB i.e Valid Char
;<4-WORKING-SOURCES.MONITOR>LOGNAM.MAC.4,  5-Jun-80 06:27:36, Edit by SCHMITT
; CAIGLE from previous edit to CAILE
; UPD ID= 10, FARK:<4-WORKING-SOURCES.MONITOR>LOGNAM.MAC.2,  29-May-80 13:20:03 by SCHMITT
; TCO 5.1051 - Cure ILMREF when AC3 for CRLNM JSYS contains invalid Byte Size
;<4.MONITOR>LOGNAM.MAC.4,  3-Jan-80 08:09:26, EDIT BY R.ACE
;UPDATE COPYRIGHT DATE
;<OSMAN.MON>LOGNAM.MAC.1, 10-Sep-79 15:41:06, EDIT BY OSMAN
;TCO 4.2412 - Move definition of BUGHLTs, BUGCHKs, and BUGINFs to BUGS.MAC
;<4.MONITOR>LOGNAM.MAC.2,  4-Mar-79 18:13:45, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4


;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976,1977,1978,1979,1980,1981,1982 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

	SEARCH PROLOG
	TTITLE LOGNAM
	SWAPCD

;SPECIAL AC DEFINITIONS

DEFAC (JFN,P2)
DEFAC (F1,P5)



;STORAGE REQUIREMENTS

NR(SYLNTB,1)			;POINTER TO SYSTEM LOGICAL NAME TABLE
NR(SYLNLK,1)			;SYSTEM LOGICAL NAME TABLE LOCK


;ROUTINE TO INITIALIZE THE SYSTEM LOGICAL NAME TABLE AT START UP TIME

	EXTN <SYNMTB,SYNMCT>

;	CALL SLNINI		;MUST BE IN CONTEXT OF A JOB
;RETURNS +1:	ALWAYS

SLNINI::SETZM SYLNTB		;INITIALIZE POINTER TO NAME TABLE
	SETOM SYLNLK		;AND SYSTEM LOGICAL NAME LOCK
	MOVNI T4,SYNMCT		;SET UP AOBJN COUNTER
	HRLZS T4		;THE HARD WAY
	JUMPGE T4,R		;IF NO NAMES TO DO, EXIT
	PUSH P,CAPENB		;SAVE CAPABILITIES
	MOVEI T1,SC%WHL		;MAKE THIS FORK A WHEEL
	IORM T1,CAPENB
SLNLOP:	MOVEI T1,.CLNSY		;FUNCTION CODE TO CREATE SYSTEM LN
	HLRO T2,SYNMTB(T4)	;GET POINTER TO LOGICAL NAME STRING
	HRRO T3,SYNMTB(T4)	;GET POINTER TO DEFINITION STRING
	CRLNM			;CREATE THIS SYSTEM LN
	 BUG(NOSLNM)
	AOBJN T4,SLNLOP		;LOOP BACK FOR ALL ENTRIES IN TABLE
	POP P,CAPENB		;RESTORE CAPABILITIES
	RET			;AND EXIT
; CRLNM - CREATE A LOGICAL NAME
;
;	THIS JSYS IS USED TO ADD NEW LOGICAL NAMES TO THE LIST OF
;	EXISTING LOGICAL NAMES, TO CHANGE THE DEFINITION OF AN EXISTING
;	LOGICAL NAME, TO DELETE A LOGICAL NAME FORM THE LIST OF LOGICAL
;	NAMES, OR TO DELETE THE ENTIRE LIST OF LOGICAL NAMES.
;
;CALLING SEQUENCE:
;	MOVE 1,FUNCTION CODE
;	MOVE 2,STRING POINTER TO LOGICAL NAME
;	MOVE 3,STRING POINTER TO DEFINITION STRING (OPTIONAL)
;	CRLNM
;	 UNSUCCESSFUL RETURN, ERROR CODE IN 1
;	SUCCESSFUL RETURN


.CRLNM::MCENT			;ENTER SLOW JSYS
	XCTU [HRRZ P1,1]	;GET THE USER'S FIRST ARG
	CAILE P1,.CLNSY		;LEGAL FUNCTION CODE?
	RETERR (CRLNX3)		;NO, ILLEGAL FUNCTION CODE
	MOVEI P4,0		;P4 = 0 MEANS JSB
	TRNE P1,1		;EVEN FUNCTION CODES MEAN JSB
	MOVEI P4,1		;P4 = 1 MEANS SYSTEM LOGICAL NAMES
	MOVE T1,CAPENB		;GET PRIVILEGES
	TRNN T1,SC%WHL!SC%OPR	;IS USER PRIVILEGED?
	JUMPN P4,[RETERR (CRLNX2)] ;NO, ERROR IF SYSTEM LN FUNCTION
	NOINT			;DISABLE INTERRUPTS
	CAIE P1,.CLNJA		;DELETE ALL LOGICAL NAMES?
	CAIN P1,.CLNSA		;...
	JRST CRLNMA		;YES, GO DELETE THEM
	JUMPE P4,[UMOVE T1,2	;IF JOB WIDE LN, USE CPYFU0
		CALL CPYFU0	;THIS TRIMS THE BLOCK AFTER COPYING
		 RETERR (GJFX22) ;NO ROOM IN JSB
		JRST CRLNM2]	;CONTINUE ON
	MOVEI T1,MAXLW+1	;GET A STRING FOR THE LOGICAL NAME
	CALL GTEMP		;FROM THE APPROPRIATE FREE POOL
	 RETERR			;NONE LEFT
	MOVE T1,T2		;GET ADDRESS OF BLOCK
	UMOVE T2,2		;GET POINTER TO LOGICAL NAME
	CALL CPYFU1		;COPY THE STRING INTO BLOCK
	 JFCL			;NEVER COMES HERE
	IBP T2			;STEP OVER NULL AT END OF STRING
	PUSH P,T1		;SAVE ADDRESS OF STRING
	CALL TRMSWP		;TRIM THE BLOCK
	POP P,T1		;GET BACK THE POINTER TO THE STRING
CRLNM2:	HRLI T1,(<POINT 7,0,35>);TURN THIS INTO A BYTE POINTER
	CAIE P1,.CLNJ1		;USER WANT TO DELETE THIS NAME?
	CAIN P1,.CLNS1		;...
	JRST CRLNMD		;YES, GO DELETE IT
	UMOVE T2,3		;GET STRING POINTER FROM AC 3
	JUMPGE T2,CRLNM0	;IS THIS ALREADY A BYTE POINTER?
	CAML T2,[777777000000]	;HOW ABOUT -1,,ADR?
	 HRLI T2,(<POINT 7,0>)	;MAKE IT A STANDARD BYTE POINTER
	;..
	;..
CRLNM0:	PUSH P,T1		;SAVE THE JSB COPY OF THE LOGICAL NAME
;**;[1755] Remove edit 1718	RAS	2-JUL-80
;**;[1718] Add Following Four Lines at CRLNM0+1  RAS  29-MAY-80
;	LDB T3,[POINT 6,T2,11]	; [1718] GET BYTE SIZE
;	CAILE T3,7		; IS IT LESS THAN 7 BITS?
;	JRST [	MOVEI T1,ARGX09	; NO, GIVE INVALID BYTE SIZE
;		JRST CRLNE2]	; ERROR
	CALL LNPARS		;GO PARSE THE NAME AND CREATE AN E-BLOCK
	 JRST [UMOVEM T2,3	;THERE WAS A PROBLEM, GO CLEAN UP
		JRST CRLNE2]	;AFTER STORING UPDATED STRING POINTER
	UMOVEM T2,3		;STORE UPDATED STRING POINTER FOR USER
	PUSH P,T1		;SAVE THE E-BLOCK ADDRESS
	MOVE T2,-1(P)		;STACK NOW HAS LOGICAL NAME AND E-BLOCK
	LOCK @LOKTAB(P4)	;INTERLOCK THE LOGICAL NAME TABLE
	SKIPN T1,@LNTAB(P4)	;IS THERE A TABLE FOR LOGICAL NAMES YET?
	 JRST [MOVEI T1,TABINC	;NO, GO CREATE ONE
		CALL GTEMP	;GET A BLOCK FROM THE JSB FREE POOL
		 JRST CRLNE3	;NO ROOM
		MOVE T1,T2	;GET ADR OF BLOCK INTO T1
		HRRZM T1,@LNTAB(P4);SAVE LOCATION OF LOGICAL NAME TABLE
		HRRZS 0(T1)	;CLEAN OUT LH OF TABLE
		MOVE T2,-1(P)	;RESTORE LOGICAL NAME POINTER
		JRST .+1]	;OK, WE NOW HAVE A TABLE; CONTINUE ON
	CALL TABLK		;SEE IF THE LOGICAL NAME IS THERE ALREADY
	 JRST CRLNM1		;NO MATCH
	PUSH P,T1		;SAVE ENTRY INTO TABLE
	CALL ENTDEL		;GO RELEASE AL SPACE HELD BY THIS ENTRY
	POP P,T1		;RESTORE INDEX INTO TABLE
CRLNM1:	MOVE T2,T1		;GET LOCATION FOR THIS NEW ENTRY
	MOVE T1,@LNTAB(P4)	;GET TABLE ADDRESS
	CALL TABADD		;MAKE ROOM IN THE TABLE FOR THIS NEW ENTRY
	 JRST CRLNE3		;SOMETHING WENT WRONG, GO CLEAN UP
	HRRZM T1,@LNTAB(P4)	;STORE NEW TABLE ADDRESS
	HRLZ T1,-1(P)		;GET LOGICAL NAME STRING POINTER
	HRR T1,0(P)		;AND POINTER TO THE E-BLOCK
	MOVEM T1,0(T2)		;STORE THE NEW LOGICAL NAME ENTRY
	POP P,T1		;CLEAR THE STACK OUT
	POP P,T2		;...
	UNLOCK @LOKTAB(P4)	;FREE UP LOGICAL NAME INTERLOCK
	OKINT			;FINISHED CHANGING THE LOGICAL NAME TABLE
	SMRETN			;GIVE SKIP RETURN TO USER
; ROUTINE TO DELETE ALL ENTRIES FROM THE LOGICAL NAME TABLE

CRLNMA:	LOCK @LOKTAB(P4)	;INTERLOCK THE LOGICAL NAME TABLE
CRLNA0:	MOVE P3,@LNTAB(P4)	;GET ADDRESS OF TABLE
	JUMPE P3,CRLNA2		;NOTHING TO BE DONE
	HLRZ P6,0(P3)		;GET # OF ENTRIES USED
	JUMPE P6,CRLNA1		;NO ENTRIES, JUST RELEASE TABLE
	MOVEI T1,1(P3)		;GET ENTRY TO BE DELETED
	CALL ENTDEL		;GO GIVE BACK ALL JSB SPACE USED
	JRST CRLNA0		;LOOP BACK FOR ALL ENTRIES

CRLNA1:	MOVE T1,@LNTAB(P4)	;GET TABLE ADDRESS
	SETZM @LNTAB(P4)	;ZERO TABLE POINTER
	CALL RELTMP		;...
CRLNA2:	UNLOCK @LOKTAB(P4)	;RELEASE LOGICAL NAME LOCK
	OKINT
	SMRETN			;SKIP RETURN TO USER
;ROUTINE TO DELETE A SINGLE ENTRY FROM THE LOGICAL NAME TABLE

CRLNMD:	LOCK @LOKTAB(P4)	;INTERLOCK THE LOGICAL NAME TABLE
	MOVE T2,T1		;GET POINTER TO LN STRING IN JSB
	PUSH P,T2		;SAVE LN POINTER
	SKIPE T1,@LNTAB(P4)	;GET ADR OF TABLE
	CALL TABLK		;LOOKUP THIS LOGICAL NAME
	 JRST CRLNE1		;NO MATCH
	EXCH T1,0(P)		;GET LN POINTER AND SAVE INDEX
	CALL RELTMP		;GIVE UP LN POINTER STRING
	POP P,T1		;GET TABLE ENTRY INDEX TO BE DELETED
	CALL ENTDEL		;GO GIVE BACK ALL SPACE OWNED BY THIS ENTRY
	UNLOCK @LOKTAB(P4)	;UNLOCK INTERLOCK ON LOGICAL NAME TABLE
	OKINT
	SMRETN			;EXIT SUCCESSFULLY

CRLNE3:	POP P,T1		;GET E-BLOCK ADR
	CALL RELLN		;GO RELEASE IT
	SKIPA T1,[GJFX22]	;NO ROOM IN JSB
CRLNE1:	MOVEI T1,CRLNX1		;NO SUCH LOGICAL NAME
CRLNE2:	EXCH T1,0(P)		;GET LN POINTER AND SAVE ERROR CODE
	CALL RELTMP		;RETURN IT TO FREE POOL
	POP P,T1		;RESTORE ERROR CODE
UNLKER:	UNLOCK @LOKTAB(P4)	;FREE UP LOGICAL NAME TABLE
	OKINT
	JRST MRETNE		;UNSUCCESSFUL RETURN WITH ERROR CODE IN 1


; ROUTINE TO DELETE AN ENTRY FROM THE LOGICAL NAME TABLE
;
;CALLING SEQUENCE:
;	MOVE T1,INDEX OF ENTRY TO BE DELETED
;	CALL ENTDEL
;	RETURN HERE ALWAYS

ENTDEL:	PUSH P,T1		;SAVE INDEX
	HRRZ T3,0(P)		;GET INDEX
	HLRZ T1,0(T3)		;GET POINTER TO LN STRING
	CALL RELTMP		;RELEASE IT
	HRRZ T3,0(P)		;GET INDEX AGAIN
	HRRZ T1,0(T3)		;GET E-BLOCK ADR
	CALL RELLN		;GO RELEASE THAT ALSO
	POP P,T2		;GET INDEX FOR FINAL TIME
	MOVE T1,@LNTAB(P4)	;GET TABLE ADR
	CALLRET TABDEL		;GO SHRINK DOWN THE TABLE
;INLNM - JSYS TO RETURN A LOGICAL NAME GIVEN AN INDEX VALUE
;
;CALLING SEQUENCE:
;	MOVE 1,[FUNCTION CODE ,, INDEX VALUE]
;	MOVE 2,POINTER TO STRING FOR RETURNED LOGICAL NAME
;	INLNM
;	 UNSUCCESSFUL, ERROR CODE IN 1
;	SUCCESSFUL, UPDATED STRING POINTER IN 2

.INLNM::MCENT			;ENTER SLOW JSYS CODE
	XCTU [HRRZ T2,1]	;GET INDEX VALUE
	XCTU [HLRZ P4,1]	;GET FUNCTION CODE
	CAILE P4,.INLSY		;LEGAL FUNCTION?
	RETERR (INLNX2)		;YES, GIVE ERROR RETURN
	HRLI P4,400000
	NOINT
	LOCK @LOKTAB(P4)	;INTERLOCK THE LOGICAL NAME TABLE
	SKIPN T1,@LNTAB(P4)	;GET ADR OF LN TABLE
	 JRST [MOVEI T1,INLNX1	;NO ENTRIES AT ALL
		JRST UNLKER]	;GO CLEAN UP
	HLRZ T3,0(T1)		;GET # OF ENTRIES IN TABLE
	SKIPE T3		;ANY ENTRIES?
	CAILE T2,-1(T3)		;YES, IS INDEX VALUE OK?
	 JRST [MOVEI T1,INLNX1	;NO, GIVE ERROR RETURN
		JRST UNLKER]	;GO UNLOCK INTERLOCKS
	ADDI T2,1(T1)		;GET ADR OF FIRST ENTRY
	HLRZ T2,0(T2)		;GET POINTER TO LOGICAL NAME STRING
	UMOVE T1,2		;GET POINTER TO USER'S STRING
	CALL CPYTUS		;COPY THE NAME TO THE USER'S STRING
	UNLOCK @LOKTAB(P4)	;RELEASE LOGICAL NAME TABLE
	OKINT
	SMRETN			;EXIT SUCCESSFULLY
;LNMST - LOGICAL NAME TO STRING JSYS
;
;	THIS JSYS RETURNS THE DEFINITION OF A LOGICAL NAME TO THE USER
;
;CALLING SEQUENCE:
;	MOVE 1,FUNCTION CODE
;	MOVE 2,POINTER TO LOGICAL NAME STRING TO BE LOOKED UP
;	MOVE 3,POINTER TO STRING FOR RETURNED DEFINITION
;	LNMST
;	 UNSUCCESSFUL, ERROR CODE IN 1
;	SUCCESSFUL, UPDATED STRING POINTER IN 3

.LNMST::MCENT			;ENTER SLOW JSYS
	XCTU [HRRZ P1,1]	;GET FUNCTION CODE
	MOVE P4,P1		;SET UP INDEX REG
	CAILE P4,.LNSSY		;IS THIS A LEGAL FUNCTION?
	RETERR (LNSTX2)		;YES, GIVE ERROR RETURN
	HRLI P4,400000
	UMOVE T1,2		;GET POINTER TO LN
	CALL CPYFU0		;MAKE A COPY OF THE LN IN THE JSB
	 RETERR GJFX22		;NO ROOM IN JSB
	HRLI T1,(POINT 7,0,35)	;SET UP BYTE POINTER TO TEMP STRING
	NOINT
	LOCK @LOKTAB(P4)	;INTERLOCK THE LOGICAL NAME TABLE
	PUSH P,T1		;SAVE LN POINTER
	CALL LNMLK1		;GO LOOKUP THIS LOGICAL NAME
	 JRST LNMSTE		;NO MATCH
	HRRZ P3,0(T1)		;GET E-BLOCK POINTER FOR THIS LN
	POP P,T1		;RELEASE THIS STRING
	HRRZS T1
	HRRZ T2,0(T1)		;GET SIZE OF BLOCK
	CALL RELJSB		;THIS BLOCK CAME FROM JSB
	UMOVE T2,3		;GET POINTER OUT OF AC 3
	JUMPGE T2,.+3		;IS IT ALREADY SET UP?
	CAML T2,[777777000000]	;NO, IS THIS A DEFAULT STRING POINTER
	 HRLI T2,(<POINT 7,0>)	;YES, SET UP A GOOD BYTE POINTER VALUE
LNMST1:	SKIPN T1,LNDEV(P3)	;IS THERE A DEVICE FIELD SPECIFIED?
	 JRST LNMST2		;NO, DONT GIVE ANYTHING TO USER
	CALL STTU1		;STORE DEVICE IN USER STRING
	MOVEI T1,":"		;END IT WITH A COLON
	XCTBU [IDPB T1,T2]	;...
	;..			;FALL THROUGH TO LNMST2
	;..
LNMST2:	SKIPN T1,LNDIR(P3)	;WAS THERE A DIR SPECIFIED?
	 JRST LNMST3		;NO
	MOVEI T3,"<"		;PUT AN OPEN ANGLE BRACKET ON FIRST
	CALL STTU31		;THEN THE DIR
	MOVEI T1,">"		;FINISH WITH A CLOSE BRACKET
	XCTBU [IDPB T1,T2]	;...
LNMST3:	SKIPE T1,LNNAM(P3)	;WAS A NAME FIELD SPECIFIED?
	 CALL STTU1		;YES, GIVE IT TO USER
	SKIPN T1,LNEXT(P3)	;WAS THERE AN EXT?
	 JRST LNMST4		;NO
	MOVEI T3,"."		;PREFIX IT WITH A DOT
	CALL STTU31		;FOLLOWED BY THE EXT
LNMST4:	SKIPN T1,LNVER(P3)	;NOW CHECK VERSION
	 JRST LNMST5		;NONE THERE
	MOVEI T3,PNCVER		;PREFIX WITH PROPER PUNCTUATION
	CALL STTU31		;FOLLOWED BY THE NUMBER
LNMST5:	SKIPN T1,LNACT(P3)	;AN ACCOUNT?
	 JRST LNMST6		;NO
	MOVEI T3,PNCATT		;ADD A SEMI
	XCTBU [IDPB T3,T2]	;...
	MOVEI T3,"A"		;AND AN "A"
	CALL STTU31		;FOLLOWED BY THE ACCOUNT NUMBER
LNMST6:	SKIPN T1,LNPRT(P3)	;ANY PROTECTION?
	 JRST LNMST7		;NO
	MOVEI T3,PNCATT		;START WITH A SEMI
	XCTBU [IDPB T3,T2]	;...
	MOVEI T3,"P"		;THEN A "P"
	CALL STU31O		;FOLLOWED BY THE PROTECTION
LNMST7:	SKIPN LNATR(P3)		;ANY ATTRIBUTES?
	JRST LNMS7E		;NO
	HRRZ P1,LNATR(P3)	;YES, GET THE POINTER TO THE FIRST
LNMS7A:	LOAD T1,PRFXV,(P1)	;GET THE PREFIX VALUE
	HLRZ Q1,PRFXTB		;NOW SEARCH THE PREFIX TABLE THIS VALUE
	MOVNS Q1		;GET THE NUMBER OF ENTRIES IN TABLE
	HRLZS Q1		;SET UP AN AOBJN POINTER
	HRRI Q1,PRFXTB+1	;PRETIX TABLE IS IN TBLUK FORMAT
LNMS7B:	HRRZ T3,0(Q1)		;GET THE PREFIX VALUE
	ANDI T3,PFXMSK		;GET JUST THE PREFIX VALUE
	CAMN T1,T3		;FOUND A MATCH YET?
	JRST LNMS7C		;YES, GO GIVE IT TO USER
	AOBJN Q1,LNMS7B		;LOOP BACK TIL PREFIX VALUE IS FOUND
	JRST LNMS7D		;NOT FOUND, SKIP IT

LNMS7C:	MOVEI T1,PNCATT		;START WITH A SEMI-COLON
	XCTBU [IDPB T1,T2]	;STORE THE CHARACTER IN THE USER'S STRING
	HLRZ T1,0(Q1)		;GET THE PREFIX STRING
	HRLI T1,(POINT 7,0)	;SET UP A STRING POINTER
	CALL ST2U		;GIVE THIS STRING TO THE USER
	MOVEI T1,NOATRF		;NOW SEE IF THIS HAS AN ATTRIBUTE VALUE
	TDNE T1,0(Q1)		;CHECK THE NOATRF FLAG
	JRST LNMS7D		;THERE IS NO VALUE, SO DO NOT TYPE COLON
	MOVEI T1,PNCPFX		;GET THE PUNCTUATION AFTER THE PREFIX
	XCTBU [IDPB T1,T2]	;PUT THE CHARACTER INTO THE USER STRING
	MOVEI T1,0(P1)		;NOW ADD ON THE VALUE STRING
	HRLI T1,(POINT 7,0,35)
	CALL ST2U		;COPY THE STRING TO THE USER STRING
LNMS7D:	HLRZ P1,0(P1)		;STEP TO THE NEXT ATTRIBUTE
	JUMPN P1,LNMS7A		;LOOP BACK FOR REST OF THE ATTRIBUTES
LNMS7E:	SKIPN LNTMP(P3)		;TEMPORARY FILE?
	 JRST LNMST8		;NO
	MOVEI T1,PNCATT		;YES, GIVE USER A SEMI
	XCTBU [IDPB T1,T2]	;...
	MOVEI T1,"T"		;THEN A "T"
	XCTBU [IDPB T1,T2]	;...
LNMST8:	HLRZ P3,LNBLK(P3)	;GET POINTER TO NEXT LN BLOCK
	JUMPE P3,LNMST9		;NO MORE DEFINITION BLOCKS
	MOVEI T1,","		;SEPARATE WITH A COMMA
	XCTBU [IDPB T1,T2]	;IN USERS STRING
	JRST LNMST1		;LOOP BACK FOR THIS DEFINITION
LNMST9:	UNLOCK @LOKTAB(P4)	;ALLOW ACCESS TO LOGICAL NAME TABLE AGAIN
	OKINT
	UMOVEM T2,3		;STORE UPDATED STRING POINTER
	SETZ T1,		;AND TERMINATE THE STRING WITH A NULL
	XCTBU [IDPB T1,T2]	;...
	SMRETN			;EXIT SUCCESSFULLY
LNMSTE:	POP P,T1		;GET BACK POINTER TO STRING IN JSB
	HRRZS T1
	HRRZ T2,0(T1)		;GET LENGTH OF STRING
	CALL RELJSB		;GIVE BACK THE STORAGE
	MOVEI T1,LNSTX1		;NO SUCH LOGICAL NAME
	JRST UNLKER		;AND GIVE ERROR RETURN TO USER


; ROUTINE TO DECODE AN E-BLOCK ENTRY AND PASS THE VALUE TO USER
;
;CALLING STRING:
;	MOVE T1,E-BLOCK ENTRY
;	MOVE T2,POINTER TO USER STRING
;	CALL STTU1
;	RETURN HERE ALWAYS

STU31O:	TQOA <OCTF>		;PRINT THIS NUMBER IN OCTAL
STTU31:	TQZ <OCTF>		;PRINT ANY NUMBER IN DECIMAL
	XCTBU [IDPB T3,T2]	;STORE PRECEEDING CHARACTER IN USER STRING
STTU1:	CAMN T1,[-2]		;IS THIS A NULL STRING ENTRY?
	 RET			;YES, THEN WE ARE THROUGH
	CAMN T1,[-3]		;IS THIS A STAR FIELD
	 JRST [MOVEI T1,"*"	;YES, ADD IN A STAR
		XCTBU [IDPB T1,T2]
		RET]		;AND RETURN
	HLRZ T3,T1		;SEE IF THIS IS A STRING
	CAIE T3,(<POINT 7,0,35>);...
	 JRST STTNUM		;NO, IT MUST BE A NUMBER
	CALLRET ST2U		;COPY STRING TO USER SPACE

ST2U:	ILDB T3,T1		;GET A CHARACTER FROM JSB
	JUMPE T3,R		;THROUGH?
	XCTBU [IDPB T3,T2]	;STORE IN USER AREA
	JRST ST2U		;LOOP BACK

STTNUM:	MOVE T3,T1		;GET NUMBER TO BE DECODED
	TLZ T3,500000		;CLEAR NUMBER CODE
	MOVEI T1,10		;PREPARE FOR OCTAL DECODING
	TQNN <OCTF>		;WANT OCTAL NUMBER?
	 MOVEI T1,12		;NO, THEN GET DECIMAL
STNUM1:	IDIV T3,T1		;GET NEXT DIGIT
	PUSH P,T4		;STORE DIGIT
	SKIPE T3		;THROUGH YET?
	CALL STNUM1		;NO, RECURSE BACK FOR REST OF DIGITS
	POP P,T1		;GET BACK HIGH ORDER DIGIT
	ADDI T1,60		;MAKE IT AN ASCII NUMBER
	XCTBU [IDPB T1,T2]	;STORE DIGIT IN USER STRING
	RET			;AND GO BACK FOR OTHER DIGITS
;PARSING SUBROUTINES FOR LOGICAL NAME
;
;THE FOLLOWING IS THE AC USAGE THROUGHOUT THESE ROUTINES
;
;	P3 - ADDRESS OF START OF E-BLOCK BEING BUILT
;	P4 - 0 MEANS JOB WIDE LN,  1 MEANS SYSTEM WIDE LN
;	P6 - INPUT STRING POINTER (STRING IS IN USERS ADDRESS SPACE)
;	F - STATUS FLAGS AS DEFINED FOR GTJFN
;	F1 - MORE STATUS FLAGS AS DEFINED FOR GTJFN
;	T1 - CONTAINS CURRENT CHARACTER
;	T2 - CONTAINS INDEX INTO E-BLOCK FOR INDIVIDUAL FIELDS
;	T4 - NUMBER COLLECTOR DURING PARSE
;	Q1 - STARTING OUTPUT POINTER
;	Q2 - OUTPUT STRING POINTER (STRING IS IN JSB)
;	Q3 - COUNT OF CHARACTERS LEFT IN OUTPUT STRING


;FORMAT OF THE E-BLOCK:

	LNBLK==0		;XWD LINK TO NEXT E-BLOCK, LENGTH OF E-BLOCK
	LNDEV==1		;POINTER TO DEVICE STRING
				;0 MEANS NO DEFAULT WAS SPECIFIED
	LNDIR==2		;0 OR POINTER TO DIRECTORY STRING
				;-3 MEANS STAR WAS TYPED
	LNNAM==3		;0 OR -3 OR POINTER TO NAME DEFAULT
	LNEXT==4		;0 OR -3 OR POINTER TO EXTENSION STRING
				;-2 MEANS A NULL FIELD WAS SPECIFIED
	LNVER==5		;0 OR -3 OR POINTER TO VERSION DEFAULT
	LNACT==6		;0 OR POINTER TO ACCOUNT DEFAULT OR NUMBER
				;NUMBER IS OF FORM: 5XXXXX,,XXXXXX
	LNPRT==7		;0 OR A NUMBER
	LNTMP==10		;0 IF NOT TEMPORARY
				;-1 IF TEMPORARY
	LNATR==11		;ATTRIBUTE CHAIN
				;LH = PREFIX VALUE OF CURRENT PREFIX
				;RH = POINTER TO ATTRIBUTE CHAIN
	LNLEN==12		;LENGTH OF E-BLOCK
; LNPARS - ROUTINE TO PARSE THE USER'S STRING AND SET UP AN E-BLOCK
;
;CALLING SEQUENCE:
;	MOVE T2,BYTE POINTER TO USER'S STRING
;	CALL LNPARS
;	 UNSUCCESSFUL RETURN, ERROR CODE IN T1 AND UPDATED STRING POINTER IN T2
;	RETURN HERE WITH E-BLOCK BUILT AND ADDRESS OF E-BLOCK IN T1
;		UPDATED STRING POINTER IN T2

LNPARS:	STKVAR <LNPRV1,LNPRV2,LNPRV3,LNPRV4>
	SETZM LNPRV1		;POINTER TO LAST E-BLOCK BUILT
	SETZM LNPRV3		;POINTER TO FIRST LN-BLOCK
LNPAR0:	CALL LNPRS		;GO PARSE THE FIRST E-BLOCK
	 JRST LNPAR3		;ERROR DURING PARSE
	SKIPN LNPRV1		;IS THIS THE FIRST E-BLOCK BUILT
	MOVEM T1,LNPRV3		;YES, SAVE POINTER TO FIRST ONE
	SKIPE T3,LNPRV1		;GET POINTER TO LAST BLOCK
	HRLM T1,LNBLK(T3)	;PUT IN FORWARD POINTER TO NEXT BLOCK
	MOVEM T1,LNPRV1		;SAVE THE POINTER TO THIS BLOCK
	XCTBU [LDB T3,T2]	;GET TERMINATOR CHARACTER
	MOVEM T2,LNPRV2		;SAVE T2
	SKIPA			;PROCEED
LNPAR1:	XCTBU [ILDB T3,T2]	;GET NEXT CHARACTER FROM USER
	JUMPE T3,LNPAR2		;IF END OF STRING, GO RETURN
	MOVEM T2,LNPRV2		;SAVE NEW STRING POINTER
	MOVE T2,T3		;GET CHARACTER IN T2
	CALL GTCODE		;GET CHARACTER CLASS CODE
	 JRST [	MOVE T2,LNPRV2	;ERROR
		JRST LNPAR3]	;RETURN TO CALLER
	CAIN T2,SPACHR		;A SPACE?
	JRST [	MOVE T2,LNPRV2	;YES. GET BACK STRING POINTER
		JRST LNPAR1]	;AND PEEL OFF SPACES
	CAIE T2,COMCHR		;IS IT A LIST SEPARATOR?
	JRST LNPAR2		;NO. ALL DONE THEN
	MOVE T2,LNPRV2		;SET UP TO PARSE NEXT E-BLOCK
	JRST LNPAR0		;LOOP BACK FOR THIS E-BLOCK DEFINITION

LNPAR2:	MOVE T1,LNPRV3		;GET POINTER TO FIRST E-BLOCK
	MOVE T2,LNPRV2		;GET STRING POINTER
	RETSKP			;AND EXIT TO CALLER

LNPAR3:	MOVEM T2,LNPRV2		;AN ERROR OCCURED, GO RELEASE E-BLOCKS
	MOVEM T1,LNPRV4		;SAVE ERROR CODE
LNPAR4:	SKIPE T1,LNPRV3		;IS THERE A PREVIOUS E-BLOCK?
	CALL RELLN		;YES, RELEASE IT
	MOVE T1,LNPRV4		;GET ERROR CODE
	MOVE T2,LNPRV2		;GET UPDATED STRING POINTER
	RET			;AND GIVE ERROR RETURN

LNPRS:	SETZB Q3,P3		;START WITH A CLEAN SET OF POINTER ACS
	SETZB F,F1		;THESE ACS CONTROL THE PARSING
	MOVE P6,T2		;GET POINTER TO USER STRING
	MOVEI T1,LNLEN		;GO GET A BLOCK FOR THIS LOGICAL NAME
	CALL GTEMP		;  FROM THE JSB FREE POOL
	 JRST LNEROR		;NONE THERE
	HRRZ P3,T2		;SET UP POINTER TO E-BLOCK
	CALL GETTMP		;GET A TMP STRING FOR PARSED STRINGS
	 JRST LNEROR		;UNSUCCESSFUL, GO CLEAN UP AND RETURN
LNPR1:	CALL CCGET		;GET A CHARACTER FROM THE USERS STRING
	 JRST LNDONE		;NONE LEFT, TREAT IT AS CONFIRMING CHAR
	MOVE T2,T1		;NOW GET CHARACTER TYPE
	CALL GTCODE		;GET CHARACTER CLASS CODE
	 JRST LNEROR		;NO, ILLEGAL CHARACTER CODE
	CAIN T2,SPACHR		;IS THIS A SPACE OR TAB?
	JRST LNPR1		;YES. FLUSH IT AND PROCEED
	XCT CCTAB(T2)		;GO PROCESS CHARACTER
	 JRST LNEROR		;UNSUCCESSFUL, GO PROCESS ERROR AND CLEAN UP
	JRST LNPR1		;LOOP BACK FOR ALL CHARACTERS


;ROUTINE TO GET CHARACTER CLASS CODE
;ACCEPTS CHARACTER IN T2
;SKIP RETURNS WITH CLASS CODE IN T2

;**;[1754] INSERT 2 LINES AT GTCODE::	ARS	2-JUL-80
GTCODE::CAILE T2,.CHDEL		;[1754] VALID ASCII CHAR?
	 RETBAD (GJFX4)		;[1754] NO
	IDIVI T2,CCBPW		;GET BYTE POSITION IN TABLE
	LDB T2,CPTAB(T3)	;GET THE CHAR CODE (SEE GTJFN FOR TABLE)
	CAIL T2,ECCTAB-CCTAB	;WITHIN BOUNDS?
	 RETBAD (GJFX4)		;NO, ERROR
	RETSKP
; CHARACTER CLASS TRANSFER TABLE
;
;	THIS TABLE IS BASED ON THE CHARACTER CLASS DEFINITIONS AS SET
;	UP BY GTJFN.  THIS WAS DONE TO HAVE THE LOGICAL NAME ROUTINES
;	BE CONSISTENT WITH ANY CHANGES TO THE SYNTAX OF A FILE STRING
;	THAT MIGHT BE ADDED TO GTJFN IN THE FUTURE.

CCTAB:	CALL CC0		; (0) UPPER CASE CHARACTER
	CALL CC1		; (1) LOWER CASE CHARACTER
	JRST CCILL		; (2) CONT-U - ILLEGAL
	JRST CCILL		; (3) CONT-R - ILLEGAL
	COMCHR==.-CCTAB
	JRST LNDONE		; (4) COMMA
	SPACHR==.-CCTAB
	JRST LNDONE		; (5) SPACE
	JRST CCILL		; (6) CONT-F AND CONT-U - ILLEGAL
	TRMCHR==.-CCTAB		;TERMINATION CHARACTER
	JRST LNDONE		; (7) CONFIRMING CHARACTER
	JRST CCILL		; (10) ALTMODE - ILLEGAL
	CALL CC11		; (11) COLON
	CALL CC12		; (12) OPEN ANGLE BRACKET
	CALL CC13		; (13) CLOSE ANGLE BRACKET
	CALL CC14		; (14) DOT
	CALL CC15		; (15) SEMI-COLON
	CALL CC16		; (16) CONTROL-V
	JRST CCILL		; (17) ILLEGAL CHARACTER
	CALL CC0		; (20) ASTERISK
	CALL CC21		; (21) DIGIT
	CALL CC22		; (22) UPPER CASE T
	CALL CC23		; (23) UPPER CASE P
	CALL CC24		; (24) UPPER CASE A
	CALL CC25		; (25) LOWER CASE T
	CALL CC26		; (26) LOWER CASE P
	CALL CC27		; (27) LOWER CASE A
	CALL CC30		; (30) MINUS SIGN
	JRST CCILL		; (31) CONT-X - ILLEGAL
	JRST CCILL		; (32) ? - ILLEGAL
	CALL CC0		; (33) WILD CHARACTER
	CALL RSKP		;(34) IGNORE CARRIAGE RETURN
ECCTAB:
; LOWER AND UPPER CASE LETTER ROUTINES

CC1:	SUBI T1,40		;MAKE THIS AN UPPER CASE LETTER
CC0:	TQZN <TMPFF>		;ENTERING A ;T?
	TQZE <KEYFF>		;WAS THE LAST CHAR A SEMI-COLON?
	TQO <PFXFF>		;YES, NOW COLLECTING A PREFIX
	TQZ <NUMFF>		;INVALIDATE ANY MORE DIGITS
	TQZN <PRTFF>		;COLLECTING A PROTECTION?
	JRST CC0A		;NO
	TQO <PFXFF>		;YES, NOW COLLECTING A PREFIX
	CAIE Q3,MAXLC		;IS THE STRING EMPTY STILL?
	RETBAD (GJFX40)		;NO, ILLEGAL PREFIX
	PUSH P,T1		;SAVE THE CHAR
	MOVEI T1,"P"		;PUT IN THE "P" AS THE FIRST CHAR
	CALL CC0A
	 RETBAD (,<POP P,0(P)>)	;ERROR OCCURED
	POP P,T1		;GET BACK THE CHAR
CC0A:	TQNE <STARF>		;HAS A STAR BEEN TYPED IN PREVIOUSLY?
	 RETBAD GJFX31		;YES, ILLEGAL FORMAT
	SOJL Q3,[RETBAD GJFX5]	;IS THE IDENTIFIER TOO LONG
	IDPB T1,Q2		;STORE THIS LETTER IN OUTPUT STRING
	RETSKP			;AND RETURN FOR MORE INPUT


; COLON

CC11:	TQNE <STARF>		;TRYING TO USE WILD CARD DEVICE?
	 RETBAD GJFX31		;YES, THAT IS NOT LEGAL
	TQZE <PFXFF>		;GATHERING A PREFIX?
	JRST STOPFX		;YES, GO STORE IT
	TQOE <DEVF>		;MARK THAT A DEVICE WAS SEEN
	 RETBAD GJFX6		;ERROR IF ALREADY SEEN A DEVICE
	TQNN <DIRFF>		;SEEN AN OPEN ANGLE BRACKET?
	TQNE <DIRF,NAMF>	;OR ALREADY HAVE A NAME OR DIR?
	 RETBAD GJFX6		;YES, ILLEGAL SYNTAX
	MOVEI T2,LNDEV(P3)	;GET E-BLOCK ENTRY FOR DEVICE FIELD
	CALLRET STOSTR		;GO STORE THIS STRING


; OPEN ANGLE BRACKET

CC12:	CAIGE Q3,MAXLC		;HAVE ANY CHARACTERS BEEN SEEN YET?
	 RETBAD GJFX7		;YES, ERROR IN SYNTAX FOR DIR
	TQNN <DIRF,NAMF>	;ALREADY SEEN NAME OR DIR?
	TQOE <DIRFF>		;OR IS A DIRECTORY ALREADY IN PROGRESS?
	 RETBAD GJFX8		;YES, BAD SYNTAX: TWO OPEN ANGLE BRACKETS
	RETSKP			;RETURN


; CLOSE ANGLE BRACKET

CC13:	TQZE <DIRFF>		;SEEN OPEN ANGLE BRACKET YET?
	TQOE <DIRF>		;ALREADY HAVE A DIRECTORY?
	 RETBAD GJFX7		;YES, BAD SYNTAX
	TQNE <NAMF>		;ALREADY SEEN A NAME?
	 RETBAD GJFX7		;YES, BAD SYNTAX: DIR MUST BE BEFORE NAME
	MOVEI T2,LNDIR(P3)	;GET E-BLOCK ADDRESS FOR DIR
	CALLRET STOSTR		;GO STORE THIS STRING
; DOT

CC14:	TQNE <DIRFF,ACTFF>	;ENTERING A DIR NAME OR ACCOUNT STR?
	JRST CC0A		;YES, DOT IS LEGAL
	TQOE <NAMF>		;ALREADY SEEN A NAME?
	JRST [	TQZE <EXTFF>	;EXTENSION NEXT?
		TQNE <EXTF>	;HAVE AN EXTENSION?
		RETBAD (GJFX9)	;YES. ERROR
		CALLRET STOEXT]	;NO. GO STORE EXTENSION
	TQNE <EXTF>		;SEEN AN EXTENSION?
	 RETBAD GJFX9		;BAD SYNTAX, FILE NAME OUT OF ORDER
	TQO <EXTFF>		;MARK THAT AN EXTENSION IS NEXT
STOFIL:	TQO <NAMF>		;MARK THAT A NAME WAS SEEN
	MOVEI T2,LNNAM(P3)	;GET E-BLOCK ADDRESS FOR NAME
	TQNE <STARF>		;WAS THIS A STARRED FIELD?
	 JRST STOFL1		;YES, GO STORE STAR
	CAIL Q3,MAXLC		;NO, IF NULL FILE NAME, DONT STORE IT
	 JRST NUMINI		;NULL NAME IS ILLEGAL, NEVER USE AS DEFAULT
STOFL1:	CALLRET STOSTR		;GO STORE THE STRING


; SEMI-COLON

CC15:	TQNE <DIRFF>		;IN A DIRECTORY NAME?
	RETBAD (GJFX4)		;YES, SEMI COLON IS ILLEGAL
	TQOE <KEYFF>		;SEMI-COLON LAST CHARACTER TOO?
	 RETBAD GJFX10		;YES, ERROR IN SYNTAX
	TQZE <EXTFF>		;GETTING AN EXTENSION?
	JRST [	CALL STOEXT	;YES. GO STORE IT
		 RETBAD		;RETURN ERROR
		SETZ T4,	;DEFAULT VERSION
		CALLRET STOVER]	;GO STORE THE DEFAULT VERSION AS WELL
	TQZE <ACTFF>		;IS THIS AN ACCT FIELD
	 JRST [CALLRET STOACT]	;YES, GO STORE IT
	TQZE <PRTFF>		;IS IT A PROTECTION FIELD?
	 JRST [CALLRET STOPRT]	;YES, GO STORE PROTECTION
	TQZE <TMPFF>		;GETTING A ;T?
	JRST [	CALLRET STOTMP]	;YES
	TQZE <PFXFF>		;GETTING A PREFIX?
	JRST [	CALLRET STOPFO]	;YES, STORE PREFIX ONLY
	TQZE <ATRFF>		;GETTING AN ATTRIBUTE VALUE?
	JRST [	CALLRET STOATR]	;YES, GO STORE THE ATTRIBUTE
	TQNN <NAMF>		;IS THIS A NAME FIELD
	 JRST [CALLRET STOFIL]	;YES, THEN GO STORE IT
	CALLRET STOVER		;THIS MUST BE A VERSION

; CONTROL-V

CC16:	CALL CCGET		;GET NEXT CHARACTER FROM USER STRING
	 RETBAD GJFX15		;CONTROL-V ON A NULL IS AN ERROR
	CALLRET CC0		;GO STORE THIS CHARACTER AS IS
; DIGITS

CC21:	TQZ <KEYFF>		;CLEAR "LAST CHARACTER WAS A SEMI" FLAG
	CAIGE Q3,MAXLC-7	;ONLY 7 DIGITS ARE LEGAL
	 JRST [CALLRET CC0]	;TREAT THIS AS A STRING NOW
	TQNE <OCTF>		;OCTAL?
	CAIGE T1,"8"		; AND A LEGAL DIGIT
	TQNN <NUMFF>		;NUMBERS STILL VALID?
	 JRST [CALLRET CC0]	;NO, TREAT THIS AS A STRING
	MOVEI T2,12		;SET UP FOR DECIMAL
	TQNE <OCTF>		;OCTAL?
	 MOVEI T2,10		;YES
	IMUL T4,T2		;ADD THIS DIGIT INTO NUMBER BEING FORMED
	TQNN <NEGF>		;NEGATIVE NUMBER?
	 ADDI T4,-60(T1)	;NO, ADD IN DIGIT
	TQNE <NEGF>		;NEGATIVE NUMBER?
	 SUBI T4,-60(T1)	;YES, SUBTRACT LOW ORDER DIGIT
	CALLRET CC0A		;GO UPDATE STRING ALSO


; LOWER AND UPPER CASE T

CC25:	SUBI T1,40		;MAKE IT UPPER CASE
CC22:	TQZN <KEYFF>		;WAS THE LAST CHAR A SEMI COLON?
	 JRST [CALLRET CC0]	;NO, THIS IS THE LETTER T
	TQNE <TMPTF>		;ALREADY SEEN A ;T?
	 RETBAD GJFX4		;YES, SYNTAX ERROR
	TQO <TMPFF>		;MARK THAT WE ARE GATHERING A ;T
	CALLRET CC0A		;STORE THE "T" IN THE STRING


; LOWER AND UPPER CASE P

CC26:	SUBI T1,40		;MAKE THIS INTO AN UPPER CASE P
CC23:	TQZN <KEYFF>		;WAS LAST CHARACTER A SEMI-COLON
	 JRST [CALLRET CC0]	;NO, TREAT AS NORMAL CHARACTER
	TQNE <PRTF>		;ALREADY HAVE PROTECTION?
	 RETBAD GJFX13		;YES, TWO PROT FIELDS IS TOO MANY
	TQO <PRTFF,NUMFF>	;MARK THAT A PROTECTION IS BEING SPECIFIED
	JRST OCTINI		;GO INITIALIZE FOR AN OCTAL NUMBER AND RETURN
; LOWER AND UPPER CASE A

CC27:	SUBI T1,40		;MAKE IT AN UPPER CASE A
CC24:	TQZN <KEYFF>		;WAS THE LAST CHAR A SEMI-COLON?
	 JRST [CALLRET CC0]	;NO, TREAT THIS AS A NORMAL CHARACTER
	TQNE <ACTF>		;ALREADY HAVE ACCOUNT FIELD?
	 RETBAD GJFX12		;YES, ERROR
	TQO <ACTFF>		;MARK THAT ACCT IS BEING SPECIFIED
	JRST NUMINI		;INITIALIZE FOR DECIMAL NUMBER AND RETSKP


; MINUS SIGN

CC30:	JUMPN T4,[CALLRET CC0]	;IF SOME DIGITS HAVE BEEN SEEN TREAT AS A STRING
	TQOE <NEGF>		;HAS A MINUS SIGN BEEN TYPED ALREADY?
	 JRST [CALLRET CC0]	;YES, TREAT AS STRING
	CALLRET CC0A		;GO ADD TO STRING JUST IN CASE


STOEXT:	TQOE <EXTF>		;ALREADY HAVE AN EXT?
	 RETBAD GJFX10		;YES, SYNTAX ERROR
	MOVEI T2,LNEXT(P3)	;GET INDEX INTO E-BLOCK
	CALLRET STOSTR		;GO STORE THIS EXTENSION STRING

STOVER:	TQOE <VERF>		;ALREADY HAVE A VERSION?
	 RETBAD GJFX11		;YES, SYNTAX ERROR
	MOVEI T2,LNVER(P3)	;GET VERSION INDEX IN E-BLOCK
	TQNE <STARF>		;VERSION FIELD STARRED?
	 JRST [CALLRET STOAST]	;YES, GO STORE THE STAR
	HRRZS T4		;VERSIONS ARE ONLY 18 BITS
	TQNE <NUMFF>		;FOUND A REAL NUMBER?
	JRST [	CALLRET STONUM]	;YES. GO DO IT
	CAIL Q3,MAXLC		;NO. FOUND SOME CHARACTERS?
	JRST STONUL		;NO. GO STORE NULL VALUE
	CAIE Q3,MAXLC-1		;FOUND EXACTLY ONE?
	RETBAD (GJFX10)		;NO. BAD,BAD
	MOVE T1,Q1		;YES. LET'S SEE IT THEN
	ILDB T1,T1		;THIS IS IT GANG
	CAIE T1,"*"		;IS IT A WILD CARD?
	RETBAD (GJFX10)		;NO. ILLEGAL SPEC THEN
	JRST STOAST		;YES. GO SET IT UP

STOACT:	TQOE <ACTF>		;ALREADY HAVE AN ACCOUNT?
	 RETBAD GJFX12		;YES, SYNTAX ERROR
	MOVEI T2,LNACT(P3)	;GET E-BLOCK INDEX
	JUMPL T4,STOSTR		;NEGATIVE NUMBERS ARE TREATED AS STRINGS
	TQNE <NUMFF>		;WAS A NUMBER ENTERED FOR ACCOUNT?
	 JRST [CALLRET STONUM]	;YES, GO STORE NUMBER INSTEAD OF STRING
	CALLRET STOSTR		;GO STORE THE ACCOUNT STRING

STOPRT:	TQOE <PRTF>		;ALREADY SEEN A PROTECTION VALUE?
	 RETBAD GJFX13		;YES, THIS IS A SYNTAX ERROR
	MOVEI T2,LNPRT(P3)	;GET PROTECTION INDEX
	CALLRET STONUM		;GO STORE THE NUMBER

STOTMP:	TQO <TMPTF>		;MARK THAT ;T WAS TYPED
	SETOM LNTMP(P3)		;REMEMBER IT IN THE E-BLOCK
	CALLRET STRRES		;GO INITIALIZE THE STRING

STOPFX:	CALL GETPFX		;GO PARSE THE PREFIX STRING 
	 RETBAD ()		;NOT FOUND
	TRNE T1,NOATRF		;DOES THIS TAKE AN ATTRIBUTE?
	RETBAD (GJFX47)		;NO, ILLEGAL SYNTAX FOR ATTRIBUTE
	TQO <ATRFF>		;NOW COLLECTING AN ATTRIBUTE VALUE
	HRLM T1,LNATR(P3)	;STORE THE PREFIX VALUE IN E-BLOCK
	CALLRET STRRES		;GO INITIALIZE THE STRING

STOPFO:	CALL GETPFX		;GET PREFIX VALUE
	 RETBAD ()		;UNKNOWN PREFIX
	TRNN T1,NOATRF		;DOES THIS PREFIX HAVE A VALUE
	RETBAD (GJFX46)		;YES, THEN THE VALUE MUST BE GIVEN
	HRLM T1,LNATR(P3)	;SAVE THE PREFIX VALUE
	CALL STRRES		;SET UP A NULL STRING
	 RETBAD()		;FAILED
	CALLRET STOATR		;GO STORE A NULL ATTRIBUTE VALUE


GETPFX:	MOVEI T1,0		;TIE THE STRING OFF WITH A NULL BYTE
	IDPB T1,Q2		;STORE THE NULL
	MOVE T2,Q1		;GET STRING POINTER
	MOVEI T1,PRFXTB		;AND POINTER TO PREFIX TABLE
	TBLUK			;LOOKUP THE PREFIX
	 ERJMP [RETBAD (GJFX40)] ;UNKNOWN PREFIX
	TXNN T2,TL%ABR!TL%EXM	;FOUND ONE?
	RETBAD (GJFX40)		;NO, UNKNOWN ATTRIBUTE
	HRRZ T1,0(T1)		;GET THE PREFIX VALUE
	RETSKP			;AND RETURN

STOATR:	MOVEI T1,0		;END STRING WITH A NULL
	IDPB T1,Q2
	HRRZS T1,Q1		;GET THE START ADR OF THE STRING
	HRRZ T2,Q2		;AND THE END OF THE STRING
	CALL @TRMTAB(P4)	;TRIM THE STRING BLOCK
	HRR T1,LNATR(P3)	;GET POINTER DOWN THE CHAIN
	HRLM T1,0(Q1)		;MAKE THE NEW BLOCK POINT DOWN THE CHAIN
	HLRZ T1,LNATR(P3)	;GET THE PREFIX VALUE
	STOR T1,PRFXV,(Q1)	;STORE THE VALUE IN THE STRING HEADER
	HRRZM Q1,LNATR(P3)	;SET UP CHAIN POINTER IN E-BLOCK
	CALL GETTMP		;SET UP ANOTHER STRING
	 RETBAD ()		;FAILED
	CALLRET NUMINI		;GO SET UP FOR THE NEXT FIELD

; ILLEGAL CHARACTER

CCILL:	RETBAD GJFX4		;ILLEGAL CHATRACTER
; ROUTINE TO STORE A STRING IN THE E-BLOCK
;
;CALLING SEQUENCE:
;	MOVE T2,ADDRESS IN E-BLOCK OF WHERE TO STORE STRING
;	CALL STOSTR
;	RETURN HERE ALWAYS WITH Q1, Q2, AND Q3 SET UP FOR NEXT STRING

STOSTR:	TQZE <STARF>		;SEEN A STAR?
	 JRST STOAST		;YES, GO NOTE THAT FACT
	CAIL Q3,MAXLC		;WERE ANY CHARACTERS ENTERED IN THIS FIELD?
	 JRST STONUL		;NO, MARK THAT IT WAS NULL
	MOVEI T1,0		;END THE STRING
	IDPB T1,Q2		; WITH A NULL
	MOVEM Q1,(T2)		;STORE THE STRING POINTER
	HRRZ T1,Q1		;GO TRIM THE BLOCK DOWN
	HRRZ T2,Q2		;LAST WORD USED
	CALL @TRMTAB(P4)	;RETURN UNUSED WORDS TO FREE POOL
	CALL GETTMP		;GET A NEW STRING BLOCK
	 RET			;ERROR RETURN
	JRST NUMINI		;GO INITIALIZE FLAGS


;ROUTINES TO STORE ASTERISK, NULL, AND NUMBER
;
;	THESE ROUTINES HAVE THE SAME CALLING SEQUENCE AS STOSTR

STONUL:	SKIPA T1,[-2]		;-2 MEANS NULL FIELD IN E-BLOCK
STOAST:	MOVNI T1,3		;-3 MEANS A STAR WAS ENTERED
	MOVEM T1,(T2)		;STORE THE VALUE
	JRST STRRES		;GO RECYCLE STRING AND RETURN

STONUM:	SKIPL T4		;NEGATIVE NUMBERS ARE NOT ALLOWED
	TQNN <NUMFF>		;IS THIS A NUMBER?
	 RETBAD GJFX14		;NO, SYNTAX ERROR
	TLO T4,500000		;MARK THAT THIS IS A NUMBER, NOT A STRING
	MOVEM T4,(T2)		;STORE IN E-BLOCK
STRRES:	MOVE Q2,Q1		;RECYCLE THE TEMPORARY STRING BLOCK
	MOVEI Q3,MAXLC		;GIVE IT THE FULL CHARACTER COUNT
	;...

;COMMON EXIT ROUTINES TO INITIALIZE FLAGS AND NUMBER REGISTER
;NUMINI SETS UP FOR A DECIMAL NUMBER, AND
;OCTINI SETS UP FOR AN OCTAL NUMBER
;BOTH ROUTINES SKIP RETURN

NUMINI:	TQZA <OCTF>		;INITIALIZE FOR A DECIMAL NUMBER
OCTINI:	TQO <OCTF>		;SET UP FOR AN OCTAL NUMBER
	TQZ <NEGF>		;AND CLEAR NEGATIVE FLAG
	TQO <NUMFF>		;INITIALIZE NUMBER FLAG
	SETZ T4,		;INITAILIZE NUMBER GATHERING AC
	RETSKP			;AND RETURN

; CONFIRMING CHARACTER OR SPACE

LNDONE:	TQNE <STARF>		;WAS A STAR TYPED?
	 JRST LNDON0		;YES, GO STORE IT
	CAIL Q3,MAXLC		;WERE THERE ANY CHARACTERS ENTERED
	 JRST LNDON1		;NO, THEN THE PARSE IS THROUGH
LNDON0:	TQNE <ACTFF>		;CURRENTLY DOING AN ACCOUNT FIELD?
	 JRST [CALL STOACT	;YES, GO STORE THIS ACCOUNT STRING
		 JRST LNEROR	;UNSUCCESSFUL, GO PROCESS ERROR AND CLEAN UP
		JRST LNDON1]	;THEN FINISH
	TQNE <PRTFF>		;PROTECTION FIELD BEING ENTERED
	 JRST [CALL STOPRT	;YES, GO STORE PROTECTION FIELD
		 JRST LNEROR	;UNSUCCESSFUL, GO PROCESS ERROR AND CLEAN UP
		JRST LNDON1]	;THEN RETURN
	TQZE <TMPFF>		;GETTING A ;T?
	JRST [	CALL STOTMP	;YES, STORE IT
		 JRST LNEROR	;FAILED
		JRST LNDON1]
	TQZE <PFXFF>		;GETTING A PREFIX?
	JRST [	CALL STOPFO	;YES, STORE IT WITH A NULL VALUE
		 JRST LNEROR
		JRST LNDON1]
	TQZE <ATRFF>		;GETTING AN ATTRIBUTE VALUE?
	JRST [	CALL STOATR	;YES, GO STORE IT ON LNATR CHAIN
		 JRST LNEROR
		JRST LNDON1]
	TQNE <EXTFF>		;EXTENSION BEING SPECIFIED?
	 JRST [CALL STOEXT	;YES, GO STORE FINAL EXTENSION
		 JRST LNEROR	;UNSUCCESSFUL, GO PROCESS ERROR AND CLEAN UP
		JRST LNDON1]	;THEN FINISH
	TQNE <DIRFF>		;GETTING DIRECTORY?
	 JRST [MOVEI T1,GJFX8	;YES, NO CLOSING ANGLE BRACKET
		JRST LNEROR]	;GO CLEAN UP
	TQNE <NAMF>		;HAS A NAME BEEN SEEN?
	 JRST [CALL STOVER	;YES, THEN THIS MUST BE A VERSION NUMBER
		 JRST LNEROR	;UNSUCCESSFUL, GO PROCESS ERROR AND CLEAN UP
		JRST LNDON1]	;FINISHED!
	CALL STOFIL		;THIS MUST BE A FILE, SO GO STORE IT
	 JRST LNEROR		;UNSUCCESSFUL, GO PROCESS ERROR AND CLEAN UP

LNDON1:	MOVEI T1,0(Q1)		;GET TEMP STRING
	CALL RELTMP		;RELEASE IT BACK TO POOL
	MOVE T1,P3		;RETURN WITH POINTER TO E-BLOCK IN T1
	MOVE T2,P6		;AND UPDATED STRING POINTER IN T2
	RETSKP			;TAKE SUCCESSFUL RETURN
;ROUTINE TO HANDLE ERRORS AND CLEAN UP THE FREE SPACE POOL
;
;CALLING SEQUENCE:
;	MOVE T1,ERROR CODE
;	JRST LNEROR
;
;THIS ROUTINE RETURNS TO THE CALLER OF THE LNPARS ROUTINE WITH A NON-SKIP RETURN

LNEROR:	PUSH P,T1		;SAVE ERROR CODE
	JUMPE Q3,LNER1		;IS THERE A STRING POINTER IN Q1?
	HRRZI T1,0(Q1)		;YES, GO RETURN IT TO THE POOL
	CALL RELTMP		;...
LNER1:	JUMPE P3,LNER2		;IS THERE AN E-BLOCK YET
	MOVE T1,P3		;YES, GO RETURN ALL STRINGS IN E-BLOCK
	CALL RELLN		;AND ALSO THE E-BLOCK ITSELF
LNER2:	POP P,T1		;RESTORE ERROR CODE TO AC T1
	MOVE T2,P6		;GET UPDATED STRING POINTER INTO T2
	RET			;AND TAKE NON-SKIP RETURN


;ROUTINE TO RELEASE AN E-BLOCK TO THE FREE POOL
;
;CALLING SEQUENCE:
;	MOVE T1,ADDRESS OF E-BLOCK TO BE RETURNED
;	CALL RELLN
;	RETURN HERE ALWAYS

RELLN:	ASUBR <RELLNA,RELLNB,RELLNC>
RELLN2:	HLRZ T2,LNBLK(T1)	;GET POINTER TO NEXT E-BLOCK
	MOVEM T2,RELLNB		;SAVE POINTER TO NEXT E-BLOCK
	MOVEM T1,RELLNA		;SAVE ADDRESS OF THIS E-BLOCK
	CALL RELATR		;GO RELEASE THE ATTRIBUTE CHAIN
	MOVE T1,RELLNA		;GET BACK THE ADR OF THIS E-BLOCK
	HRLZI T3,1-LNLEN	;SET UP AN AOBJN POINTER TO E-BLOCK
	HRRI T3,1(T1)		;...
RELLN0:	SKIPN T2,0(T3)		;IS THERE A STRING IN THIS FIELD
	 JRST RELLN1		;NO, GO CHECK OTHER FIELDS
	HLRZ T1,0(T3)		;GET LEFT HALF
	CAIE T1,(<POINT 7,0,35>);IS THIS A STRING POINTER?
	 JRST RELLN1		;NO, IGNORE IT
	HRRZ T1,T2		;GET ADDRESS OF STRING
	MOVEM T3,RELLNC		;SAVE AOBJN POINTER
	CALL RELTMP		;RELEASE THE STRING
	MOVE T3,RELLNC		;RESTORE AOBJN POINTER
RELLN1:	AOBJN T3,RELLN0		;LOOP BACK FOR OTHER FIELDS
	MOVE T1,RELLNA		;GET THE ADDRESS OF THE E-BLOCK
	CALL RELTMP		;GO RELEASE IT TOO
	MOVE T1,RELLNB		;GET THE POINTER TO THE NEXT E-BLOCK
	JUMPN T1,RELLN2		;IF ONE THERE, GO RELEASE IT TOO
	RET			;AND RETURN


;ROUTINE TO RELEASE THE ATTRIBUTE CHAIN
;	ACCEPTS IN T1/	ADDRESS OF THE E-BLOCK

;**;[7418] Replace 1 line with 2 at RELATR:+0L	MDR	24-FEB-87
RELATR:	HRRZ T2,LNATR(T1)	;[7418] Get attribute chain
	SKIPN T2		;[7418] Is there one?
	RET			;NO
	SETZM LNATR(T1)		;YES, CLEAR IT OUT
	HRRZ T1,T2		;GET THE POINTER TO THE FIRST BLOCK
RELAT1:	HLRZ T2,0(T1)		;GET THE POINTER TO THE NEXT BLOCK
	PUSH P,T2		;SAVE IT
	LOAD T2,PRFXS,(T1)	;GET THE LENGTH OF THE BLOCK
	MOVEM T2,0(T1)		;STORE LENGTH IN FIRST WORD OF BLOCK
	CALL RELTMP		;AND RELEASE THE BLOCK
	POP P,T1		;GET THE POINTER TO THE NEXT BLOCK
	JUMPN T1,RELAT1		;LOOP BACK FOR REST OF THE BLOCKS
	RET			;ALL DONE
;ROUTINE TO RELEASE A BLOCK BACK TO THE JSB FREE POOL
;
;CALLING SEQUENCE:
;	MOVE T1,ADDRESS OF BLOCK TO BE RETURNED TO POOL
;	CALL RELTMP
;	RETURN HERE ALWAYS

RELTMP:	HRRZS T1		;GET ADDRESS ONLY
	HRRZ T2,0(T1)		;GET LENGTH OF BLOCK
	NOINT			;DONT ALLOW INTERRUPTS
	CALL @RELTAB(P4)	;RELEASE THE SPACE
	OKINT			;DONE WITH UNINTERRUPTIBLE CODE
	RET			;RETURN TO CALLER
; ROUTINE TO GET A CHARACTER FROM THE USER'S STRING
;
;CALLING SEQUENCE
;	CALL CCGET
;	 RETURN HERE IF NO MORE CHARACTERS IN STRING
;	RETUURN HERE WITH CHAR IN T1

CCGET:	XCTBU [ILDB T1,P6]	;GET THE NEXT CHARACTER
	JUMPN T1,RSKP		;IF NOT NULL, GIVE SKIP RETURN
	RET			;NULL, GIVE NON-SKIP RETURN


; ROUTINE TO GET A BLOCK OF CORE IN THE JSB FOR A STRING
;
;CALLING SEQUENCE
;	CALL GETTMP
;	 RETURN HERE IF UNSUCCESSFUL WITH ERROR CODE IN T1
;	RETURN HERE WITH STRING POINTER IN Q1 AND Q2
;		AND CHARACTER COUNT IN Q3

GETTMP:	MOVEI T1,MAXLW+1	;GET A BLOCK LARGE ENOUGH FOR LONGEST STRING
	CALL GTEMP		;GET A BLOCK FROM THE FREE POOL
	 RET			;AN ERROR HAPPENED
	HRLI T2,(<POINT 7,0,35>);SET UP POINTER
	MOVE Q1,T2		;SKIP OVER HEADER WORD IN BLOCK
	MOVE Q2,Q1		;MAKE A COPY OF INITIAL POINTER
	MOVEI Q3,MAXLC		;SET UP CHARACTER COUNT
	RETSKP			;AND RETURN


;ROUTINE TO ACTUALLY GET SPACE FROM THE JSB FREE POOL
;
;CALLING SEQUENCE:
;	MOVE T1,# OF WORDS NEEDED IN BLOCK
;	CALL GTEMP
;	 RETURN HERE IF UNSUCCESSFUL, ERROR CODE IN T1
;	RETURN HERE WITH ADDRESS OF BLOCK IN T2

GTEMP:	NOINT			;GUARD AGAINST CONFUSION IN JOB FREE POOL
	CALL @ASGTAB(P4)	;GET BLOCK
	 JRST [OKINT		;NO MORE ROOM
		SETZ Q3,	;MARK THAT THERE IS NO STRING IN Q1
		RETBAD GJFX22]	;GIVE ERROR RETRUN TO USER
	OKINT			;WE ARE THROUGH THE RACE PRONE CODE
	MOVE T2,T1		;GET ANSWER IN T2
	HRRZ T3,0(T1)		;NOW ZERO THE BLOCK
	ADDI T3,-1(T1)		;T3 NOW POINTS TO LAST WORD OF BLOCK
	HRRZS 0(T1)		;CLEAR OUT LEFT HALF OF FIRST WORD
	SETZM 1(T1)		;ZERO THE FIRST DATA WORD OF BLOCK
	HRLI T1,1(T1)		;GET SOURCE POINTER
	HRRI T1,2(T1)		;AND DESTINATION
	BLT T1,0(T3)		;ZERO THE BLOCK
	RETSKP			;GIVE THE OK RETURN
;TABLES FOR DIFERENTIATING BETWEEN JOB WIDE AND SYSTEM LOGICAL NAMES

;ALL TABLES ARE INDEXED BY P4 WHICH MUST CONTAIN EITHER 0 OR 1

LOKTAB:	IFIW!LNMLCK		;JOB WIDE LOGICAL NAME LOCK
	IFIW!SYLNLK		;SYSTEM LOGICAL NAME LOCK

ASGTAB:	IFIW!ASGJSB		;ROUTINE TO GET STORAGE FROM JSB
	IFIW!ASGSWP		;ROUTINE TO GET SWAPPABLE STORAGE

RELTAB:	IFIW!RELJSB		;ROUTINE TO RELEASE JSB STORAGE
	IFIW!RELSWP		;ROUTINE TO RELEASE SWAPPABLE STORAGE

LNTAB:	IFIW!LNTABP		;ADDR OF POINTER TO JOB WIDE LN TABLE 
	IFIW!SYLNTB		;ADDRESS OF POINTER TO SYSTEM LN TABLE

TRMTAB:	IFIW!TRMBLK		;ADR OF ROUTINE TO TRIM A JSB BLOCK
	IFIW!TRMSWP		;ADR OF ROUTINE TO TRIM A SWP BLOCK


;ROUTINE TO GET STORAGE FROM JSB

;ACCEPTS IN T1/	# OF WORDS NEEDED FROM JSB
;	CALL ASGJSB
;RETURNS +1:	ERROR - ERROR CODE IN T1
;	 +2:	SUCCESSFUL - ADDRESS OF STRING IN T1

ASGJSB:	MOVE T2,T1		;GET DESIRED # OF WORDS FROM JSB
	CALLRET ASGJFR		;GO GET SPACE


;ROUTINE TO RELEASE JSB STORAGE

;ACCEPTS IN T1/	ADDRESS OF BLOCK
;	    T2/	LENGTH OF BLOCK
;	CALL RELJSB
;RETURNS +1:	ALWAYS

RELJSB:	HRRZM T2,0(T1)		;STORE LENGTH OF BLOCK
	MOVE T2,T1		;SET UP FOR CALL TO RELFRE
	MOVEI T1,JSBFRE
	CALLRET RELFRE		;GO RELEASE BLOCK


;ROUTINE TO TRIM A BLOCK THAT IS IN THE SWAPPABLE POOL
;ACCEPTS IN T1/	START ADR OF BLOCK
;	    T2/	ADR OF LAST WORD USED IN BLOCK
;	CALL TRMSWP
;RETURNS +1 ALWAYS

TRMSWP:	MOVEI T3,SWPFRE		;GET ADDRESS OF POOL HEADER
	CALLRET TRIMER		;GO TRIM THE BLOCK

;ROUTINES CALLED BY GTJFN TO GET DEFAULT FIELDS FROM THE LOGICAL NAME DEFINITION

;THE FOLLOWING ROUTINES: GLNDEV, GLNDIR, GLNNAM, ETC. ARE CALLED TO
; GET A SPECIFIC DEFAULT STRING COPIED FROM THE LOGICAL NAME DEFINITION
; TO THE DEFAULT STRING POINTED TO BY THE LEFT HALF OF FILTMP(JFN).
;CALLING SEQUENCE:
;	CALL GLNXXX		;DEV, DIR, NAM, EXT, ACT, PRT, VER
;	 UNSUCCESSFUL RETURN, NO DEFAULT OR NO LGICAL NAME
;	SUCCESSFUL, LH(FILTMP) POINTS TO DEFAULT STRING
;		T1/  NUMBER  (UNLESS A STRING)
;		T2/  0 IF NUMBER, -1 IF STRING IN LH(FILTMP)

GLNDEV::MOVEI T1,LNDEV		;GET DEVICE FIELD OF LOGICAL NAME
	CALLRET GLNSTR		;GO COPY STRING

GLNDIR::MOVEI T1,LNDIR		;GET DIRECTORY DEFAULT FROM LOGICAL NAME
	CALLRET GLNSTR		;COPY STRING

GLNNAM::MOVEI T1,LNNAM		;GET NAME FIELD
	CALLRET GLNSTR		;COPY DEFAULT STRING

GLNEXT::MOVEI T1,LNEXT		;GET EXTENSION FIELD (COULD BE NULL)
	CALLRET GLNSTR		;COPY STRING

GLNVER::MOVEI T1,LNVER		;GET VERSION NUMBER
	CALL GLNNUM		;RETURN A NUMBER OR A STAR
	 RET			;NO DEFAULT
	HRRES T1		;MAKE THIS A FULL WORD VERSION
				; WHERE -3 MEANS STAR
	RETSKP			;AND RETURN

GLNACT::PUSH P,P4		;SAVE THE PERMANENT ACS USED
	MOVEI T1,LNACT		;GET DESIRED FIELD
	MOVEI T2,FILLNM(JFN)	;GET ADDRESS OF CHAIN HEADER WORD
	CALL GLNFLD		;GET THE DEFAULT
	 JRST [	POP P,P4	;NO DEFAULT
		JRST RFALSE]	;RETURN 0 IN T1
	CAMG T1,[577777,,-1]	;IS THIS A NUMBER
	CAMGE T1,[500000,,0]	;...
	 JRST GLNST1		;NO, STORE THIS STRING
	JRST GLNSKP		;AND RETURN

GLNPRT::MOVEI T1,LNPRT		;GET PROTECTION
	CALL GLNNUM		;THIS MUST BE A NUMBER
	 RET			;NO DEFAULT PROTECTION
	RETSKP			;AND RETURN

GLNATR::PUSH P,P4		;SAVE PERMANENT ACS
	PUSH P,T1		;SAVE THE ATTRIBUTE NUMBER
	MOVEI T1,LNATR
	MOVEI T2,FILLNM(JFN)	;GET POINTER TO CHAIN HEADER WORD
	CALL GLNFLD		;GET THE POINTER TO THE ATTRIBUTE CHAIN
	 JRST [	POP P,(P)	;NONE THERE
		POP P,P4	;RESTORE THE PERMANENT AC
		JRST RFALSE]	;GIVE ERROR RETURN
	POP P,T4		;GET BACK THE ATTRIBUTE NUMBER
GLNAT1:	SOJL T4,GLNAT2		;IF AT RIGHT ONE, GO RETURN TO USER
	HLRZ T1,0(T1)		;STEP TO NEXT ATTRIBUTE ON LIST
	JUMPN T1,GLNAT1		;IF ONE THERE, LOOP BACK TIL DONE
	JRST GLNERR		;NO MORE ENTRIES ON THE LIST

GLNAT2:	LOAD T2,PRFXV,(T1)	;GET THE PREFIX VALUE
	PUSH P,T2		;SAVE IT FOR LATER
	HRLI T1,(POINT 7,0,35)	;SET UP A STRING POINTER TO STRING
	CALL LNMCPY		;COPY THE STRING TO THE DEFAULT STRING
	 JRST [	POP P,(P)	;CLEAN UP THE STACK
		JRST GLNER2]	;AND EXIT
	POP P,T1		;RETURN THE PREFIX VALUE IN T1
	JRST GLNSK1		;AND GIVE SKIP RETURN
GLNNUM:	PUSH P,P4		;SAVE P4
	MOVEI T2,FILLNM(JFN)	;GET ADDRESS OF CHAIN HEADER WORD
	CALL GLNFLD		;GET THE DEFAULT
	 JRST [	POP P,P4	;NONE
		JRST RFALSE]	;RETURN 0 IN T1
	JRST GLNSKP		;YES, RETURN IT IN T1

GLNSTR:	CALL GLNST0		;GET THE STRING
	 RET			;ERROR RETURN
	CAMN T1,[-3]		;STAR?
	TQO <DFSTF>		;YES, SET STAR FLAG
	RETSKP

GLNST0:	PUSH P,P4		;SAVE P4 
	MOVEI T2,FILLNM(JFN)	;GET ADDRESS OF CHAIN HEADER WORD
	CALL GLNFLD		;GET THE DEFAULT FIELD
	 JRST [	POP P,P4	;NONE FOUND
		JRST RFALSE]	;RETURN 0 IN T1
GLNST1:	CAMN T1,[-3]		;IS THIS A STAR FIELD?
	JRST GLNSK1		;YES, GIVE SKIP RETURN
	CALL LNMCPY		;NO, THEN COPY STRING TO DEFAULT STRING
	 JRST GLNER2		;ERROR DURING COPYING
GLNSK1:	SKIPA T2,[-1]		;RETURN WITH T2=-1 TO DENOTE A STRING
GLNSKP:	SETZ T2,		;SET T2 TO ZERO TO DENOTE A NUMBER
LNSKPR:	UNLOCK @LOKTAB(P4)	;RELEASE INTERLOCK
	OKINT			;...
	POP P,P4		;RESTORE P4
	RETSKP			;AND TAKE SUCCESSFUL RETURN

GLNERR:	SETZ T1,		;LEAVE T1 0
GLNER2:	UNLOCK @LOKTAB(P4)	;RELEASE INTERLOCK
	OKINT			;...
	POP P,P4		;RESTORE PERMANENT AC
	RET			;TAKE UNSUCCESSFUL RETURN
;ROUTINE TO GET A DEFAULT FIELD FROM THE LOGICAL NAME CHAIN
;ACCEPTS IN T1/	FIELD #
;	    T2/	ADDRESS OF CHAIN HEADER WORD
;	CALL GLNFLD
;RETURNS +1:	NO DEFAULT  (NOTHING LOCKED)
;	 +2:	DEFAULT IN T1  (NOINT AND @LOKTAB(P4) LOCKED)

GLNFLD:	STKVAR <GLNFLC,GLNFLN,GLNFLP,GLNFLS>
	MOVEM T1,GLNFLN		;SAVE FIELD NUMBER
	HRRZM T2,GLNFLS		;SAVE ADDRESS OF CHAIN WORD
	NOINT			;THIS RETURNS LOCKED UP
	CAIN T1,LNDEV		;IS THIS A DEVICE FIELD BEING LOOKED FOR
	JRST [	HRRZ T1,0(T2)	;YES, GET POINTER TO FIRST ONE ON CHAIN
		JUMPE T1,[OKINT	;MAKE SURE THERE IS A CHAIN
			  RET]
		MOVEI T3,1	;ONLY LOOK AT THE FIRST ONE ON THE CHAIN
		JRST GLNFL2]
	HRRZ T2,0(T2)		;GET POINTER TO FIRST BLOCK
	SETZB T1,T3		;INITIALIZE COUNTERS
GLNFL1:	JUMPE T2,GLNFL2		;AT END OF LIST?
	LOAD T1,LNMLNK,(T2)	;GET LINK TO NEXT BLOCK
	EXCH T1,T2		;SAVE LAST ONE IN T1
	AOJA T3,GLNFL1		;COUNT UP COUNTER

GLNFL2:	MOVEM T3,GLNFLC		;SAVE NUMBER OF BLOCKS ON CHAIN
GLNFL3:	SOSGE GLNFLC		;COUNT DOWN COUNTER
	JRST [	OKINT		;NO MORE LOGICAL NAMES
		RET]
	LOAD P4,LNMIDX,(T1)	;GET INDEX
	HRLI P4,400000
	LOCK @LOKTAB(P4)	;LOCK UP THE LN DATA BASE
	CALL GLNDEF		;GET E-BLOCK POINTER
	 JRST [	UNLOCK @LOKTAB(P4)
		OKINT
		RET]
	ADD T1,GLNFLN		;CALCULATE ADDRESS OF DESIRED ENTRY
	SKIPE T1,0(T1)		;IS THERE A DEFAULT HERE?
	RETSKP			;YES, GIVE IT TO CALLER
	UNLOCK @LOKTAB(P4)	;NO, UNLOCK
	HRRZ T1,GLNFLS
	HRRZ T1,0(T1)		;SCAN DOWN CHAIN AGAIN
	MOVE T3,GLNFLC		;GET LENGTH OF CHAIN-1
GLNFL4:	SOJLE T3,GLNFL3		;AT PROPER LEVEL
	LOAD T1,LNMLNK,(T1)	;GET NEXT BLOCK ON CHAIN
	JRST GLNFL4		;LOOP BACK
;ROUTINE TO GET E-BLOCK ADDRESS OF CURRENT LOGICAL NAME
;
;ACCEPTS IN T1/	ADDRESS OF LOGICAL NAME HEADER BLOCK ON CHAIN
;	CALL GLNDEF
;	 UNSUCCESSFUL, NO LOGICAL NAME
;	SUCCESSFUL RETURN WITH ADDRESS OF E-BLOCK IN T1

GLNDEF:	STKVAR <GLNDFC>
	LOAD T2,LNMCNT,(T1)	;GET THE DEPTH COUNT
	MOVEM T2,GLNDFC		;SAVE IT FOR LATER
	LOAD T1,LNMPNT,(T1)	;GET POINTER TO NAME STRING
	CALL LNMLK1		;LOOKUP THE LOGICAL NAME
	 RET			;NOT FOUND
	HRRZ T1,0(T1)		;GET E-BLOCK ADDRESS
GLNDF1:	SOSGE GLNDFC		;SCAN DOWN TO PROPER DEPTH
	RETSKP			;ALL DONE
	HLRZ T1,LNBLK(T1)	;GET POINTER TO NEXT BLOCK
	JUMPN T1,GLNDF1		;LOOP BACK TILL DONE
	RET			;END OF LIST!
;ROUTINE CALLED BY .STDEV AND .RCDIR TO TRANSLATE A LOGICAL NAME STRING TO
;  THE DEFAULTED PHYSICAL NAME AND DIRECTORY IF ANY
;
;ACCEPTS:
;	T1/RH OF LOOKUP POINTER TO BLOCK CONTAINING DEVICE NAME TO BE LOOKED UP
;	T2/-1 IF WANT DIRECTORY NAME, 0 IF NOT

;	CALL CHKLND

;RETURNS +1: ALWAYS,
;	T1/RH OFLOOKUP POINTER TO UPDATED DEVICE FIELD
;		T2/RH OF LOOKUP POINTER TO DIRECTORY STRING
;			OR
;		   0 IF NOT FOUND
;			OR
;		   -1 IF STAR WAS FOUND

;USE OF STKVARS:
;	CHKLDP - RH OF LOOKUP POINTER TO DEVICE NAME IN JSB (TEMPORARY LOCATION
;		 BEFORE ADDING TO LOGINAL NAME LINK)
;	CHKLDO - RH OF LOOKUP POINTER TO CURRENT DEVICE FIELD (AS UPDATED WITH
;		 LOGICAL NAMES)
;	CHKLDC - HEADER FOR LOGICAL NAME CHAIN
;	CHKLDI - INDEX (0 FOR JOB-WIDE LOGICAL NAME, 1 FOR SYSTEM)
;	CHKLDA - BYTE POINTER TO DIRECTORY NAME IN LOGICAL NAME CHAIN

;THIS ROUTINE CREATES A CHAIN OF LOGICAL NAMES BASED ON THE DEFINITION
;OF THE SPECIFIED LOGICAL NAME.  IT RETURNS WHEN A DEVICE FIELD IS FOUND
;THAT DOES NOT CONTAIN A DEFINED LOGICAL NAME.  THIS MAY OR MAY NOT BE
;A LEGITIMATE DEVICE NAME.  FOR EACH LOGICAL NAME IN THE CHAIN, ONLY THE
;FIRST DEFINITION IS USED.  THUS, IF FOO IS DEFINED AS LOGA,LOGB, ONLY
;THE DEFINITION OF LOGA IS USED.

; * * * *
;NOTE: PROBABLY NEEDS AN ERROR RETURN 
; * * * *

CHKLND::SAVEP			;SAVE P4 AND FRIENDS
	STKVAR <CHKLDP,CHKLDO,CHKLDC,CHKLDI,CHKLDA>
	MOVEM T2,P6		;SAVE DIRECTORY FLAG
	NOINT			;DISABLE INTERRUPTS WHILE SEARCHING
	SETZM CHKLDC		;INITIALIZE POINTER TO CHAIN
	SETZM CHKLDP		;WE HAVE NO STRING IN CHKLDP
	MOVEM T1,CHKLDO		;SAVE POINTER TO ORIGINAL STRING
CHKLD1:	MOVE T1,CHKLDO		;GET POINTER TO CURRENT DEVICE NAME
	CALL LNLUKG		;SEE IF THIS STRING IS A LOGICAL NAME
				;RETURNS: 2/INDEX (0 FOR JOB, -1 FOR SYSTEM)
	 JRST CHKLD3		;NO LOGICAL NAME FOR THIS STRING
	;..
;CHKLDO POINTS TO THE CURRENT DEVICE FIELD, WHICH IS A LOGICAL NAME.
;LINK IT TO THE CHAIN OF LOGICAL NAMES

	;..
CHKLD0:	MOVEM T2,CHKLDI		;SAVE INDEX OF LOGICAL NAME
	MOVEI T2,MAXLW+1	;GET A STRING FOR THIS NAME
	CALL ASGJFR		;FROM JSB FREE SPACE
	 JRST CHKLD3		;NO ROOM, GO RETURN
	MOVEM T1,CHKLDP		;SAVE LOOKUP POINTER TO FREE SPACE
	HRRZ T2,T1		;DEST: JSB FREE SPACE
	HRRZ T1,CHKLDO		;SOURCE: CURRENT DEVICE NAME
	CALL CPYSTR		;COPY CURRENT DEVICE STRING TO FREE SPACE
	MOVE T1,CHKLDP		;GET POINTER TO THIS DEVICE
	MOVE T2,CHKLDI		;GET ITS INDEX VALUE
	MOVEI T3,CHKLDC		;GET ADDRESS OF CHAIN HEADER WORD
	SETZ T4,		;MAKE ALL STEPS BE THE SAME
	CALL LNKLNM		;LINK THIS STRING TO CHAIN
	 JRST CHKLD3		;SOMETHING WENT WRONG, EXIT
	SETZM CHKLDP		;NO LONGER HAVE TO RETURN THIS FREE SPACE - 
				; RELLNS WILL DO IT LATER

;LOGICAL NAME IS AT THE BEGINNING OF THE CHAIN.  SEE IF THERE IS A DEVICE
;FIELD IN THE LOGICAL NAME DEFINITION

	MOVEI T1,LNDEV		;NOW GET DEFAULT FIELD
	MOVEI T2,CHKLDC		;GET ADDRESS OF CHAIN POINTER WORD
	CALL GLNFLD		;GET THE DEFAULT DEVICE FIELD
				;LOCK LOGINAL NAME DATA BASE, GO NOINT
				;RETURNS 1/POINTER TO DEVICE STRING,
				;P4/INDEX (0 OR 1)
	 JRST CHKLD2		;THERE WASNT ANY, GO USE "DSK"

;A DEVICE FIELD WAS FOUND.  IT MAY BE A TRUE DEVICE OR ANOTHER LOGICAL
;NAME.  REPLACE THE ORIGINAL STRING WITH THIS FIELD.

	HRRZS T1
	HRRZ T2,CHKLDO		;DEST: POINTER TO ORIGINAL STRING
	CALL CPYSTR		;COPY DEFAULT INTO ORIGINAL STRING
	UNLOCK @LOKTAB(P4)	;UNLOCK THE LN TABLE LOCKED BY GLNFLD
	OKINT			;GLNFLD WENT NOINT
;IF THIS STRING IS NOT ALREADY ON THE LOGICAL NAME CHAIN, LOOP BACK
;AS THOUGH IT WERE THE ORIGINAL STRING.  IF IT IS ON THE CHAIN, SEE
;WHETHER IT IS ON THE CHAIN AS A JOB-WIDE LOGICAL NAME OR A SYSTEM
;LOGICAL NAME.  IF SYSTEM, WE ARE AT THE END OF THE SEARCH.  IF JOB-
;WIDE, SEE IF IT IS ALOS A SYSTEM LOGICAL NAME.  IF SO, LOOP BACK
;AS THOUGH IT WERE THE ORIGINAL STRING.  NOTE THAT IF A NAME IS BOTH
;A JOB-WIDE AND A SYSTEM LOGICAL NAME, THE JOB-WIDE DEFINITION WILL GO
;ON THE CHAIN FIRST; WHEN THE SYSTEM DEFINITION IS ADDED, IT WILL GO
;ON THE CHAIN AHEAD OF THE JOB-WIDE DEFINITION.

	MOVE T1,CHKLDO		;T1/POINTER TO CURRENT DEVICE NAME
CHKLD4:	MOVEI T2,CHKLDC		;T2/ADDRESS OF CHAIN HEADER WORD
	CALL CHKCHN		;SEE IF THIS IS ON THE CHAIN ALREADY
				;RETURNS: 1/INDEX   ??????
	 JRST CHKLD1		;NO, LOOP BACK TIL END OF LOGICAL NAMES
	JUMPG T1,CHKLD3		;YES. IF THIS IS A SYSTEM LN, GO RETURN
	MOVE T1,CHKLDO		;GET POINTER TO NAME STRING
	CALL LNLUKS		;SEE IF THIS IS A SYSTEM LOGICAL NAME
				;RETURNS: 2/INDEX
	 JRST CHKLD3		;NO, GO RETURN
	JRST CHKLD0		;YES, GO STORE THIS ON THE CHAIN

;A LOGICAL NAME DEFINITION THAT DOES NOT CONTAIN A DEVICE FIELD HAS BEEN FOUND.
;SUBSTITUTE 'DSK', AND SEE IF IT IS A LOGICAL NAME.  IF NOT, RETURN 'DSK'
;WHICH WILL BE INTERPRETED AS CONNECTED STRUCTURE.

CHKLD2:	MOVE T1,CHKLDO		;GET BACK POINTER TO ORIGINAL STRING
	MOVE T2,[ASCIZ/DSK/]
	MOVEM T2,1(T1)		;STORE DSK AS THE DEVICE FIELD
	JRST CHKLD4		;GO SEE IF IT IS A LOGICAL NAME

;DEVICE FIELD HAS BEEN FOUND OR DISK IS BEING USED.  IF REQUESTED,
;SEE IF A DIRECTORY WAS SPECIFIED IN THE LOGICAL NAME.  IF IT IS NOT
;ALREADY ON THE CHAIN, DON'T ADD IT

CHKLD3:	SETZ P1,		;INDICATE DIRECTORY NOT FOUND
	SKIPN P6		;DO WE WANT TO GET THE DIRECTORY?
	 JRST CHKLD6		;NO. ACT AS IF NOT FOUND
	;..
	;..
	MOVEI T1,LNDIR		;T1/OFFSET IN E-BLOCK FOR DIRECTORY
	MOVEI T2,CHKLDC		;T2/ADDRESS OF CHAIN HEADER WORD
	CALL GLNFLD		;SEE IF THIS LOGICAL NAME HAS A DIRECTORY
				; FIELD, LOCK LOGICAL NAME DATA BASE, GO NOINT
				; RETURNS T1/POINTER TO DIRECTORY STRING
				; P4/INDEX
	 JRST CHKLD6		;NO DIRECTORY FIELD
	CAMN T1,[-3]		;WAS STAR FOUND?
	JRST [	SETOM P1	;YES. INDICATE IT FOR LATER
		JRST CHKLD5]
	MOVEM T1,CHKLDA		;SAVE POINTER TO STRING IN CHAIN
	MOVEI T2,MAXLW+1	;T2/NUMBER OF WORDS IN DIRECTORY STRING
	NOINT			;WILL RETURN WITH THIS BLOCK ALLOCATED
	CALL ASGJFR		;GET SPACE TO STORE THE STRING
	 JRST [	SETOM P1	;NO FREE SPACE. INDICATE DIRECTORY NOT FOUND
		OKINT		;OKINT SINCE NO SPACE ASSIGNED
;**;[2821] CHANGE 1 LINE AT CHKLD3:+21L	TAM	28-SEP-82
		JRST CHKLD5]	;[2821]
	MOVEM T1,P1		;SAVE LOOKUP POINTER TO STRING  IN JSB
	HRROI T1,1(T1)		;1/DEST: FIRST WORD AFTER HEADER
	MOVE T2,CHKLDA		;2/SOURCE: DIRECTORY FIELD IN E-BLOCK
	MOVEI T3,MAXLC		;3/LIMIT OF CHARACTERS
	SETZ T4,		;4/TERMINATE ON NULL
	SOUT			;COPY DIRECTORY STRING TO JSB FREE SPACE
;NEEDS AN ERJMP
	HRRZS T1		;GET ADDRESS OF LAST BYTE
	SUB T1,P1		;GET NUMBER OF WORDS WRITTEN
	SOS T1			;FULL-WORD COUNT IS LENGTH-1
	MOVNS T1		;GET NEGATIVE
	HRLM T1,P1		;STORE FULL LOOKUP POINTER
CHKLD5:	UNLOCK @LOKTAB(P4)	;UNLOCK LOGICAL NAME DATA LOCKED BY GLNFLD
	OKINT			;GLNFLD WENT NOINT
CHKLD6:	MOVEI T1,CHKLDC		;T1/ADDRESS OF CHAIN POINTER
	CALL RELLNS		;GO RELEASE THIS LOGICAL NAME CHAIN
	MOVEI T1,JSBFRE		;NOW RETURN TEMP STRING
	SKIPE T2,CHKLDP		;IF ANY
	CALL RELFRE		;RELEASE SPACE OBTAINED BY ASGJFR
	MOVE T2,P1		;T2/ADDRESS OF DIRECTORY STRING
				; OR INDICATION OF NOT FOUND OR STAR
	MOVE T1,CHKLDO		;T1/ADDRESS OF DEVICE STRING
	OKINT			;CHKLND WENT NOINT AT START
	RET
;ROUTINE TO LOOKUP A LOGICAL NAME IN BOTH TABLES OR SYSTEM LN TABLE
;ACCEPTS IN T1/	STRING POINTER TO LOGICAL NAME
;	CALL LNLUKG		;EITHER JOB WIDE OR SYSTEM LN
;	    OR
;	CALL LNLUKS		;SYSTEM LN ONLY
;RETURNS +1:	NO LOGICAL NAME
;	 +2:	FOUND A LOGICAL NAME, T2=0 FOR JOB WIDE, T2=1 FOR SYSTEM

LNLUKG::PUSH P,T1		;SAVE POINTER TO STRING
	MOVEI T2,0		;FIRST CHECK THE JOB WIDE TABLE
	CALL LNMLUK		;...
	 JRST LNLKG1		;NOT A JOB WIDE LN, TRY SYSTEM LN
	POP P,(P)		;CLEAN OUT STACK
	MOVEI T2,0		;MARK THAT A JOB WIDE LN WAS FOUND
	RETSKP

LNLKG1:	POP P,T1		;GET BACK STRING POINTER
LNLUKS::MOVEI T2,1		;TRY LOOKING IN SYSTEM LN TABLE
	CALL LNMLUK
	 RET			;NOT FOUND
	MOVEI T2,1		;MARK THAT THIS IS A SYSTEM LN
	RETSKP
;ROUTINE TO LOOKUP A LOGICAL NAME IN THE LOGICAL NAME TABLE
;
;CALLING SEQUENCE:
;	MOVE T1,STRING POINTER TO LOGICAL NAME TO BE LOOKED UP
;	T2 - 0 MEANS JOB WIDE LN,  1 MEANS SYSTEM WIDE LN
;	CALL LNMLUK
;	 UNSUCCESSFUL, NO SUCH LOGICAL NAME IN TABLE
;	SUCCESSFUL, T1 CONTAINS PONTER TO TABLE ENTRY
;		T2 = -1	NO MATCH
;		T2 = 0	AMBIGOUUS
;		T2 = 1	UNIQUE ABREVIATION
;		T3 = POINTER TO REST OF NAME STRING

LNMLUK::PUSH P,P4		;SAVE PERMANENT ACS USED
	TRZE T2,777776		;IS THIS A VAILD INDEX VALUE?
	BUG(LNMILI)
	HRRO P4,T2		;SET UP INDEX REG
	NOINT			;LOCK UP DATA BASE
	LOCK @LOKTAB(P4)
	CALL LNMLK1		;DO THE LOOKUP
	 JRST GLNERR		;ERROR RETURN
	JRST LNSKPR		;OK RETURN

LNMLK1:	HRLI T1,(POINT 7,0,35)	;SET UP POINTER TO LOGICAL NAME
	MOVE T2,T1		;PREPARE TO CALL TABLE LOOKUP ROUTINE
	SKIPN T1,@LNTAB(P4)	;IS THERE A TABLE OF LOGICAL NAMES YET?
	 JRST [SETO T2,		;GIVE UNSUCCESSFUL RETURN
		RET]		;...
	CALL TABLK		;YES, GO LOOKUP THE NAME
	 RET			;NO SUCH NAME IN TABLE
	RETSKP			;SUCCESSFUL, RETURN POINTER TO TABLE ENTRY
;ROUTINE TO STEP A LOGICAL NAME TO TNE NEXT E-BLOCK
;ACCEPTS IN JFN, POINTER TO JFN BLOCK
;RETURNS +1:	NO MORE LOGICAL NAME BLOCKS
;	 +2:	LOGICAL NAME STEPPED

LNSTEP::HRRZ T2,FILLNM(JFN)	;GET POINTER TO LOGICAL NAME CHAIN
	JUMPE T2,R		;NO LOGICAL NAMES
	PUSH P,P4		;SAVE P4
	NOINT
LNSTP0:	HRRZ T1,FILLNM(JFN)	;GET NEXT CHAIN ELEMENT
	JUMPE T1,[OKINT		;IF 0, NO MORE LOGICAL NAMES
		POP P,P4	;RESTORE P4
		RET]		;RETURN TO CALLER
	LOAD P4,LNMIDX,(T1)	;GET INDEX OF THIS ELEMENT
	HRLI P4,400000
	LOCK @LOKTAB(P4)	;LOCK THE DATA BASE
	CALL GLNDEF		;GET POINTER TO E-BLOCK
	 JRST LNSTP1		;NO LOGICAL NAME
	HLRZ T2,LNBLK(T1)	;GET POINTER TO NEXT E-BLOCK
	JUMPE T2,LNSTP1		;NONE LEFT, GO DELETE THIS CHAIN BLOCK
	HRRZ T1,FILLNM(JFN)	;GET FIRST ITEM ON CHAIN
	LOAD T2,LNMCNT,(T1)	;GET DEPTH COUNT
	AOS T2			;INCREMENT IT
	STOR T2,LNMCNT,(T1)
	JRST LNSKPR		;GIVE OK RETURN

LNSTP1:	MOVEI T1,FILLNM(JFN)	;SET UP POINTER TO CHAIN HEADER WORD
	CALL REL1LN		;DELETE THE FIRST BLOCK ON CHAIN
	 JRST GLNERR		;PROBLEM
	UNLOCK @LOKTAB(P4)	;UNLOCK THIS DATA BASE
	JRST LNSTP0		;LOOP BACK FOR ANOTHER ONE
; TABLE MANIPULATING ROUTINES
;
; ADD AN ENTRY, DELETE AN ENTRY, AND LOOKUP A NAME
;
;TABLE FORMAT:
;
;	TABLE:	XWD # OF ENTRIES IN USE, # OF RESERVED WORDS FOR TABLE
;		XWD ADR OF STRING BLOCK, ANYTHING
;			.
;			.
;			.
;

;TABDEL:	DELETE AN ENTRY FROM THE TABLE
;
;	THIS ROUTINE DELETES AN ENTRY FROM THE INDEX TABLE.
;	THIS ROUTINE DOES NOT TRY TO RETURN ANY SPACE TO THE FREE POOL,
;	AND IT DOES NOT DO ANYTHING WITH THE ENTRY BEING DELETED.
;	IT SIMPLY COMPACTS THE TABLE ELIMINATING THE
;	SPECIFIED ENTRY.
;
;CALLING SEQUENCE:
;
;	MOVE T1,CURRENT TABLE ADDRESS
;	MOVE T2,ADDRESS OF ENTRY TO BE DELETED (AS RETURNED BY LOOKUP)
;	CALL TABDEL
;	RETURN HERE ALWAYS

TABDEL:	HLRZ T4,0(T1)		;GET USED COUNT
	SUBI T4,1		;DECREMENT IT
	HRLM T4,0(T1)		;STORE UPDATED COUNT BACK IN TABLE
	ADD T4,T1		;GET POINTER TO NEW LAST WORD
	CAMLE T2,T4		;IS DELETED ENTRY STILL WITHIN TABLE?
	 JRST TDELZ		;NO, THEN BLT IS NOT REQUIRED
	HRLZI T3,1(T2)		;GET BLT SOURCE ADDRESS
	HRR T3,T2		;GET DESTINATION ADDRESS
	BLT T3,(T4)		;SHRINK TABLE BY ONE WORD
TDELZ:	SETZM 1(T4)		;ZERO THE FREED UP WORD AT END OF TABLE
	RET			;AND RETURN TO CALLER
;TABADD:	ADD AN ENTRY INTO THE TABLE
;
;	THE ADDITION ROUTINE CREATES A SLOT IN THE TABLE AT THE DESIRED
;	SPOT BY SHUFFLING THE END OF THE TABLE DOWN ONE WORD.
;	IF THE TABLE DOES NOT HAVE ENOUGH ROOM TO FIT IN AN ADDITIONAL
;	ENTRY, THEN IT GRABS A LARGER CHUNK OF FREE CORE FROM THE
;	JSB AND COPIES THE OLD TABLE INTO THIS NEW AREA. IT THEN
;	RETURNS THE OLD TABLE AREA TO THE FREE CORE POOL.
;
;CALLING SEQUENCE:
;	MOVE T1,CURRENT TABLE ADDRESS
;	MOVE T2,ADDRESS OF NEW ENTRY IN TABLE (AS RETURNED BY LOOKUP)
;	P4 - 0 MEANS JOB WIDE LN,  1 MEANS SYSTEM WIDE LN
;	CALL TABADD
;	 RETURN HERE IF NO MORE FREE CORE IN JSB
;	SUCCESSFUL RETURN WITH T1 CONTAINING NEW TABLE ADDRESS AND
;	 T2 CONTAINING ADDRESS OF NEW ENTRY POSITION


	TABINC==^D16		;INCREMENTAL GROWTH FOR LOGICAL NAME TABLE

TABADD:	PUSH P,P6		;SAVE PERMANENT AC'S
	HRRZ T3,0(T1)		;GET TOTAL SIZE OF THIS TABLE
	HLRZ T4,0(T1)		;GET USED SPACE MINUS ONE
	CAILE T3,1(T4)		;ANY ROOM FOR THIS ENTRY?
	 JRST TADD1		;YES, DONT EXPAND TABLE
	PUSH P,T1		;SAVE TABLE ADDRESS
	PUSH P,T2		;  AND ENTRY LOCATION
	MOVEI T1,TABINC(T3)	;GET THE AMOUNT NEEDED FOR NEW TABLE
	MOVEM T1,P6		;SAVE THIS FOR LATER
	CALL @ASGTAB(P4)	;GO GET MORE ROOM FROM FREE POOL
	 JRST [POP P,T2		;CLEAN UP STACK
		POP P,T1
		POP P,P6
		RET]		;AND TAKE ERROR RETURN
	POP P,T2		;RESTORE ENTRY LOCATION
	HRLZ T3,0(P)		;GET OLD TABLE ADDRESS
	HRR T3,T1		;SET UP A BLT POINTER
	MOVEI T4,-TABINC(P6)	;GET # OF WORDS TO BE COPIED
	ADDI T4,0(T1)		;GET FINAL BLT LOCATION
	BLT T3,(T4)		;COPY TABLE TO ITS NEW HOME
	POP P,T3		;GET BACK OLD TABLE ADDRESS
	SUB T2,T3		;CALCULATE INDEX INTO TABLE FOR NEW ENTRY
	ADD T2,T1		;T2 NOW HAS ABSOLUTE ENTRY POINT IN NEW TABLE
	PUSH P,T1		;SAVE TEMPORARIES AGAIN
	PUSH P,T2		;TABLE ADDRESS AND ENTRY POSITION
	MOVE T1,T3		;OLD TABLE ADDRESS
	CALL RELTMP		;RETURN OLD TABLE TO JSB FREE POOL
	POP P,T2		;RESTORE ENTRY POSITION
	POP P,T1		;AND TABLE ADDRESS
	HRRM P6,0(T1)		;STORE NEW TABLE LENGTH
				;FALL THRU TO TADD1
TADD1:	HLRZ T3,0(T1)		;GET # OF USED WORDS
	AOS T3			;UPDATE # OF WORDS USED
	HRLM T3,0(T1)		;IN FIRST WORD OF TABLE
	ADD T3,T1		;GET START OF AREA TO BE MOVED
TADD2:	CAML T2,T3		;SHUFFLING DONE YET?
	 JRST [POP P,P6		;RESTORE P6
		RETSKP]		;AND TAKE SUCCESSFUL RETURN
	MOVE T4,-1(T3)		;GET WORD TO BE MOVED
	MOVEM T4,(T3)		;SHUFFLE IT DOWN
	SOJA T3,TADD2		;LOOP BACK FOR REST OF THE WORDS
;TABLK - TABLE LOOKUP WITH ABBREVIATION RECOGNITION
;
;CALL:
; T1/ TABLE ADDRESS
; T2/ TEST STRING POINTER
;	CALL TABLK
;RETURN:
; +1 = FAILED,	T1/ ADR OF WHERE ENTRY WOULD BE IF IT WERE IN TABLE
;		T2/ -1 FOR NO MATCH AT ALL
;		 0 FOR AMBIGUOUS
;		 +1 FOR UNIQUE ABREVIATION OF A DEFINED NAME
;		T3/ POINTER TO REMAINDER OF ABREVIATED NAME
; +2 = SUCCESS, T1/ ADDRESS OF TABLE ENTRY WHICH MATCHED

;AC USAGE:
; T1/ TEST STRING FROM CALL
; T2/ STRING FROM TABLE
; T3/ CLOBBERED BY STRCMP
; T4/ " "
; Q1/ CURRENT TABLE INDEX
; Q2/ ADR OF TABLE(Q1)
; Q3/ SIZE OF TABLE
; P3/ INDEX INCREMENT FOR LOG SEARCH

TABLK:	PUSH P,P3		;SAVE PERMANENT ACS
	PUSH P,Q1
	PUSH P,Q2
	PUSH P,Q3
	HRLI T1,Q1+400000		;CONSTRUCT TABADR(Q1+
	AOS Q2,T1		;LEAVE IT HERE
	HLRZ Q1,-1(T1)		;SET INITIAL INDEX TO SIZ/2
	ASH Q1,-1
	HLRZ P3,-1(T1)		;INITIAL INCREMENT IS SIZE
	MOVE Q3,P3		;SAVE SIZE FOR RANGE CHECKS
	PUSH P,T2		;SAVE TEST STRING
	JUMPE Q3,TABLKX		;IF NO ENTRIES IN TABLE, THEN NO MATCH
TABLK0:	HLRZ T2,@Q2		;GET ADR OF STRING FROM TABLE
	HRLI T2,(POINT 7,0,35)	;MAKE BYTE PTR
	MOVE T1,0(P)		;TEST STRING
	CALL STRCMP		;COMPARE STRINGS
	 JRST TABLK1		;NOT EXACTLY EQUAL
TABLKF:	AOS -5(P)		;EXACTLY EQUAL, DOUBLE SKIP RETURN
TABLKM:	TDZA T2,T2		;SET UP FOR AN AMBIGUOUS RETURN
TABLKX:	SETO T2,		;GIVE NO-MATCH CODE IN T2
TABLKA:	MOVEI T1,@Q2		;RETURN TABLE ADDRESS OF ENTRY
	POP P,0(P)
	POP P,Q3		;RESTORE PERMANENT ACS
	POP P,Q2
	POP P,Q1
	POP P,P3
	RET
;STRING MAY HAVE BEEN UNEQUAL OR A SUBSET, SEE WHICH

TABLK1:	JUMPN T1,TABLKN		;UNEQUAL, GO SETUP NEXT PROBE
TABLK3:	JUMPE Q1,TABLK2		;IF NOW AT TOP OF TABLE, CHECK NO HIGHER
	PUSH P,T2		;SAVE POINTER TO REMAINDER OF STRING
	MOVEI T1,@Q2		;CHECK PREVIOUS ENTRY, GET ITS ADDRESS
	HLRZ T2,-1(T1)		;GET STRING ADDRESS
	HRLI T2,(POINT 7,0,35)
	MOVE T1,-1(P)		;GET ORIGINAL STRING AGAIN
	CALL STRCMP		;SEE ABOUT PREVIOUS ENTRY
	 JRST .+2
	SOJA Q1,[POP P,T2	;EXACTLY EQUAL, DONE
		 JRST TABLKF]	;...
	JUMPG T1,TBLK2B		;IF LESS, THEN HAVE FOUND HIGHEST SUBSET
	POP P,0(P)		;POP AWAY UNDESIRED BASE STRING
	SOJA Q1,TABLK3		;STILL A SUBSET, CHECK PREVIOUS

;NOW POINTING AT HIGHEST ENTRY WHICH IS SUBSET.  IF THERE IS AN EXACT
;MATCH, IT IS BEFORE ALL SUBSETS AND HAS ALREADY BEEN FOUND

TABLK2:	PUSH P,T2		;SAVE PTR TO REST OF BASE
TBLK2B:	MOVEI T1,@Q2		;CHECK NEXT ENTRY FOR AMBIGUOUS
	CAIL Q1,-1(Q3)		;IS THIS THE LAST ENTRY ALREADY?
	 JRST [POP P,T3		;YES, THIS ENTRY IS DISTINCT
		JRST TBLK2A]	;GO RETURN +1 IN T2
	HLRZ T2,1(T1)
	HRLI T2,(POINT 7,0,35)
	MOVE T1,-1(P)
	CALL STRCMP
	 JRST .+2
	BUG(ILLTAB)
	POP P,T2
	JUMPE T1,TABLKM		;NEXT ENTRY NOT DISTINCT, GIVE AMBIGUOUS RETURN
	MOVE T3,T2		;GET POINTER TO REST OF BASE STRING
TBLK2A:	MOVEI T2,1		;SET UP FOR ABREIVATION RETURN
	JRST TABLKA		;GIVE NON-SKIP RETURN

;HERE WHEN PROBE NOT EQUAL

TABLKN:	CAIG P3,1		;INCREMENT NOW 1?
	 JRST [JUMPL T1,TABLKX	;YES, NO MATCH FOUND
		AOJA Q1,TABLKX]	;IF STRING GREATER, MAKE ADDR ONE MORE
	ADDI P3,1		;NEXT INC = <INC+1>/2
	ASH P3,-1
	JUMPG T1,[ADD Q1,P3	;IF LAST PROBE LOW, ADD INCREMENT
		JRST TBLKN1]	;GO CHECK BOUNDS
	SUB Q1,P3		;LAST PROBE HIGH, SUBTRACT INCREMENT
TBLKN1:	CAIL Q1,0(Q3)		;OVER THE TOP OF THE TABLE?
	 JRST [SETO T1,		;YES, FAKE PROBE TO HIGH
		JRST TABLKN]	;GO PROBE AGAIN
	JUMPGE Q1,TABLK0	;IF STILL WITHIN TABLE, GO PROBE
	MOVEI T1,1		;BELOW TABLE, FAKE LOW PROBE
	JRST TABLKN
;STRING COMPARE ROUTINE
;CALL:
; T1/ TEST STRING POINTER
; T2/ BASE STRING POINTER
;	CALL STRCMP
;RETURN:
; +1 = NOT EXACT MATCH, T1 GIVES STATUS:
;	-1 = TEST STRING LESS THAN BASE STRING
;	0 = TEST STRING SUBSET OF BASE STRING
;	+1 - TEST STRING GREATER THAN BASE STRING
; +2 = EXACT MATCH

STRCMP:: ILDB T3,T1		;GET NEXT CHAR FROM EACH STRING
	ILDB T4,T2
	CAME T3,T4		;STILL EQUAL?
	JRST STRC2		;NO, GO SEE WHY
	JUMPN T3,STRCMP		;KEEP GOING IF NOT END OF STRING
	RETSKP 			;STRINGS ENDED TOGETHER, EXACT MATCH
	RET

STRC2:	JUMPE T3,[SETZ T1,	;TEST STRING ENDED, IS A SUBSET
		ADD T2,[70000,,0] ;DECREMENT BYTE POINTER BY ONE BYTE
		RET]
	CAMG T3,T4		;STRINGS UNEQUAL
	SKIPA T1,[-1]		;TEST STRING LESS, RETURN -1
	MOVEI T1,1		;TEST STRING GREATER, RETURN +1
	RET

;ROUTINE TO COPY ONE STRING TO ANOTHER
;ASSUMES BOTH STRINGS ARE STANDARD TYPE STRINGS WITH FIRST WORD
;   CONTAINING  -1,,N   WHERE N = # OF WORDS IN STRING
;ACCEPTS IN T1/	SOURCE STRING POINTER
;	    T2/	DESTINATION STRING POINTER
;	CALL CPYSTR
;RETURNS +1:	ALWAYS

CPYSTR:	HRRZ T3,0(T1)		;GET LENGTH OF SOURCE STRING
	SOJLE T3,R		;IF NO WORDS IN STRING, RETURN
CPYST1:	MOVE T4,1(T1)		;GET A WORD OF TEXT FROM SOURCE
	MOVEM T4,1(T2)		;STORE IN DESTNATION
	AOS T1
	AOS T2			;STEP TO NEXT WORD IN STRING
	SOJG T3,CPYST1		;LOOP BACK TILL ALL WORDS COPIED
	RET			;THEN RETURN

	TNXEND
	END