.TITLE VTLVMS - Native Mode Interface .IDENT /1.6/ .ENABL LC ;+ ; ; Free software BY ; Project Software & Development, Inc. ; ; This software is furnished for free and may be used and copied as ; desired. This software or any other copies thereof may be provided ; or otherwise made available to any other person. No title to and ; ownership of the software is hereby transferred or allowed. ; ; The information in this software is subject to change without notice ; and should not be construed as a commitment by PROJECT SOFTWARE ; AND DEVELOPMENT, INC. ; ; PROJECT SOFTWARE assumes no responsibility for the use or reliability ; of this software on any equipment whatsoever. ; ; Project Software & Development, Inc. ; 14 Story St. ; Cambridge, Ma. 02138 ; 617-661-1444 ; ; ; Title: VTLVMS.MAC ; Author: Gary Larsen ; Date: July 15, 1983 ; ; Description: ; ; These routines are used to call VMS native mode routines using the ; undocumented elephant directive. ; ;- .ENABL AMA .NLIST BEX .MCALL DIR$, CSI$ .IFNDF RSX11M ; This is VAX/VMS specific code. CSI$ ; Define the CSI offsets. ;+ ; ; Modification History: ; ; April 4, 1985 by Robin Miller. Version 1.6 ; Look for the native mode image using the logical name SYS$ROBIN ; instead of SYS$NORDEN (I don't work there anymore). ; ; June 14, 1984 by Robin Miller. Version 1.5 ; Look for the native mode routine in SYS$NORDEN then SYS$SYSTEM ; to speed up the initial startup time. ; ; June 7, 1984 by Robin Miller. Edit (01), Version 1.4 ; Added routines and VMSPRS and VMSNXT to support multiple file ; specifications for VMS. ; ; June 5, 1984 by Robin Miller. Version 1.3 ; Added routine VMSPWN to call the native mode spawn routine. Added ; routine VMSPRI to format and spawn "$ PRINT filename". ; ; October 1983 by Robin Miller. Version 1.2 ; Copy the FDB address before saving the VMS status code returned ; from native mode routine. ; ; September 1983 by Robin Miller. Version 1.1 ; Look for the VTL native mode routine in SYS$NORDEN and SYS$SYSTEM. ; ;- ; Define offsets into out DPB: E.IMGN == 4 ; Address of the image name. E.IMGL == 6 ; Length of the image name. E.FUNC == 10 ; The subfuction code. E.FDES == 12 ; Address of input file descriptor. E.XDES == 14 ; Address of expanded descriptor. E.CONT == 16 ; Address to store the context. E.IOSB == 20 ; The VMS I/O status block. ELDPB:: .BYTE 145.,8. ; Directive code and length. .WORD 4 ; Native mode execution. .WORD IMGNAM ; Address of image name string. .WORD IMGLEN ; Length of the image name string. ; Parameters to pass to native mode image .WORD 0 ; Subfunction code. .WORD FILDES ; Address of input file descriptor. .WORD EXPDES ; Address of expanded descriptor. .WORD 0 ; Address to store context longword. .BLKW 4 ; The VMS I/O status longword. IMGNAM: .ASCIZ "SYS$ROBIN:VTLNATIVE.EXE" IMGLEN = <.-IMGNAM>-1 ALTNAM: .ASCIZ "SYS$SYSTEM:VTLNATIVE.EXE" ALTLEN = <.-ALTNAM>-1 PRINTC: .ASCIZ "$ PRINT " ; ASCII string for DCL print command. .EVEN FILDES::.WORD 0,0 ; Length of input file name. .WORD 0,0 ; Address of the file name string. EXPDES::.WORD FILSIZ,0 ; Maximum length of expanded file. .WORD 0,0 ; Address to store expanded file name. .SBTTL DOVMS - Do the VMS elephant directive. ;+ ; ; DOVMS - Do the VMS elephant directive. ; ; This routine is used to execute the undocumented elephant directive. ; This directive allows a native mode routine to be called from compatibility ; mode programs. The AME picks up this special directive, maps and starts ; the native mode image specified. ; ; Inputs: ; R5 = The file entry address. ; ; Implicit inputs: ; O.FPTR - Pointer to the input buffer. ; O.FNAM - Address of the file name buffer. ; ; Outputs: ; C bit clear/set = success/failure. ; ; Implicit outputs: ; Bit B.NATV in the switch mask is cleared if the native mode ; routine is not available for the wildcard lookup. ; ;- DOVMS:: CALL $SAVAL ; Save all registers. BIT #B.NATV,SWMASK ; Native mode routine disabled ? BEQ 90$ ; If EQ, yes (return failure). MOV #ELDPB,R4 ; Set address of elephant DPB. CLR E.FUNC(R4) ; Set wildcard lookup function code. 2$: MOV R5,R1 ; Copy the file entry address. ADD #O.CONT,R1 ; Set address of the context word. MOV R1,E.CONT(R4) ; Save address of context longword. ;(01) MOV O.FPTR(R5),R0 ; Copy the input file address. MOV O.FSAV(R5),R0 ; Copy pointer to the file name.(01) CALL GETLEN ; Calculate the length. MOV R1,FILDES ; Save the file name length. MOV R0,FILDES+4 ; Save the file name buffer. MOV O.FNAM(R5),EXPDES+4 ; Expanded file name buffer address. MOV O.FNB(R5),R1 ; Copy the FNB address. BIT #NB.NXD,N.STAT(R1) ; Are we going to next directory ? BEQ 5$ ; If EQ, no. CALL VMSNXD ; Else, find the next directory. BIC #NB.NXD,N.STAT(R1) ; We're now at the next directory. BR 10$ ; And continue ... 5$: CALL VMSELE ; Execute the elephant directive. 10$: BCS 95$ ; If CS, image wasn't found. MOV O.FDB(R5),R0 ; Copy the FDB address. CLR F.ERR(R0) ; Initialize the error code. BISB E.IOSB(R4),F.ERR(R0) ; Save the I/O status code. ; Terminate the file name with a null. It's padded with spaces. MOV O.FNAM(R5),R2 ; Copy the file name address. MOV #FILSIZ,R3 ; Set the maximum file size. 20$: CMPB (R2)+,#SPACE ; Have we found the space ? BEQ 30$ ; If EQ, yes (terminate it). SOB R3,20$ ; SOB to prevent infinite loop. 30$: CLRB -(R2) ; Terminate name with a null. TSTB F.ERR(R0) ; Did we have any I/O errors ? BPL 100$ ; If PL, no (Return success). 90$: CMPB #IE.NSF,F.ERR(R0) ; Is the error "No such file" ? (01) BNE 95$ ; If NE, no (unexpected error). (01) CLR O.CONT(R5) ; Clear the context longword (01) CLR O.CONT+2(R5) ; for VMS wildcard lookup.(01) CALL VMSNXT ; Check for next file name. (01) BCC 2$ ; If CC, another file name. (01) 95$: SEC ; Show we've had an error. 100$: RETURN .SBTTL VMSELE - Execute the elephant directive. ;+ ; ; VMSELE - Execute the elephant directive. ; ; This routine is called to execute the elephant directive to access a ; VMS native mode routine. If the directive fails, a second attempt is ; made using the alternate directory string. ; ; Inputs: ; R4 = The directive parameter block address. ; R5 = The file entry address. ; ; Outputs: ; C bit clear/set = success/failure. ; ; All registers are preserved. ; ;- VMSELE: CALL $SAVAL ; Save all registers. DIR$ R4 ; Execute the elephant directive. BCC 100$ ; If CC, the directive was successful. ; Try to find the native routine using the alternate directory string. MOV #ALTNAM,E.IMGN(R4) ; Set address of alternate directory. MOV #ALTLEN,E.IMGL(R4) ; Set the alternate directory length. DIR$ R4 ; Execute the elephant directive again. BCC 100$ ; If CC, found it this time. MOV O.FDB(R5),R0 ; Copy the FDB address. ; ; If we get a directive, we presume the AME could not map and start ; the image with our native mode routines. We display the image name ; in the error message, prompt the user before continuing, and then ; clear the native mode flag to show a normal open should be done. ; MOV $DSW,F.ERR(R0) ; Else, copy the directive error. MOV O.FNAM(R5),R0 ; Copy the file name address. MOV E.IMGN(R4),R1 ; Copy the image name address. CALL MOVEC ; Copy it to the file name buffer. CALL FILERR ; Report the file error message. CALL PRUSER ; Prompt the user before continuing. BIC #B.NATV,SWMASK ; Show native mode not available. 90$: SEC 100$: RETURN .SBTTL VMSNXD - Find next VMS directory. ;+ ; ; VMSNXD - Find the next VMS directory. ; ; This routine is used to loop calling the VMS wildcard lookup routine ; until the next directory (if any) is found. ; ; Inputs: ; R4 = The DPB address. ; R5 = The file entry address. ; ; Outputs: ; C bit clear/set = success/directive error. ; ; All registers are preserved. ; ;- VMSNXD: CALL $SAVAL ; Save all registers. MOV O.FNAM(R5),R0 ; Copy the file name address. 10$: CMPB (R0)+,#'[ ; Find start of the directory ? BNE 10$ ; If NE, no. MOV #INBUF,R1 ; Set address to store directory. 20$: MOVB (R0)+,(R1) ; Copy the directory string. CMPB (R1)+,#'] ; Find end of the directory ? BNE 20$ ; If NE, no. CLRB (R1) ; Yes, terminate the directory. ; Find the next VMS file name. 30$: TST STATUS ; Was CTRL/C typed to abort ? BMI 100$ ; If MI, yes (stop looping). DIR$ R4 ; Execute the elephant directive. BCS 100$ ; If CS, return failure. TSTB E.IOSB(R4) ; Did we have an I/O error ? BMI 100$ ; If MI, yes. ; Now compare the new directory with the previous directory. MOV O.FNAM(R5),R0 ; Address of expanded file name. 50$: CMPB (R0)+,#'[ ; Find start of the directory ? BNE 50$ ; If NE, no. MOV #INBUF,R1 ; Set address of previous directory. 60$: TSTB (R1) ; End of the previous directory ? BEQ 30$ ; If EQ, yes (get next file spec). CMPB (R0)+,(R1)+ ; Do the directory strings match ? BEQ 60$ ; If EQ, yes (check the rest). CLC ; Show success. 100$: RETURN .SBTTL VMSNXT - Find the next file specification. ;+ ; ; VMSNXT - Find the next file specification (if any). ; ; This routine checks for another file specification and if found, ; updates the pointer in the file entry to point to it. ; ; Inputs: ; R5 = The file entry address. ; ; Outputs: ; C bit clear/set = another file/no more files. ; ;+ VMSNXT::JSR R2,$SAVVR ; Save R0 - R2. MOV O.FSAV(R5),R0 ; Copy current file pointer. CALL GETLEN ; Calculate the length. INC R1 ; Adjust for the null byte. ADD R1,R0 ; Point to the next file name. TSTB (R0) ; Is there another file name ? BEQ 90$ ; If EQ, no. MOV R0,O.FSAV(R5) ; Yes, save pointer to the next. CLC ; Show we have another file. BR 100$ ; And use common return ... 90$: SEC ; Show no more files found. 100$: RETURN .SBTTL VMSPRI - Check for VMS print command. ;+ ; ; VMSPRI - Check for VMS print command. ; ; If we're running on VMS we build a DCL print command and use the native ; mode spawn command to print this file. ; ; Inputs: ; R5 = The file entry address. ; ; Outputs: ; C bit clear/set = success/failure. ; ; All registers are preserved. ; ;- VMSPRI::JSR R2,$SAVVR ; Save R0 - R2. MOV #TMPBUF,R0 ; Set address of temporary buffer. MOV R0,R2 ; Save the starting address. MOV #PRINTC,R1 ; Set address of "$ PRINT " string. CALL MOVEC ; Copy the string. MOV O.FNAM(R5),R1 ; Copy the input file address. CALL MOVEC ; Now Append the command file. MOV R2,R0 ; Restore starting buffer address. CALL VMSPWN ; Spawn the command line. RETURN .SBTTL VMSPRS - Parse multiple file specifications. ;+ ; ; VMSPRS - Parse multiple file specifications. ; ; This routine is called to parse multiple file names separated by ; commas. Each comma is converted to a null and an extra null is ; placed at the end of the command line for later parsing. ; ; Inputs: ; R5 = The file entry address. ; ; Outputs: ; O.FSAV = Pointer to the first file specification. ; ; All registers are preserved. ; ;- VMSPRS::JSR R2,$SAVVR ; Save R0 - R2. MOV O.FPTR(R5),R0 ; Copy the file buffer address. MOV R0,O.FSAV(R5) ; Set pointer to first file name. CALL GETLEN ; Calculate the length. 10$: CMPB (R0)+,#COMMA ; Another file name specified ? BNE 20$ ; If NE, no. CLRB -1(R0) ; Yes, convert it to a null. 20$: SOB R1,10$ ; Loop until done. CLRB (R0)+ ; Terminate last file name. CLRB (R0)+ ; Terminate the command line. RETURN .SBTTL VMSPWN - Spawn a VMS command line. ;+ ; ; VMSPWN - Spawn a VMS command line. ; ; Inputs: ; R0 = Address of command to spawn (terminated by null). ; ; Outputs: ; All registers are preserved. ; ;- VMSPWN::CALL $SAVAL ; Save all registers. BIT #B.NATV,SWMASK ; Native mode routine disabled ? BEQ 90$ ; If EQ, yes (return failure). MOV #ELDPB,R4 ; Set address of elephant DPB. MOV #1,E.FUNC(R4) ; Set function code for spawn. CALL GETLEN ; Calculate the length. MOV R1,FILDES ; Save the file name length. MOV R0,FILDES+4 ; Save the file name buffer. DIR$ R4 ; Execute the elephant directive. BCC 100$ ; If CC, success ... 90$: SEC ; Return failure ... 100$: RETURN .SBTTL VMSWLD - Check for VMS wildcards. ;+ ; ; VMSWLD - Check for VMS wildcard characters. ; ; Since the wildcard context longword from the RMS name block does not ; have the wildcard bits set as expected, this routine check for wildcard ; characters in the file name string and passes back a status. This is ; done so we know whether to prompt the user after an open error. ; ; Inputs: ; R5 = The file entry address. ; ; Outputs: ; C bit clear/set = wildcards/no wildcards. ; ;- VMSWLD::JSR R2,$SAVVR ; Save R0 - R2. MOV O.FPTR(R5),R0 ; Copy the file name string address. 10$: TSTB (R0) ; Are we at end of file string ? BEQ 90$ ; If EQ, yes (return failure). CMPB (R0),#'% ; Is there a percent wildcard ? BEQ 20$ ; If EQ, yes. CMPB (R0),#'* ; Is there an asterisk wildcard ? BEQ 20$ ; If EQ, yes. CMPB (R0)+,#'. ; Is there a possible elipsis ? BNE 10$ ; If NE, no. CMPB (R0),#'. ; Is this really [directory...] ? BNE 10$ ; If NE, no. 20$: CLC ; Show there is a wildcard. RETURN 90$: SEC ; Show no wildcards specified. RETURN .ENDC ;.IFNDF RSX11M .END