Google
 

Trailing-Edge - PDP-10 Archives - BB-M081Z-SM - monitor-sources/futili.mac
There are 49 other files named futili.mac in the archive. Click here to see a list.
; Edit= 8994 to FUTILI.MAC on 2-Nov-88 by LOMARTIRE
;Merge Production changes to BUG text
; Edit= 8937 to FUTILI.MAC on 23-Aug-88 by LOMARTIRE
;Spell MONITR correctly in ACTION field of BUGs!
; Edit= 8915 to FUTILI.MAC on 18-Aug-88 by LOMARTIRE
;Improve BUG. documentation
; UPD ID= 8521, RIP:<7.MONITOR>FUTILI.MAC.6,   9-Feb-88 15:36:36 by GSCOTT
;TCO 7.1218 - Update copyright date.
; UPD ID= 245, RIP:<7.MONITOR>FUTILI.MAC.5,   4-Nov-87 16:40:26 by MCCOLLUM
;TCO 7.1112 - Fix up CNVDIR and CHKMNT to use LGSIDX
; UPD ID= 176, RIP:<7.MONITOR>FUTILI.MAC.4,  21-Oct-87 08:34:53 by RASPUZZI
;TCO 7.1076 - Make CPYTU6 global for CLUDGR
; UPD ID= 46, RIP:<7.MONITOR>FUTILI.MAC.3,  18-Jul-87 09:50:17 by RASPUZZI
;TCO 7.1023 - Remove edit 7411 until a better solution is found. That
;edit broke DLUSER among other things.
; *** Edit 7411 to FUTILI.MAC by RASPUZZI on 23-Jan-87, for SPR #21306
; Prevent possible ILMNRFs by making CPYUS1 copy the correct amount of bytes 
; UPD ID= 2078, SNARK:<6.1.MONITOR>FUTILI.MAC.21,   3-Jun-85 14:37:33 by MCCOLLUM
;TCO 6.1.1406  - Update copyright notice.
; UPD ID= 1953, SNARK:<6.1.MONITOR>FUTILI.MAC.20,   9-May-85 18:22:41 by MCCOLLUM
;TCO 6.1.1238 - Fix more BUG. documentation
; UPD ID= 1880, SNARK:<6.1.MONITOR>FUTILI.MAC.19,   4-May-85 12:52:45 by MCCOLLUM
;TCO 6.1.1238 - Fix more BUG. documentation
; UPD ID= 1826, SNARK:<6.1.MONITOR>FUTILI.MAC.18,  25-Apr-85 16:32:28 by MCCOLLUM
;TCO 6.1.1238 - Fix BUG. documentation
; UPD ID= 4808, SNARK:<6.MONITOR>FUTILI.MAC.17,  17-Sep-84 10:01:04 by PURRETTA
;Update copyright notice
; UPD ID= 4335, SNARK:<6.MONITOR>FUTILI.MAC.16,  13-Jun-84 21:42:06 by MOSER
;TCO 6.2037 - FIX LOKK AND UNLOKK
; UPD ID= 4048, SNARK:<6.MONITOR>FUTILI.MAC.15,   5-Apr-84 08:32:20 by PAETZOLD
;TCO 6.2022 - Remove call to MSTKOV as we now have global stack pointers.
; UPD ID= 4017, SNARK:<6.MONITOR>FUTILI.MAC.14,  31-Mar-84 16:15:22 by PAETZOLD
;TCO 6.2019 - Use ADJSPs
; UPD ID= 3798, SNARK:<6.MONITOR>FUTILI.MAC.13,  29-Feb-84 01:42:25 by TGRADY
;Implement Global Job Numbers
; In CKJBNO/CKJBLI, argument is a local job index, so make sure the comments
; say so.
; UPD ID= 1261, SNARK:<6.MONITOR>FUTILI.MAC.12,  30-Sep-82 18:26:08 by LEACHE
;TCO 6.1292 Protect against ILLIND BUGHLTS
; UPD ID= 892, SNARK:<6.MONITOR>FUTILI.MAC.11,   9-Jun-82 22:56:32 by MURPHY
;TCO 6.1147 - Move bugdefs from BUGS.MAC to here and put them in-line.
; UPD ID= 139, SNARK:<6.MONITOR>FUTILI.MAC.10,  19-Oct-81 15:58:08 by COBB
;TCO 6.1029 - CHANGE SE1CAL TO EA.ENT
; UPD ID= 166, SNARK:<5.MONITOR>FUTILI.MAC.9,  10-Sep-81 14:46:02 by PAETZOLD
;TCO 5.1481 - Put checks for illegal OWGBP's in CNVSTD
; UPD ID= 1373, SNARK:<5.MONITOR>FUTILI.MAC.8,  22-Dec-80 09:58:58 by ENGEL
;FIX ASSEMBLY BUG
;<5.MONITOR>FUTILI.MAC.7, 10-Dec-80 09:35:49, EDIT BY ENGEL
;FIX RELLOK BUG
; UPD ID= 1085, SNARK:<5.MONITOR>FUTILI.MAC.6,   1-Oct-80 12:01:21 by MURPHY
;FIX ACVAR
; UPD ID= 947, SNARK:<5.MONITOR>FUTILI.MAC.5,  21-Aug-80 18:32:08 by ENGEL
;CHANGE RELODR TO RELORD BECAUSE OF A BUG IN BUGDEF
; UPD ID= 936, SNARK:<5.MONITOR>FUTILI.MAC.3,  20-Aug-80 15:16:05 by ENGEL
;TCO #5.1136 - CHANGE ALL LOCKS TO CONFORM TO THE NEW LOCK SCHEME
; UPD ID= 660, SNARK:<5.MONITOR>FUTILI.MAC.2,  16-Jun-80 17:23:13 by KONEN
;TCO 5.1063 - ADD PUTNAM TO INSERT SYSTEM STRUCTURE NAME INTO A STRING

;	COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1976, 1988.
;	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 THAT IS NOT SUPPLIED BY DIGITAL.
	SEARCH PROLOG
	TTITLE FUTILITY
	SWAPCD



;NO SPECIAL AC DEFINITIONS USED HEREIN

; Save ac's before monitor call

SAVAC::
	ADJSP P,NSAC-1		; Make room for nsac ac's
	PUSH P,-<NSAC-1>(P)	; Move return to end
	MOVEM NSAC-1,-1(P)	; Save last ac
	MOVEI NSAC-1,-NSAC(P)	; Make blt pointer
	BLT NSAC-1,-2(P)	; Blt onto stack
	RET

RESAC::
	MOVSI NSAC-1,-NSAC(P)	; Blt from stack to 0
	BLT NSAC-1,NSAC-1
	POP P,-NSAC(P)		; Move return to new top
	ADJSP P,-<NSAC-1>	; Flush the room on the stack
	RET
;ROUTINE TO ACCEPT YES/NO ANSWER FROM USER.  REQUIRES USER TO
;TYPE Y OR N.  RETURNS "TRUE" ON Y, "FALSE" ON N IN A.

YESNO::	STKVAR <<YESNOL,2>,YESAB,YESAC>
	EA.ENT
	MOVEM B,YESAB		;PRESERVE ALL ACS
	MOVEM C,YESAC
