.TITLE BATUSSDISP Battelle User System Services .IDENT /1.0/ ;++ ; ; Title: ; BATUSSDISP - Collection of Battelle-written system service. ; ; Version: ; 1.0 ; ; Facility: ; Local system services. ; ; Abstract: ; This module contains a collection of Battelle-written system ; services. The structure of this module is copied from the ; VMS-supplied USSDISP.MAR in SYS$EXAMPLES. ; ; Environment: ; Must be installed /PROTECT. ; ; Author: ; Mark Oakley Battelle Memorial Institute 29-Jul-1987 ; ; Modified: ; ; ;-- ; .SBTTL Marcos, Declarations, Equates .LIBRARY "SYS$LIBRARY:LIB.MLB" ; Macro library for system structure ; definitions ; ; Macro Definitions ; ; ; Macro to handle return codes. ; .MACRO ON_ERR THERE,?HERE BLBS R0,HERE BRW THERE HERE: .ENDM ON_ERR ; ; DEFINE_SERVICE - A macro to make the appropriate entries in several ; different PSECTs required to define an EXEC or KERNEL ; mode service. These include the transfer vector, ; the case table for dispatching, and a table containing ; the number of required arguments. ; ; DEFINE_SERVICE Name,Number_of_Arguments,Mode ; .MACRO DEFINE_SERVICE,NAME,NARG=0,MODE=KERNEL .PSECT $$$TRANSFER_VECTOR,PAGE,NOWRT,EXE,PIC .ALIGN QUAD ; Align entry points for speed and style .TRANSFER NAME ; Define name as universal symbol for entry .MASK NAME ; Use entry mask defined in main routine .IF IDN MODE,KERNEL CHMK # ; Change to kernel mode and execute RET ; Return KERNEL_COUNTER=KERNEL_COUNTER+1 ; Advance counter .PSECT KERNEL_NARG,BYTE,NOWRT,EXE,PIC .BYTE NARG ; Define number of required arguments .PSECT USER_KERNEL_DISP1,BYTE,NOWRT,EXE,PIC .WORD 2+NAME-KCASE_BASE ; Make entry in kernel mode CASE table .IFF CHME # ; Change to executive mode and execute RET ; Return EXEC_COUNTER=EXEC_COUNTER+1 ; Advance counter .PSECT EXEC_NARG,BYTE,NOWRT,EXE,PIC .BYTE NARG ; Define number of required arguments .PSECT USER_EXEC_DISP1,BYTE,NOWRT,EXE,PIC .WORD 2+NAME-ECASE_BASE ; Make entry in exec mode CASE table .ENDC ; .ENDM DEFINE_SERVICE ; ; ; Equated Symbols ; $DCDEF ; Device classes. $DVIDEF ; For $GETDVI calls. $FABDEF ; File access block symbols. $JPIDEF ; For $GETJPI calls. $IODEF ; For $QIO calls. $NAMDEF ; (File) name access block symbols. $PCBDEF ; Process contorl block defs. $PHDDEF ; Define process header offsets $PLVDEF ; Define PLV offsets and values $PSLDEF ; Processor status longword defs. $SSDEF ; Define system status codes $XABDEF ; (File) attribute block symbols. ; ; Initialize counters for change mode dispatching codes ; KERNEL_COUNTER=0 ; Kernel code counter EXEC_COUNTER=0 ; Exec code counter ; ; Own Storage ; .PSECT KERNEL_NARG,BYTE,NOWRT,EXE,PIC KERNEL_NARG: ; Base of byte table containing the ; number of required arguments. .PSECT EXEC_NARG,BYTE,NOWRT,EXE,PIC EXEC_NARG: ; Base of byte table containing the ; number of required arguments. .SBTTL Transfer Vector and Service Definitions DEFINE_SERVICE BAT$CHANGE_TO_IMAGE_UIC,0,KERNEL DEFINE_SERVICE BAT$RESTORE_PROCESS_UIC,0,KERNEL KCODE_BASE=-1024 ; Base CHMK code value for these services ECODE_BASE=-1024 ; Base CHME code value for these services .SBTTL Change Mode Dispatcher Vector Block .WEAK SYS$K_VERSION .PSECT USER_SERVICES,PAGE,VEC,PIC,NOWRT,EXE .LONG PLV$C_TYP_CMOD ; Set type of vector to change mode dispatcher .LONG SYS$K_VERSION ; Identify system version .LONG KERNEL_DISPATCH-. ; Offset to kernel mode dispatcher .LONG EXEC_DISPATCH-. ; Offset to executive mode dispatcher .LONG USER_RUNDOWN-. ; Offset to user rundown service .LONG 0 ; Reserved. .LONG 0 ; No RMS dispatcher .LONG 0 ; Address check - PIC image .PAGE .SBTTL Kernel Mode Dispatcher ;++ ; Input Parameters: ; ; (SP) - Return address if bad change mode value ; ; R0 - Change mode argument value. ; ; R4 - Current PCB Address. (Therefore R4 must be specified in all ; register save masks for kernel routines.) ; ; AP - Argument pointer existing when the change ; mode instruction was executed. ; ; FP - Address of minimal call frame to exit ; the change mode dispatcher and return to ; the original mode. ;-- .PSECT USER_KERNEL_DISP0,BYTE,NOWRT,EXE,PIC KACCVIO: ; Kernel access violation MOVZWL #SS$_ACCVIO,R0 ; Set access violation status code RET ; and return KINSFARG: ; Kernel insufficient arguments. MOVZWL #SS$_INSFARG,R0 ; Set status code and RET ; return KNOTME: RSB ; RSB to forward request KERNEL_DISPATCH:: ; Entry to dispatcher MOVAB W^-KCODE_BASE(R0),R1 ; Normalize dispatch code value BLSS KNOTME ; Branch if code value too low CMPW R1,#KERNEL_COUNTER ; Check high limit BGEQU KNOTME ; Branch if out of range ; ; The dispatch code has now been verified as being handled by this dispatcher, ; now the argument list will be probed and the required number of arguments ; verified. ; MOVZBL W^KERNEL_NARG[R1],R1 ; Get required argument count MOVAL @#4[R1],R1 ; Compute byte count including arg count IFNORD R1,(AP),KACCVIO ; Branch if arglist not readable CMPB (AP),W^[R0] ; Check for required number BLSSU KINSFARG ; of arguments MOVL FP,SP ; Reset stack for service routine CASEW R0,- ; Case on change mode - ; argument value #KCODE_BASE,- ; Base value # ; Limit value (number of entries) KCASE_BASE: ; Case table base address for DEFINE_SERVICE ; ; Case table entries are made in the PSECT USER_KERNEL_DISP1 by ; invocations of the DEFINE_SERVICE macro. The three PSECTS, ; USER_KERNEL_DISP0,1,2 will be abutted in lexical order at link-time. ; .PSECT USER_KERNEL_DISP2,BYTE,NOWRT,EXE,PIC BUG_CHECK IVSSRVRQST,FATAL ; Since the change mode code is validated ; above, we should never get here .SBTTL Executive Mode Dispatcher ;++ ; Input Parameters: ; ; (SP) - Return address if bad change mode value ; ; R0 - Change mode argument value. ; ; AP - Argument pointer existing when the change ; mode instruction was executed. ; ; FP - Address of minimal call frame to exit ; the change mode dispatcher and return to ; the original mode. ;-- .PSECT USER_EXEC_DISP0,BYTE,NOWRT,EXE,PIC EACCVIO: ; Exec access violation MOVZWL #SS$_ACCVIO,R0 ; Set access violation status code RET ; and return EINSFARG: ; Exec insufficient arguments. MOVZWL #SS$_INSFARG,R0 ; Set status code and RET ; return ENOTME: RSB ; RSB to forward request EXEC_DISPATCH:: ; Entry to dispatcher MOVAB W^-ECODE_BASE(R0),R1 ; Normalize dispatch code value BLSS ENOTME ; Branch if code value too low CMPW R1,#EXEC_COUNTER ; Check high limit BGEQU ENOTME ; Branch if out of range ; ; The dispatch code has now been verified as being handled by this dispatcher, ; now the argument list will be probed and the required number of arguments ; verified. ; MOVZBL W^EXEC_NARG[R1],R1 ; Get required argument count MOVAL @#4[R1],R1 ; Compute byte count including arg count IFNORD R1,(AP),EACCVIO ; Branch if arglist not readable CMPB (AP),W^[R0] ; Check for required number BLSSU EINSFARG ; of arguments MOVL FP,SP ; Reset stack for service routine CASEW R0,- ; Case on change mode - ; argument value #ECODE_BASE,- ; Base value # ; Limit value (number of entries) ECASE_BASE: ; Case table base address for DEFINE_SERVICE ; ; Case table entries are made in the PSECT USER_EXEC_DISP1 by ; invocations of the DEFINE_SERVICE macro. The three PSECTS, ; USER_EXEC_DISP0,1,2 will be abutted in lexical order at link-time. ; .PSECT USER_EXEC_DISP2,BYTE,NOWRT,EXE,PIC BUG_CHECK IVSSRVRQST,FATAL ; Since the change mode code is validated ; above, we should never get here .SBTTL User Rundown Service ;++ ; Functional description: ; This service is invoked from within the kernel mode system service ; that performs image rundown. It is invoked before any system ; rundown functions (i.e. deassign channels, release memory) are ; performed. User code should not invoked any RMS services or RTL ; routines, must not signal any exceptions. User code can invoke ; most system services execpt those that use RMS (e.g. $PUTMSG). ; ; Calling sequence: ; JSB USER_RUNDOWN ; Entered at IPL=0 and must leave at IPL=0. ; ; Input Parameters: ; R4 - Current PCB Address. (Therefore R4 must be specified in all ; register save masks for kernel routines.) ; ; R7 - Access mode parameter to $RUNDWN maximized with previous mode ; ; AP - Argument pointer existing when the $RUNDWN system ; service was invoked. ; ; 4(AP) - Access mode parameter to $RUNDWN ; ;-- .PSECT USER_CODE,BYTE,NOWRT,EXE,PIC USER_RUNDOWN:: ; Entry point for service ; ; Restore process uic if it was changed! ; TSTL PROCESS_UIC_FLAG BEQL 30$ MOVL PROCESS_UIC,PCB$L_UIC(R4) 30$: RSB .SBTTL Change process UIC to that of image file ;-- ;++ ; ; Functional Description: ; This routine determines the owner (uic) of the file that is ; currently being executed, and (temporarily) changes the process ; uic to the file uic. ; ; Calling Sequence: ; status = BAT$CHANGE_TO_IMAGE_UIC (control_c_handler_flag, ; control_c_handler_flag) ; ; Input Parameters: ; CONTROL_C_HANDLER_FLAG - Optional argument, passed by reference. If ; set to 0, no control C handler will be enabled. ; CONTROL_Y_HANDLER_FLAG - Optional argument, passed by reference. If ; set to 0, no control Y handler will be enabled. ; ; Output Parameters: ; None. ; ; Implicit Inputs: ; PROCESS_UIC_FLAG - Zero if this routine has not been called. ; CTL$GL_PCB - PCB address. ; ; Implicit Outputs: ; None. ; ; Procedures called: ; $GETDVI, $GETJPI, $OPEN, $CLOSE, $ASSIGN, $QIOW ; ; Completion Status: ; Returned in R0. ; ; Side Effects: ; UIC in PCB may be changed. ; ;-- .PSECT BAT$CHANGE_TO_IMAGE_UIC_DATA RD,WRT,NOEXE,PAGE,NOSHR,PIC JPI_ITEM_LIST: ; Item list to get the name .WORD FILE_NAME_BUF_SIZ ; of the file we are executing .WORD JPI$_IMAGNAME ; and the process uic. .ADDRESS FILE_NAME_BUF .ADDRESS FILE_NAME_LEN .WORD 4 .WORD JPI$_UIC .ADDRESS PROCESS_UIC .LONG 0 .LONG 0 FILE_NAME_BUF: ; Buffer to hold name of file .BLKB NAM$C_MAXRSS ; that is being executed. FILE_NAME_BUF_SIZ = . - FILE_NAME_BUF FILE_NAME_LEN: .BLKL 1 PROCESS_UIC: ; Original process uic. .BLKL 1 PROCESS_UIC_FLAG: ; Set to 1 if changed the process uic. .LONG 0 ; Otherwise it's 0. Init to 0. .ALIGN LONG FILE_FAB: ; FAB for file we are executing. $FAB FNA=FILE_NAME_BUF,- XAB=FILE_XAB FILE_XAB: ; Owner-uic of executable file $XABPRO ; will be here. IMAGE_UIC: ; Remember uic of file. .BLKL 1 SYSOUT_DESC: ; Will establish ^C and ^Y .ASCID /SYS$COMMAND/ ; handlers to this device. IOSB: ; Return status. .BLKQ 1 C_ARG = 4 ; Offset for AP reg. C_CHANNEL: ; Need a channel for each out-of-band .BLKL 1 ; ast we declare. C_MASK: ; Mask for declaring ast (^C is .LONG 0,<1@3> ; represented by bit #3). Y_ARG = 8 ; Offset for AP reg. Y_CHANNEL: ; Need a channel for each out-of-band .BLKL 1 ; ast we declare. Y_MASK: ; Mask for declaring ast (^Y is .LONG 0,<1@25> ; represented by bit #25). RMS_RUNDOWN_BUF: ; Buffer for running down image. .BLKB 22 RMS_RUNDOWN_DESC: .LONG 22 .ADDRESS RMS_RUNDOWN_BUF DVI_ITEM_LIST: ; Item list to get device class .WORD 4 ; (terminal, disk, tape, etc.). .WORD DVI$_DEVCLASS .ADDRESS DEVCLASS .LONG 0 .LONG 0 DEVCLASS: .BLKL 1 .SBTTL BAT$CHANGE_TO_IMAGE_UIC Code .PSECT BAT$CHANGE_TO_IMAGE_UIC RD,NOWRT,EXE,PAGE,SHR,PIC .ENTRY BAT$CHANGE_TO_IMAGE_UIC,^M TSTL PROCESS_UIC_FLAG ; Has the process uic already been BEQL 20$ ; changed? MOVL #SS$_NORMAL,R0 ; Yes, just return RET ; with success. 20$: ; No, keep going. $GETDVI_S - ; Determine what class of device DEVNAM=SYSOUT_DESC,- ; we are talking to. ITMLST=DVI_ITEM_LIST,- IOSB=IOSB ON_ERR BAT$CHANGE_TO_IMAGE_UIC_EXIT MOVW IOSB,R0 ON_ERR BAT$CHANGE_TO_IMAGE_UIC_EXIT CMPL #DC$_TERM,DEVCLASS ; Is it a terminal? BEQL 40$ BRW END_ARG_CHECK ; No, don't even try to declare 40$: ; any ^C or ^Y handlers. CHECK_C_ARG: ; Do we need to declare a ^C handler? IFNORD #4,@C_ARG(AP),HANDLE_C ; Was an arg specified? TSTL @C_ARG(AP) ; Yes, was non-zero? BEQL CHECK_Y_ARG HANDLE_C: ; Yes, declare the handler $ASSIGN_S DEVNAM=SYSOUT_DESC,CHAN=C_CHANNEL,ACMODE=#PSL$C_USER ON_ERR BAT$CHANGE_TO_IMAGE_UIC_EXIT CLRQ -(SP) PUSHL #0 PUSHL #PSL$C_USER PUSHAL C_MASK PUSHAL AST_RTN CLRQ -(SP) PUSHAL IOSB PUSHL #IO$_SETMODE!IO$M_OUTBAND PUSHL C_CHANNEL PUSHL #0 CALLS #12,G^SYS$QIOW ON_ERR BAT$CHANGE_TO_IMAGE_UIC_EXIT CHECK_Y_ARG: ; Do we need to declare a ^Y handler? IFNORD #4,@Y_ARG(AP),HANDLE_Y ; Was an arg specified? TSTL @Y_ARG(AP) ; Yes, was non-zero? BEQL END_ARG_CHECK HANDLE_Y: ; Yes, declare the handler $ASSIGN_S DEVNAM=SYSOUT_DESC,CHAN=Y_CHANNEL,ACMODE=#PSL$C_USER ON_ERR BAT$CHANGE_TO_IMAGE_UIC_EXIT CLRQ -(SP) PUSHL #0 PUSHL #PSL$C_USER PUSHAL Y_MASK PUSHAL AST_RTN CLRQ -(SP) PUSHAL IOSB PUSHL #IO$_SETMODE!IO$M_OUTBAND PUSHL Y_CHANNEL PUSHL #0 CALLS #12,G^SYS$QIOW ON_ERR BAT$CHANGE_TO_IMAGE_UIC_EXIT END_ARG_CHECK: $GETJPI_S - ; Get the process uic and the ITMLST=JPI_ITEM_LIST ; name of the image file. ON_ERR BAT$CHANGE_TO_IMAGE_UIC_EXIT MOVAL FILE_NAME_BUF,FILE_FAB+FAB$L_FNA ; Setup for getting MOVZWL FILE_NAME_LEN,FILE_FAB+FAB$B_FNS ; the file uic. $OPEN FAB=FILE_FAB ; File uic will be in XAB. ON_ERR BAT$CHANGE_TO_IMAGE_UIC_EXIT MOVL FILE_XAB+XAB$L_UIC,IMAGE_UIC ; Remember the file uic. MOVL @#CTL$GL_PCB,R4 ; Change the process uic to MOVL IMAGE_UIC,PCB$L_UIC(R4) ; that of the file. MOVL #1,PROCESS_UIC_FLAG ; Remember that we changed it! $CLOSE FAB=FILE_FAB ON_ERR BAT$CHANGE_TO_IMAGE_UIC_EXIT BAT$CHANGE_TO_IMAGE_UIC_EXIT: RET ; ; This is the routine we execute if a control-C handler is declared, ; and a control-C is typed. (This same routine is for control-Y, also.) ; Note that we just exit. The user run-down handler will take care of ; restoring the process uic. ; .ENTRY AST_RTN,^M<> PUSHL #0 ; Close files as needed. PUSHAL RMS_RUNDOWN_DESC CALLS #2,G^SYS$RMSRUNDWN PUSHL #1 CALLS #1,G^SYS$EXIT RET .SBTTL BAT$RESTORE_PROCESS_UIC Code ;++ ; ; Functional Description: ; This routine restores the uic of the process, if it was ; changed by BAT$CHANGE_TO_IMAGE_UIC. If control-C or ; control-Y handlers were declared, then they are cancelled. ; ; Calling Sequence: ; status = BAT$RESTORE_PROCESS_UIC () ; ; Input Parameters: ; None. ; ; Output Parameters: ; None. ; ; Implicit Inputs: ; PROCESS_UIC_FLAG - Non-zero if process uic has been changed. ; C_CHANNEL - Non-zero if ^C handler has been declared. ; Y_CHANNEL - Non-zero if ^C handler has been declared. ; PROCESS_UIC - Holds correct uic of process. ; ; Implicit Outputs: ; PROCESS_UIC_FLAG - Cleared if non-zero. ; C_CHANNEL - Cleared if non-zero. ; Y_CHANNEL - Cleared if non-zero. ; ; Procedures called: ; $CANCEL, $DASSGN ; ; Completion Status: ; Returned in R0. ; ; Side Effects: ; UIC in PCB is changed (if necessary) ; ;-- .PSECT BAT$RESTORE_PROCESS_UIC RD,NOWRT,EXE,PAGE,SHR,PIC .ENTRY BAT$RESTORE_PROCESS_UIC,^M TSTL PROCESS_UIC_FLAG ; Did the process uic really get BNEQ 20$ ; changed? MOVL #SS$_NORMAL,R0 ; No, just return with success. RET 20$: MOVL @#CTL$GL_PCB,R4 ; Yes, restore it. MOVL PROCESS_UIC,PCB$L_UIC(R4) CLRL PROCESS_UIC_FLAG TSTL C_CHANNEL ; Need to cancel a control-C handler? BEQL 40$ $CANCEL_S CHAN=C_CHANNEL ON_ERR BAT$RESTORE_PROCESS_UIC_EXIT $DASSGN_S CHAN=C_CHANNEL ON_ERR BAT$RESTORE_PROCESS_UIC_EXIT CLRL C_CHANNEL 40$: TSTL Y_CHANNEL ; Need to cancel a control-C handler? BEQL 60$ $CANCEL_S CHAN=Y_CHANNEL ON_ERR BAT$RESTORE_PROCESS_UIC_EXIT $DASSGN_S CHAN=Y_CHANNEL ON_ERR BAT$RESTORE_PROCESS_UIC_EXIT CLRL Y_CHANNEL 60$: MOVL #SS$_NORMAL,R0 BAT$RESTORE_PROCESS_UIC_EXIT: RET .END