Trailing-Edge
-
PDP-10 Archives
-
BB-Y393I-SM
-
monitor-sources/futili.mac
There are 49 other files named futili.mac in the archive. Click here to see a list.
; UPD ID= 43, FARK:<4-1-WORKING-SOURCES.MONITOR>FUTILI.MAC.2, 3-Apr-82 17:28:55 by ZIMA
;Edit 2607 - add ENDAV.s to ACVARs to use v5 MACSYM.
;<4-1-FIELD-IMAGE.MONITOR>FUTILI.MAC.2, 25-Feb-82 20:22:09, EDIT BY DONAHUE
;UPDATE COPYRIGHT DATE
;<4.MONITOR>FUTILI.MAC.15, 3-Jan-80 08:08:48, EDIT BY R.ACE
;UPDATE COPYRIGHT DATE
;<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,1980,1981,1982 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
;**;[2607] Add one line at STDIR3: +3L JGZ 3-APR-82
ENDAV. ;[2607] 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
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!!!!
;**;[2607] Add one line at CMPLOP: +7L JGZ 3-APR-82
ENDAV. ;[2607] 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
TNXEND
END