YESN2:	HRROI A,YESNOL		;POINT TO STACK BUFFER
	MOVE B,[RD%BEL+^D10]
	MOVEI C,0		;NO ^R BUFFER
	RDTTY			;READ A LINE
	 JRST YESN1		;SHOULDN'T HAPPEN
	TXNN B,RD%BTM		;LINE TERMINATED WITH BREAK CHAR?
	JRST YESN1		;NO, OBJECT
	MOVE B,YESAB		;RESTORE AC'S
	MOVE C,YESAC
	LDB A,[POINT 7,YESNOL,6] ;GET FIRST CHAR OF LINE
	CAIL A,"A"+40		;LOWER CASE?
	CAILE A,"Z"+40
	SKIPA			;NO
	SUBI A,40		;YES, CONVERT
	CAIN A,"Y"		;GOT A "Y"?
	JRST RTRUE		;YES, RETURN TRUE
	CAIN A,"N"		;GOT A "N"?
	JRST RFALSE		;YES, RETURN FALSE
YESN1:	HRROI A,[ASCIZ / (Y OR N) /]
	PSOUT			;PROMPT USER
	JRST YESN2		;TRY AGAIN
;COPY STRING FROM USER TO JSB.  ASSIGN SPACE AND TRIM BLOCK AFTER COPY.
;ACCEPTS:
;	A/ STRING PTR TO USER'S ADDRESS SPACE
;	CALL CPYFU0
; RETURN +1: NO ROOM
; RETURN +2: SUCCESS, NOINT
;		A/ LOOKUP PTR TO JSB FREE SPACE
;		B/ UPDATED STRING PTR IN JSB FREE SPACE
;		C/ UPDATED STRING POINTER IN USER ADDRESS SPACE

CPYFU0::SETZB D,B		;DO TRMBLK AFTER COPY, USE DEFAULT BLOCK SIZE
	EA.ENT
	JRST CPYUS4

;COPY STRING FROM USER TO JSB.  ASSIGN SPACE BUT DONOT TRIM BLOCK.
; A/ STRING PTR TO USER'S ADDRESS SPACE
; B/ LENGTH OF BLOCK IN WORDS IF CALLING CPYUSR
;	CALL CPYFUS (OR CPYUSR IF SUPPLYING LENGTH)
; RETURN +1: NO ROOM
; RETURN +2: SUCCESS, NOINT
;		A/ LOOKUP PTR TO JSB FREE SPACE
;		B/ UPDATED STRING PTR IN JSB FREE SPACE
;		C/ UPDATED STRING POINTER IN USER SPACE

CPYFUS::SETZM B			;USE DEFAULT BLOCK SIZE
CPYUSR::SETO D,			;SAY NO TRMBLK

	EA.ENT
CPYUS4:	STKVAR<CPYFLG,CPYPTR>
	MOVEM D,CPYFLG		;SAVE FLAG FOR TRIMMING BLOCK
	HLRZ C,A		;GET LH OF BYTE POINTER
	CAIN C,-1		;IS BP -1,,ADDR?
	HRLI A,(<POINT 7,0>)	;YES. GET REASONABLE LH
	TXZ A,1B12		;MAKE SURE IT IS SINGLE WORD BYTE POINTER
	XCTBU [	LDB C,A]	;TEST THE BYTE POINTER FOR AN INDIRECT LOOP
	MOVEM A,CPYPTR		;SAVE USER'S STRING POINTER
	SKIPN B			;BLOCK SIZE SUPPLIED ?
	MOVEI B,MAXLW		;NO, USE DEFUALT SIZE
	ADDI B,1		;ALLOW FOR BLOCK HEADER
	NOINT
	CALL ASGJFR		;ASSIGN JSB SPACE. RETURNS ADDRESS OF
				; BLOCK IN AC 1
	 JRST [	MOVE A,CPYPTR	;FAILED. RESTORE USER'S POINTER
		RET]		;TAKE ERROR RETURN
	MOVE B,CPYPTR		;B/POINTER TO USER SPACE
	HRRZ C,A
	HRRZ C,(C)		;GET SIZE OF THIS BLOCK FROM HEADER
	IMULI C,5		;GET # OF CHARACTERS IN BLOCK
	SUBI C,6		;ALLOW FOR NULL; SUBTRACT # OF CHARS IN HEADER
				; 5*(SIZE-1) - 1
	MOVE D,CPYFLG		;RESTORE FLAG FOR TRIMMING BLOCK
	JRST CPYFU6		;GO DO THE COPY
;COPY STRING FROM USER TO SPACE ALREADY ASSIGNED
; A/ LOC-1, STRING WILL GET WRITTEN TO LOC
; B/ USER PTR
;	CALL CPYFU1
; RETURN +2: ALWAYS, STRING COPIED AND BLOCK NOT TRIMMED
;		A/ -(NWORDS-1) ,, ORG (LOOKUP POINTER)
;		B/ BYTE POINTER TO END OF STRING (BEFORE NULL)
;		C/ UPDATED USER POINTER

;THE BLOCK THAT IS PROVIDED MUST HAVE ROOM FOR MAXLC CHARACTERS PLUS A
;WORD (NORMALLY THE HEADER)

CPYFU1::SETO D,			;SAY NO TRMBLK
	EA.ENT
	MOVEI C,MAXLC		;USE DEFAULT NUMBER OF CHARACTERS
	JRST CPYFU6		;GO DO THE COPY


;COPY STRING FROM USERS TO SPACE ALREADY ASSIGNED.  LIKE CPYFU1 BUT
;THE LENGTH IS PROVIDED BY THE CALLER
; A/ LOC-1, STRING WILL GET WRITTEN TO LOC
; B/ USER PTR
; C/ LENGTH OF STRING
;	CALL CPYFU2
; RETURN +2: ALWAYS, STRING COPIED AND BLOCK NOT TRIMMED
;		A/ -(NWORDS-1) ,, ORG (LOOKUP POINTER)
;		B/ BYTE POINTER TO END OF STRING (BEFORE NULL)
;		C/ UPDATED POINTER TO USER'S ADDRESS SPACE

;THE BLOCK THAT IS PROVIDED MUST HAVE ROOM FOR THE CHARACTERS PLUS A
;WORD (NORMALLY THE HEADER)

CPYFU2::SETO D,			;SAY NO TRMBLK
	EA.ENT
	JRST CPYFU6		;GO DO THE COPY
;CPYFU6 - COMMON CODE FOR CPYUSR, CPYFUS, CPYFU1, CPYFU0

;A/LOCATION OF FREE SPACE
;B/USER'S STRING POINTER
;C/NUMBER CHARACTERS THAT FREE SPACE CAN HOLD
;D/0 IF WANT TO TRIM BLOCK AFTER COPY, -1 IF NOT

CPYFU6::STKVAR<CPYFLG,CPYBLK,CPYUPT,CPYLPT> ;[7.1076]
	MOVEM D,CPYFLG		;SAVE TRMBLK FLAG
	MOVEM A,CPYBLK		;SAVE LOCATION OF FREE SPACE BLOCK
	EXCH A,B		;A/USER'S STRING POINTER, B/ADDRESS OF JSB FREE SPACE
	HRLI B,(<POINT 7,0,35>)	;POINT TO FIRST WORD AFTER HEADER
	JUMPGE A,CPYUS1		;IF USER SPECIFIED (-1,,ADDRESS)
	CAML A,[777777000000]	; CONVERT IT TO BYTE POINTER FOR ILDB
	HRLI A,(<POINT 7,0>)

CPYUS1:	TXZ A,1B12		;DISALLOW DOUBLE WORD BYTE POINTER
	XCTBU [ILDB D,A]	;GET THE NEXT CHARACTER FROM USER SPACE
	SOSGE C			;[7.1023] Out of space in JSB block?
	MOVEI D,0		;YES. OVERWRITE LAST CHARACTER WITH NULL
	JUMPE D,CPYUS2		;FOUND A NULL OR OUT OF SPACE?
	CAIN D,"V"-100		;quote character?
	JRST [	XCTBU [ILDB D,A];yes, get next char
		JRST CPYUS9]	;and don't uppercase
	CAIL D,"A"+40		;NO. LOWER CASE?
	CAILE D,"Z"+40
	SKIPA			;NO
	TRZ D,40		;YES, RAISE
