Trailing-Edge
-
PDP-10 Archives
-
bb-m080w-sm_t20_v7_0_02_mon_src_mod
-
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