Trailing-Edge
-
PDP-10 Archives
-
BB-Y393T-SM
-
monitor-sources/lognam.mac
There are 52 other files named lognam.mac in the archive. Click here to see a list.
; *** Edit 7418 to LOGNAM.MAC by RASPUZZI on 24-Feb-87, for SPR #21535
; Make sure that RELATR attempts to release free space properly by only using
; the right half of LNATR(T1) and not the fullword
; UPD ID= 179, FARK:<4-1-WORKING-SOURCES.MONITOR>LOGNAM.MAC.2, 28-Sep-82 15:42:10 by MOSER
;EDIT 2821 - PREVENT HUNG JOBS/SYSTEM UNLOCK AFTER FAILING ASGJFR
;<4-1-FIELD-IMAGE.MONITOR>LOGNAM.MAC.2, 25-Feb-82 20:29:04, EDIT BY DONAHUE
;UPDATE COPYRIGHT DATE
; UPD ID= 113, FARK:<4-WORKING-SOURCES.MONITOR>LOGNAM.MAC.5, 2-Jul-80 14:41:51 by SCHMITT
;Edit 1755 - Remove edit 1718 because 1754 makes it redundant
; UPD ID= 110, FARK:<4-WORKING-SOURCES.MONITOR>LOGNAM.MAC.4, 2-Jul-80 14:27:32 by SANICHARA
;EDIT 1754 - Do range checking for dispatch into CCTAB i.e Valid Char
;<4-WORKING-SOURCES.MONITOR>LOGNAM.MAC.4, 5-Jun-80 06:27:36, Edit by SCHMITT
; CAIGLE from previous edit to CAILE
; UPD ID= 10, FARK:<4-WORKING-SOURCES.MONITOR>LOGNAM.MAC.2, 29-May-80 13:20:03 by SCHMITT
; TCO 5.1051 - Cure ILMREF when AC3 for CRLNM JSYS contains invalid Byte Size
;<4.MONITOR>LOGNAM.MAC.4, 3-Jan-80 08:09:26, EDIT BY R.ACE
;UPDATE COPYRIGHT DATE
;<OSMAN.MON>LOGNAM.MAC.1, 10-Sep-79 15:41:06, EDIT BY OSMAN
;TCO 4.2412 - Move definition of BUGHLTs, BUGCHKs, and BUGINFs to BUGS.MAC
;<4.MONITOR>LOGNAM.MAC.2, 4-Mar-79 18:13:45, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;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 LOGNAM
SWAPCD
;SPECIAL AC DEFINITIONS
DEFAC (JFN,P2)
DEFAC (F1,P5)
;STORAGE REQUIREMENTS
NR(SYLNTB,1) ;POINTER TO SYSTEM LOGICAL NAME TABLE
NR(SYLNLK,1) ;SYSTEM LOGICAL NAME TABLE LOCK
;ROUTINE TO INITIALIZE THE SYSTEM LOGICAL NAME TABLE AT START UP TIME
EXTN <SYNMTB,SYNMCT>
; CALL SLNINI ;MUST BE IN CONTEXT OF A JOB
;RETURNS +1: ALWAYS
SLNINI::SETZM SYLNTB ;INITIALIZE POINTER TO NAME TABLE
SETOM SYLNLK ;AND SYSTEM LOGICAL NAME LOCK
MOVNI T4,SYNMCT ;SET UP AOBJN COUNTER
HRLZS T4 ;THE HARD WAY
JUMPGE T4,R ;IF NO NAMES TO DO, EXIT
PUSH P,CAPENB ;SAVE CAPABILITIES
MOVEI T1,SC%WHL ;MAKE THIS FORK A WHEEL
IORM T1,CAPENB
SLNLOP: MOVEI T1,.CLNSY ;FUNCTION CODE TO CREATE SYSTEM LN
HLRO T2,SYNMTB(T4) ;GET POINTER TO LOGICAL NAME STRING
HRRO T3,SYNMTB(T4) ;GET POINTER TO DEFINITION STRING
CRLNM ;CREATE THIS SYSTEM LN
BUG(NOSLNM)
AOBJN T4,SLNLOP ;LOOP BACK FOR ALL ENTRIES IN TABLE
POP P,CAPENB ;RESTORE CAPABILITIES
RET ;AND EXIT
; CRLNM - CREATE A LOGICAL NAME
;
; THIS JSYS IS USED TO ADD NEW LOGICAL NAMES TO THE LIST OF
; EXISTING LOGICAL NAMES, TO CHANGE THE DEFINITION OF AN EXISTING
; LOGICAL NAME, TO DELETE A LOGICAL NAME FORM THE LIST OF LOGICAL
; NAMES, OR TO DELETE THE ENTIRE LIST OF LOGICAL NAMES.
;
;CALLING SEQUENCE:
; MOVE 1,FUNCTION CODE
; MOVE 2,STRING POINTER TO LOGICAL NAME
; MOVE 3,STRING POINTER TO DEFINITION STRING (OPTIONAL)
; CRLNM
; UNSUCCESSFUL RETURN, ERROR CODE IN 1
; SUCCESSFUL RETURN
.CRLNM::MCENT ;ENTER SLOW JSYS
XCTU [HRRZ P1,1] ;GET THE USER'S FIRST ARG
CAILE P1,.CLNSY ;LEGAL FUNCTION CODE?
RETERR (CRLNX3) ;NO, ILLEGAL FUNCTION CODE
MOVEI P4,0 ;P4 = 0 MEANS JSB
TRNE P1,1 ;EVEN FUNCTION CODES MEAN JSB
MOVEI P4,1 ;P4 = 1 MEANS SYSTEM LOGICAL NAMES
MOVE T1,CAPENB ;GET PRIVILEGES
TRNN T1,SC%WHL!SC%OPR ;IS USER PRIVILEGED?
JUMPN P4,[RETERR (CRLNX2)] ;NO, ERROR IF SYSTEM LN FUNCTION
NOINT ;DISABLE INTERRUPTS
CAIE P1,.CLNJA ;DELETE ALL LOGICAL NAMES?
CAIN P1,.CLNSA ;...
JRST CRLNMA ;YES, GO DELETE THEM
JUMPE P4,[UMOVE T1,2 ;IF JOB WIDE LN, USE CPYFU0
CALL CPYFU0 ;THIS TRIMS THE BLOCK AFTER COPYING
RETERR (GJFX22) ;NO ROOM IN JSB
JRST CRLNM2] ;CONTINUE ON
MOVEI T1,MAXLW+1 ;GET A STRING FOR THE LOGICAL NAME
CALL GTEMP ;FROM THE APPROPRIATE FREE POOL
RETERR ;NONE LEFT
MOVE T1,T2 ;GET ADDRESS OF BLOCK
UMOVE T2,2 ;GET POINTER TO LOGICAL NAME
CALL CPYFU1 ;COPY THE STRING INTO BLOCK
JFCL ;NEVER COMES HERE
IBP T2 ;STEP OVER NULL AT END OF STRING
PUSH P,T1 ;SAVE ADDRESS OF STRING
CALL TRMSWP ;TRIM THE BLOCK
POP P,T1 ;GET BACK THE POINTER TO THE STRING
CRLNM2: HRLI T1,(<POINT 7,0,35>);TURN THIS INTO A BYTE POINTER
CAIE P1,.CLNJ1 ;USER WANT TO DELETE THIS NAME?
CAIN P1,.CLNS1 ;...
JRST CRLNMD ;YES, GO DELETE IT
UMOVE T2,3 ;GET STRING POINTER FROM AC 3
JUMPGE T2,CRLNM0 ;IS THIS ALREADY A BYTE POINTER?
CAML T2,[777777000000] ;HOW ABOUT -1,,ADR?
HRLI T2,(<POINT 7,0>) ;MAKE IT A STANDARD BYTE POINTER
;..
;..
CRLNM0: PUSH P,T1 ;SAVE THE JSB COPY OF THE LOGICAL NAME
;**;[1755] Remove edit 1718 RAS 2-JUL-80
;**;[1718] Add Following Four Lines at CRLNM0+1 RAS 29-MAY-80
; LDB T3,[POINT 6,T2,11] ; [1718] GET BYTE SIZE
; CAILE T3,7 ; IS IT LESS THAN 7 BITS?
; JRST [ MOVEI T1,ARGX09 ; NO, GIVE INVALID BYTE SIZE
; JRST CRLNE2] ; ERROR
CALL LNPARS ;GO PARSE THE NAME AND CREATE AN E-BLOCK
JRST [UMOVEM T2,3 ;THERE WAS A PROBLEM, GO CLEAN UP
JRST CRLNE2] ;AFTER STORING UPDATED STRING POINTER
UMOVEM T2,3 ;STORE UPDATED STRING POINTER FOR USER
PUSH P,T1 ;SAVE THE E-BLOCK ADDRESS
MOVE T2,-1(P) ;STACK NOW HAS LOGICAL NAME AND E-BLOCK
LOCK @LOKTAB(P4) ;INTERLOCK THE LOGICAL NAME TABLE
SKIPN T1,@LNTAB(P4) ;IS THERE A TABLE FOR LOGICAL NAMES YET?
JRST [MOVEI T1,TABINC ;NO, GO CREATE ONE
CALL GTEMP ;GET A BLOCK FROM THE JSB FREE POOL
JRST CRLNE3 ;NO ROOM
MOVE T1,T2 ;GET ADR OF BLOCK INTO T1
HRRZM T1,@LNTAB(P4);SAVE LOCATION OF LOGICAL NAME TABLE
HRRZS 0(T1) ;CLEAN OUT LH OF TABLE
MOVE T2,-1(P) ;RESTORE LOGICAL NAME POINTER
JRST .+1] ;OK, WE NOW HAVE A TABLE; CONTINUE ON
CALL TABLK ;SEE IF THE LOGICAL NAME IS THERE ALREADY
JRST CRLNM1 ;NO MATCH
PUSH P,T1 ;SAVE ENTRY INTO TABLE
CALL ENTDEL ;GO RELEASE AL SPACE HELD BY THIS ENTRY
POP P,T1 ;RESTORE INDEX INTO TABLE
CRLNM1: MOVE T2,T1 ;GET LOCATION FOR THIS NEW ENTRY
MOVE T1,@LNTAB(P4) ;GET TABLE ADDRESS
CALL TABADD ;MAKE ROOM IN THE TABLE FOR THIS NEW ENTRY
JRST CRLNE3 ;SOMETHING WENT WRONG, GO CLEAN UP
HRRZM T1,@LNTAB(P4) ;STORE NEW TABLE ADDRESS
HRLZ T1,-1(P) ;GET LOGICAL NAME STRING POINTER
HRR T1,0(P) ;AND POINTER TO THE E-BLOCK
MOVEM T1,0(T2) ;STORE THE NEW LOGICAL NAME ENTRY
POP P,T1 ;CLEAR THE STACK OUT
POP P,T2 ;...
UNLOCK @LOKTAB(P4) ;FREE UP LOGICAL NAME INTERLOCK
OKINT ;FINISHED CHANGING THE LOGICAL NAME TABLE
SMRETN ;GIVE SKIP RETURN TO USER
; ROUTINE TO DELETE ALL ENTRIES FROM THE LOGICAL NAME TABLE
CRLNMA: LOCK @LOKTAB(P4) ;INTERLOCK THE LOGICAL NAME TABLE
CRLNA0: MOVE P3,@LNTAB(P4) ;GET ADDRESS OF TABLE
JUMPE P3,CRLNA2 ;NOTHING TO BE DONE
HLRZ P6,0(P3) ;GET # OF ENTRIES USED
JUMPE P6,CRLNA1 ;NO ENTRIES, JUST RELEASE TABLE
MOVEI T1,1(P3) ;GET ENTRY TO BE DELETED
CALL ENTDEL ;GO GIVE BACK ALL JSB SPACE USED
JRST CRLNA0 ;LOOP BACK FOR ALL ENTRIES
CRLNA1: MOVE T1,@LNTAB(P4) ;GET TABLE ADDRESS
SETZM @LNTAB(P4) ;ZERO TABLE POINTER
CALL RELTMP ;...
CRLNA2: UNLOCK @LOKTAB(P4) ;RELEASE LOGICAL NAME LOCK
OKINT
SMRETN ;SKIP RETURN TO USER
;ROUTINE TO DELETE A SINGLE ENTRY FROM THE LOGICAL NAME TABLE
CRLNMD: LOCK @LOKTAB(P4) ;INTERLOCK THE LOGICAL NAME TABLE
MOVE T2,T1 ;GET POINTER TO LN STRING IN JSB
PUSH P,T2 ;SAVE LN POINTER
SKIPE T1,@LNTAB(P4) ;GET ADR OF TABLE
CALL TABLK ;LOOKUP THIS LOGICAL NAME
JRST CRLNE1 ;NO MATCH
EXCH T1,0(P) ;GET LN POINTER AND SAVE INDEX
CALL RELTMP ;GIVE UP LN POINTER STRING
POP P,T1 ;GET TABLE ENTRY INDEX TO BE DELETED
CALL ENTDEL ;GO GIVE BACK ALL SPACE OWNED BY THIS ENTRY
UNLOCK @LOKTAB(P4) ;UNLOCK INTERLOCK ON LOGICAL NAME TABLE
OKINT
SMRETN ;EXIT SUCCESSFULLY
CRLNE3: POP P,T1 ;GET E-BLOCK ADR
CALL RELLN ;GO RELEASE IT
SKIPA T1,[GJFX22] ;NO ROOM IN JSB
CRLNE1: MOVEI T1,CRLNX1 ;NO SUCH LOGICAL NAME
CRLNE2: EXCH T1,0(P) ;GET LN POINTER AND SAVE ERROR CODE
CALL RELTMP ;RETURN IT TO FREE POOL
POP P,T1 ;RESTORE ERROR CODE
UNLKER: UNLOCK @LOKTAB(P4) ;FREE UP LOGICAL NAME TABLE
OKINT
JRST MRETNE ;UNSUCCESSFUL RETURN WITH ERROR CODE IN 1
; ROUTINE TO DELETE AN ENTRY FROM THE LOGICAL NAME TABLE
;
;CALLING SEQUENCE:
; MOVE T1,INDEX OF ENTRY TO BE DELETED
; CALL ENTDEL
; RETURN HERE ALWAYS
ENTDEL: PUSH P,T1 ;SAVE INDEX
HRRZ T3,0(P) ;GET INDEX
HLRZ T1,0(T3) ;GET POINTER TO LN STRING
CALL RELTMP ;RELEASE IT
HRRZ T3,0(P) ;GET INDEX AGAIN
HRRZ T1,0(T3) ;GET E-BLOCK ADR
CALL RELLN ;GO RELEASE THAT ALSO
POP P,T2 ;GET INDEX FOR FINAL TIME
MOVE T1,@LNTAB(P4) ;GET TABLE ADR
CALLRET TABDEL ;GO SHRINK DOWN THE TABLE
;INLNM - JSYS TO RETURN A LOGICAL NAME GIVEN AN INDEX VALUE
;
;CALLING SEQUENCE:
; MOVE 1,[FUNCTION CODE ,, INDEX VALUE]
; MOVE 2,POINTER TO STRING FOR RETURNED LOGICAL NAME
; INLNM
; UNSUCCESSFUL, ERROR CODE IN 1
; SUCCESSFUL, UPDATED STRING POINTER IN 2
.INLNM::MCENT ;ENTER SLOW JSYS CODE
XCTU [HRRZ T2,1] ;GET INDEX VALUE
XCTU [HLRZ P4,1] ;GET FUNCTION CODE
CAILE P4,.INLSY ;LEGAL FUNCTION?
RETERR (INLNX2) ;YES, GIVE ERROR RETURN
HRLI P4,400000
NOINT
LOCK @LOKTAB(P4) ;INTERLOCK THE LOGICAL NAME TABLE
SKIPN T1,@LNTAB(P4) ;GET ADR OF LN TABLE
JRST [MOVEI T1,INLNX1 ;NO ENTRIES AT ALL
JRST UNLKER] ;GO CLEAN UP
HLRZ T3,0(T1) ;GET # OF ENTRIES IN TABLE
SKIPE T3 ;ANY ENTRIES?
CAILE T2,-1(T3) ;YES, IS INDEX VALUE OK?
JRST [MOVEI T1,INLNX1 ;NO, GIVE ERROR RETURN
JRST UNLKER] ;GO UNLOCK INTERLOCKS
ADDI T2,1(T1) ;GET ADR OF FIRST ENTRY
HLRZ T2,0(T2) ;GET POINTER TO LOGICAL NAME STRING
UMOVE T1,2 ;GET POINTER TO USER'S STRING
CALL CPYTUS ;COPY THE NAME TO THE USER'S STRING
UNLOCK @LOKTAB(P4) ;RELEASE LOGICAL NAME TABLE
OKINT
SMRETN ;EXIT SUCCESSFULLY
;LNMST - LOGICAL NAME TO STRING JSYS
;
; THIS JSYS RETURNS THE DEFINITION OF A LOGICAL NAME TO THE USER
;
;CALLING SEQUENCE:
; MOVE 1,FUNCTION CODE
; MOVE 2,POINTER TO LOGICAL NAME STRING TO BE LOOKED UP
; MOVE 3,POINTER TO STRING FOR RETURNED DEFINITION
; LNMST
; UNSUCCESSFUL, ERROR CODE IN 1
; SUCCESSFUL, UPDATED STRING POINTER IN 3
.LNMST::MCENT ;ENTER SLOW JSYS
XCTU [HRRZ P1,1] ;GET FUNCTION CODE
MOVE P4,P1 ;SET UP INDEX REG
CAILE P4,.LNSSY ;IS THIS A LEGAL FUNCTION?
RETERR (LNSTX2) ;YES, GIVE ERROR RETURN
HRLI P4,400000
UMOVE T1,2 ;GET POINTER TO LN
CALL CPYFU0 ;MAKE A COPY OF THE LN IN THE JSB
RETERR GJFX22 ;NO ROOM IN JSB
HRLI T1,(POINT 7,0,35) ;SET UP BYTE POINTER TO TEMP STRING
NOINT
LOCK @LOKTAB(P4) ;INTERLOCK THE LOGICAL NAME TABLE
PUSH P,T1 ;SAVE LN POINTER
CALL LNMLK1 ;GO LOOKUP THIS LOGICAL NAME
JRST LNMSTE ;NO MATCH
HRRZ P3,0(T1) ;GET E-BLOCK POINTER FOR THIS LN
POP P,T1 ;RELEASE THIS STRING
HRRZS T1
HRRZ T2,0(T1) ;GET SIZE OF BLOCK
CALL RELJSB ;THIS BLOCK CAME FROM JSB
UMOVE T2,3 ;GET POINTER OUT OF AC 3
JUMPGE T2,.+3 ;IS IT ALREADY SET UP?
CAML T2,[777777000000] ;NO, IS THIS A DEFAULT STRING POINTER
HRLI T2,(<POINT 7,0>) ;YES, SET UP A GOOD BYTE POINTER VALUE
LNMST1: SKIPN T1,LNDEV(P3) ;IS THERE A DEVICE FIELD SPECIFIED?
JRST LNMST2 ;NO, DONT GIVE ANYTHING TO USER
CALL STTU1 ;STORE DEVICE IN USER STRING
MOVEI T1,":" ;END IT WITH A COLON
XCTBU [IDPB T1,T2] ;...
;.. ;FALL THROUGH TO LNMST2
;..
LNMST2: SKIPN T1,LNDIR(P3) ;WAS THERE A DIR SPECIFIED?
JRST LNMST3 ;NO
MOVEI T3,"<" ;PUT AN OPEN ANGLE BRACKET ON FIRST
CALL STTU31 ;THEN THE DIR
MOVEI T1,">" ;FINISH WITH A CLOSE BRACKET
XCTBU [IDPB T1,T2] ;...
LNMST3: SKIPE T1,LNNAM(P3) ;WAS A NAME FIELD SPECIFIED?
CALL STTU1 ;YES, GIVE IT TO USER
SKIPN T1,LNEXT(P3) ;WAS THERE AN EXT?
JRST LNMST4 ;NO
MOVEI T3,"." ;PREFIX IT WITH A DOT
CALL STTU31 ;FOLLOWED BY THE EXT
LNMST4: SKIPN T1,LNVER(P3) ;NOW CHECK VERSION
JRST LNMST5 ;NONE THERE
MOVEI T3,PNCVER ;PREFIX WITH PROPER PUNCTUATION
CALL STTU31 ;FOLLOWED BY THE NUMBER
LNMST5: SKIPN T1,LNACT(P3) ;AN ACCOUNT?
JRST LNMST6 ;NO
MOVEI T3,PNCATT ;ADD A SEMI
XCTBU [IDPB T3,T2] ;...
MOVEI T3,"A" ;AND AN "A"
CALL STTU31 ;FOLLOWED BY THE ACCOUNT NUMBER
LNMST6: SKIPN T1,LNPRT(P3) ;ANY PROTECTION?
JRST LNMST7 ;NO
MOVEI T3,PNCATT ;START WITH A SEMI
XCTBU [IDPB T3,T2] ;...
MOVEI T3,"P" ;THEN A "P"
CALL STU31O ;FOLLOWED BY THE PROTECTION
LNMST7: SKIPN LNATR(P3) ;ANY ATTRIBUTES?
JRST LNMS7E ;NO
HRRZ P1,LNATR(P3) ;YES, GET THE POINTER TO THE FIRST
LNMS7A: LOAD T1,PRFXV,(P1) ;GET THE PREFIX VALUE
HLRZ Q1,PRFXTB ;NOW SEARCH THE PREFIX TABLE THIS VALUE
MOVNS Q1 ;GET THE NUMBER OF ENTRIES IN TABLE
HRLZS Q1 ;SET UP AN AOBJN POINTER
HRRI Q1,PRFXTB+1 ;PRETIX TABLE IS IN TBLUK FORMAT
LNMS7B: HRRZ T3,0(Q1) ;GET THE PREFIX VALUE
ANDI T3,PFXMSK ;GET JUST THE PREFIX VALUE
CAMN T1,T3 ;FOUND A MATCH YET?
JRST LNMS7C ;YES, GO GIVE IT TO USER
AOBJN Q1,LNMS7B ;LOOP BACK TIL PREFIX VALUE IS FOUND
JRST LNMS7D ;NOT FOUND, SKIP IT
LNMS7C: MOVEI T1,PNCATT ;START WITH A SEMI-COLON
XCTBU [IDPB T1,T2] ;STORE THE CHARACTER IN THE USER'S STRING
HLRZ T1,0(Q1) ;GET THE PREFIX STRING
HRLI T1,(POINT 7,0) ;SET UP A STRING POINTER
CALL ST2U ;GIVE THIS STRING TO THE USER
MOVEI T1,NOATRF ;NOW SEE IF THIS HAS AN ATTRIBUTE VALUE
TDNE T1,0(Q1) ;CHECK THE NOATRF FLAG
JRST LNMS7D ;THERE IS NO VALUE, SO DO NOT TYPE COLON
MOVEI T1,PNCPFX ;GET THE PUNCTUATION AFTER THE PREFIX
XCTBU [IDPB T1,T2] ;PUT THE CHARACTER INTO THE USER STRING
MOVEI T1,0(P1) ;NOW ADD ON THE VALUE STRING
HRLI T1,(POINT 7,0,35)
CALL ST2U ;COPY THE STRING TO THE USER STRING
LNMS7D: HLRZ P1,0(P1) ;STEP TO THE NEXT ATTRIBUTE
JUMPN P1,LNMS7A ;LOOP BACK FOR REST OF THE ATTRIBUTES
LNMS7E: SKIPN LNTMP(P3) ;TEMPORARY FILE?
JRST LNMST8 ;NO
MOVEI T1,PNCATT ;YES, GIVE USER A SEMI
XCTBU [IDPB T1,T2] ;...
MOVEI T1,"T" ;THEN A "T"
XCTBU [IDPB T1,T2] ;...
LNMST8: HLRZ P3,LNBLK(P3) ;GET POINTER TO NEXT LN BLOCK
JUMPE P3,LNMST9 ;NO MORE DEFINITION BLOCKS
MOVEI T1,"," ;SEPARATE WITH A COMMA
XCTBU [IDPB T1,T2] ;IN USERS STRING
JRST LNMST1 ;LOOP BACK FOR THIS DEFINITION
LNMST9: UNLOCK @LOKTAB(P4) ;ALLOW ACCESS TO LOGICAL NAME TABLE AGAIN
OKINT
UMOVEM T2,3 ;STORE UPDATED STRING POINTER
SETZ T1, ;AND TERMINATE THE STRING WITH A NULL
XCTBU [IDPB T1,T2] ;...
SMRETN ;EXIT SUCCESSFULLY
LNMSTE: POP P,T1 ;GET BACK POINTER TO STRING IN JSB
HRRZS T1
HRRZ T2,0(T1) ;GET LENGTH OF STRING
CALL RELJSB ;GIVE BACK THE STORAGE
MOVEI T1,LNSTX1 ;NO SUCH LOGICAL NAME
JRST UNLKER ;AND GIVE ERROR RETURN TO USER
; ROUTINE TO DECODE AN E-BLOCK ENTRY AND PASS THE VALUE TO USER
;
;CALLING STRING:
; MOVE T1,E-BLOCK ENTRY
; MOVE T2,POINTER TO USER STRING
; CALL STTU1
; RETURN HERE ALWAYS
STU31O: TQOA <OCTF> ;PRINT THIS NUMBER IN OCTAL
STTU31: TQZ <OCTF> ;PRINT ANY NUMBER IN DECIMAL
XCTBU [IDPB T3,T2] ;STORE PRECEEDING CHARACTER IN USER STRING
STTU1: CAMN T1,[-2] ;IS THIS A NULL STRING ENTRY?
RET ;YES, THEN WE ARE THROUGH
CAMN T1,[-3] ;IS THIS A STAR FIELD
JRST [MOVEI T1,"*" ;YES, ADD IN A STAR
XCTBU [IDPB T1,T2]
RET] ;AND RETURN
HLRZ T3,T1 ;SEE IF THIS IS A STRING
CAIE T3,(<POINT 7,0,35>);...
JRST STTNUM ;NO, IT MUST BE A NUMBER
CALLRET ST2U ;COPY STRING TO USER SPACE
ST2U: ILDB T3,T1 ;GET A CHARACTER FROM JSB
JUMPE T3,R ;THROUGH?
XCTBU [IDPB T3,T2] ;STORE IN USER AREA
JRST ST2U ;LOOP BACK
STTNUM: MOVE T3,T1 ;GET NUMBER TO BE DECODED
TLZ T3,500000 ;CLEAR NUMBER CODE
MOVEI T1,10 ;PREPARE FOR OCTAL DECODING
TQNN <OCTF> ;WANT OCTAL NUMBER?
MOVEI T1,12 ;NO, THEN GET DECIMAL
STNUM1: IDIV T3,T1 ;GET NEXT DIGIT
PUSH P,T4 ;STORE DIGIT
SKIPE T3 ;THROUGH YET?
CALL STNUM1 ;NO, RECURSE BACK FOR REST OF DIGITS
POP P,T1 ;GET BACK HIGH ORDER DIGIT
ADDI T1,60 ;MAKE IT AN ASCII NUMBER
XCTBU [IDPB T1,T2] ;STORE DIGIT IN USER STRING
RET ;AND GO BACK FOR OTHER DIGITS
;PARSING SUBROUTINES FOR LOGICAL NAME
;
;THE FOLLOWING IS THE AC USAGE THROUGHOUT THESE ROUTINES
;
; P3 - ADDRESS OF START OF E-BLOCK BEING BUILT
; P4 - 0 MEANS JOB WIDE LN, 1 MEANS SYSTEM WIDE LN
; P6 - INPUT STRING POINTER (STRING IS IN USERS ADDRESS SPACE)
; F - STATUS FLAGS AS DEFINED FOR GTJFN
; F1 - MORE STATUS FLAGS AS DEFINED FOR GTJFN
; T1 - CONTAINS CURRENT CHARACTER
; T2 - CONTAINS INDEX INTO E-BLOCK FOR INDIVIDUAL FIELDS
; T4 - NUMBER COLLECTOR DURING PARSE
; Q1 - STARTING OUTPUT POINTER
; Q2 - OUTPUT STRING POINTER (STRING IS IN JSB)
; Q3 - COUNT OF CHARACTERS LEFT IN OUTPUT STRING
;FORMAT OF THE E-BLOCK:
LNBLK==0 ;XWD LINK TO NEXT E-BLOCK, LENGTH OF E-BLOCK
LNDEV==1 ;POINTER TO DEVICE STRING
;0 MEANS NO DEFAULT WAS SPECIFIED
LNDIR==2 ;0 OR POINTER TO DIRECTORY STRING
;-3 MEANS STAR WAS TYPED
LNNAM==3 ;0 OR -3 OR POINTER TO NAME DEFAULT
LNEXT==4 ;0 OR -3 OR POINTER TO EXTENSION STRING
;-2 MEANS A NULL FIELD WAS SPECIFIED
LNVER==5 ;0 OR -3 OR POINTER TO VERSION DEFAULT
LNACT==6 ;0 OR POINTER TO ACCOUNT DEFAULT OR NUMBER
;NUMBER IS OF FORM: 5XXXXX,,XXXXXX
LNPRT==7 ;0 OR A NUMBER
LNTMP==10 ;0 IF NOT TEMPORARY
;-1 IF TEMPORARY
LNATR==11 ;ATTRIBUTE CHAIN
;LH = PREFIX VALUE OF CURRENT PREFIX
;RH = POINTER TO ATTRIBUTE CHAIN
LNLEN==12 ;LENGTH OF E-BLOCK
; LNPARS - ROUTINE TO PARSE THE USER'S STRING AND SET UP AN E-BLOCK
;
;CALLING SEQUENCE:
; MOVE T2,BYTE POINTER TO USER'S STRING
; CALL LNPARS
; UNSUCCESSFUL RETURN, ERROR CODE IN T1 AND UPDATED STRING POINTER IN T2
; RETURN HERE WITH E-BLOCK BUILT AND ADDRESS OF E-BLOCK IN T1
; UPDATED STRING POINTER IN T2
LNPARS: STKVAR <LNPRV1,LNPRV2,LNPRV3,LNPRV4>
SETZM LNPRV1 ;POINTER TO LAST E-BLOCK BUILT
SETZM LNPRV3 ;POINTER TO FIRST LN-BLOCK
LNPAR0: CALL LNPRS ;GO PARSE THE FIRST E-BLOCK
JRST LNPAR3 ;ERROR DURING PARSE
SKIPN LNPRV1 ;IS THIS THE FIRST E-BLOCK BUILT
MOVEM T1,LNPRV3 ;YES, SAVE POINTER TO FIRST ONE
SKIPE T3,LNPRV1 ;GET POINTER TO LAST BLOCK
HRLM T1,LNBLK(T3) ;PUT IN FORWARD POINTER TO NEXT BLOCK
MOVEM T1,LNPRV1 ;SAVE THE POINTER TO THIS BLOCK
XCTBU [LDB T3,T2] ;GET TERMINATOR CHARACTER
MOVEM T2,LNPRV2 ;SAVE T2
SKIPA ;PROCEED
LNPAR1: XCTBU [ILDB T3,T2] ;GET NEXT CHARACTER FROM USER
JUMPE T3,LNPAR2 ;IF END OF STRING, GO RETURN
MOVEM T2,LNPRV2 ;SAVE NEW STRING POINTER
MOVE T2,T3 ;GET CHARACTER IN T2
CALL GTCODE ;GET CHARACTER CLASS CODE
JRST [ MOVE T2,LNPRV2 ;ERROR
JRST LNPAR3] ;RETURN TO CALLER
CAIN T2,SPACHR ;A SPACE?
JRST [ MOVE T2,LNPRV2 ;YES. GET BACK STRING POINTER
JRST LNPAR1] ;AND PEEL OFF SPACES
CAIE T2,COMCHR ;IS IT A LIST SEPARATOR?
JRST LNPAR2 ;NO. ALL DONE THEN
MOVE T2,LNPRV2 ;SET UP TO PARSE NEXT E-BLOCK
JRST LNPAR0 ;LOOP BACK FOR THIS E-BLOCK DEFINITION
LNPAR2: MOVE T1,LNPRV3 ;GET POINTER TO FIRST E-BLOCK
MOVE T2,LNPRV2 ;GET STRING POINTER
RETSKP ;AND EXIT TO CALLER
LNPAR3: MOVEM T2,LNPRV2 ;AN ERROR OCCURED, GO RELEASE E-BLOCKS
MOVEM T1,LNPRV4 ;SAVE ERROR CODE
LNPAR4: SKIPE T1,LNPRV3 ;IS THERE A PREVIOUS E-BLOCK?
CALL RELLN ;YES, RELEASE IT
MOVE T1,LNPRV4 ;GET ERROR CODE
MOVE T2,LNPRV2 ;GET UPDATED STRING POINTER
RET ;AND GIVE ERROR RETURN
LNPRS: SETZB Q3,P3 ;START WITH A CLEAN SET OF POINTER ACS
SETZB F,F1 ;THESE ACS CONTROL THE PARSING
MOVE P6,T2 ;GET POINTER TO USER STRING
MOVEI T1,LNLEN ;GO GET A BLOCK FOR THIS LOGICAL NAME
CALL GTEMP ; FROM THE JSB FREE POOL
JRST LNEROR ;NONE THERE
HRRZ P3,T2 ;SET UP POINTER TO E-BLOCK
CALL GETTMP ;GET A TMP STRING FOR PARSED STRINGS
JRST LNEROR ;UNSUCCESSFUL, GO CLEAN UP AND RETURN
LNPR1: CALL CCGET ;GET A CHARACTER FROM THE USERS STRING
JRST LNDONE ;NONE LEFT, TREAT IT AS CONFIRMING CHAR
MOVE T2,T1 ;NOW GET CHARACTER TYPE
CALL GTCODE ;GET CHARACTER CLASS CODE
JRST LNEROR ;NO, ILLEGAL CHARACTER CODE
CAIN T2,SPACHR ;IS THIS A SPACE OR TAB?
JRST LNPR1 ;YES. FLUSH IT AND PROCEED
XCT CCTAB(T2) ;GO PROCESS CHARACTER
JRST LNEROR ;UNSUCCESSFUL, GO PROCESS ERROR AND CLEAN UP
JRST LNPR1 ;LOOP BACK FOR ALL CHARACTERS
;ROUTINE TO GET CHARACTER CLASS CODE
;ACCEPTS CHARACTER IN T2
;SKIP RETURNS WITH CLASS CODE IN T2
;**;[1754] INSERT 2 LINES AT GTCODE:: ARS 2-JUL-80
GTCODE::CAILE T2,.CHDEL ;[1754] VALID ASCII CHAR?
RETBAD (GJFX4) ;[1754] NO
IDIVI T2,CCBPW ;GET BYTE POSITION IN TABLE
LDB T2,CPTAB(T3) ;GET THE CHAR CODE (SEE GTJFN FOR TABLE)
CAIL T2,ECCTAB-CCTAB ;WITHIN BOUNDS?
RETBAD (GJFX4) ;NO, ERROR
RETSKP
; CHARACTER CLASS TRANSFER TABLE
;
; THIS TABLE IS BASED ON THE CHARACTER CLASS DEFINITIONS AS SET
; UP BY GTJFN. THIS WAS DONE TO HAVE THE LOGICAL NAME ROUTINES
; BE CONSISTENT WITH ANY CHANGES TO THE SYNTAX OF A FILE STRING
; THAT MIGHT BE ADDED TO GTJFN IN THE FUTURE.
CCTAB: CALL CC0 ; (0) UPPER CASE CHARACTER
CALL CC1 ; (1) LOWER CASE CHARACTER
JRST CCILL ; (2) CONT-U - ILLEGAL
JRST CCILL ; (3) CONT-R - ILLEGAL
COMCHR==.-CCTAB
JRST LNDONE ; (4) COMMA
SPACHR==.-CCTAB
JRST LNDONE ; (5) SPACE
JRST CCILL ; (6) CONT-F AND CONT-U - ILLEGAL
TRMCHR==.-CCTAB ;TERMINATION CHARACTER
JRST LNDONE ; (7) CONFIRMING CHARACTER
JRST CCILL ; (10) ALTMODE - ILLEGAL
CALL CC11 ; (11) COLON
CALL CC12 ; (12) OPEN ANGLE BRACKET
CALL CC13 ; (13) CLOSE ANGLE BRACKET
CALL CC14 ; (14) DOT
CALL CC15 ; (15) SEMI-COLON
CALL CC16 ; (16) CONTROL-V
JRST CCILL ; (17) ILLEGAL CHARACTER
CALL CC0 ; (20) ASTERISK
CALL CC21 ; (21) DIGIT
CALL CC22 ; (22) UPPER CASE T
CALL CC23 ; (23) UPPER CASE P
CALL CC24 ; (24) UPPER CASE A
CALL CC25 ; (25) LOWER CASE T
CALL CC26 ; (26) LOWER CASE P
CALL CC27 ; (27) LOWER CASE A
CALL CC30 ; (30) MINUS SIGN
JRST CCILL ; (31) CONT-X - ILLEGAL
JRST CCILL ; (32) ? - ILLEGAL
CALL CC0 ; (33) WILD CHARACTER
CALL RSKP ;(34) IGNORE CARRIAGE RETURN
ECCTAB:
; LOWER AND UPPER CASE LETTER ROUTINES
CC1: SUBI T1,40 ;MAKE THIS AN UPPER CASE LETTER
CC0: TQZN <TMPFF> ;ENTERING A ;T?
TQZE <KEYFF> ;WAS THE LAST CHAR A SEMI-COLON?
TQO <PFXFF> ;YES, NOW COLLECTING A PREFIX
TQZ <NUMFF> ;INVALIDATE ANY MORE DIGITS
TQZN <PRTFF> ;COLLECTING A PROTECTION?
JRST CC0A ;NO
TQO <PFXFF> ;YES, NOW COLLECTING A PREFIX
CAIE Q3,MAXLC ;IS THE STRING EMPTY STILL?
RETBAD (GJFX40) ;NO, ILLEGAL PREFIX
PUSH P,T1 ;SAVE THE CHAR
MOVEI T1,"P" ;PUT IN THE "P" AS THE FIRST CHAR
CALL CC0A
RETBAD (,<POP P,0(P)>) ;ERROR OCCURED
POP P,T1 ;GET BACK THE CHAR
CC0A: TQNE <STARF> ;HAS A STAR BEEN TYPED IN PREVIOUSLY?
RETBAD GJFX31 ;YES, ILLEGAL FORMAT
SOJL Q3,[RETBAD GJFX5] ;IS THE IDENTIFIER TOO LONG
IDPB T1,Q2 ;STORE THIS LETTER IN OUTPUT STRING
RETSKP ;AND RETURN FOR MORE INPUT
; COLON
CC11: TQNE <STARF> ;TRYING TO USE WILD CARD DEVICE?
RETBAD GJFX31 ;YES, THAT IS NOT LEGAL
TQZE <PFXFF> ;GATHERING A PREFIX?
JRST STOPFX ;YES, GO STORE IT
TQOE <DEVF> ;MARK THAT A DEVICE WAS SEEN
RETBAD GJFX6 ;ERROR IF ALREADY SEEN A DEVICE
TQNN <DIRFF> ;SEEN AN OPEN ANGLE BRACKET?
TQNE <DIRF,NAMF> ;OR ALREADY HAVE A NAME OR DIR?
RETBAD GJFX6 ;YES, ILLEGAL SYNTAX
MOVEI T2,LNDEV(P3) ;GET E-BLOCK ENTRY FOR DEVICE FIELD
CALLRET STOSTR ;GO STORE THIS STRING
; OPEN ANGLE BRACKET
CC12: CAIGE Q3,MAXLC ;HAVE ANY CHARACTERS BEEN SEEN YET?
RETBAD GJFX7 ;YES, ERROR IN SYNTAX FOR DIR
TQNN <DIRF,NAMF> ;ALREADY SEEN NAME OR DIR?
TQOE <DIRFF> ;OR IS A DIRECTORY ALREADY IN PROGRESS?
RETBAD GJFX8 ;YES, BAD SYNTAX: TWO OPEN ANGLE BRACKETS
RETSKP ;RETURN
; CLOSE ANGLE BRACKET
CC13: TQZE <DIRFF> ;SEEN OPEN ANGLE BRACKET YET?
TQOE <DIRF> ;ALREADY HAVE A DIRECTORY?
RETBAD GJFX7 ;YES, BAD SYNTAX
TQNE <NAMF> ;ALREADY SEEN A NAME?
RETBAD GJFX7 ;YES, BAD SYNTAX: DIR MUST BE BEFORE NAME
MOVEI T2,LNDIR(P3) ;GET E-BLOCK ADDRESS FOR DIR
CALLRET STOSTR ;GO STORE THIS STRING
; DOT
CC14: TQNE <DIRFF,ACTFF> ;ENTERING A DIR NAME OR ACCOUNT STR?
JRST CC0A ;YES, DOT IS LEGAL
TQOE <NAMF> ;ALREADY SEEN A NAME?
JRST [ TQZE <EXTFF> ;EXTENSION NEXT?
TQNE <EXTF> ;HAVE AN EXTENSION?
RETBAD (GJFX9) ;YES. ERROR
CALLRET STOEXT] ;NO. GO STORE EXTENSION
TQNE <EXTF> ;SEEN AN EXTENSION?
RETBAD GJFX9 ;BAD SYNTAX, FILE NAME OUT OF ORDER
TQO <EXTFF> ;MARK THAT AN EXTENSION IS NEXT
STOFIL: TQO <NAMF> ;MARK THAT A NAME WAS SEEN
MOVEI T2,LNNAM(P3) ;GET E-BLOCK ADDRESS FOR NAME
TQNE <STARF> ;WAS THIS A STARRED FIELD?
JRST STOFL1 ;YES, GO STORE STAR
CAIL Q3,MAXLC ;NO, IF NULL FILE NAME, DONT STORE IT
JRST NUMINI ;NULL NAME IS ILLEGAL, NEVER USE AS DEFAULT
STOFL1: CALLRET STOSTR ;GO STORE THE STRING
; SEMI-COLON
CC15: TQNE <DIRFF> ;IN A DIRECTORY NAME?
RETBAD (GJFX4) ;YES, SEMI COLON IS ILLEGAL
TQOE <KEYFF> ;SEMI-COLON LAST CHARACTER TOO?
RETBAD GJFX10 ;YES, ERROR IN SYNTAX
TQZE <EXTFF> ;GETTING AN EXTENSION?
JRST [ CALL STOEXT ;YES. GO STORE IT
RETBAD ;RETURN ERROR
SETZ T4, ;DEFAULT VERSION
CALLRET STOVER] ;GO STORE THE DEFAULT VERSION AS WELL
TQZE <ACTFF> ;IS THIS AN ACCT FIELD
JRST [CALLRET STOACT] ;YES, GO STORE IT
TQZE <PRTFF> ;IS IT A PROTECTION FIELD?
JRST [CALLRET STOPRT] ;YES, GO STORE PROTECTION
TQZE <TMPFF> ;GETTING A ;T?
JRST [ CALLRET STOTMP] ;YES
TQZE <PFXFF> ;GETTING A PREFIX?
JRST [ CALLRET STOPFO] ;YES, STORE PREFIX ONLY
TQZE <ATRFF> ;GETTING AN ATTRIBUTE VALUE?
JRST [ CALLRET STOATR] ;YES, GO STORE THE ATTRIBUTE
TQNN <NAMF> ;IS THIS A NAME FIELD
JRST [CALLRET STOFIL] ;YES, THEN GO STORE IT
CALLRET STOVER ;THIS MUST BE A VERSION
; CONTROL-V
CC16: CALL CCGET ;GET NEXT CHARACTER FROM USER STRING
RETBAD GJFX15 ;CONTROL-V ON A NULL IS AN ERROR
CALLRET CC0 ;GO STORE THIS CHARACTER AS IS
; DIGITS
CC21: TQZ <KEYFF> ;CLEAR "LAST CHARACTER WAS A SEMI" FLAG
CAIGE Q3,MAXLC-7 ;ONLY 7 DIGITS ARE LEGAL
JRST [CALLRET CC0] ;TREAT THIS AS A STRING NOW
TQNE <OCTF> ;OCTAL?
CAIGE T1,"8" ; AND A LEGAL DIGIT
TQNN <NUMFF> ;NUMBERS STILL VALID?
JRST [CALLRET CC0] ;NO, TREAT THIS AS A STRING
MOVEI T2,12 ;SET UP FOR DECIMAL
TQNE <OCTF> ;OCTAL?
MOVEI T2,10 ;YES
IMUL T4,T2 ;ADD THIS DIGIT INTO NUMBER BEING FORMED
TQNN <NEGF> ;NEGATIVE NUMBER?
ADDI T4,-60(T1) ;NO, ADD IN DIGIT
TQNE <NEGF> ;NEGATIVE NUMBER?
SUBI T4,-60(T1) ;YES, SUBTRACT LOW ORDER DIGIT
CALLRET CC0A ;GO UPDATE STRING ALSO
; LOWER AND UPPER CASE T
CC25: SUBI T1,40 ;MAKE IT UPPER CASE
CC22: TQZN <KEYFF> ;WAS THE LAST CHAR A SEMI COLON?
JRST [CALLRET CC0] ;NO, THIS IS THE LETTER T
TQNE <TMPTF> ;ALREADY SEEN A ;T?
RETBAD GJFX4 ;YES, SYNTAX ERROR
TQO <TMPFF> ;MARK THAT WE ARE GATHERING A ;T
CALLRET CC0A ;STORE THE "T" IN THE STRING
; LOWER AND UPPER CASE P
CC26: SUBI T1,40 ;MAKE THIS INTO AN UPPER CASE P
CC23: TQZN <KEYFF> ;WAS LAST CHARACTER A SEMI-COLON
JRST [CALLRET CC0] ;NO, TREAT AS NORMAL CHARACTER
TQNE <PRTF> ;ALREADY HAVE PROTECTION?
RETBAD GJFX13 ;YES, TWO PROT FIELDS IS TOO MANY
TQO <PRTFF,NUMFF> ;MARK THAT A PROTECTION IS BEING SPECIFIED
JRST OCTINI ;GO INITIALIZE FOR AN OCTAL NUMBER AND RETURN
; LOWER AND UPPER CASE A
CC27: SUBI T1,40 ;MAKE IT AN UPPER CASE A
CC24: TQZN <KEYFF> ;WAS THE LAST CHAR A SEMI-COLON?
JRST [CALLRET CC0] ;NO, TREAT THIS AS A NORMAL CHARACTER
TQNE <ACTF> ;ALREADY HAVE ACCOUNT FIELD?
RETBAD GJFX12 ;YES, ERROR
TQO <ACTFF> ;MARK THAT ACCT IS BEING SPECIFIED
JRST NUMINI ;INITIALIZE FOR DECIMAL NUMBER AND RETSKP
; MINUS SIGN
CC30: JUMPN T4,[CALLRET CC0] ;IF SOME DIGITS HAVE BEEN SEEN TREAT AS A STRING
TQOE <NEGF> ;HAS A MINUS SIGN BEEN TYPED ALREADY?
JRST [CALLRET CC0] ;YES, TREAT AS STRING
CALLRET CC0A ;GO ADD TO STRING JUST IN CASE
STOEXT: TQOE <EXTF> ;ALREADY HAVE AN EXT?
RETBAD GJFX10 ;YES, SYNTAX ERROR
MOVEI T2,LNEXT(P3) ;GET INDEX INTO E-BLOCK
CALLRET STOSTR ;GO STORE THIS EXTENSION STRING
STOVER: TQOE <VERF> ;ALREADY HAVE A VERSION?
RETBAD GJFX11 ;YES, SYNTAX ERROR
MOVEI T2,LNVER(P3) ;GET VERSION INDEX IN E-BLOCK
TQNE <STARF> ;VERSION FIELD STARRED?
JRST [CALLRET STOAST] ;YES, GO STORE THE STAR
HRRZS T4 ;VERSIONS ARE ONLY 18 BITS
TQNE <NUMFF> ;FOUND A REAL NUMBER?
JRST [ CALLRET STONUM] ;YES. GO DO IT
CAIL Q3,MAXLC ;NO. FOUND SOME CHARACTERS?
JRST STONUL ;NO. GO STORE NULL VALUE
CAIE Q3,MAXLC-1 ;FOUND EXACTLY ONE?
RETBAD (GJFX10) ;NO. BAD,BAD
MOVE T1,Q1 ;YES. LET'S SEE IT THEN
ILDB T1,T1 ;THIS IS IT GANG
CAIE T1,"*" ;IS IT A WILD CARD?
RETBAD (GJFX10) ;NO. ILLEGAL SPEC THEN
JRST STOAST ;YES. GO SET IT UP
STOACT: TQOE <ACTF> ;ALREADY HAVE AN ACCOUNT?
RETBAD GJFX12 ;YES, SYNTAX ERROR
MOVEI T2,LNACT(P3) ;GET E-BLOCK INDEX
JUMPL T4,STOSTR ;NEGATIVE NUMBERS ARE TREATED AS STRINGS
TQNE <NUMFF> ;WAS A NUMBER ENTERED FOR ACCOUNT?
JRST [CALLRET STONUM] ;YES, GO STORE NUMBER INSTEAD OF STRING
CALLRET STOSTR ;GO STORE THE ACCOUNT STRING
STOPRT: TQOE <PRTF> ;ALREADY SEEN A PROTECTION VALUE?
RETBAD GJFX13 ;YES, THIS IS A SYNTAX ERROR
MOVEI T2,LNPRT(P3) ;GET PROTECTION INDEX
CALLRET STONUM ;GO STORE THE NUMBER
STOTMP: TQO <TMPTF> ;MARK THAT ;T WAS TYPED
SETOM LNTMP(P3) ;REMEMBER IT IN THE E-BLOCK
CALLRET STRRES ;GO INITIALIZE THE STRING
STOPFX: CALL GETPFX ;GO PARSE THE PREFIX STRING
RETBAD () ;NOT FOUND
TRNE T1,NOATRF ;DOES THIS TAKE AN ATTRIBUTE?
RETBAD (GJFX47) ;NO, ILLEGAL SYNTAX FOR ATTRIBUTE
TQO <ATRFF> ;NOW COLLECTING AN ATTRIBUTE VALUE
HRLM T1,LNATR(P3) ;STORE THE PREFIX VALUE IN E-BLOCK
CALLRET STRRES ;GO INITIALIZE THE STRING
STOPFO: CALL GETPFX ;GET PREFIX VALUE
RETBAD () ;UNKNOWN PREFIX
TRNN T1,NOATRF ;DOES THIS PREFIX HAVE A VALUE
RETBAD (GJFX46) ;YES, THEN THE VALUE MUST BE GIVEN
HRLM T1,LNATR(P3) ;SAVE THE PREFIX VALUE
CALL STRRES ;SET UP A NULL STRING
RETBAD() ;FAILED
CALLRET STOATR ;GO STORE A NULL ATTRIBUTE VALUE
GETPFX: MOVEI T1,0 ;TIE THE STRING OFF WITH A NULL BYTE
IDPB T1,Q2 ;STORE THE NULL
MOVE T2,Q1 ;GET STRING POINTER
MOVEI T1,PRFXTB ;AND POINTER TO PREFIX TABLE
TBLUK ;LOOKUP THE PREFIX
ERJMP [RETBAD (GJFX40)] ;UNKNOWN PREFIX
TXNN T2,TL%ABR!TL%EXM ;FOUND ONE?
RETBAD (GJFX40) ;NO, UNKNOWN ATTRIBUTE
HRRZ T1,0(T1) ;GET THE PREFIX VALUE
RETSKP ;AND RETURN
STOATR: MOVEI T1,0 ;END STRING WITH A NULL
IDPB T1,Q2
HRRZS T1,Q1 ;GET THE START ADR OF THE STRING
HRRZ T2,Q2 ;AND THE END OF THE STRING
CALL @TRMTAB(P4) ;TRIM THE STRING BLOCK
HRR T1,LNATR(P3) ;GET POINTER DOWN THE CHAIN
HRLM T1,0(Q1) ;MAKE THE NEW BLOCK POINT DOWN THE CHAIN
HLRZ T1,LNATR(P3) ;GET THE PREFIX VALUE
STOR T1,PRFXV,(Q1) ;STORE THE VALUE IN THE STRING HEADER
HRRZM Q1,LNATR(P3) ;SET UP CHAIN POINTER IN E-BLOCK
CALL GETTMP ;SET UP ANOTHER STRING
RETBAD () ;FAILED
CALLRET NUMINI ;GO SET UP FOR THE NEXT FIELD
; ILLEGAL CHARACTER
CCILL: RETBAD GJFX4 ;ILLEGAL CHATRACTER
; ROUTINE TO STORE A STRING IN THE E-BLOCK
;
;CALLING SEQUENCE:
; MOVE T2,ADDRESS IN E-BLOCK OF WHERE TO STORE STRING
; CALL STOSTR
; RETURN HERE ALWAYS WITH Q1, Q2, AND Q3 SET UP FOR NEXT STRING
STOSTR: TQZE <STARF> ;SEEN A STAR?
JRST STOAST ;YES, GO NOTE THAT FACT
CAIL Q3,MAXLC ;WERE ANY CHARACTERS ENTERED IN THIS FIELD?
JRST STONUL ;NO, MARK THAT IT WAS NULL
MOVEI T1,0 ;END THE STRING
IDPB T1,Q2 ; WITH A NULL
MOVEM Q1,(T2) ;STORE THE STRING POINTER
HRRZ T1,Q1 ;GO TRIM THE BLOCK DOWN
HRRZ T2,Q2 ;LAST WORD USED
CALL @TRMTAB(P4) ;RETURN UNUSED WORDS TO FREE POOL
CALL GETTMP ;GET A NEW STRING BLOCK
RET ;ERROR RETURN
JRST NUMINI ;GO INITIALIZE FLAGS
;ROUTINES TO STORE ASTERISK, NULL, AND NUMBER
;
; THESE ROUTINES HAVE THE SAME CALLING SEQUENCE AS STOSTR
STONUL: SKIPA T1,[-2] ;-2 MEANS NULL FIELD IN E-BLOCK
STOAST: MOVNI T1,3 ;-3 MEANS A STAR WAS ENTERED
MOVEM T1,(T2) ;STORE THE VALUE
JRST STRRES ;GO RECYCLE STRING AND RETURN
STONUM: SKIPL T4 ;NEGATIVE NUMBERS ARE NOT ALLOWED
TQNN <NUMFF> ;IS THIS A NUMBER?
RETBAD GJFX14 ;NO, SYNTAX ERROR
TLO T4,500000 ;MARK THAT THIS IS A NUMBER, NOT A STRING
MOVEM T4,(T2) ;STORE IN E-BLOCK
STRRES: MOVE Q2,Q1 ;RECYCLE THE TEMPORARY STRING BLOCK
MOVEI Q3,MAXLC ;GIVE IT THE FULL CHARACTER COUNT
;...
;COMMON EXIT ROUTINES TO INITIALIZE FLAGS AND NUMBER REGISTER
;NUMINI SETS UP FOR A DECIMAL NUMBER, AND
;OCTINI SETS UP FOR AN OCTAL NUMBER
;BOTH ROUTINES SKIP RETURN
NUMINI: TQZA <OCTF> ;INITIALIZE FOR A DECIMAL NUMBER
OCTINI: TQO <OCTF> ;SET UP FOR AN OCTAL NUMBER
TQZ <NEGF> ;AND CLEAR NEGATIVE FLAG
TQO <NUMFF> ;INITIALIZE NUMBER FLAG
SETZ T4, ;INITAILIZE NUMBER GATHERING AC
RETSKP ;AND RETURN
; CONFIRMING CHARACTER OR SPACE
LNDONE: TQNE <STARF> ;WAS A STAR TYPED?
JRST LNDON0 ;YES, GO STORE IT
CAIL Q3,MAXLC ;WERE THERE ANY CHARACTERS ENTERED
JRST LNDON1 ;NO, THEN THE PARSE IS THROUGH
LNDON0: TQNE <ACTFF> ;CURRENTLY DOING AN ACCOUNT FIELD?
JRST [CALL STOACT ;YES, GO STORE THIS ACCOUNT STRING
JRST LNEROR ;UNSUCCESSFUL, GO PROCESS ERROR AND CLEAN UP
JRST LNDON1] ;THEN FINISH
TQNE <PRTFF> ;PROTECTION FIELD BEING ENTERED
JRST [CALL STOPRT ;YES, GO STORE PROTECTION FIELD
JRST LNEROR ;UNSUCCESSFUL, GO PROCESS ERROR AND CLEAN UP
JRST LNDON1] ;THEN RETURN
TQZE <TMPFF> ;GETTING A ;T?
JRST [ CALL STOTMP ;YES, STORE IT
JRST LNEROR ;FAILED
JRST LNDON1]
TQZE <PFXFF> ;GETTING A PREFIX?
JRST [ CALL STOPFO ;YES, STORE IT WITH A NULL VALUE
JRST LNEROR
JRST LNDON1]
TQZE <ATRFF> ;GETTING AN ATTRIBUTE VALUE?
JRST [ CALL STOATR ;YES, GO STORE IT ON LNATR CHAIN
JRST LNEROR
JRST LNDON1]
TQNE <EXTFF> ;EXTENSION BEING SPECIFIED?
JRST [CALL STOEXT ;YES, GO STORE FINAL EXTENSION
JRST LNEROR ;UNSUCCESSFUL, GO PROCESS ERROR AND CLEAN UP
JRST LNDON1] ;THEN FINISH
TQNE <DIRFF> ;GETTING DIRECTORY?
JRST [MOVEI T1,GJFX8 ;YES, NO CLOSING ANGLE BRACKET
JRST LNEROR] ;GO CLEAN UP
TQNE <NAMF> ;HAS A NAME BEEN SEEN?
JRST [CALL STOVER ;YES, THEN THIS MUST BE A VERSION NUMBER
JRST LNEROR ;UNSUCCESSFUL, GO PROCESS ERROR AND CLEAN UP
JRST LNDON1] ;FINISHED!
CALL STOFIL ;THIS MUST BE A FILE, SO GO STORE IT
JRST LNEROR ;UNSUCCESSFUL, GO PROCESS ERROR AND CLEAN UP
LNDON1: MOVEI T1,0(Q1) ;GET TEMP STRING
CALL RELTMP ;RELEASE IT BACK TO POOL
MOVE T1,P3 ;RETURN WITH POINTER TO E-BLOCK IN T1
MOVE T2,P6 ;AND UPDATED STRING POINTER IN T2
RETSKP ;TAKE SUCCESSFUL RETURN
;ROUTINE TO HANDLE ERRORS AND CLEAN UP THE FREE SPACE POOL
;
;CALLING SEQUENCE:
; MOVE T1,ERROR CODE
; JRST LNEROR
;
;THIS ROUTINE RETURNS TO THE CALLER OF THE LNPARS ROUTINE WITH A NON-SKIP RETURN
LNEROR: PUSH P,T1 ;SAVE ERROR CODE
JUMPE Q3,LNER1 ;IS THERE A STRING POINTER IN Q1?
HRRZI T1,0(Q1) ;YES, GO RETURN IT TO THE POOL
CALL RELTMP ;...
LNER1: JUMPE P3,LNER2 ;IS THERE AN E-BLOCK YET
MOVE T1,P3 ;YES, GO RETURN ALL STRINGS IN E-BLOCK
CALL RELLN ;AND ALSO THE E-BLOCK ITSELF
LNER2: POP P,T1 ;RESTORE ERROR CODE TO AC T1
MOVE T2,P6 ;GET UPDATED STRING POINTER INTO T2
RET ;AND TAKE NON-SKIP RETURN
;ROUTINE TO RELEASE AN E-BLOCK TO THE FREE POOL
;
;CALLING SEQUENCE:
; MOVE T1,ADDRESS OF E-BLOCK TO BE RETURNED
; CALL RELLN
; RETURN HERE ALWAYS
RELLN: ASUBR <RELLNA,RELLNB,RELLNC>
RELLN2: HLRZ T2,LNBLK(T1) ;GET POINTER TO NEXT E-BLOCK
MOVEM T2,RELLNB ;SAVE POINTER TO NEXT E-BLOCK
MOVEM T1,RELLNA ;SAVE ADDRESS OF THIS E-BLOCK
CALL RELATR ;GO RELEASE THE ATTRIBUTE CHAIN
MOVE T1,RELLNA ;GET BACK THE ADR OF THIS E-BLOCK
HRLZI T3,1-LNLEN ;SET UP AN AOBJN POINTER TO E-BLOCK
HRRI T3,1(T1) ;...
RELLN0: SKIPN T2,0(T3) ;IS THERE A STRING IN THIS FIELD
JRST RELLN1 ;NO, GO CHECK OTHER FIELDS
HLRZ T1,0(T3) ;GET LEFT HALF
CAIE T1,(<POINT 7,0,35>);IS THIS A STRING POINTER?
JRST RELLN1 ;NO, IGNORE IT
HRRZ T1,T2 ;GET ADDRESS OF STRING
MOVEM T3,RELLNC ;SAVE AOBJN POINTER
CALL RELTMP ;RELEASE THE STRING
MOVE T3,RELLNC ;RESTORE AOBJN POINTER
RELLN1: AOBJN T3,RELLN0 ;LOOP BACK FOR OTHER FIELDS
MOVE T1,RELLNA ;GET THE ADDRESS OF THE E-BLOCK
CALL RELTMP ;GO RELEASE IT TOO
MOVE T1,RELLNB ;GET THE POINTER TO THE NEXT E-BLOCK
JUMPN T1,RELLN2 ;IF ONE THERE, GO RELEASE IT TOO
RET ;AND RETURN
;ROUTINE TO RELEASE THE ATTRIBUTE CHAIN
; ACCEPTS IN T1/ ADDRESS OF THE E-BLOCK
;**;[7418] Replace 1 line with 2 at RELATR:+0L MDR 24-FEB-87
RELATR: HRRZ T2,LNATR(T1) ;[7418] Get attribute chain
SKIPN T2 ;[7418] Is there one?
RET ;NO
SETZM LNATR(T1) ;YES, CLEAR IT OUT
HRRZ T1,T2 ;GET THE POINTER TO THE FIRST BLOCK
RELAT1: HLRZ T2,0(T1) ;GET THE POINTER TO THE NEXT BLOCK
PUSH P,T2 ;SAVE IT
LOAD T2,PRFXS,(T1) ;GET THE LENGTH OF THE BLOCK
MOVEM T2,0(T1) ;STORE LENGTH IN FIRST WORD OF BLOCK
CALL RELTMP ;AND RELEASE THE BLOCK
POP P,T1 ;GET THE POINTER TO THE NEXT BLOCK
JUMPN T1,RELAT1 ;LOOP BACK FOR REST OF THE BLOCKS
RET ;ALL DONE
;ROUTINE TO RELEASE A BLOCK BACK TO THE JSB FREE POOL
;
;CALLING SEQUENCE:
; MOVE T1,ADDRESS OF BLOCK TO BE RETURNED TO POOL
; CALL RELTMP
; RETURN HERE ALWAYS
RELTMP: HRRZS T1 ;GET ADDRESS ONLY
HRRZ T2,0(T1) ;GET LENGTH OF BLOCK
NOINT ;DONT ALLOW INTERRUPTS
CALL @RELTAB(P4) ;RELEASE THE SPACE
OKINT ;DONE WITH UNINTERRUPTIBLE CODE
RET ;RETURN TO CALLER
; ROUTINE TO GET A CHARACTER FROM THE USER'S STRING
;
;CALLING SEQUENCE
; CALL CCGET
; RETURN HERE IF NO MORE CHARACTERS IN STRING
; RETUURN HERE WITH CHAR IN T1
CCGET: XCTBU [ILDB T1,P6] ;GET THE NEXT CHARACTER
JUMPN T1,RSKP ;IF NOT NULL, GIVE SKIP RETURN
RET ;NULL, GIVE NON-SKIP RETURN
; ROUTINE TO GET A BLOCK OF CORE IN THE JSB FOR A STRING
;
;CALLING SEQUENCE
; CALL GETTMP
; RETURN HERE IF UNSUCCESSFUL WITH ERROR CODE IN T1
; RETURN HERE WITH STRING POINTER IN Q1 AND Q2
; AND CHARACTER COUNT IN Q3
GETTMP: MOVEI T1,MAXLW+1 ;GET A BLOCK LARGE ENOUGH FOR LONGEST STRING
CALL GTEMP ;GET A BLOCK FROM THE FREE POOL
RET ;AN ERROR HAPPENED
HRLI T2,(<POINT 7,0,35>);SET UP POINTER
MOVE Q1,T2 ;SKIP OVER HEADER WORD IN BLOCK
MOVE Q2,Q1 ;MAKE A COPY OF INITIAL POINTER
MOVEI Q3,MAXLC ;SET UP CHARACTER COUNT
RETSKP ;AND RETURN
;ROUTINE TO ACTUALLY GET SPACE FROM THE JSB FREE POOL
;
;CALLING SEQUENCE:
; MOVE T1,# OF WORDS NEEDED IN BLOCK
; CALL GTEMP
; RETURN HERE IF UNSUCCESSFUL, ERROR CODE IN T1
; RETURN HERE WITH ADDRESS OF BLOCK IN T2
GTEMP: NOINT ;GUARD AGAINST CONFUSION IN JOB FREE POOL
CALL @ASGTAB(P4) ;GET BLOCK
JRST [OKINT ;NO MORE ROOM
SETZ Q3, ;MARK THAT THERE IS NO STRING IN Q1
RETBAD GJFX22] ;GIVE ERROR RETRUN TO USER
OKINT ;WE ARE THROUGH THE RACE PRONE CODE
MOVE T2,T1 ;GET ANSWER IN T2
HRRZ T3,0(T1) ;NOW ZERO THE BLOCK
ADDI T3,-1(T1) ;T3 NOW POINTS TO LAST WORD OF BLOCK
HRRZS 0(T1) ;CLEAR OUT LEFT HALF OF FIRST WORD
SETZM 1(T1) ;ZERO THE FIRST DATA WORD OF BLOCK
HRLI T1,1(T1) ;GET SOURCE POINTER
HRRI T1,2(T1) ;AND DESTINATION
BLT T1,0(T3) ;ZERO THE BLOCK
RETSKP ;GIVE THE OK RETURN
;TABLES FOR DIFERENTIATING BETWEEN JOB WIDE AND SYSTEM LOGICAL NAMES
;ALL TABLES ARE INDEXED BY P4 WHICH MUST CONTAIN EITHER 0 OR 1
LOKTAB: IFIW!LNMLCK ;JOB WIDE LOGICAL NAME LOCK
IFIW!SYLNLK ;SYSTEM LOGICAL NAME LOCK
ASGTAB: IFIW!ASGJSB ;ROUTINE TO GET STORAGE FROM JSB
IFIW!ASGSWP ;ROUTINE TO GET SWAPPABLE STORAGE
RELTAB: IFIW!RELJSB ;ROUTINE TO RELEASE JSB STORAGE
IFIW!RELSWP ;ROUTINE TO RELEASE SWAPPABLE STORAGE
LNTAB: IFIW!LNTABP ;ADDR OF POINTER TO JOB WIDE LN TABLE
IFIW!SYLNTB ;ADDRESS OF POINTER TO SYSTEM LN TABLE
TRMTAB: IFIW!TRMBLK ;ADR OF ROUTINE TO TRIM A JSB BLOCK
IFIW!TRMSWP ;ADR OF ROUTINE TO TRIM A SWP BLOCK
;ROUTINE TO GET STORAGE FROM JSB
;ACCEPTS IN T1/ # OF WORDS NEEDED FROM JSB
; CALL ASGJSB
;RETURNS +1: ERROR - ERROR CODE IN T1
; +2: SUCCESSFUL - ADDRESS OF STRING IN T1
ASGJSB: MOVE T2,T1 ;GET DESIRED # OF WORDS FROM JSB
CALLRET ASGJFR ;GO GET SPACE
;ROUTINE TO RELEASE JSB STORAGE
;ACCEPTS IN T1/ ADDRESS OF BLOCK
; T2/ LENGTH OF BLOCK
; CALL RELJSB
;RETURNS +1: ALWAYS
RELJSB: HRRZM T2,0(T1) ;STORE LENGTH OF BLOCK
MOVE T2,T1 ;SET UP FOR CALL TO RELFRE
MOVEI T1,JSBFRE
CALLRET RELFRE ;GO RELEASE BLOCK
;ROUTINE TO TRIM A BLOCK THAT IS IN THE SWAPPABLE POOL
;ACCEPTS IN T1/ START ADR OF BLOCK
; T2/ ADR OF LAST WORD USED IN BLOCK
; CALL TRMSWP
;RETURNS +1 ALWAYS
TRMSWP: MOVEI T3,SWPFRE ;GET ADDRESS OF POOL HEADER
CALLRET TRIMER ;GO TRIM THE BLOCK
;ROUTINES CALLED BY GTJFN TO GET DEFAULT FIELDS FROM THE LOGICAL NAME DEFINITION
;THE FOLLOWING ROUTINES: GLNDEV, GLNDIR, GLNNAM, ETC. ARE CALLED TO
; GET A SPECIFIC DEFAULT STRING COPIED FROM THE LOGICAL NAME DEFINITION
; TO THE DEFAULT STRING POINTED TO BY THE LEFT HALF OF FILTMP(JFN).
;CALLING SEQUENCE:
; CALL GLNXXX ;DEV, DIR, NAM, EXT, ACT, PRT, VER
; UNSUCCESSFUL RETURN, NO DEFAULT OR NO LGICAL NAME
; SUCCESSFUL, LH(FILTMP) POINTS TO DEFAULT STRING
; T1/ NUMBER (UNLESS A STRING)
; T2/ 0 IF NUMBER, -1 IF STRING IN LH(FILTMP)
GLNDEV::MOVEI T1,LNDEV ;GET DEVICE FIELD OF LOGICAL NAME
CALLRET GLNSTR ;GO COPY STRING
GLNDIR::MOVEI T1,LNDIR ;GET DIRECTORY DEFAULT FROM LOGICAL NAME
CALLRET GLNSTR ;COPY STRING
GLNNAM::MOVEI T1,LNNAM ;GET NAME FIELD
CALLRET GLNSTR ;COPY DEFAULT STRING
GLNEXT::MOVEI T1,LNEXT ;GET EXTENSION FIELD (COULD BE NULL)
CALLRET GLNSTR ;COPY STRING
GLNVER::MOVEI T1,LNVER ;GET VERSION NUMBER
CALL GLNNUM ;RETURN A NUMBER OR A STAR
RET ;NO DEFAULT
HRRES T1 ;MAKE THIS A FULL WORD VERSION
; WHERE -3 MEANS STAR
RETSKP ;AND RETURN
GLNACT::PUSH P,P4 ;SAVE THE PERMANENT ACS USED
MOVEI T1,LNACT ;GET DESIRED FIELD
MOVEI T2,FILLNM(JFN) ;GET ADDRESS OF CHAIN HEADER WORD
CALL GLNFLD ;GET THE DEFAULT
JRST [ POP P,P4 ;NO DEFAULT
JRST RFALSE] ;RETURN 0 IN T1
CAMG T1,[577777,,-1] ;IS THIS A NUMBER
CAMGE T1,[500000,,0] ;...
JRST GLNST1 ;NO, STORE THIS STRING
JRST GLNSKP ;AND RETURN
GLNPRT::MOVEI T1,LNPRT ;GET PROTECTION
CALL GLNNUM ;THIS MUST BE A NUMBER
RET ;NO DEFAULT PROTECTION
RETSKP ;AND RETURN
GLNATR::PUSH P,P4 ;SAVE PERMANENT ACS
PUSH P,T1 ;SAVE THE ATTRIBUTE NUMBER
MOVEI T1,LNATR
MOVEI T2,FILLNM(JFN) ;GET POINTER TO CHAIN HEADER WORD
CALL GLNFLD ;GET THE POINTER TO THE ATTRIBUTE CHAIN
JRST [ POP P,(P) ;NONE THERE
POP P,P4 ;RESTORE THE PERMANENT AC
JRST RFALSE] ;GIVE ERROR RETURN
POP P,T4 ;GET BACK THE ATTRIBUTE NUMBER
GLNAT1: SOJL T4,GLNAT2 ;IF AT RIGHT ONE, GO RETURN TO USER
HLRZ T1,0(T1) ;STEP TO NEXT ATTRIBUTE ON LIST
JUMPN T1,GLNAT1 ;IF ONE THERE, LOOP BACK TIL DONE
JRST GLNERR ;NO MORE ENTRIES ON THE LIST
GLNAT2: LOAD T2,PRFXV,(T1) ;GET THE PREFIX VALUE
PUSH P,T2 ;SAVE IT FOR LATER
HRLI T1,(POINT 7,0,35) ;SET UP A STRING POINTER TO STRING
CALL LNMCPY ;COPY THE STRING TO THE DEFAULT STRING
JRST [ POP P,(P) ;CLEAN UP THE STACK
JRST GLNER2] ;AND EXIT
POP P,T1 ;RETURN THE PREFIX VALUE IN T1
JRST GLNSK1 ;AND GIVE SKIP RETURN
GLNNUM: PUSH P,P4 ;SAVE P4
MOVEI T2,FILLNM(JFN) ;GET ADDRESS OF CHAIN HEADER WORD
CALL GLNFLD ;GET THE DEFAULT
JRST [ POP P,P4 ;NONE
JRST RFALSE] ;RETURN 0 IN T1
JRST GLNSKP ;YES, RETURN IT IN T1
GLNSTR: CALL GLNST0 ;GET THE STRING
RET ;ERROR RETURN
CAMN T1,[-3] ;STAR?
TQO <DFSTF> ;YES, SET STAR FLAG
RETSKP
GLNST0: PUSH P,P4 ;SAVE P4
MOVEI T2,FILLNM(JFN) ;GET ADDRESS OF CHAIN HEADER WORD
CALL GLNFLD ;GET THE DEFAULT FIELD
JRST [ POP P,P4 ;NONE FOUND
JRST RFALSE] ;RETURN 0 IN T1
GLNST1: CAMN T1,[-3] ;IS THIS A STAR FIELD?
JRST GLNSK1 ;YES, GIVE SKIP RETURN
CALL LNMCPY ;NO, THEN COPY STRING TO DEFAULT STRING
JRST GLNER2 ;ERROR DURING COPYING
GLNSK1: SKIPA T2,[-1] ;RETURN WITH T2=-1 TO DENOTE A STRING
GLNSKP: SETZ T2, ;SET T2 TO ZERO TO DENOTE A NUMBER
LNSKPR: UNLOCK @LOKTAB(P4) ;RELEASE INTERLOCK
OKINT ;...
POP P,P4 ;RESTORE P4
RETSKP ;AND TAKE SUCCESSFUL RETURN
GLNERR: SETZ T1, ;LEAVE T1 0
GLNER2: UNLOCK @LOKTAB(P4) ;RELEASE INTERLOCK
OKINT ;...
POP P,P4 ;RESTORE PERMANENT AC
RET ;TAKE UNSUCCESSFUL RETURN
;ROUTINE TO GET A DEFAULT FIELD FROM THE LOGICAL NAME CHAIN
;ACCEPTS IN T1/ FIELD #
; T2/ ADDRESS OF CHAIN HEADER WORD
; CALL GLNFLD
;RETURNS +1: NO DEFAULT (NOTHING LOCKED)
; +2: DEFAULT IN T1 (NOINT AND @LOKTAB(P4) LOCKED)
GLNFLD: STKVAR <GLNFLC,GLNFLN,GLNFLP,GLNFLS>
MOVEM T1,GLNFLN ;SAVE FIELD NUMBER
HRRZM T2,GLNFLS ;SAVE ADDRESS OF CHAIN WORD
NOINT ;THIS RETURNS LOCKED UP
CAIN T1,LNDEV ;IS THIS A DEVICE FIELD BEING LOOKED FOR
JRST [ HRRZ T1,0(T2) ;YES, GET POINTER TO FIRST ONE ON CHAIN
JUMPE T1,[OKINT ;MAKE SURE THERE IS A CHAIN
RET]
MOVEI T3,1 ;ONLY LOOK AT THE FIRST ONE ON THE CHAIN
JRST GLNFL2]
HRRZ T2,0(T2) ;GET POINTER TO FIRST BLOCK
SETZB T1,T3 ;INITIALIZE COUNTERS
GLNFL1: JUMPE T2,GLNFL2 ;AT END OF LIST?
LOAD T1,LNMLNK,(T2) ;GET LINK TO NEXT BLOCK
EXCH T1,T2 ;SAVE LAST ONE IN T1
AOJA T3,GLNFL1 ;COUNT UP COUNTER
GLNFL2: MOVEM T3,GLNFLC ;SAVE NUMBER OF BLOCKS ON CHAIN
GLNFL3: SOSGE GLNFLC ;COUNT DOWN COUNTER
JRST [ OKINT ;NO MORE LOGICAL NAMES
RET]
LOAD P4,LNMIDX,(T1) ;GET INDEX
HRLI P4,400000
LOCK @LOKTAB(P4) ;LOCK UP THE LN DATA BASE
CALL GLNDEF ;GET E-BLOCK POINTER
JRST [ UNLOCK @LOKTAB(P4)
OKINT
RET]
ADD T1,GLNFLN ;CALCULATE ADDRESS OF DESIRED ENTRY
SKIPE T1,0(T1) ;IS THERE A DEFAULT HERE?
RETSKP ;YES, GIVE IT TO CALLER
UNLOCK @LOKTAB(P4) ;NO, UNLOCK
HRRZ T1,GLNFLS
HRRZ T1,0(T1) ;SCAN DOWN CHAIN AGAIN
MOVE T3,GLNFLC ;GET LENGTH OF CHAIN-1
GLNFL4: SOJLE T3,GLNFL3 ;AT PROPER LEVEL
LOAD T1,LNMLNK,(T1) ;GET NEXT BLOCK ON CHAIN
JRST GLNFL4 ;LOOP BACK
;ROUTINE TO GET E-BLOCK ADDRESS OF CURRENT LOGICAL NAME
;
;ACCEPTS IN T1/ ADDRESS OF LOGICAL NAME HEADER BLOCK ON CHAIN
; CALL GLNDEF
; UNSUCCESSFUL, NO LOGICAL NAME
; SUCCESSFUL RETURN WITH ADDRESS OF E-BLOCK IN T1
GLNDEF: STKVAR <GLNDFC>
LOAD T2,LNMCNT,(T1) ;GET THE DEPTH COUNT
MOVEM T2,GLNDFC ;SAVE IT FOR LATER
LOAD T1,LNMPNT,(T1) ;GET POINTER TO NAME STRING
CALL LNMLK1 ;LOOKUP THE LOGICAL NAME
RET ;NOT FOUND
HRRZ T1,0(T1) ;GET E-BLOCK ADDRESS
GLNDF1: SOSGE GLNDFC ;SCAN DOWN TO PROPER DEPTH
RETSKP ;ALL DONE
HLRZ T1,LNBLK(T1) ;GET POINTER TO NEXT BLOCK
JUMPN T1,GLNDF1 ;LOOP BACK TILL DONE
RET ;END OF LIST!
;ROUTINE CALLED BY .STDEV AND .RCDIR TO TRANSLATE A LOGICAL NAME STRING TO
; THE DEFAULTED PHYSICAL NAME AND DIRECTORY IF ANY
;
;ACCEPTS:
; T1/RH OF LOOKUP POINTER TO BLOCK CONTAINING DEVICE NAME TO BE LOOKED UP
; T2/-1 IF WANT DIRECTORY NAME, 0 IF NOT
; CALL CHKLND
;RETURNS +1: ALWAYS,
; T1/RH OFLOOKUP POINTER TO UPDATED DEVICE FIELD
; T2/RH OF LOOKUP POINTER TO DIRECTORY STRING
; OR
; 0 IF NOT FOUND
; OR
; -1 IF STAR WAS FOUND
;USE OF STKVARS:
; CHKLDP - RH OF LOOKUP POINTER TO DEVICE NAME IN JSB (TEMPORARY LOCATION
; BEFORE ADDING TO LOGINAL NAME LINK)
; CHKLDO - RH OF LOOKUP POINTER TO CURRENT DEVICE FIELD (AS UPDATED WITH
; LOGICAL NAMES)
; CHKLDC - HEADER FOR LOGICAL NAME CHAIN
; CHKLDI - INDEX (0 FOR JOB-WIDE LOGICAL NAME, 1 FOR SYSTEM)
; CHKLDA - BYTE POINTER TO DIRECTORY NAME IN LOGICAL NAME CHAIN
;THIS ROUTINE CREATES A CHAIN OF LOGICAL NAMES BASED ON THE DEFINITION
;OF THE SPECIFIED LOGICAL NAME. IT RETURNS WHEN A DEVICE FIELD IS FOUND
;THAT DOES NOT CONTAIN A DEFINED LOGICAL NAME. THIS MAY OR MAY NOT BE
;A LEGITIMATE DEVICE NAME. FOR EACH LOGICAL NAME IN THE CHAIN, ONLY THE
;FIRST DEFINITION IS USED. THUS, IF FOO IS DEFINED AS LOGA,LOGB, ONLY
;THE DEFINITION OF LOGA IS USED.
; * * * *
;NOTE: PROBABLY NEEDS AN ERROR RETURN
; * * * *
CHKLND::SAVEP ;SAVE P4 AND FRIENDS
STKVAR <CHKLDP,CHKLDO,CHKLDC,CHKLDI,CHKLDA>
MOVEM T2,P6 ;SAVE DIRECTORY FLAG
NOINT ;DISABLE INTERRUPTS WHILE SEARCHING
SETZM CHKLDC ;INITIALIZE POINTER TO CHAIN
SETZM CHKLDP ;WE HAVE NO STRING IN CHKLDP
MOVEM T1,CHKLDO ;SAVE POINTER TO ORIGINAL STRING
CHKLD1: MOVE T1,CHKLDO ;GET POINTER TO CURRENT DEVICE NAME
CALL LNLUKG ;SEE IF THIS STRING IS A LOGICAL NAME
;RETURNS: 2/INDEX (0 FOR JOB, -1 FOR SYSTEM)
JRST CHKLD3 ;NO LOGICAL NAME FOR THIS STRING
;..
;CHKLDO POINTS TO THE CURRENT DEVICE FIELD, WHICH IS A LOGICAL NAME.
;LINK IT TO THE CHAIN OF LOGICAL NAMES
;..
CHKLD0: MOVEM T2,CHKLDI ;SAVE INDEX OF LOGICAL NAME
MOVEI T2,MAXLW+1 ;GET A STRING FOR THIS NAME
CALL ASGJFR ;FROM JSB FREE SPACE
JRST CHKLD3 ;NO ROOM, GO RETURN
MOVEM T1,CHKLDP ;SAVE LOOKUP POINTER TO FREE SPACE
HRRZ T2,T1 ;DEST: JSB FREE SPACE
HRRZ T1,CHKLDO ;SOURCE: CURRENT DEVICE NAME
CALL CPYSTR ;COPY CURRENT DEVICE STRING TO FREE SPACE
MOVE T1,CHKLDP ;GET POINTER TO THIS DEVICE
MOVE T2,CHKLDI ;GET ITS INDEX VALUE
MOVEI T3,CHKLDC ;GET ADDRESS OF CHAIN HEADER WORD
SETZ T4, ;MAKE ALL STEPS BE THE SAME
CALL LNKLNM ;LINK THIS STRING TO CHAIN
JRST CHKLD3 ;SOMETHING WENT WRONG, EXIT
SETZM CHKLDP ;NO LONGER HAVE TO RETURN THIS FREE SPACE -
; RELLNS WILL DO IT LATER
;LOGICAL NAME IS AT THE BEGINNING OF THE CHAIN. SEE IF THERE IS A DEVICE
;FIELD IN THE LOGICAL NAME DEFINITION
MOVEI T1,LNDEV ;NOW GET DEFAULT FIELD
MOVEI T2,CHKLDC ;GET ADDRESS OF CHAIN POINTER WORD
CALL GLNFLD ;GET THE DEFAULT DEVICE FIELD
;LOCK LOGINAL NAME DATA BASE, GO NOINT
;RETURNS 1/POINTER TO DEVICE STRING,
;P4/INDEX (0 OR 1)
JRST CHKLD2 ;THERE WASNT ANY, GO USE "DSK"
;A DEVICE FIELD WAS FOUND. IT MAY BE A TRUE DEVICE OR ANOTHER LOGICAL
;NAME. REPLACE THE ORIGINAL STRING WITH THIS FIELD.
HRRZS T1
HRRZ T2,CHKLDO ;DEST: POINTER TO ORIGINAL STRING
CALL CPYSTR ;COPY DEFAULT INTO ORIGINAL STRING
UNLOCK @LOKTAB(P4) ;UNLOCK THE LN TABLE LOCKED BY GLNFLD
OKINT ;GLNFLD WENT NOINT
;IF THIS STRING IS NOT ALREADY ON THE LOGICAL NAME CHAIN, LOOP BACK
;AS THOUGH IT WERE THE ORIGINAL STRING. IF IT IS ON THE CHAIN, SEE
;WHETHER IT IS ON THE CHAIN AS A JOB-WIDE LOGICAL NAME OR A SYSTEM
;LOGICAL NAME. IF SYSTEM, WE ARE AT THE END OF THE SEARCH. IF JOB-
;WIDE, SEE IF IT IS ALOS A SYSTEM LOGICAL NAME. IF SO, LOOP BACK
;AS THOUGH IT WERE THE ORIGINAL STRING. NOTE THAT IF A NAME IS BOTH
;A JOB-WIDE AND A SYSTEM LOGICAL NAME, THE JOB-WIDE DEFINITION WILL GO
;ON THE CHAIN FIRST; WHEN THE SYSTEM DEFINITION IS ADDED, IT WILL GO
;ON THE CHAIN AHEAD OF THE JOB-WIDE DEFINITION.
MOVE T1,CHKLDO ;T1/POINTER TO CURRENT DEVICE NAME
CHKLD4: MOVEI T2,CHKLDC ;T2/ADDRESS OF CHAIN HEADER WORD
CALL CHKCHN ;SEE IF THIS IS ON THE CHAIN ALREADY
;RETURNS: 1/INDEX ??????
JRST CHKLD1 ;NO, LOOP BACK TIL END OF LOGICAL NAMES
JUMPG T1,CHKLD3 ;YES. IF THIS IS A SYSTEM LN, GO RETURN
MOVE T1,CHKLDO ;GET POINTER TO NAME STRING
CALL LNLUKS ;SEE IF THIS IS A SYSTEM LOGICAL NAME
;RETURNS: 2/INDEX
JRST CHKLD3 ;NO, GO RETURN
JRST CHKLD0 ;YES, GO STORE THIS ON THE CHAIN
;A LOGICAL NAME DEFINITION THAT DOES NOT CONTAIN A DEVICE FIELD HAS BEEN FOUND.
;SUBSTITUTE 'DSK', AND SEE IF IT IS A LOGICAL NAME. IF NOT, RETURN 'DSK'
;WHICH WILL BE INTERPRETED AS CONNECTED STRUCTURE.
CHKLD2: MOVE T1,CHKLDO ;GET BACK POINTER TO ORIGINAL STRING
MOVE T2,[ASCIZ/DSK/]
MOVEM T2,1(T1) ;STORE DSK AS THE DEVICE FIELD
JRST CHKLD4 ;GO SEE IF IT IS A LOGICAL NAME
;DEVICE FIELD HAS BEEN FOUND OR DISK IS BEING USED. IF REQUESTED,
;SEE IF A DIRECTORY WAS SPECIFIED IN THE LOGICAL NAME. IF IT IS NOT
;ALREADY ON THE CHAIN, DON'T ADD IT
CHKLD3: SETZ P1, ;INDICATE DIRECTORY NOT FOUND
SKIPN P6 ;DO WE WANT TO GET THE DIRECTORY?
JRST CHKLD6 ;NO. ACT AS IF NOT FOUND
;..
;..
MOVEI T1,LNDIR ;T1/OFFSET IN E-BLOCK FOR DIRECTORY
MOVEI T2,CHKLDC ;T2/ADDRESS OF CHAIN HEADER WORD
CALL GLNFLD ;SEE IF THIS LOGICAL NAME HAS A DIRECTORY
; FIELD, LOCK LOGICAL NAME DATA BASE, GO NOINT
; RETURNS T1/POINTER TO DIRECTORY STRING
; P4/INDEX
JRST CHKLD6 ;NO DIRECTORY FIELD
CAMN T1,[-3] ;WAS STAR FOUND?
JRST [ SETOM P1 ;YES. INDICATE IT FOR LATER
JRST CHKLD5]
MOVEM T1,CHKLDA ;SAVE POINTER TO STRING IN CHAIN
MOVEI T2,MAXLW+1 ;T2/NUMBER OF WORDS IN DIRECTORY STRING
NOINT ;WILL RETURN WITH THIS BLOCK ALLOCATED
CALL ASGJFR ;GET SPACE TO STORE THE STRING
JRST [ SETOM P1 ;NO FREE SPACE. INDICATE DIRECTORY NOT FOUND
OKINT ;OKINT SINCE NO SPACE ASSIGNED
;**;[2821] CHANGE 1 LINE AT CHKLD3:+21L TAM 28-SEP-82
JRST CHKLD5] ;[2821]
MOVEM T1,P1 ;SAVE LOOKUP POINTER TO STRING IN JSB
HRROI T1,1(T1) ;1/DEST: FIRST WORD AFTER HEADER
MOVE T2,CHKLDA ;2/SOURCE: DIRECTORY FIELD IN E-BLOCK
MOVEI T3,MAXLC ;3/LIMIT OF CHARACTERS
SETZ T4, ;4/TERMINATE ON NULL
SOUT ;COPY DIRECTORY STRING TO JSB FREE SPACE
;NEEDS AN ERJMP
HRRZS T1 ;GET ADDRESS OF LAST BYTE
SUB T1,P1 ;GET NUMBER OF WORDS WRITTEN
SOS T1 ;FULL-WORD COUNT IS LENGTH-1
MOVNS T1 ;GET NEGATIVE
HRLM T1,P1 ;STORE FULL LOOKUP POINTER
CHKLD5: UNLOCK @LOKTAB(P4) ;UNLOCK LOGICAL NAME DATA LOCKED BY GLNFLD
OKINT ;GLNFLD WENT NOINT
CHKLD6: MOVEI T1,CHKLDC ;T1/ADDRESS OF CHAIN POINTER
CALL RELLNS ;GO RELEASE THIS LOGICAL NAME CHAIN
MOVEI T1,JSBFRE ;NOW RETURN TEMP STRING
SKIPE T2,CHKLDP ;IF ANY
CALL RELFRE ;RELEASE SPACE OBTAINED BY ASGJFR
MOVE T2,P1 ;T2/ADDRESS OF DIRECTORY STRING
; OR INDICATION OF NOT FOUND OR STAR
MOVE T1,CHKLDO ;T1/ADDRESS OF DEVICE STRING
OKINT ;CHKLND WENT NOINT AT START
RET
;ROUTINE TO LOOKUP A LOGICAL NAME IN BOTH TABLES OR SYSTEM LN TABLE
;ACCEPTS IN T1/ STRING POINTER TO LOGICAL NAME
; CALL LNLUKG ;EITHER JOB WIDE OR SYSTEM LN
; OR
; CALL LNLUKS ;SYSTEM LN ONLY
;RETURNS +1: NO LOGICAL NAME
; +2: FOUND A LOGICAL NAME, T2=0 FOR JOB WIDE, T2=1 FOR SYSTEM
LNLUKG::PUSH P,T1 ;SAVE POINTER TO STRING
MOVEI T2,0 ;FIRST CHECK THE JOB WIDE TABLE
CALL LNMLUK ;...
JRST LNLKG1 ;NOT A JOB WIDE LN, TRY SYSTEM LN
POP P,(P) ;CLEAN OUT STACK
MOVEI T2,0 ;MARK THAT A JOB WIDE LN WAS FOUND
RETSKP
LNLKG1: POP P,T1 ;GET BACK STRING POINTER
LNLUKS::MOVEI T2,1 ;TRY LOOKING IN SYSTEM LN TABLE
CALL LNMLUK
RET ;NOT FOUND
MOVEI T2,1 ;MARK THAT THIS IS A SYSTEM LN
RETSKP
;ROUTINE TO LOOKUP A LOGICAL NAME IN THE LOGICAL NAME TABLE
;
;CALLING SEQUENCE:
; MOVE T1,STRING POINTER TO LOGICAL NAME TO BE LOOKED UP
; T2 - 0 MEANS JOB WIDE LN, 1 MEANS SYSTEM WIDE LN
; CALL LNMLUK
; UNSUCCESSFUL, NO SUCH LOGICAL NAME IN TABLE
; SUCCESSFUL, T1 CONTAINS PONTER TO TABLE ENTRY
; T2 = -1 NO MATCH
; T2 = 0 AMBIGOUUS
; T2 = 1 UNIQUE ABREVIATION
; T3 = POINTER TO REST OF NAME STRING
LNMLUK::PUSH P,P4 ;SAVE PERMANENT ACS USED
TRZE T2,777776 ;IS THIS A VAILD INDEX VALUE?
BUG(LNMILI)
HRRO P4,T2 ;SET UP INDEX REG
NOINT ;LOCK UP DATA BASE
LOCK @LOKTAB(P4)
CALL LNMLK1 ;DO THE LOOKUP
JRST GLNERR ;ERROR RETURN
JRST LNSKPR ;OK RETURN
LNMLK1: HRLI T1,(POINT 7,0,35) ;SET UP POINTER TO LOGICAL NAME
MOVE T2,T1 ;PREPARE TO CALL TABLE LOOKUP ROUTINE
SKIPN T1,@LNTAB(P4) ;IS THERE A TABLE OF LOGICAL NAMES YET?
JRST [SETO T2, ;GIVE UNSUCCESSFUL RETURN
RET] ;...
CALL TABLK ;YES, GO LOOKUP THE NAME
RET ;NO SUCH NAME IN TABLE
RETSKP ;SUCCESSFUL, RETURN POINTER TO TABLE ENTRY
;ROUTINE TO STEP A LOGICAL NAME TO TNE NEXT E-BLOCK
;ACCEPTS IN JFN, POINTER TO JFN BLOCK
;RETURNS +1: NO MORE LOGICAL NAME BLOCKS
; +2: LOGICAL NAME STEPPED
LNSTEP::HRRZ T2,FILLNM(JFN) ;GET POINTER TO LOGICAL NAME CHAIN
JUMPE T2,R ;NO LOGICAL NAMES
PUSH P,P4 ;SAVE P4
NOINT
LNSTP0: HRRZ T1,FILLNM(JFN) ;GET NEXT CHAIN ELEMENT
JUMPE T1,[OKINT ;IF 0, NO MORE LOGICAL NAMES
POP P,P4 ;RESTORE P4
RET] ;RETURN TO CALLER
LOAD P4,LNMIDX,(T1) ;GET INDEX OF THIS ELEMENT
HRLI P4,400000
LOCK @LOKTAB(P4) ;LOCK THE DATA BASE
CALL GLNDEF ;GET POINTER TO E-BLOCK
JRST LNSTP1 ;NO LOGICAL NAME
HLRZ T2,LNBLK(T1) ;GET POINTER TO NEXT E-BLOCK
JUMPE T2,LNSTP1 ;NONE LEFT, GO DELETE THIS CHAIN BLOCK
HRRZ T1,FILLNM(JFN) ;GET FIRST ITEM ON CHAIN
LOAD T2,LNMCNT,(T1) ;GET DEPTH COUNT
AOS T2 ;INCREMENT IT
STOR T2,LNMCNT,(T1)
JRST LNSKPR ;GIVE OK RETURN
LNSTP1: MOVEI T1,FILLNM(JFN) ;SET UP POINTER TO CHAIN HEADER WORD
CALL REL1LN ;DELETE THE FIRST BLOCK ON CHAIN
JRST GLNERR ;PROBLEM
UNLOCK @LOKTAB(P4) ;UNLOCK THIS DATA BASE
JRST LNSTP0 ;LOOP BACK FOR ANOTHER ONE
; TABLE MANIPULATING ROUTINES
;
; ADD AN ENTRY, DELETE AN ENTRY, AND LOOKUP A NAME
;
;TABLE FORMAT:
;
; TABLE: XWD # OF ENTRIES IN USE, # OF RESERVED WORDS FOR TABLE
; XWD ADR OF STRING BLOCK, ANYTHING
; .
; .
; .
;
;TABDEL: DELETE AN ENTRY FROM THE TABLE
;
; THIS ROUTINE DELETES AN ENTRY FROM THE INDEX TABLE.
; THIS ROUTINE DOES NOT TRY TO RETURN ANY SPACE TO THE FREE POOL,
; AND IT DOES NOT DO ANYTHING WITH THE ENTRY BEING DELETED.
; IT SIMPLY COMPACTS THE TABLE ELIMINATING THE
; SPECIFIED ENTRY.
;
;CALLING SEQUENCE:
;
; MOVE T1,CURRENT TABLE ADDRESS
; MOVE T2,ADDRESS OF ENTRY TO BE DELETED (AS RETURNED BY LOOKUP)
; CALL TABDEL
; RETURN HERE ALWAYS
TABDEL: HLRZ T4,0(T1) ;GET USED COUNT
SUBI T4,1 ;DECREMENT IT
HRLM T4,0(T1) ;STORE UPDATED COUNT BACK IN TABLE
ADD T4,T1 ;GET POINTER TO NEW LAST WORD
CAMLE T2,T4 ;IS DELETED ENTRY STILL WITHIN TABLE?
JRST TDELZ ;NO, THEN BLT IS NOT REQUIRED
HRLZI T3,1(T2) ;GET BLT SOURCE ADDRESS
HRR T3,T2 ;GET DESTINATION ADDRESS
BLT T3,(T4) ;SHRINK TABLE BY ONE WORD
TDELZ: SETZM 1(T4) ;ZERO THE FREED UP WORD AT END OF TABLE
RET ;AND RETURN TO CALLER
;TABADD: ADD AN ENTRY INTO THE TABLE
;
; THE ADDITION ROUTINE CREATES A SLOT IN THE TABLE AT THE DESIRED
; SPOT BY SHUFFLING THE END OF THE TABLE DOWN ONE WORD.
; IF THE TABLE DOES NOT HAVE ENOUGH ROOM TO FIT IN AN ADDITIONAL
; ENTRY, THEN IT GRABS A LARGER CHUNK OF FREE CORE FROM THE
; JSB AND COPIES THE OLD TABLE INTO THIS NEW AREA. IT THEN
; RETURNS THE OLD TABLE AREA TO THE FREE CORE POOL.
;
;CALLING SEQUENCE:
; MOVE T1,CURRENT TABLE ADDRESS
; MOVE T2,ADDRESS OF NEW ENTRY IN TABLE (AS RETURNED BY LOOKUP)
; P4 - 0 MEANS JOB WIDE LN, 1 MEANS SYSTEM WIDE LN
; CALL TABADD
; RETURN HERE IF NO MORE FREE CORE IN JSB
; SUCCESSFUL RETURN WITH T1 CONTAINING NEW TABLE ADDRESS AND
; T2 CONTAINING ADDRESS OF NEW ENTRY POSITION
TABINC==^D16 ;INCREMENTAL GROWTH FOR LOGICAL NAME TABLE
TABADD: PUSH P,P6 ;SAVE PERMANENT AC'S
HRRZ T3,0(T1) ;GET TOTAL SIZE OF THIS TABLE
HLRZ T4,0(T1) ;GET USED SPACE MINUS ONE
CAILE T3,1(T4) ;ANY ROOM FOR THIS ENTRY?
JRST TADD1 ;YES, DONT EXPAND TABLE
PUSH P,T1 ;SAVE TABLE ADDRESS
PUSH P,T2 ; AND ENTRY LOCATION
MOVEI T1,TABINC(T3) ;GET THE AMOUNT NEEDED FOR NEW TABLE
MOVEM T1,P6 ;SAVE THIS FOR LATER
CALL @ASGTAB(P4) ;GO GET MORE ROOM FROM FREE POOL
JRST [POP P,T2 ;CLEAN UP STACK
POP P,T1
POP P,P6
RET] ;AND TAKE ERROR RETURN
POP P,T2 ;RESTORE ENTRY LOCATION
HRLZ T3,0(P) ;GET OLD TABLE ADDRESS
HRR T3,T1 ;SET UP A BLT POINTER
MOVEI T4,-TABINC(P6) ;GET # OF WORDS TO BE COPIED
ADDI T4,0(T1) ;GET FINAL BLT LOCATION
BLT T3,(T4) ;COPY TABLE TO ITS NEW HOME
POP P,T3 ;GET BACK OLD TABLE ADDRESS
SUB T2,T3 ;CALCULATE INDEX INTO TABLE FOR NEW ENTRY
ADD T2,T1 ;T2 NOW HAS ABSOLUTE ENTRY POINT IN NEW TABLE
PUSH P,T1 ;SAVE TEMPORARIES AGAIN
PUSH P,T2 ;TABLE ADDRESS AND ENTRY POSITION
MOVE T1,T3 ;OLD TABLE ADDRESS
CALL RELTMP ;RETURN OLD TABLE TO JSB FREE POOL
POP P,T2 ;RESTORE ENTRY POSITION
POP P,T1 ;AND TABLE ADDRESS
HRRM P6,0(T1) ;STORE NEW TABLE LENGTH
;FALL THRU TO TADD1
TADD1: HLRZ T3,0(T1) ;GET # OF USED WORDS
AOS T3 ;UPDATE # OF WORDS USED
HRLM T3,0(T1) ;IN FIRST WORD OF TABLE
ADD T3,T1 ;GET START OF AREA TO BE MOVED
TADD2: CAML T2,T3 ;SHUFFLING DONE YET?
JRST [POP P,P6 ;RESTORE P6
RETSKP] ;AND TAKE SUCCESSFUL RETURN
MOVE T4,-1(T3) ;GET WORD TO BE MOVED
MOVEM T4,(T3) ;SHUFFLE IT DOWN
SOJA T3,TADD2 ;LOOP BACK FOR REST OF THE WORDS
;TABLK - TABLE LOOKUP WITH ABBREVIATION RECOGNITION
;
;CALL:
; T1/ TABLE ADDRESS
; T2/ TEST STRING POINTER
; CALL TABLK
;RETURN:
; +1 = FAILED, T1/ ADR OF WHERE ENTRY WOULD BE IF IT WERE IN TABLE
; T2/ -1 FOR NO MATCH AT ALL
; 0 FOR AMBIGUOUS
; +1 FOR UNIQUE ABREVIATION OF A DEFINED NAME
; T3/ POINTER TO REMAINDER OF ABREVIATED NAME
; +2 = SUCCESS, T1/ ADDRESS OF TABLE ENTRY WHICH MATCHED
;AC USAGE:
; T1/ TEST STRING FROM CALL
; T2/ STRING FROM TABLE
; T3/ CLOBBERED BY STRCMP
; T4/ " "
; Q1/ CURRENT TABLE INDEX
; Q2/ ADR OF TABLE(Q1)
; Q3/ SIZE OF TABLE
; P3/ INDEX INCREMENT FOR LOG SEARCH
TABLK: PUSH P,P3 ;SAVE PERMANENT ACS
PUSH P,Q1
PUSH P,Q2
PUSH P,Q3
HRLI T1,Q1+400000 ;CONSTRUCT TABADR(Q1+
AOS Q2,T1 ;LEAVE IT HERE
HLRZ Q1,-1(T1) ;SET INITIAL INDEX TO SIZ/2
ASH Q1,-1
HLRZ P3,-1(T1) ;INITIAL INCREMENT IS SIZE
MOVE Q3,P3 ;SAVE SIZE FOR RANGE CHECKS
PUSH P,T2 ;SAVE TEST STRING
JUMPE Q3,TABLKX ;IF NO ENTRIES IN TABLE, THEN NO MATCH
TABLK0: HLRZ T2,@Q2 ;GET ADR OF STRING FROM TABLE
HRLI T2,(POINT 7,0,35) ;MAKE BYTE PTR
MOVE T1,0(P) ;TEST STRING
CALL STRCMP ;COMPARE STRINGS
JRST TABLK1 ;NOT EXACTLY EQUAL
TABLKF: AOS -5(P) ;EXACTLY EQUAL, DOUBLE SKIP RETURN
TABLKM: TDZA T2,T2 ;SET UP FOR AN AMBIGUOUS RETURN
TABLKX: SETO T2, ;GIVE NO-MATCH CODE IN T2
TABLKA: MOVEI T1,@Q2 ;RETURN TABLE ADDRESS OF ENTRY
POP P,0(P)
POP P,Q3 ;RESTORE PERMANENT ACS
POP P,Q2
POP P,Q1
POP P,P3
RET
;STRING MAY HAVE BEEN UNEQUAL OR A SUBSET, SEE WHICH
TABLK1: JUMPN T1,TABLKN ;UNEQUAL, GO SETUP NEXT PROBE
TABLK3: JUMPE Q1,TABLK2 ;IF NOW AT TOP OF TABLE, CHECK NO HIGHER
PUSH P,T2 ;SAVE POINTER TO REMAINDER OF STRING
MOVEI T1,@Q2 ;CHECK PREVIOUS ENTRY, GET ITS ADDRESS
HLRZ T2,-1(T1) ;GET STRING ADDRESS
HRLI T2,(POINT 7,0,35)
MOVE T1,-1(P) ;GET ORIGINAL STRING AGAIN
CALL STRCMP ;SEE ABOUT PREVIOUS ENTRY
JRST .+2
SOJA Q1,[POP P,T2 ;EXACTLY EQUAL, DONE
JRST TABLKF] ;...
JUMPG T1,TBLK2B ;IF LESS, THEN HAVE FOUND HIGHEST SUBSET
POP P,0(P) ;POP AWAY UNDESIRED BASE STRING
SOJA Q1,TABLK3 ;STILL A SUBSET, CHECK PREVIOUS
;NOW POINTING AT HIGHEST ENTRY WHICH IS SUBSET. IF THERE IS AN EXACT
;MATCH, IT IS BEFORE ALL SUBSETS AND HAS ALREADY BEEN FOUND
TABLK2: PUSH P,T2 ;SAVE PTR TO REST OF BASE
TBLK2B: MOVEI T1,@Q2 ;CHECK NEXT ENTRY FOR AMBIGUOUS
CAIL Q1,-1(Q3) ;IS THIS THE LAST ENTRY ALREADY?
JRST [POP P,T3 ;YES, THIS ENTRY IS DISTINCT
JRST TBLK2A] ;GO RETURN +1 IN T2
HLRZ T2,1(T1)
HRLI T2,(POINT 7,0,35)
MOVE T1,-1(P)
CALL STRCMP
JRST .+2
BUG(ILLTAB)
POP P,T2
JUMPE T1,TABLKM ;NEXT ENTRY NOT DISTINCT, GIVE AMBIGUOUS RETURN
MOVE T3,T2 ;GET POINTER TO REST OF BASE STRING
TBLK2A: MOVEI T2,1 ;SET UP FOR ABREIVATION RETURN
JRST TABLKA ;GIVE NON-SKIP RETURN
;HERE WHEN PROBE NOT EQUAL
TABLKN: CAIG P3,1 ;INCREMENT NOW 1?
JRST [JUMPL T1,TABLKX ;YES, NO MATCH FOUND
AOJA Q1,TABLKX] ;IF STRING GREATER, MAKE ADDR ONE MORE
ADDI P3,1 ;NEXT INC = <INC+1>/2
ASH P3,-1
JUMPG T1,[ADD Q1,P3 ;IF LAST PROBE LOW, ADD INCREMENT
JRST TBLKN1] ;GO CHECK BOUNDS
SUB Q1,P3 ;LAST PROBE HIGH, SUBTRACT INCREMENT
TBLKN1: CAIL Q1,0(Q3) ;OVER THE TOP OF THE TABLE?
JRST [SETO T1, ;YES, FAKE PROBE TO HIGH
JRST TABLKN] ;GO PROBE AGAIN
JUMPGE Q1,TABLK0 ;IF STILL WITHIN TABLE, GO PROBE
MOVEI T1,1 ;BELOW TABLE, FAKE LOW PROBE
JRST TABLKN
;STRING COMPARE ROUTINE
;CALL:
; T1/ TEST STRING POINTER
; T2/ BASE STRING POINTER
; CALL STRCMP
;RETURN:
; +1 = NOT EXACT MATCH, T1 GIVES STATUS:
; -1 = TEST STRING LESS THAN BASE STRING
; 0 = TEST STRING SUBSET OF BASE STRING
; +1 - TEST STRING GREATER THAN BASE STRING
; +2 = EXACT MATCH
STRCMP:: ILDB T3,T1 ;GET NEXT CHAR FROM EACH STRING
ILDB T4,T2
CAME T3,T4 ;STILL EQUAL?
JRST STRC2 ;NO, GO SEE WHY
JUMPN T3,STRCMP ;KEEP GOING IF NOT END OF STRING
RETSKP ;STRINGS ENDED TOGETHER, EXACT MATCH
RET
STRC2: JUMPE T3,[SETZ T1, ;TEST STRING ENDED, IS A SUBSET
ADD T2,[70000,,0] ;DECREMENT BYTE POINTER BY ONE BYTE
RET]
CAMG T3,T4 ;STRINGS UNEQUAL
SKIPA T1,[-1] ;TEST STRING LESS, RETURN -1
MOVEI T1,1 ;TEST STRING GREATER, RETURN +1
RET
;ROUTINE TO COPY ONE STRING TO ANOTHER
;ASSUMES BOTH STRINGS ARE STANDARD TYPE STRINGS WITH FIRST WORD
; CONTAINING -1,,N WHERE N = # OF WORDS IN STRING
;ACCEPTS IN T1/ SOURCE STRING POINTER
; T2/ DESTINATION STRING POINTER
; CALL CPYSTR
;RETURNS +1: ALWAYS
CPYSTR: HRRZ T3,0(T1) ;GET LENGTH OF SOURCE STRING
SOJLE T3,R ;IF NO WORDS IN STRING, RETURN
CPYST1: MOVE T4,1(T1) ;GET A WORD OF TEXT FROM SOURCE
MOVEM T4,1(T2) ;STORE IN DESTNATION
AOS T1
AOS T2 ;STEP TO NEXT WORD IN STRING
SOJG T3,CPYST1 ;LOOP BACK TILL ALL WORDS COPIED
RET ;THEN RETURN
TNXEND
END