CPYUS9:	IDPB D,B		;STORE IN FREE SPACE BLOCK
	JRST CPYUS1		;GO GET NEXT CHARACTER

;AT END OF STRING.  APPEND A NULL AND BACKUP THE LOCAL COPY OF THE USER'S BYTE
;POINTER TO POINT TO THE LAST CHARACTER

CPYUS2:	MOVNI C,1		;AMOUNT TO ADJUST BYTE POINTER
	ADJBP C,A		;BACKUP THE USER'S BYTE POINTER TO POINT TO
				; LAST CHARACTER
	MOVEM C,CPYUPT		;SAVE THE ADJUSTED POINTER
	MOVE A,CPYBLK		;RECOVER ORG OF BLOCK
	MOVEM B,CPYLPT		;SAVE END STRING PTR
	IDPB D,B		;APPEND NULL TO STRING
	SKIPE CPYFLG		;WANT TO TRIM BLOCK?
	JRST [	SUBM A,B	;NO. COMPUTE -NWORDS
		HRLI A,1(B)	;MAKE LOOKUP PTR: -(NWORDS-1),,ORG
		JRST CPYUS3]
	CALL TRMBLK		;YES. A/ADDRESS OF BLOCK, B/LAST WORD USED
				;TRIM BLOCK, RETURN EXCESS TO FREE LIST
	HRRZ A,CPYBLK		;RECOVER ORG
	MOVN B,0(A)		;GET NEG LENGTH OF BLOCK
	HRLI A,2(B)		;NWORDS-1 = BLOCKLENGTH-2
CPYUS3:	MOVE C,CPYUPT		;RECOVER USER'S UPDATED BYTE POINTER
	MOVE B,CPYLPT		;RECOVER PTR TO END OF STRING IN JSB
	RETSKP
; Copy string to user
; Call:	A	; User pointer
;	B	; LOC-1, where LOC is the address of the string in monitor space
;	CALL CPYTUS
;	UPDATED POINTER ALWAYS WRITTEN TO USER'S AC2.  USE CPYTU1 FOR
;	WRITING UPDATED POINTER TO SOMEWHERE ELSE

CPYTUS::MOVEI C,2	;RETURN UPDATED POINTER IN USER'S AC2
	CALLRET CPYTU1	;DO THE WORK AND RETURN

; Copy string to user
; Call:	A	; User pointer
;	B	; LOC-1, where LOC is the address of the string in monitor space
;	C	;USER ADDRESS INTO WHICH TO WRITE UPDATED POINTER
;	CALL CPYTU1

CPYTU1::EA.ENT
	ACVAR <W1>		;RESERVE A WORK REGISTER
	JUMPGE A,STDIR0
	CAML A,[777777000000]
	HRLI A,(<POINT 7,0>)
STDIR0:	TXZ A,1B12		;MAKE SURE NOT A DOUBLE WORD BYTE POINTER
	MOVE W1,[POINT 7,0(B),35] ;GET A BYTE POINTER TO SOURCE
STDIR2:	ILDB D,W1
	JUMPE D,STDIR3
	XCTBU [IDPB D,A]
	JRST STDIR2

STDIR3:	UMOVEM A,(C)
	XCTBU [IDPB D,A]
	RET

	ENDAV.			;END ACVAR
; ROUTINE TO FORM A FILESPEC OF THE FORM STR:FILE-SPEC
;
; CALL: ACCEPTS IN T1/ DESTINATION POINTER
;		   T2/ STRUCTURE NUMBER
;		   T3/ POINTER TO FILENAME
;		CALL STRST
; RETURNS: +1	 ERROR
;	   +2	SUCCESS

STRST::	EA.ENT
	ASUBR <DSTPNT,STRNM,FPNTR>
	MOVE T1,STRNM		;COPY STRUCTURE #
	CALL STRCNV		;CONVERT TO UNIQUE CODE
	 RET			;ERROR
	MOVE T2,T1		;RETURNS IN T1
	HRLI T2,.DVDES+.DVDSK	;FORM DEVICE DESIGNATOR
	MOVE T1,DSTPNT		;GET POINTER
	DEVST			;TRANSLATE STR NUMBER TO STRING
	 RET			;RETURN, ERROR
	MOVEI T4,":"		;GET DEVICE PUNCTUATION
	IDPB T4,T1		;TERMINATE STRUCTURE NAME
	MOVE T2,FPNTR		;GET POINTER TO FILESPEC
	SETZM T3		;TERMINATE ON NULL
	SOUT			;COPY REMAINDER OF FILENAME
	 ERJMP R		;IF ERROR, JUST RETURN
	RETSKP			;RETURN
;GTCSCD, GTOJCD, - ROUTINES TO GET CONNECTED STRUCTURE AND DIRECTORY

;ACCEPTS: IF CALLING GTCSCD, NONE
;	 IF CALLING GTOJCD,
;		T1/OFFSET TO USE IN ADDRESSING OTHER JOB'S JSB

;RETURNS +1: ALWAYS
;		T1/STRUCTURE UNIQUE CODE,,DIRECTORY NUMBER

;GTCSCD HANDLES THE CASE WHERE THE JOB IS ASKING ABOUT ITSELF.
;IT ASSUMES THE JSB IS MAPPED AT THE USUAL PLACE
;GTOJCD HANDLES THE CASE WHERE THE JOB IS ASKING ABOUT ANOTHER
;JOB.  THE JSB MUST BE MAPPED, AND T1 MUST CONTAIN THE DIFFERENCE BETWEEN
;WHERE THE JSB IS USUALLY MAPPED AND WHERE THE OTHER JOB'S JSB IS MAPPED.
;THIS VALUE IS RETURNED BY SETJSB

GTCSCD::SETZ T1,		;THIS JOB. JSB IS MAPPED IN USUAL PLACE
GTOJCD::LOAD T2,JSUC,(T1) 	;GET UNIQUE CODE FOR CONNECTED STRUCTURE
	LOAD T1,JSDIR,(T1)	;GET CONNECTED DIRECTORY NUMBER
	HRL T1,T2		;GET STRUCTURE CODE
	RET
;CNVSTR - CONVERT STRUCTURE UNIQUE CODE TO STRUCTURE NUMBER (OFFSET
;IN STRTAB)

;ACCEPTS:
;	T1/STRUCTURE UNIQUE CODE IN RH

;RETURNS +1: STRUCTURE DOES NOT EXIST IN SDB
;	 +2: STRUCTURE EXISTS, NOINT
;		T1/STRUCTURE NUMBER

;NOTE: THIS LEAVES THE STRUCTURE LOCKED.  ALWAYS CALL ULKSTR TO UNLOCK IT

CNVSTR::LDB T2,[POINT STRNS,T1,35] ;GET THE STR NUMBER 
	NOSKED			;AVOIDS PAGE FAULT WHILE NOSKED
	CAIGE T2,STRN		;IS IT A LEGAL STR NUMBER?
	SKIPN T3,STRTAB(T2)	;GET ADDRESS OF SDB FOR THIS STRUCTURE
	RETBAD (STRX01,<OKSKED>) ;UNKNOWN STRUCTURE UNIQUE CODE
	LOAD T4,STRUC,(T3)	;GET STRUCTURE UNIQUE CODE
	CAME T1,T4		;IS IT THE ONE WE WANT?
	RETBAD (STRX01,<OKSKED>) ;UNKNOWN STRUCTURE UNIQUE CODE
	INCR STRLK,(T3)		;INDICATE STRUCTURE LOCKED
	NOINT
	OKSKED
	HRRZ T1,T2		;RETURN OFFSET IN STRTAB AS STRUCTURE NUMBER
	RETSKP

