.MCALL .MODULE .MODULE ISFINF,VERSION=04,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. ;-- ;+ ;COND ; SLIB$M (0) Generate standard SYSLIB routine ; SLIB$M 1 Generate U mode part of Supervisor library ; SLIB$M 2 Generate S mode part of Supervisor library ; ; SLIB$M values are referenced using symbols of the form *PART ; in conditional startements. ;- .IIF NDF SLIB$M SLIB$M=0 OPART = SLIB$M ;0 = generate if building old library UPART = SLIB$M-1 ;0 = generate if building User part SPART = SLIB$M-2 ;0 = generate if building Supy part OSPART = OPART*SPART ;0 = generate ... old or Supy OUPART = OPART*UPART ;0 = generate ... old or User .SBTTL Module Declarations .NLIST .ENABL LC .DSABL GBL .NLIST CND .LIST ; ++ ; FACILITY: ; ; RT-11 System Subroutine Library ; ; ENVIRONMENT: ; ; This routine can be used by any job running in a single-job ; or multi-job environment. ; ; CALLABLE ENTRIES: ; ; ISFINF, ISFSTA ; ; INCLUDE FILES: ; ; SYSMAC.SML ; RT-11 system macro library ; EXTERNAL REFERENCES: ; .IF EQ OSPART .GLOBL $NXVAL ; Entry point to next value routine .GLOBL $NXADR ; Entry point to next address routine .GLOBL $GSFIN ; Entry point to set infirmation service rouitne .GLOBL $ARGER ; Code for missing argument .ENDC; EQ OSPART .IF EQ OUPART .GLOBL $SYSLB ; Include system library work area .ENDC; EQ OUPART .IF EQ UPART .GLOBL SFINF$ ; Supervisor entry .ENDC; EQ UPART .SBTTL ISFINF - Fortran-callable Routine ; ; ++ ; FUNCTIONAL DESCRIPTION: ; ; The ISFINF function saves and then modifies the contents of the specified ; Directory Entry Word for file specified. ; ; CALLING SEQUENCE: ; ; i = ISFINF (chan, dblk, value, oper, offset [, iold]) ; ; INPUT PARAMETERS: ; ; R5 - address of ISFINF argument block ; ; 0(R5) - argument count of ISFINF call ; 2(R5) - address of the integer value of the RT-11 channel to be used ; 4(R5) - address of the four word RT-11 file specification, in Radix- ; 50, of the file whose Directory Entry Word is being modified ; 6(R5) - address of the value to be used to change specified Directory ; Entry Word ; 10(R5) - address of operation code ('G','S','C' or 'M') to perform on ; specified Directory Entry Word ; 12(R5) - address of offset to Directory Entry Word to perfrom specified ; operation ; 14(R5) - address of the variable in which to return old value of the ; modified Directory Entry Word ; ; OUTPUT PARAMETERS: ; ; iold - The previous value of the modified Directory Entry Word ; ; RETURNED FUNCTION VALUE: ; ; i = 0 - Normal return ; -1 - Channel was open ; -2 - File not found ; -3 - Invalid operation ; -4 - Invalid offset ; -257. - Required argument missing ; ; -- .SBTTL ISFSTA - Fortran-callable Routine ; ; ++ ; FUNCTIONAL DESCRIPTION: ; ; The ISFSTA function saves and then modifies Directory Entry Status Word ; for specified file. ; ; CALLING SEQUENCE: ; ; i = ISFSTA (chan, dblk, value, oper[, iold]) ; ; INPUT PARAMETERS: ; ; R5 - address of ISFSTA argument block ; ; 0(R5) - argument count of ISFSTA call ; 2(R5) - address of the integer value of the RT-11 channel to be used ; 4(R5) - address of the four word RT-11 file specification, in Radix-50, ; of the file whose Directory Entry Word is being modified ; 6(R5) - address of the value to be used to change Directory Entry Word ; 10(R5) - address of operation code ('G','S','C' or 'M') to perform on ; specified Directory Entry Word ; 12(R5) - address of the variable to return old value of specified ; Directory Entry Word ; ; OUTPUT PARAMETERS: ; ; iold - The previous value of specified Directory Entry Word ; ; RETURNED FUNCTION VALUE: ; ; i = 0 - Normal return ; -1 - Channel was open ; -2 - File not found ; -3 - Operation invalid ; -257. - Required argument missing ; -- .IF EQ OUPART .PSECT SYS$S,D OPS: .ASCIZ "GCSM" .EVEN .ENDC; EQ OUPART .PSECT SYS$I,I .MCALL .ASSUME .BR .CKXX .CKXX S.ORG = 1000 ;test value for stack .ENABL LSB CK.SP=S.ORG .IF EQ OPART CK.SP ,-2,S.TYPE SFINF:: ISFINF::MOV #-1,-(SP) ;Set flag for ISFINF BR 10$ ;Join common code CK.SPA=S.ORG CK.SPA ,-2,S.TYPE SFSTA:: ISFSTA::CLR -(SP) ;Offset=0 to Directory Entry Status Word .BR 10$ 10$: .ENDC; EQ OPART .IF EQ UPART SFINF:: ISFINF::MOV #-1,R1 ;Set flag for ISFINF BR 10$ ;Join common code CK.SPA=S.ORG SFSTA:: ISFSTA::CLR R1 ;Offset=0 to Directory Entry Status Word .BR 10$ 10$: MOV #OPS,R0 ;pass data area address JMP SFINF$ ;go to supy library .ENDC; EQ OUPART .IF EQ SPART SFINF$:: CK.SP ,-2,S.TYPE MOV R1,-(SP) ;Save type code CK.SP ,-2,S.OPS MOV R0,-(SP) ;save ops address .ENDC; EQ SPART .IF EQ OSPART MOV (R5)+,R4 ;Get count CALL $NXADR ;Get channel address CK.SPA=CK.SP BCS 70$ ;Required arg missing MOVB @R0,R1 ;Get channel number CALL $NXADR ;Get dblk address CK.SPA=CK.SP BCS 70$ ;Required arg missing MOV R0,R2 ;Save it CALL $NXVAL ;Get 'val' value CK.SPA=CK.SP BCS 70$ ;Required arg missing MOV R0,R3 ;Value, save it CALL $NXADR ;Get addr of 'oper' argument CK.SPA=CK.SP BCS 70$ ;Required arg missing CK.SP ,-2,S.OPER MOVB @R0,-(SP) ;Save oper first char BMI 40$ ;User oper code CK.SP S.OPER BIC #40,@SP ;Force uppercase .IF EQ OPART MOV #OPS,R0 ;Point to valid oper list .IFF; EQ OPART .Assume CK.SP+2 EQ S.OPS MOV 2(SP),R0 ;Point to valid oper list .ENDC; EQ OPART CK.SP S.OPER 20$: CMPB @SP,@R0 ;Match ? CK.SPB=CK.SP BEQ 30$ ;Yes TSTB (R0)+ ;Get next valid oper value BNE 20$ ;More .IF EQ OPART CK.SPB ,+2+2 CMP (SP)+,(SP)+ ;Align stack .IFF; EQ OPART CK.SPB ,+6 ADD #6.,SP ;Align stack .ENDC; EQ OPART MOV #-3,R0 ;Invalid oper code CK.SPB S.ORG RETURN 30$: .IF EQ OPART SUB #OPS,R0 ;Calculate ops code .IFF; EQ OPART .Assume CK.SP+2 EQ S.OPS SUB 2(SP),R0 ;Calculate ops code .ENDC; EQ OPART CK.SP S.OPER MOV R0,@SP ;Save it 40$: .IF EQ SPART CK.SP S.OPER CK.SP ,+2,S.OPER MOV (SP)+,@SP .ENDC; EQ SPART .Assume CK.SP+2 EQ S.TYPE TST 2(SP) ;Is it ISFINF ? BEQ 50$ ;No, then skip offset CALL $NXVAL ;Get offset value CK.SPB=CK.SP BCS 60$ ;Required arg missing .Assume CK.SP+2 EQ S.TYPE MOV R0,2(SP) ;Save offset value 50$: CLR R0 ;clear R0 in case 'iold' arg missing CALL $NXADR ;get 'iold' addr .Assume CK.SP EQ S.OPER .Assume CK.SP+2 EQ S.TYPE CALLR $GSFIN ;Call common service 60$: .IF EQ OPART CK.SPB ,+2 TST (SP)+ ;Align stack .IFTF; EQ OPART 70$: .IFT; EQ OPART CK.SPB ,+2 CK.SPA ,+2 TST (SP)+ ;Align stack .IFF; EQ OPART CK.SPB ,+2+2 CK.SPA ,+2+2 CMP (SP)+,(SP)+ ;Align stack .ENDC; EQ OPART MOV #$ARGER,R0 ;Required arg missing CK.SPA S.ORG CK.SPB S.ORG RETURN .ENDC; EQ OSPART .DSABL LSB .END