.MCALL .MODULE .MODULE IGTDIR,VERSION=05,COMMENT=,IDENT=NO,LIB=YES ; Copyright (c) 1998 by Mentec, Inc., Nashua, NH. ; All rights reserved ; ; This software is furnished under a license for use only on a ; single computer system and may be copied only 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 except for use on such ; system and to one who agrees to these license terms. Title ; to and ownership of the software shall at all times remain ; in Mentec, Inc. ; ; The information in this document is subject to change without ; notice and should not be construed as a commitment by Digital ; Equipment Corporation, or Mentec, Inc. ; ; Digital and Mentec assume no responsibility for the use or ; reliability of its software on equipment which is not supplied ; by Digital or Mentec, and listed in the Software Product ; Description. ;++ ; ; Edit Who Date Description of modification ; ---- --- ---- --------------------------- ; 001 WLD 16-OCT-90 Standardize PSECT names. ;-- .SBTTL Calling Sequence ; RT-11 SYSTEM SUBROUTINE LIBRARY (SYSLIB) FUNCTION ; ; MODULE: ; ; IGTDIR() - "GET DIRECTORY" ; ; CALLING SEQUENCE: ; ; INTEGER*2 WKAREA(64) ; INTEGER*2 BUFFER(512) ; ... ; I = IGTDIR( WKSIZE, WKAREA, CHAN, BUFFER, [HEADER], [DEVICE], ; 1 [STRING], [STVALU], [STMASK], [DATREL], [DATEWD], ; 2 [RESRV1], [RESRV2], [STOFST] ) ; ; PASSED ARGUMENTS: ; ; WKSIZE is the work area size. WKSIZE=64 should be adequate. ; WKAREA is a work area array (about 64 words (see WASIZE in code)) ; CHAN is an I/O channel, if <= 255, or an external READ ; routine address if > 255 ; BUFFER is a 512-WORD buffer for directory segments ; HEADER is a returned 5-word directory header ; If HEADER is specified, a complete directory entry will ; be returned by IGTENT (including extra words). If HEADER ; is NOT specified, only the standard part of a directory ; entry will be returned, not including the extra words. ; DEVICE is a RAD50 device or file specification, or special mode ; indicator. ; if not supplied, ; CHAN already open ; if passed as zero, ; CHAN already open, ; 2nd word contains block no. of directory (default 6) ; 3rd word=0 indicates RETURN_ONLY_MATCHES, ; word=1 indicates RETURN_ALL_ENTRIES ; STRING is a wildcard filespec string (without device specs) ; STVALU is the desired entry status bit value(s) ; STMASK indicates status bits to check ; DATREL is a relationship code for DATE ; DATEWD is an RT-11 date word to compare with directory entries ; RESRV1 reserved for future use ; RESRV2 reserved for future use ; STOFST is a directory entry's starting offset: ; STOFST = SEGMENT*2000+SEG_OFFSET ; ; Defaults: ; WKSIZE ; WKAREA ; CHAN ; BUFFER ; HEADER (header not returned) ; DEVICE (CHAN already open) ; STRING *.* ; STVALU 2000 (permanent directory entry) ; STMASK 7000 ("interesting bits" of permanent entry) ; DATREL 'EQ' if DATEWD specified; else 'ALL' ; DATEWD current date if DATREL specified; ; STOFST start of directory ; ; RETURNED ARGUMENT VALUES: ; ; WKAREA - Work area is initialized ; HEADER - INTEGER*2 array of 5 elements. A directory header. ; ; RETURNED FUNCTION VALUE: ; ; I = 0 - SUCCESS ; = -1 - CHANNEL IN USE ; = -2 - FILE NOT FOUND ; = -3 - ALREADY OPEN ; = -5 - INVALID DIRECTORY STRUCTURE ; = -7 - ERROR READING DIRECTORY ; = -12 - INVALID DEVICE FOR DIRECTORY SEARCH ; = -13 - INVALID DATE RELATIONSHIP CODE ; = -16 - SUPPLIED WORK AREA INADEQUATE ; = -19 - INVALID ARGUMENT LIST ; ; CONDITIONALS: F$TSP = 0 ; Time checks ; MACRO REFERENCES: .MCALL .DATE, .DSTAT, .GTIM, .SERR, .HERR, .LOOKUP .MCALL .READW, .CLOSE, SOB, .ASSUME ; LOCALLY DEFINED MACROS: .MACRO ...... .ENDM ...... ; EXTERNAL INCLUDE FILES: ; ; IGTWAO.MAC - Work Area Offset Definitions ; ; EXTERNAL REFERENCES: .GLOBL $SYSLB .GLOBL $NXADR .GLOBL $NXVAL .GLOBL $NOARG ; Missing argument code .SBTTL Equates and Definitions ERRBYT =: 52 ; System Error Byte address DS.MSK =: 7000 ; Default Interesting Bits .INCLUDE 'SRC:IGTWAO.MAC' .SBTTL Data ; Date Relationship Table .PSECT SYS$S,D IG$RLT: .WORD A.ALL, A.EQ, A.LT, A.LE, A.GT, A.GE, A.NE, -1 .SBTTL IGTDIR Entry and Argument Processing .PSECT SYS$I,I .ENABL LSB ; Get passed arguments; most are addresses that will be needed ; by other routines. Put the information in the caller's work ; area. Insert the $NOARG code for arguments not passed. GTDIR:: IGTDIR:: MOV (R5)+,R4 ; Get arg count for $NXxxx CALL $NXVAL ; get 1st arg, WASIZE BCS 20$ ; error if not present. CMP R0,#IG$WAS ; error if not big enough BGE 10$ MOV #E.IVWA,R0 ; Inadequate Work Area RETURN ...... 10$: CALL $NXADR ; Get WKAREA address BCS 20$ ; error if not present. MOV R0,R1 ; save it. CALL $NXADR ; Get CHAN address BCC 30$ ; Proceed if it's there. 20$: MOV #E.IVAR,R0 ; Error return RETURN ...... 30$: MOV R0,IG.CHA(R1) ; Store CHAN address in WKAREA ;;; MOV R1,IG.WKA(R1) ; Store WKAREA address in WKAREA (?) MOV R1,R0 ; Get WKAREA address ADD #IG.ARE,R0 ; Get EMT AREA address MOV R0,IG.EMT(R1) ; store it for general use MOV R1,R2 ; moving offset pointer ADD #3*2,R2 ; account for 3 $NXxxx's already MOV R1,R3 ADD #IG.STO,R3 ; Point to end of argument area 40$: MOV #$NOARG,R0 ; Preload R0 with missing data value CALL $NXADR ; Get next arg address CMP R2,R3 ; beyond end of table? BHI 50$ MOV R0,(R2)+ ; store it. BR 40$ ; loop until all args copied ...... ; Set up default values for arguments not specified 50$: MOV #$NOARG,R0 ; Preload R0 with missing data value CMP IG.BUF(R1),R0 ; Was BUFFER supplied? BEQ 20$ ; error if not. CLR IG.LFO(R1) ; Indicate no file opened. CLR IG.LSG(R1) ; Indicate no current segment. CLR IG.LDP(R1) ; Indicate no current entry. CLR IG.RET(R1) ; Indicate RETURN_ON_MATCHES MOV #6,IG.SKP(R1) ; 1st directory block MOV R1,R3 ; Calculate address of ADD #IG.LHD,R3 ; local (impure) header buffer. MOV R3,IG.LHP(R1) ; and store it. CMP IG.STA(R1),R0 ; Status bits specified? BNE 60$ ; Branch if so. MOV #E.PERM,R2 ; No. Default. Use Permanent Code BR 70$ 60$: MOV @IG.STA(R1),R2 ; Use what's passed. 70$: MOV R2,IG.LST(R1) ; Store desired status value 80$: CMP IG.MSK(R1),R0 ; Mask specified? BNE 90$ ; Branch if so. MOV #DS.MSK,R2 ; No. Use default mask BR 100$ 90$: MOV @IG.MSK(R1),R2 ; Use what's passed. 100$: COM R2 ; Complement it for convenience. MOV R2,IG.LBM(R1) ; Store Local Bit Mask (inverted) 110$: CALL DT$DEF ; Fill in DATE defaults BCC 120$ ; Proceed if no error MOV #E.IVDR,R0 ; Otherwise indicate INVALID RETURN ; DATE_RELATIONSHIP CODE ...... .SBTTL Open Specified Channel ; Try opening the specified device of file through the specified channel 120$: MOV @IG.CHA(R1),R3 ; Get user's channel number MOV R3,IG.LCH(R1) ; Store it in case he changes it MOV IG.DEV(R1),R0 ; Get address of passed DEVICE arg CMP R0,R2 ; channel already open? (no argument?) BEQ 150$ ; Branch if so. TST (R0)+ ; channel already open? (zero passed?) BNE 130$ ; Branch if it contains device name MOV (R0)+,IG.SKP(R1) ; Otherwise store supplied dir offset MOV @R0,IG.RET(R1) ; and RETURN mode code. BR 150$ ; and don't open the device/file ...... 130$: MOV #^C,R4 ; Device attributes mask MOV IG.DEV(R1),R0 ; point to DBLK TST 2(R0) ; file or device? BEQ 131$ ; branch if device BIS #SPECL$,R4 ; file. Allow SPECL$ access. 131$: MOV IG.EMT(R1),R2 ; Get EMT AREA address .DSTAT R2,IG.DEV(R1) ; Get device status, MOV #E.INVD,R0 ; Prepare for invalid device, BCS 135$ ; return with error if DSTAT failed MOV @R2,-(SP) ; get device status word BIC R4,@SP ; isolate interesting bits CMP (SP)+,# ; Is device RT-11 directory readable? BNE 135$ ; if not, we can't deal with it. .SERR ; Trap monitor errors MOV R0,R4 ; save previous SERR/HERR state .LOOKUP R2,R3,IG.DEV(R1) ; LOOKUP the device/file BCC 140$ ; and proceed if no errors. CALL $ERRM0 ; Convert lookup error to pos code 132$: TST R4 ; Was SERR set before entry? BNE 135$ ; don't do .HERR if so. MOV R0,R3 ; Stash ERRM0's code away, .HERR ; Turn off system error trapping, MOV R3,R0 ; get error code, 135$: RETURN ...... .SBTTL Read Segment 1 140$: CALL 132$ ; Good LOOKUP - Reset error response 150$: MOV #IG.ID,IG.LFO(R1) ; Indicate file opened. MOV #1,R3 ; Segment number = 1 CALL IG$SEG ; Read segment 1 ;; TST R0 ; success? BEQ 180$ ; if so, continue 160$: RETURN ...... 170$: MOV #E.IVSO,R0 ; Invalid STOFST value error RETURN ...... ; Transfer the first 5 words of the segment to the local header buffer, ; and optionally, to the user's header buffer. 180$: CLR IG.LQL(R1) ; Reset file length accumulator MOV IG.BUF(R1),R3 ; Point to seg buffer MOV R1,R0 ADD #IG.LHD,R0 ; Point to impure header buffer MOV IG.HED(R1),R4 ; Point to user's header buffer MOV #5,R2 ; Do this many words 190$: MOV @R3,(R0)+ ; Move header word, CMP R4,#$NOARG ; And if user's header specified, BEQ 200$ MOV @R3,(R4)+ ; move it there too. 200$: TST (R3)+ ; advance src ptr by word SOB R2,190$ ; Validate the directory header by checking to see whether certain ; values are in range. SUB #12,R3 ; point to D.TOTA entry MOV (R3)+,R0 ; get it CMP R0,#1 ; compare low limit BLO 210$ ; bad if less than 1 CMP R0,#31. ; compare high limit BHI 210$ ; bad if higher than 31 MOV (R3)+,R2 ; get D.NEXT BLT 210$ ; can't be less than zero CMP R2,R0 ; can't be more than D.TOTA BHI 210$ MOV (R3)+,R2 ; get D.HIGH CMP R2,R0 ; can't be more than D.TOTA BHI 210$ TST R2 ; check D.HIGH again BLE 210$ ; D.HIGH can't be less than 1 MOV @R3,R0 ; get D.EXTR CMP R0,#128. ; check against reasonable limit BHI 210$ ; Branch if bad ROR R0 ; check its evenness BCC 220$ ; Passes the test if even. 210$: MOV #E.IVDF,R0 ; Invalid directory format RETURN ; If ENTOFS was specified, read the appropriate block, and calculate ; the starting block number of the indexed entry. 220$: MOV IG.LDP(R1),R3 ; was ENTOFS specified? BEQ GOOD ; Return now if not. MOV R3,R4 ; If so, position on entry. BIC #^C1777,R4 ; isolate offset bits BIC #^C76000,R3 ; isolate segment number bits, SWAB R3 ASR R3 ASR R3 ; now THAT's a segment number. MOV R3,R2 ; save a copy CMP R3,#1 ; is it the first one again? BEQ 230$ ; don't bother reading it. CALL IG$SEG ; Read the segment BNE 160$ ; Branch on error CLR IG.LQL(R1) ; Reset file length accumulator ; Meander through the segment to determine the starting block number 230$: MOV IG.BUF(R1),R0 ; point to buffer (total segs) CMP R2,(R0) ; greater than total? BHI 170$ ; Error if so. ADD #D.STRT,R0 ; point to starting block no. MOV (R0)+,IG.LQL(R1) ; get it, and point to 1st entry MOV #D.LENG,IG.LDP(R1) ; initialize buffer offset MOV #E.ELEN,R2 ADD (R1),R2 ; dir entry size in R2 240$: CMP IG.LDP(R1),R4 ; entry found yet? BHIS GOOD ; branch if so. ADD E.LENG(R0),IG.LQL(R1) ; accumulate file lengths ADD R2,R0 ; point to next entry ADD R2,IG.LDP(R1) ; and update offset BR 240$ ............ GOOD: MOV #IG.ID,(R1) ; Store Workspace ID at top. CLR R0 ; Indicate GOOD return. RETURN ............ .DSABL LSB .SBTTL IG$SEG - Read Directory Segment ; IG$SEG - Read directory segment, specified in R3 ; - Work area pointed to by R1 ; ; IG$RED - Read 2 blocks at block specified in R3 ; - Work area pointed to by R1 ; ; For both routines, R0 returns zero upon SUCCESS, or E.RDSG to indicate ; ERROR. No other registers are altered. ; ; Normally, the read IG$RED routine is used to transfer directory segments ; into the user-specified buffer. However, if the channel specified in ; IG.LCH(R1) is greater than 255, it specifies the address of an external ; read routine. The channel for that read routine is unknown by these ; routines, and must already be open. ; ; The external read routine calling sequence is as follows: ; ; MOV ,R1 ; MOV ,R2 ; MOV ,R3 ; CALL @R4 ; where R4 = address of ; ; read routine ; ; It should return CARRY_CLEAR upon success, or CARRY_SET on error. ; .ENABL LSB IG$SEG::MOV R3,IG.LSG(R1) ; Store new current segment no. DEC R3 ; Convert segment number ASL R3 ; to block number ADD IG.SKP(R1),R3 ; add designated block offset IG$RED: CMP IG.LCH(R1),#255 ; Channel legitimate? BLOS 10$ ; If so, use our .READW ; Use EXTERNAL read routine MOV R4,-(SP) ; Otherwise, use external read MOV R2,-(SP) MOV R1,-(SP) MOV IG.LCH(R1),R4 ; get routine address, MOV IG.BUF(R1),R1 ; buffer address... MOV #512.,R2 ; word count... CALL @R4 ; call external read routine MOV (SP)+,R1 ;*C* restore registers MOV (SP)+,R2 MOV (SP)+,R4 BCC 30$ BR 20$ ............ ; Infernal Read Routine 10$: .READW IG.EMT(R1),IG.LCH(R1),IG.BUF(R1),#512.,R3 BCC 30$ CALL IG$CLO ; Close channel 20$: MOV #E.RDSG,R0 ; Error reading dir segment RETURN ............ ; Read was successful. Move most of the new segment's header to ; the local header buffer, and return. 30$: MOV IG.BUF(R1),R0 ; Point to buffer MOV R1,R3 ADD #IG.LHD,R3 ; Point to local header area MOV (R0)+,(R3)+ ; Move D.TOTA, MOV (R0)+,(R3)+ ; D.NEXT, CMP (R0)+,(R3)+ ; (Bypass D.HIGH entry,) MOV (R0)+,(R3)+ ; D.EXTR, MOV (R0)+,(R3)+ ; and D.STRT BR GOOD ............ .SBTTL IG$CLO - Close channel ; IG$CLO - Close Channel ; - Work area pointed to by R1 IG$CLO::.CLOSE IG.LCH(R1) ; Close the channel, CLR IG.LFO(R1) ; record the event. RETURN ............ .DSABL LSB .SBTTL DT$DEF - Fill in DATE defaults ; DT$DEF - Fill in DATE defaults ; ; (This routine is designed such that it may be separated from ; this source file and put into an overlay, should a user wish) ; On entry, R1 must point to the caller's WKAREA array. ; ; On exit, the C-bit indicates success (clear) or failure (set). .ENABL LSB DT$DEF:: MOV #$NOARG,R2 ; Let R2 = Missing Arg Code CMP IG.DTR(R1),R2 ; Date relationship passed? BNE 20$ ; Branch if so. CMP IG.DTV(R1),R2 ; Date value specified? BNE 10$ ; Branch if so. ; Neither DATREL or DATEWD Specified .ASSUME R.ALL EQ 0 CLR IG.LDR(R1) ; Indicate NO_DATE_CHECK BR 70$ ............ ; No DATREL, DATEWD Specified 10$: MOV #R.EQ,IG.LDR(R1) ; Indicate DATE_CHECK on "EQUALS" BR 50$ ; go store date word locally ............ ; DATREL Specified. Get it and translate it to integer code. 20$: MOV IG.DTR(R1),R0 ; Get address of indicator CALL GETCOD ; get the two-letter code in R0 ; Check for valid DATREL code MOV R2,-(SP) ; make R2 available MOV #IG$RLT,R2 ; point to relationship table 30$: TST @R2 ; check for end of table BMI 40$ ; invalid entry. Return error. CMP R0,(R2)+ ; is it the one specified? BNE 30$ ; branch if not. SUB #,R2 ; Convert adrs to word offset... ASL R2 ; a 2-word offset MOV R2,IG.LDR(R1) ; Store it in work area MOV (SP)+,R2 ; Restore R2 CMP IG.DTV(R1),R2 ; Date value specified? BNE 50$ ; Branch if so. ; DATREL Specified, No DATEWD CMP -(SP),-(SP) ; Make dummy arg block .GTIM SP,SP ; Ensure date reflects rollover CMP (SP)+,(SP)+ ; restore stack .DATE ; Get today's date. BR 60$ ............ ; Error return 40$: MOV (SP)+,R2 ; Restore R2 BR 100$ ............ ; Both DATREL and DATEWD Specified 50$: MOV @IG.DTV(R1),R0 ; Get passed date value 60$: MOV R0,IG.LDV(R1) ; Store it for comparison. 70$: .IF NE F$TSP .INCLUDE 'SRC:TIMCHK.MAC' .ENDC; NE F$TSP ; Fill in default for ENTOFS - Entry Offset 80$: CMP IG.STO(R1),R2 ; Entry offset specified? BEQ 90$ ; Branch if not. MOV @IG.STO(R1),IG.LDP(R1) ; Get passed value 90$: TST (PC)+ 100$: SEC RETURN ............ .DSABL LSB .SBTTL Subroutine GETCOD ; Get a two-letter code pointed to by R0, ; translate to upper case, return it in R0. .ENABL LSB GETCOD: MOV R1,-(SP) ; save working register MOVB 1(R0),R1 ; get 2nd character SWAB R1 BISB (R0),R1 ; get 1st character BIC #<20040>,R1 ; convert both to upper case MOV R1,R0 ; put them in R0 MOV (SP)+,R1 ; restore working register RETURN .DSABL LSB .END