;ULKSTR - UNDO THE LOCKING DONE BY CNVSTR

;ACCEPTS:
;	T1/STRUCTURE NUMBER (OFFSET IN STRTAB)

;RETURNS +1:ALWAYS	CLOBBERS ONLY AC T1

ULKSTR::
	CALL ULKST1		;UNLOCK IT
	OKINT
	RET

;ROUTINE TO UNLOCK STR WITHOUT DOING AN OKINT

	RESCD			;MAKE IT NON-INTERRUPTABLE

ULKST1::
	CSKED			;CRITICAL REGION
	MOVE T1,STRTAB(T1)	;ADDRESS OF SDB FOR THIS STRUCTURE
	JE STRLK,(T1),[BUG.(CHK,ULKSTZ,FUTILI,SOFT,<Overly decremented structure lock>,,<

Cause:	ULKST1 was called to unlock a structure but the lock count was
	already zero.

Action:	If this BUG persists, make it dumpable and submit an SPR with the
	dump and a copy of MONITR.EXE.  If possible, include any known
	method for reproducing the problem and/or the state of the system
	at the time the BUG was observed.
>)
		JRST ULKST2]
	DECR STRLK,(T1)		;DECREMENT LOCK COUNT
ULKST2:	ECSKED			;NO LONGER CRITICAL
	RET
	SWAPCD			;RETURN TO SWAPPABLE CODE
;STRCNV - ROUTINE TO CONVERT A STRUCTURE NUMBER TO A UNIQUE CODE
;
; ACCEPTS IN T1/ STRUCTURE NUMBER
;		CALL STRCNV
; RETURNS: +1	 FAILED, ERROR CODE IN T1
;	   +2	SUCCESS,
;		T1/ UNIQUE CODE

;NOTE: INPUT TO THIS ROUTINE IS OFTEN THE RIGHT HALF OF A DEVICE DESIGNATOR.
;SINCE (600000,,-1) IS A LEGAL DESIGNATOR RESULTING FROM A LOOKUP OF THE
;DEVICE 'DSK', THIS ROUTINE CONVERTS IT TO THE USER'S CONNECTED STRUCTURE.

;IMPORTANT! THE STRUCTURE LOCK SHOULD BE LOCKED WHEN THIS ROUTINE IS
;CALLED

STRCNV::CAIE T1,-1		;WAS 'DSK' SPECIFIED?
	JRST STRCN1		;NO. MUST BE A REAL STRUCTURE NUMBER
	CALL GTCSCD		;YES. GET THIS USER'S CONNECTED STRUCTURE,,DIRECTORY
	HLRZS T1		;GET STRUCTURE ONLY
	RETSKP			;RETURN SUCCESSFULLY
STRCN1:	SKIPN T1,STRTAB(T1)	;GET ADDRESS OF STRUCTURE DATA BLOCK
	RETBAD (STRX01)		;RETURN "NO SUCH STRUCTURE"
	LOAD T1,STRUC,(T1)	;GET UNIQUE CODE FOR THIS STRUCTURE
	RETSKP			;RETURN SUCCESS


;CNVDIR -ROUTINE TO CONVERT A USER NUMBER TO ITS LOGGED-IN DIRECTORY NUMBER
;ACCEPTS IN T1/	USER NUMBER
;	CALL CNVDIR
;RETURNS +1:	ALWAYS - DIRECTORY NUMBER IN T1

;IT IS NOT NECESSARY TO HAVE THE STRUCTURE LOCKED WHEN CALLING THIS
;ROUTINE.  HOWEVER, IF THE UNIQUE CODE THAT THIS RETURNS IS TO BE CONVERTED
;TO A STRUCTURE NUMBER, THE LOCK MUST BE LOCKED AT THAT TIME

CNVDIR::HLRZ T2,T1		;GET CODE
	CAIE T2,USRLH		;IS THIS A USER NUMBER?
	RET			;NO, ASSUME IT IS A DIR NUMBER ALREADY
	MOVE T2,LGSIDX		;[7.1112]Get Login Structure number
	MOVE T2,STRTAB(T2)	;[7.1112]Get pointer to SDB
	LOAD T2,STRUC,(T2)	;GET UNIQUE CODE
	HRL T1,T2		;SET UP THE DIRECTORY NUMBER
	RET			;AND RETURN
;GTSTOF - GET STRUCTURE OFFSET IN THIS JOB'S JSB
;GTSTOJ - GET STRUCTURE OFFSET IN A JOB'S JSB

;ACCEPTS:
;	T1/STRUCTURE UNIQUE CODE
;	T2/OFFSET TO MAPPED JSB RETURNED BY SETJSB (IF CALLING GTSTOJ)

;	CALL GTSTOF/GTSTOJ

;RETURNS +1: NO ENTRY FOUND FOR STRUCTURE AND NO SLOT FREE
;	 +2: ENTRY FOUND FOR STRUCTURE OR CREATED
;		T2/ ADDRESS OF WORD 0 IN BLOCK FOR THIS STRUCTURE
;		T1,T3,T4 ARE PRESERVED

;THE JSB CONTAINS 3-WORD GROUPS THAT DESCRIBE A STRUCTURE.  THIS
;ROUTINE FINDS THE GROUP FOR A GIVEN STRUCTURE AND RETURNS THE ADDRESS
;OF THE 0TH WORD. IF THERE IS NO GROUP FOR THE STRUCTURE BUT THERE IS ROOM
;FOR A NEW ENTRY, IT CREATES THE NEW ENTRY, STORING THE STRUCTURE
;UNIQUE CODE AND ZEROING THE REMAINING FIELDS. THE DEFSTRS IN PROLOG
;CONTAIN OFFSETS FROM THIS WORD (0,1,AND 2).

; NOTE: JSB STRUCTURE INFO LOCK (JSSTLK) MUST BE LOCKED BY CALLER !

GTSTOF::
	MOVEI T2,0		;ASSUME JSB MAPPED IN NORMAL PLACE
GTSTOJ::
	STKVAR<<GTSTAC,2>,STRN01,GTSTT2>
	MOVEM T2,GTSTT2		;SAVE JSB OFFSET
	CAIE T1,-1		;UNIQUE CODE FOR DSK: SPECIFIED ?
	JRST GTSTF1		;NO, GO SAVE UNIQUE CODE
	MOVE T1,GTSTT2		;GET JSB OFFSET
	CALL GTOJCD		;YES, GET UNIQUE CODE FOR CONNECTED STR
	HLRZ T1,T1		;KEEP JUST THE UNIQUE CODE
