Trailing-Edge
-
PDP-10 Archives
-
BB-M780B-SM
-
monitor-sources/futili.mac
There are 49 other files named futili.mac in the archive. Click here to see a list.
; UPD ID= 66, SNARK:<5.1.MONITOR>FUTILI.MAC.4, 4-Oct-82 23:16:03 by LEACHE
;Remove previous - fix is now in APRSRV
; UPD ID= 58, SNARK:<5.1.MONITOR>FUTILI.MAC.3, 30-Sep-82 22:14:40 by LEACHE
;TCO 5.1.1078 Protect against bad byte pointers given to CPYFUS
; UPD ID= 57, SNARK:<5.1.MONITOR>FUTILI.MAC.2, 29-Sep-82 17:55:17 by LEACHE
;Protect against ILLIND BUGHLTS at STDIR3:
; 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
;<4.MONITOR>FUTILI.MAC.14, 1-Nov-79 13:36:06, EDIT BY DBELL
;TCO 4.2547 - DON'T USE DOUBLE WORD BYTE POINTER IN CPYUSR ROUTINES
;<4.MONITOR>FUTILI.MAC.13, 10-Oct-79 11:15:47, Edit by LCAMPBELL
; Let ctrl-V preserve case at CPYUS1
;<OSMAN.MON>FUTILI.MAC.1, 10-Sep-79 15:31:10, EDIT BY OSMAN
;TCO 4.2412 - Move definition of BUGHLTs, BUGCHKs, and BUGINFs to BUGS.MAC
;<4.MONITOR>FUTILI.MAC.11, 3-Aug-79 14:33:42, EDIT BY ENGEL
;<4.MONITOR>FUTILI.MAC.9, 17-May-79 15:41:38, Edit by KONEN
;CHECK STR BEING INITED BEFORE CHECKING IF MOUNTED IN CHKMNT
;<4.MONITOR>FUTILI.MAC.8, 4-Mar-79 17:20:55, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.MONITOR>FUTILI.MAC.7, 15-Jan-79 14:07:46, Edit by KONEN
;ALLOW USER TO PASS CHKMNT TEST IF FLAG SET IN PSB
;<4.MONITOR>FUTILI.MAC.6, 10-Nov-78 11:36:13, EDIT BY OSMAN
;IMPROVE CPYTU1, CPYTUS COMMENTS
;<4.MONITOR>FUTILI.MAC.4, 25-Oct-78 14:17:06, EDIT BY OSMAN
;MAKE CPYFU1, CPYFU2 COMMENTS MORE CLEAR
;<KONEN>FUTILI.MAC.13, 11-Aug-78 12:08:09, Edit by KONEN
;ADD ROUTINE TO DISMOUNT FORK'S STRUCTURES WHEN FORK KILLED
;<KONEN>FUTILI.MAC.2, 31-Jul-78 11:16:41, Edit by KONEN
;ADD ROUTINE TO CHECK FOR A STRUCTURE IN PSB
;<KONEN>FUTILI.MAC.12, 23-Jun-78 19:02:12, Edit by KONEN
;ADD CHKMNT TO CHECK IF USER HAS MOUNTED A REQUESTED STRUCTURE
;ADD CODE TO GTSTOF:: TO ALLOW GETTING STRUCTURE OFFSET FOR ANOTHER JOB
;<4.MONITOR>FUTILI.MAC.2, 7-Jul-78 09:24:57, EDIT BY MILLER
;MAKE ULKST1 RESIDENT AND "CRITICAL"
;<4.MONITOR>FUTILI.MAC.1, 16-May-78 17:35:21, Edit by HALL
;TCO 1900 - MOVED CMPSTR HERE FROM NSPSRV
;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 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
SEARCH PROLOG
TTITLE FUTILITY
SWAPCD
;NO SPECIAL AC DEFINITIONS USED HEREIN
; Save ac's before monitor call
SAVAC:: ADD P,BHC+NSAC-1 ; Make room for nsac ac's
JUMPGE P,MSTKOV
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
SUB P,BHC+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>
SE1CAL
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
SE1CAL
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
SE1CAL
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
SE1CAL
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
SE1CAL
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>
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 ;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::SE1CAL
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:: SE1CAL
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(ULKSTZ)
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,STRTAB+PSNUM ;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/JOB NUMBER
; CALL CKJBNO
; OR
; CALL CKJBLI
;RETURNS +1: JOB NUMBER IS INVALID OR NOT LOGGED IN
; T1/ERROR CODE
; +2: JOB NUMBER IS OK (SEE BELOW)
; T1/ CONTENTS OF JOBDIR FOR THIS JOB
;CKJBNO SUCCEEDS IF THE JOB NUMBER 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,NJOBS ;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
SKIPN T3 ;IS THIS THE PRIMARY PUBLIC 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 (LOKINT,<<T1,LOCK>,<T2,CALLER>>)
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
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 (LOKODR,<<T4,LOKREQ>,<T3,LOKOWN>>)
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 (ULKINT,<<T1,LOCK>,<T2,CALLER>>)
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
RET ;FINISHED
; FORK ATTEMPTING TO RELEASE LOCK IT DOES NOT OWN
RELOK1: BUG (LOKWRG,<<T4,LOKREQ>,<T3,FORK>>)
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