.TITLE VTLNATIVE - Native Mode Routines .IDENT /1.2/ ;++ ; ; 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.MAR ; Author: Gary Larsen ; Date: July 15, 1983 ; ; Description: ; ; This module contains the native mode routine for the VTL program. ; These routines allow us to do things unavailable to normal compatibility ; programs such as VMS wildcard lookup. ; ; Modification History: ; ; March 5, 1985 by Robin Miller. Version 1.2 ; Change SPAWN flags word to allow CLI symbols to be copied to ; the new process. This allows the EDT and/or TECO commands now ; defined as CTRL/E and CTRL/T to execute properly. ; ; June 5, 1984 by Robin Miller. Version 1.1 ; Added SPAWN routine to allow spawning of DCL commands. ; ;-- .library /SYS$LIBRARY:LIB/ ; ; Parameter list offsets for lib$findfile: ; dis_par = 28 ; Parameters from compatability mode. fildes_par = 0 ; Address of input file descriptor. retdes_par = 2 ; Address of returned file descriptor. contxt_par = 4 ; Address to store context longword. status_block = 6 ; The VMS I/O status block. $rmsdef ; RMS definitions. $fab ; FAB definitions. $nam ; NAM block definitions. vmserr: .long rms$_syn ;(01) Syntax error in file specification. .long rms$_lne ;(02) Logical name error. .long rms$_typ ;(03) Error in file type. .long rms$_ver ;(04) Error in version number. .long rms$_dev ;(05) Bad device or inappropriate device type. .long rms$_fnm ;(06) Syntax error in file name. .long rms$_dir ;(07) Error in directory name. .long rms$_dnr ;(08) Device not ready. .long rms$_fnf ;(09) File not found. .long rms$_prv ;(10) Insufficient privilege. .long rms$_flk ;(11) File is locked. .long rms$_rer ;(12) File read error. .long rms$_wer ;(13) File write error. .long rms$_exp ;(14) Expiration date not yet reached. .long rms$_chn ;(15) Channel assignment failure. .long rms$_nmf ;(16) No more files. .long rms$_wcc ;(17) Invalid wildcard context. .long rms$_dnf ;(18) Directory not found. .long rms$_fnd ;(19) ACP file or directory lookup failed. .long rms$_nod ;(20) Node name error. .long rms$_normal ;(21) Normal completion. vmsend: rsxerr: .word -54 ;(01) ie.bnm - Bad file name rms$_syn .word -54 ;(02) ie.bnm - rms$_lne .word -54 ;(03) ie.bnm - rms$_typ .word -54 ;(04) ie.bvr - Bad version number. rms$_ver .word -55 ;(05) ie.bdv - Bad device name. rms$_dev .word -54 ;(06) ie.bnm - rms$_fnm .word -52 ;(07) ie.bdi - Bad directory syntax. rms$_dir .word -3 ;(08) ie.dnr - Device not ready. rms$_dnr .word -26 ;(09) ie.nsf - No such file. rms$_fnf .word -16 ;(10) ie.pri - Privilege volation. rms$_prv .word -27 ;(11) ie.lck - Locked for read/write access rms$_flk .word -32 ;(12) io.rer - File read error. rms$_rer .word -33 ;(13) io.wer - File write error. rms$_wer .word -75 ;(14) io.exp - Expiration date not reached. rms$_exp .word -9 ;(15) ie.dun - Device not attachable. rms$_chn .word -26 ;(16) ie.nsf - No such file. rms$_nmf .word -54 ;(17) ie.bnm - Bad file name. rms$_wcc .word -26 ;(18) ie.nsf - No such file. rms$_dnf .word -26 ;(19) ie.nsf - No such file. rms$_fnd .word -54 ;(20) ie.bnm - Bad file name. rms$_nod .word 1 ;(21) is.suc - Successful completion. rms$_normal ; Define flag bits for lib$spawn: nowait = 1 ; Bit 0 = No wait. noclisym = 2 ; Bit 1 = No CLI symbols. nolognam = 4 ; Bit 4 = No logical names. ; Offsets into parameter block: cmddes_par = 0 ; Only one parameter. flags: .long 0 ; Wait / Symbols / Logicals. .sbttl start - Start of native mode program. ; This is where we start. start:: .word 0 ; Entry mask word. ; ; Dispatch to the appropriate routine: ; movl dis_par(ap),r11 case src=(r11)+,- ; Dispatch on the function. type=w,- displist=<- lookup,- ; VMS wildcard lookup. spawn> ; Spawn a DCL command. movw #-98,r0 ; Else show illegal function. ret .sbttl lookup - Do the VMS wildcard lookup. ;++ ; ; LOOKUP - Do the VMS wildcard lookup. ; ; Inputs: ; R11 = The address of the parameter block. ; ; Implicit inputs: ; The context longword must be zero for the first file lookup. ; ; Outputs: ; All registers are preserved. ; ; Implicit outputs: ; context_par = Contains the virtual address of the FAB/RAB. ; ;-- lookup::pushr #^m ; Save some registers. clrl -(sp) ; Set no related file name. clrl -(sp) ; Set no default file name. movzwl contxt_par(r11),-(sp) ; Address of context longword. movzwl retdes_par(r11),-(sp) ; Expanded file name descriptor. movzwl fildes_par(r11),-(sp) ; Input file name descriptor. calls #5,g^lib$find_file ; Go find a file for us. movw r0,status_block(r11) ; Presume success.(If there is an error ; we will try to match it in the table. blbs r0,20$ ; If LBS, success - return. moval vmserr,r1 ; Address of VMS error table. moval vmserr,r2 ; Address of VMS error table. moval vmsend,r3 ; End of VMS error table. 10$: cmpl r1,r3 ; Did we reach the end of error table. beql 20$ ; If eql, yes. cmpl r0,(r1)+ ; Find the VMS error ? bneq 10$ ; If neq, no. subl2 #4,r1 ; Else point to the entry. subl2 r2,r1 ; Find the offset into the table. divl #2,r1 ; Convert it to word displacement. clrl r2 ; Setup r2 for address of RSX error. movaw rsxerr,r2 ; Address of RSX error table. addw2 r1,r2 ; Position to equivalent RSX error. movw (r2),status_block(r11) ; Signal the error to the caller. 20$: popr #^m ; Restore the registers. movzwl #1,r0 ; Always return success. ret ;++ ; ; SPAWN - Spawn a DCL command. ; ; This routine calls the LIB$SPAWN run-time library routine to spawn ; a DCL command from compatibility mode. ; ; Inputs: ; R11 = The address of the parameter block. ; ; Outputs: ; R0 = The directive status. ; ;-- SPAWN:: clrl -(sp) ; No completion AST parameter. clrl -(sp) ; No completion AST routine. clrl -(sp) ; No completion event flag. clrl -(sp) ; No completion status longword. clrl -(sp) ; No longword for process-id. clrl -(sp) ; No specific process name. movab flags,-(sp) ; Copy logical names to subprocess. clrl -(sp) ; Default output to the terminal. clrl -(sp) ; Default input to the terminal. movzwl cmddes_par(r11),-(sp) ; Copy address of command line. calls #10,g^lib$spawn ; Spawn the command line. ret .end start