GTSTF1:	MOVEM T1,STRN01		;SAVE STRUCTURE UNIQUE CODE
	DMOVEM T3,GTSTAC	;SAVE AC'S 3 AND 4 TO RETURN
	MOVE T2,GTSTT2		;GET JSB OFFSET AGAIN
	CALL FNDSTM		;FIND THE SLOT FOR THIS STRUCTURE OR THE
				; FIRST FREE SLOT
	 JRST [	CAIN T1,STRX02	;FAILED. INSUFFICIENT RESOURCES?
		RETBAD		;YES. NO ROOM FOR A NEW ENTRY
		MOVE T1,STRN01	;GET STRUCTURE UNIQUE CODE
		STOR T1,JSSTN,(T2) ;FOUND FREE SLOT. STORE STRUCTURE CODE
		MOVEM T2,GTSTT2	;SAVE OFFSET TO JSB
		OPSTR <SKIPE T1,>,JSGRP,(T2) ;DOES THE SLOT POINT TO GROUPS?
		CALL RELGRP	;YES. RELEASE THE SPACE HOLDING THE GROUPS
		MOVE T2,GTSTT2	;RESTORE OFFSET
		SETZRO <JSMCI,JSSDM,JSGRP,JSADN>,(T2) ;INITIALIZE REMAINING FIELDS
		JRST .+1]
	DMOVE T3,GTSTAC		;RESTORE AC'S 3 AND 4
	RETSKP
;FNDSTO - FIND STRUCTURE OFFSET IN THIS JOB'S JSB
;FNDSTM - FIND STRUCTURE OFFSET IN A JOB'S JSB
;
;ACCEPTS IN T1/	STRUCTURE UNIQUE CODE
;	    T2/ OFFSET TO MAPPED JSB RETURNED BY SETJSB (IF CALLING FNDSTM)
;		CALL FNDSTO/FNDSTM
;RETURNS: +1: FAILED,
;		IF STRUCTURE NOT FOUND BUT THERE IS A FREE SLOT,
;			T1/STRX01
;			T2/LOCATION OF FIRST FREE SLOT
;		IF STRUCTURE NOT FOUND AND THERE IS NO FREE SLOT,
;			T1/STRX02
;	  +2: SUCCESS,
;		T1/UNCHANGED
;		T2/ADDRESS OF FIRST WORD IN BLOCK FOR THIS STRUCTURE

; NOTE: JSB STRUCTURE INFO LOCK (JSSTLK) MUST BE LOCKED BY CALLER !

FNDSTO::MOVEI T2,0		;ASSUME JSB MAPPED IN NORMAL PLACE
FNDSTM::MOVEI T2,JSSTRT(T2)	;POINT TO FIRST BLOCK OF STRUCTURE INFO
	LDB T3,[POINT STRNS,T1,35] ;GET STRUCTURE NUMBER
	CAIL T3,STRN		;IS IT A LEGAL STRUCTURE
	RETBAD (STRX01)		;NO, NO SUCH STRUCTURE
	IMULI T3,JSSTMX		;FORM INDEX TO CORRECT STRUCTURE BLOCK
	ADD T2,T3
	LOAD T3,JSSTN,(T2)	;GET STRUCTURE UNIQUE CODE FOR THIS BLOCK
	CAMN T3,T1		;FOUND DESIRED BLOCK ?
	RETSKP			;YES.  RETURN WITH ADDRESS IN T2
	CAIE T3,JSFRST		;NO. IS THIS SLOT FREE?
	JRST [	JE JSSDM,(T2),FNDST2 ;NO. HAS THE STRUCTURE BEEN DISMOUNTED?
		JRST .+1]	;YES. SLOT IS AVAILABLE
	RETBAD (STRX01)		;RETURN 'NO SUCH STRUCTURE'
FNDST2:	RETBAD (STRX02)		;RETURN 'INSUFFICIENT RESOURCES'
;FRJSST AND FRJSSO - FREE JSB STRUCTURE INFORMATION

;ACCEPTS: IF CALLING FRJSST,
;		T1/ STRUCTURE UNIQUE CODE
;	  IF CALLING FRJSSO,
;		T1/STRUCTURE UNIQUE CODE
;		T2/OFFSET TO MAPPED JSB AS RETURNED BY SETJSB

;RETURNS +1: ALWAYS

;THIS ROUTINE CHECKS TO SEE IF THE SLOT IN THE JSB FOR THE GIVEN
;STRUCTURE IS NEEDED.  IF NOT, IT SETS THE STRUCTURE NUMBER TO -1
;THUS MAKING THE SLOT AVAILABLE

FRJSST::SETZ T2,		;FOR THIS JOB, OFFSET IS ZERO
FRJSSO::CAIE T1,-1		;WAS UNIQUE CODE FOR DSK: ?
	JRST FRJS10		;NO, USE UNIQUE CODE SUPPLIED
	LOAD T1,JSUC,(T2)	;YES, GET UNIQUE CODE FOR CONNECTED STR
FRJS10:	CALL FNDSTO		;GET ADDRESS OF STRUCTURE DATA IN JSB
	 RET			;NO SLOT FOR THIS STRUCTURE
	OPSTR <SKIPE>,JSMCI,(T2) ;IS THE MOUNT COUNT INCREMENTED
	 RET			;YES. CAN'T CLEAR IT THEN
	OPSTR <SKIPE>,JSADN,(T2) ;IS A DIRECTORY ACCESSED?
	 RET			;YES. CAN'T CLEAR IT THEN
	OPSTR <SKIPE>,JSGRP,(T2) ;ARE THERE ANY GROUPS?
	 RET			;YES. CAN'T CLEAR IT THEN
	OPSTR <SKIPE>,JSFMT,(T2) ;HAVE ANY FORKS MOUNTED IT?
	 RET			;YES, DON'T CLEAR IT.

;USER HAS NEITHER ACCESSED STRUCTURE NOR INCREMENTED ITS COUNT.
;FREE THE SLOT

	MOVX T3,JSFRST		;SET UP TO INDICATE FREE
	STOR T3,JSSTN,(T2)	;RESET STRUCTURE UNIQUE CODE TO -1
	RET
;CNVSTD - CONVERT STRUCTURE DESIGNATOR TO STRUCTURE UNIQUE CODE,,DIRECTORY

;ACCEPTS:
;	T1/(STRUCTURE UNIQUE CODE,,DIRECTORY)
;		OR
;	   POINTER TO STRING IN USER'S SPACE

;	CALL CNVSTD (OR CNVSTU IF USER STRING IS SUPPLIED)

;RETURNS +1: NO SPACE IN JSB OR RCDIR FAILURE
;	 +2: SUCCESS,
;		T1/(STRUCTURE UNIQUE CODE,,DIRECTORY)

;THIS ROUTINE IS CALED WHEN A JSYS CALL MAY HAVE EITHER A 
;(STRUCTURE UNIQUE CODE,,DIRECTORY NUMBER) OR A POINTER TO A STRING OF THE
;FORM STR:<DIR>.  IT RETURNS (STRUCTURE UNIQUE CODE,,DIRECTORY NUMBER)

