Google
 

Trailing-Edge - PDP-10 Archives - BB-M081Q-SM - monitor-sources/futili.mac
There are 49 other files named futili.mac in the archive. Click here to see a list.
; 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,HARD,<Overly decremented structure lock>,,<

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

>)
		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.

Action:	Make the process be 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.

Action:	Make the process be 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