CNVSTU::SKIPA T2,[RCUSR]	;GET USER NUMBER
CNVSTD::MOVE T2,[RCDIR]		;GET DIRECTORY NUMBER
	STKVAR <CNDESG,CNDFR1,CNDINS>
	MOVEM T2,CNDINS		;STORE THE JSYS TO BE EXECUTED
	LOAD T3,NMFLG,T1	;GET BITS 0-2
	CAIN T3,NUMVAL		;IS IT A NUMBER?
	JRST CNVSD1		;YES. NO CONVERSION NEEDED
	MOVE T2,T1		;SAVE THE POINTER IN AC2 FOR A WHILE
	CALL PTRCHK		;CHECK THE POINTER FOR ILLEGAL OWGBP'S
	 RETBAD(DESX1)		;ILLEGAL OWGBP SO RETURN AN ERROR
	MOVE T1,T2		;PUT POINTER BACK
	MOVEI T2,MAXLW+1+^D9	;T2/MAXIMUM LENGTH OF STR:<DIR>
	CALL CPYUSR		;COPY THE STRING INTO THE JSB AND GO NOINT
	 RETBAD(STRX02,<OKINT>) ;INSUFFICIENT JSB SPACE
	MOVEM T1,CNDFR1		;SAVE LOCATION IN JSB OF BLOCK
	HRROI T2,1(T1)		;T2/POINTER TO THE STRING (AFTER HEADER IN JSB)
	MOVX T1,RC%EMO		;T1/EXACT MATCH ONLY (NO RECOGNITION)
	XCT CNDINS		;CONVERT STRING TO STRUCTURE,,DIRECTORY
	 ERJMP CNVSD2		;FAILED
	TXNE T1,RC%NOM		;DID WE GET A MATCH?
	JRST [	MOVEI T1,STRX03	;NO. REPORT ERROR
		JRST CNVSD3]
	TXNE T1,RC%AMB		;DID WE GET A UNIQUE MATCH?
	JRST [	MOVEI T1,STRX04	;NO. REPORT ERROR
		JRST CNVSD3]
	MOVEM T3,CNDESG		;SAVE (UNIQUE CODE,,DIRECTORY)
	MOVEI T1,JSBFRE		;T1/SPACE IS IN JSB
	MOVE T2,CNDFR1		;T2/POINTER TO SPACE IN JSB
	CALL RELFRE		;RETURN SPACE GOTTEN BY CPYUSR
	OKINT			;CPYUSR WENT NOINT
	MOVE T1,CNDESG		;RESTORE (STRUCTURE UNIQUE CODE,,DIR)
CNVSD1:	RETSKP			;SUCCESS

;ERROR. RETURN SPACE IN JSB THAT CPYUSR GOT

CNVSD3:	MOVEM T1,LSTERR		;SAVE ERROR CODE
CNVSD2:	MOVEI T1,JSBFRE		;T2/SPACE IS IN JSB
	MOVE T2,CNDFR1		;T2/POINTER TO SPACE IN JSB
	CALL RELFRE		;RETURN SPACE GOTTEN BY CPYUSR
	OKINT			;CPYUSR WENT NOINT
	MOVE T1,LSTERR		;RESTORE ERROR CODE
	RETBAD			;ERROR RETURN
;CKJBNO AND CKJBLI - CHECK A JOB NUMBER FOR VALIDITY

;ACCEPTS:
;	T1/LOCAL JOB INDEX

;	CALL CKJBNO
;	   OR
;	CALL CKJBLI

;RETURNS +1: JOB INDEX IS INVALID OR NOT LOGGED IN
;		T1/ERROR CODE
;	 +2: JOB INDEX IS OK (SEE BELOW)
;		T1/ CONTENTS OF JOBDIR FOR THIS JOB

;CKJBNO SUCCEEDS IF THE JOB INDEX IS VALID (< NJOBS) AND EXISTS
;	(JOBRT IS NOT NEGATIVE)
;CKJBLI SUCCEEDS IF THE ABOVE IS TRUE AND THE JOB IS LOGGED IN

CKJBNO::SETOM T2		;INDICATE DOESN'T HAVE TO BE LOGGED IN
	SKIPA
CKJBLI::SETZM T2		;INDICATE HAS TO BE LOGGED IN
	CAIL 1,0		;IS THE NUMBER POSITIVE?
	CAIL 1,MXGLBS		;YES. IS IT LEGAL?
	RETBAD (ARGX07)		;NO. RETURN 'INVALID JOB NUMBER'
	SKIPGE JOBRT(T1)	;YES. DOES THE JOB EXIST?
	RETBAD (ARGX08)		;NO. RETURN 'NO SUCH JOB'
	SKIPE T2		;DO WE WANT IT TO BE LOGGED IN?
	RETSKP			;NO. JOB NUMBER IS OK, THEN
	HRRZ T1,JOBDIR(T1)	;GET LOGGED IN DIRECTORY
	SKIPN T1		;IS IT LOGGED IN?
	RETBAD (ARGX15)		;NO. RETURN 'JOB IS NOT LOGGED IN'
	RETSKP			;YES. SUCCESS
;CMPSTR - COMPARE TWO STRINGS STORED IN EXTENDED BLOCKS

;ACCEPTS:	T1/ ADDRESS OF BLOCK 1 (NOT A BYTE POINTER)
;		T2/ ADDRESS OF BLOCK 2 (NOT A BYTE POINTER)
;		T3/ NUMBER OF BYTES TO BE COMPARED (IF CMPST1)

;	CALL CMPSTR

;RETURNS:	+1 NO MATCH
;		+2 MATCH

;STRINGS MUST BE ASCII AND START IN LEFT-MOST BYTE OF WORD POINTED TO.
;THE COMPARISON STOPS WHEN NULL IS REACHED OR 'COUNT' BYTES MATCH.
;IF ENTRY IS AT CMPSTR, A VERY LARGE COUNT IS ASSUMED
;IF T1 IS 0, A NULL STRING IS ASSUMED. SIMILARLY FOR T2

CMPSTR::MOVSI T3,1		;GET HUGE COUNT
CMPST1::ACVAR <W1,W2,W3>	;GET SOME REGS
	MOVE W3,T3		;SAVE COUNT
	SKIPN T1		;HAVE A POINTER HERE?
	MOVEI T1,[0]		;NO. INVENT A NULL STRING THEN
	SKIPN T2		;HAVE A POINTER HERE?
	MOVEI T2,[0]		;NO. INVENT ONE HERE TOO
	MOVE W1,[POINT 7,0(T1)]
	MOVE W2,[POINT 7,0(T2)]
CMPLOP:	ILDB T3,W1		;GET NEXT BYTE
	ILDB T4,W2		;GET THIS ONE'S NEXT
	CAME T3,T4		;MATCH?
	RET			;NO. NO MATCH THEN
	SOSLE W3		;ANY MORE BYTES?
	JUMPN T3,CMPLOP		;DO ENTIRE STRING
	RETSKP			;A MATCH!!!!

	ENDAV.			;END ACVAR
;CHKMNO - CHECK IF THIS USER HAS MOUNTED THE REQUESTED STRUCTURE
;CHKMNT - CHECK IF USER HAS MOUNTED REQUESTED STRUCTURE OR WHETHER
;         STRUCTURE IS A PUBLIC STRUCTURE OR BEING INITIALIZED

;ACCEPTS:	T1/  FLAGS,,STRUCTURE UNIQUE CODE
;			BIT 0 OF FLAGS SET IF SUCCESSFUL RETURN INCLUDES
;			A FORK MOUNT, BUT NOT JOB-WIDE MOUNT
;		T2/  JSB OFFSET (IF CALLING CHKMNT)

;	CALL CHKMNT/CHKMNO

;RETURNS:	+1 STRUCTURE IS NOT MOUNTED
;		+2 STRUCTURE IS MOUNTED, OR IT IS PS OR IS BEING INITED
;NOTE: JSB STRUCTURE INFOR LOCK (JSSTLK) MUST BE LOCKED BY CALLED!


CHKMNO::
	SETZ T2,		;ASSUME JSB IN REGULAR PLACE
CHKMNT::
	STKVAR <STRNO>
	LDB T3,[POINT STRNS,T1,35] ;GET THE STRUCTURE NUMBER
	CAME T3,LGSIDX		;[7.1112]Is this the Login Structure?
	CAIN T3,PSNUM		;[7.1112] Or the boot structure?
	RETSKP			;YES, NO NEED FOR FURTHER CHECKING
	CAIL T3,STRN		;IS IT A LEGAL STRUCTURE?
	RETBAD (STRX01)		;NO, RETURN 'NO SUCH STRUCTURE'
	MOVE T4,STRTAB(T3)	;GET ADDRESS OF SDB FOR THIS STRUCTURE
	JN STNRS,(T4),RSKP	;RETURN IF STRUCTURE IS NOT REGULATED
	HLL T3,T1		;SET UP TO STORE FLAGS
	MOVEM T3,STRNO		;STORE STRUCTURE NUMBER

; CHECK IF STRUCTURE BEING INITIALIZED

	ADDI T3,DVXST0		;GET OFFSET TO STRUCTURE  PART OF TABLE
	MOVE T3,DEVCH1(T3)	;GET STATUS OF DEVICE
	TXNE T3,D1%INI		;IS IT BEING INITED
	RETSKP			;YES, GOOD RETURN

;CHECK IF STRUCTURE MOUNTED

	HRRZS T1		;CLEAR FLAGS
	CALL FNDSTM		;FIND THE OFFSET IN JSB FOR THIS STR.
	 JRST CHKMN1		;STRUCTURE NOT IN USE BY THIS JOB
	JN JSMCI,(T2),RSKP	;GOOD RETURN IF STRUCTURE MOUNTED BY JOB

;CHECK IF MOUNTED ON FORK BASIS (VALID ONLY FOR CURRENT FORK)

	LOAD T1,STRFLG
	JXO T1,ST%IMC,RSKP	;IGNORE CHECKING OF MOUNT COUNT?
	SKIPL STRNO		;NO, IS IT OK IF FORK MOUNT?
	RETBAD (STRX09)		;NO
	CALL FRKSTO		;CHECK IF FORK MOUNTED STR
	 RETBAD (STRX09)	;NOT PUBLIC AND NOT MOUNTED
	RETSKP
CHKMN1:	LOAD T1,STRFLG
	JXO T1,ST%IMC,RSKP	;IGNORE CHECKING OF MOUNT COUNT?
	RETBAD (STRX09)		;NO
;FRKSTO - FIND STRUCTURE OFFSET IN THIS FORK'S JSB
;FRKSTM - FIND STRUCTURE OFFSET IN A FORK'S JSB
;
;ACCEPTS IN T1/	JOB RELATIVE FORK NUMBER (IF CALLING FRKSTM)
;	    T2/ OFFSET TO JSB DATA FOR THIS STRUCTURE
;		CALL FRKSTO/FRKSTM
;RETURNS: +1: FAILED,
;		IF STRUCTURE NOT FOUND
;			T1/STRX01
;	  +2: SUCCESS,
;
; NOTE: STRUCTURE MUST BE LOCKED DURING THIS ROUTINE

FRKSTO::MOVE T1,FORKN		;THIS IS CURRENT FORK
FRKSTM::MOVE T2,JSFKMT(T2)	;GET FORK USERS
	MOVEI T4,1		;FORM MASK FOR CHECK
	LSH T4,(T1)
	TDNN T2,T4		;IS STRUCTURE BIT SET?
	RETBAD (STRX01)		;NO, RETURN 'NO SUCH STRUCTURE'
	RETSKP			;YES.
;RELSTR - ROUTINE CALLED BY KSELF TO RELEASE ALL STRUCTURE MOUNTED BY
; THIS FORK

;ACCEPTS: NOTHING
;	CALL RELSTR
;RETURNS: +1 ALWAYS

RELSTR::STKVAR<RELST>
	LOCK JSSTLK		;LOCK JSB STRUCTURE INFORMATION LOCK
	MOVE T2,FORKN		;SET UP MASK FOR FORK TO DETERMINE
	MOVEI T1,1		; WHICH STRUCTURES IT HAS MOUNTED
	LSH T1,(T2)
	MOVEM T1,RELST		;AND STORE MASK
	SETZ T1,		;START WITH STRUCTURE 0
	MOVEI T2,JSSTRT		; AT ADDRESS JSSTRT
RELST1:	MOVE T3,JSFKMT(T2)	;GET FORK MOUNT WORD
	MOVE T4,RELST		;GET FORK MASK
	TDNE T3,T4		;DID THIS FORK MOUNT THIS STRUCTURE
	CALL DECFMC		;YES, DISMOUNT IT
	ADDI T2,JSSTMX		;GET NEXT STRUCTURE BLOCK
	AOS T1			;GET NEXT STRUCTURE
	CAIGE T1,STRN		;IS THIS THE LAST STRUCTURE?
	JRST RELST1		;NO, GO BACK FOR MORE
	UNLOCK JSSTLK		;UNLOCK THE JSB STR INFO LOCK
	RET			;AND RETURN
;PUTNAM - ROUTINE TO INSERT SYSTEM STRUCTURE NAME INTO STRING
; PRECEDED BY SIX BLANKS

;ACCEPTS: T1,	ADDRESS OF STRING
;RETURNS: +1,	ALWAYS
;		DOESN'T DESTROY T4

PUTNAM::
	MOVE T2,(T1)		;GET FIRST WORD
	CAME T2,[ASCII /     /]	;IS IT EQUAL TO BLANKS?
	RET			;NO, RETURN
	MOVE T3,T1		;SET UP BYTE PTR
	HRLI T3,440700
PUTNM1:	MOVE T2,STRTAB+PSNUM	;GET STRUCTURE BLOCK ADDRESS
	MOVEI T2,SDBNAM(T2)	;GET ADDRESS OF STRUCTURE NAME
	HRLI T2,440600		;SET UP 6-BIT POINTER
	MOVEI T1,6		;THERE IS A MAXIMUM OF 6 BYTES
PUTNM2:	ILDB Q1,T2		;GET 6-BIT CHARACTER
	JUMPE Q1,PUTNM3		;GET OUT OF LOOP IF ZERO BYTE
	ADDI Q1,40		;CONVERT IT TO 7-BIT
	IDPB Q1,T3		;PUT IT IN DEFINITION STRING
	SOJG T1,PUTNM2		;LOOP IF MORE CHARACTERS
PUTNM3:	ILDB T1,T3		;GET CHARACTER IN DEFINITION STRING
	CAIE T1,":"		;IS IT A COLON?
	JRST PUTNM3		;NO, CHECK NEXT CHARACTER
PUTNM4:	ILDB T1,T3		;GET NEXT CHARACTER IN DEFINITION STRING
	JUMPE T1,R		;FINALLY FINISHED
	CAIE T1," "		;IS IT EQUAL TO A SPACE?
	JRST PUTNM4		;NO, GET NEXT CHARACTER
	SETO T1,		;YES, DECREMENT BYTE POINTER
	IBP T1,T3
	MOVE T3,T1		;PUT DECREMENTED BYTE POINTER IN CORRECT AC
	JRST PUTNM1		; AND START OVER
;GETLOK - LOCKING ROUTINE WHICH CAPTURES INFORMATION
;	  AND CHECKS VALIDITY OF LOCKING

;ACCEPTS: T1/	INDEX INTO LCKTAB
;	  T2/	OFFSET FROM ADDRESS IN LCKTAB (USUALLY ZERO)

;RETURNS: +1	FAILURE, NOT LOCKED
;	  +2	SUCCESS, LOCKED

	RESCD

GETLOK::SAVET
	SKIPGE INTDF		;IS THE PROCESS NOINT?
	JRST [	PUSH P,T2
		MOVE T2,-6(P)	;NO - GET CALLER'S ADDRESS
		BUG.(CHK,LOKINT,FUTILI,SOFT,<Lock being locked while OKINT>,<<T1,LOCK>,<T2,CALLER>>,<

Cause:	A routine is locking a lock while OKINT.  This is dangerous since 
	allowing interrupts can cause the lock to be held indefinetly or 
	lock ownership to be lost.

Action:	If this BUG persists, make it dumpable and submit an SPR with the
	dump and a copy of MONITR.EXE.  If possible, include any known
	method for reproducing the problem and/or the state of the system
	at the time the BUG was observed.  The dump shows which routine
	is OKINT while attempting to get the lock.  Make the routine go 
	NOINT for the duration of the lock being locked.

Data:	LOCK   - Lock index and flags
	CALLER - Caller's address
>)
		POP P,T2
		JRST .+1]	;LET LOCKING GO ON ANYWAY
	HRRZ T4,T1		;GET INDEX
	ADD T2,LCKTAB(T4)	;GET LOCK BLOCK ADDRESS
	MOVE T3,FORKX		;GET FORK NUMBER
	CAMN T3,LOKFRK(T2)	;ALREADY HAVE LOCK?
	JRST [AOS LOKCNT(T2)	;YES, INCREMENT LOCK COUNT
	      RETSKP]
	NOSKED			;WE MAY NOT BE ALLOWED THIS LOCK. STOP THE WORLD
	AOSE LOKWRD(T2)		;LOCK THE LOCK
	 JRST [OKSKED		;CAN'T HAVE LOCK. LET THE WORLD CONTINUE
		RET]		;RETURN THAT WE COULDN'T GET LOCK

; CHECK IF LOCK REQUESTED OUT OF ORDER

	HRRZ T3,LOKHI		;GET INDEX OF HIGHEST LOCK IN USE
	CAMGE T4,T3		;IS LOCK REQUESTED OUT OF ORDER
	JRST GETLK1		;YES, COMPLAIN
	MOVE T3,FORKX
	MOVEM T3,LOKFRK(T2)	;STORE FORK NUMBER
	MOVE T3,LOKHI		;GET PREVIOUS HIGH LOCK
	MOVEM T3,LOKPHI(T2)	; AND STORE
	MOVEM T1,LOKHI		;STORE HIGHEST LOCK
	AOS LOKCNT(T2)		;INCREMENT NUMBER OF TIMES LOCKED
	CSKED			;BE CRITICAL WHILE WE HAVE LOCK
	OKSKED			;LOCK DATA ALL SET
	RETSKP

; LOCK HAS BEEN REQUESTED OUT OF ORDER

GETLK1:	SETOM LOKCNT(T2)	;RELEASE THE LOCK
	OKSKED			;PROCESS VIOLATED PRECEDENCE RULES
	BUG.(HLT,LOKODR,FUTILI,SOFT,<Lock requested out of order>,<<T4,LOKREQ>,<T3,LOKOWN>>,<

Cause:	There is a priority locking scheme in the monitor.  A lock is
	being requested that should have been locked previously.

Data:	LOKREQ - the requested lock
	LOKOWN - the highest lock held thus far
>)
	RET			
;RELLOK - UNLOCKING ROUTINE WHICH CHECKS VALIDITY OF UNLOCKING

;ACCEPTS: T1/	INDEX INTO LCKTAB
;	  T2/	OFFSET FROM ADDRESS IN LCKTAB (USUALLY ZERO)
;RETURNS: +1

RELLOK::SAVET
	SKIPGE INTDF		;IS THE PROCESS NOINT?
	JRST [	PUSH P,T2
		MOVE T2,-6(P)	;NO - GET CALLER'S ADDRESS
		BUG.(CHK,ULKINT,FUTILI,SOFT,<Lock being unlocked while OKINT>,<<T1,LOCK>,<T2,CALLER>>,<

Cause:	A routine is unlocking a lock while OKINT.  This is dangerous since 
	allowing interrupts can cause the lock to be held indefinetly or 
	lock ownership to be lost.  The process should have been NOINT when
	it acquired the lock or a LOKINT BUGCHK would have resulted.

Action:	If this BUG persists, make it dumpable and submit an SPR with the
	dump and a copy of MONITR.EXE.  If possible, include any known
	method for reproducing the problem and/or the state of the system
	at the time the BUG was observed.  The dump shows which routine
	is OKINT while attempting to get the lock.  Make the routine go 
	NOINT for the duration of the lock being locked.

Data:	LOCK   - Lock index and flags
	CALLER - Caller's address
>)
		POP P,T2
		JRST .+1]	;LET LOCKING GO ON ANYWAY
	HRRZ T4,T1		;GET INDEX ONLY
	ADD T2,LCKTAB(T4)	;GET LOCK BLOCK ADDRESS
	MOVE T3,FORKX		;GET CURRENT FORK NUMBER
	CAME T3,LOKFRK(T2)	;IS IT SAME AS FORK HOLDING LOCK
	JRST RELOK1		;NO,COMPLAIN
	SOSE LOKCNT(T2)		;IS THIS FINAL LOCK?
	RET			;NO, STILL HAVE LOCK
	MOVE T3,LOKPHI(T2)	;GET OLD HIGHEST LOCK INDEX
	MOVEM T3,LOKHI		;STORE IT AS HIGHEST NOW HELD
	SETOM LOKFRK(T2)	;CLEAR FORK
	SETOM LOKWRD(T2)	;CLEAR LOCK
	ECSKED
	RET			;FINISHED

; FORK ATTEMPTING TO RELEASE LOCK IT DOES NOT OWN

RELOK1:	BUG.(HLT,LOKWRG,FUTILI,SOFT,<Wrong fork is releasing lock>,<<T4,LOKREQ>,<T3,FORK>>,<

Cause:	A fork is trying to unlock a fork it has never owned, or unlocking
	it too many times.

Data:	LOKREQ - the requested lock
	FORK   - the fork trying to release the lock
>)
	RET			

;LOKTYP - DETERMINE TYPE OF LOCK AND LOCK THE LOCK

;ACCEPTS:  T1/	LOCK BLOCK ADDRESS

;RETURNS:  +1	FAILURE
;	   +2	SUCCESS
;DESTROYS T1 ONLY

LOKTYP::MOVE T1,LOKFLG(T1)		;GET CORRECT INDEX
	TXNE T1,SLOW			;DOES THIS LOCK USE SLOW MECHANISM?
	JRST LOKSLO			;IT DOES...DO APPROPRIATE THING
	HRRZS T1			;GET INDEX ONLY
	MOVE T1,LCKTAB(T1)
	AOSE (T1)			;YES, LOCKING
	 RET				;ALREADY LOCKED
	RETSKP				;SUCCESS

;HERE FOR SLOW LOCKING

LOKSLO:	CALL GETLOK		;DO THE LOCKING
	RET

;ULKTYP - DETERMINE TYPE OF LOCK AND UNLOCK LOCK

;ACCEPTS:  T1/	LOCK BLOCK ADDRESS

;RETURNS:  +1	FAILURE
;	   +2	SUCCESS
;DESTROYS T1 ONLY

ULKTYP::MOVE T1,LOKFLG(T1)		;GET CORRECT INDEX
	TXNE T1,SLOW			;DOES THIS LOCK USE SLOW MECHANISM?
	JRST ULKSLO			;IT DOES...DO APPROPRIATE THING
	HRRZS T1			;GET INDEX ONLY
	MOVE T1,LCKTAB(T1)
	SETOM (T1)			;LOCK THE LOCK
	RET

;HERE IF THE LOCK IS A SLOW LOCK

ULKSLO:	CALL RELLOK		;DO THE LOCKING
	RET

	SWAPCD
	TNXEND
	END