.TITLE ROUTINES "CLI interface glue" .IDENT /b1.0/ ;+ ; Facility: ; ROUTINES.MAR Copyright (c) 1991 Bruce R. Miller and TGV Inc. ; ; Abstract: ; Routines called from FTS_PARSE.CLD to parce DCL args and dispatch ; commands. ; ; Author: ; Bruce R. Miller, MILLER@TGV.COM ; TGV, Inc. ; 603 Mission St. ; Santa Cruz, CA 95060 ; (408) 427-4366 ; ; Date: May 10, 1991 ; ; Notes: ; Review and minimize procedure entry masks ; ; Copyright (c) 1991 Bruce R. Miller ; All rights reserved. ; ; Redistribution and use in source and binary forms are permitted ; provided that the above copyright notice and this paragraph are ; duplicated in all such forms and that any documentation, ; advertising materials, and other materials related to such ; distribution and use acknowledge that the software was developed ; by Bruce R. Miller. ; THIS SOFTWARE IS PROVIDED AS IS'' AND WITHOUT ANY EXPRESS OR ; IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED ; WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. ; ; Modifications: ; ;- .link "sys$system:sys.stb"/SELECTIVE_SEARCH .library "sys$Library:lib.mlb" $chfdef $climsgdef $dscdef $lnmdef $prtdef $psldef $rmsdef $ssdef $stsdef $smgdef ; ; Common strings ; ADDR_str: .ASCID /ADDR/ PID_str: .ASCID /PID/ DEVICE_str: .ASCID /DEVICE/ LOCATION_str: .ASCID /LOCATION/ PROTECTION_str: .ASCID /PROTECTION/ RCODE_str: .ASCID /RCODE/ SERVICE_str: .ASCID /SERVICE/ SIZE_str: .ASCID /SIZE/ VALUE_str: .ASCID /VALUE/ blank_msg: .ASCID "" Nobody_msg: .ASCID "Nobody home..." Nothing_Here_msg: .ASCID "Nothing happens here." NYI_msg: .ASCID "NYI" JASMON_K_DEFAULT = 0 JASMON_K_NULL = 1 JASMON_K_TGV = 2 JASMON_K_UCX = 3 JASMON_K_PSI = 4 ;++ ; Get_DCL_Switch - Read DCL param into a text string ; ; Input: ; 4(AP) - pntr to ASCID string with parameter name ; 8(AP) - pntr to ASCID string to hold results ; ; Output: ; R0 - Status ;-- .entry Get_DCL_Switch,^m PUSHL 4(AP) CALLS #1,G^CLI$PRESENT CMPL R0,#CLI$_ABSENT BEQL 100$ BLBC R0,110$ PUSHL 8(AP) PUSHL 4(AP) CALLS #2,G^CLI$GET_VALUE 100$: RET 110$: PUSHL R0 PUSHL 4(AP) PUSHL #1 PUSHL #FTS$_Arg CALLS #4,G^LIB$SIGNAL BRB 100$ ;++ ; Get_DCL_hex - convert DCL param from ascii into a value ; ; Functional Description: ; ; ; Input: ; 4(AP) - pntr to ASCID string with parameter name ; 8(AP) - conversion routine ; ; Output: ; R0 - Status ; R1 - hex value ;-- .entry Get_DCL_value,^m ; Has the parameter been given? PUSHL 4(AP) CALLS #1,G^CLI$PRESENT CMPL R0,#CLI$_ABSENT BEQL 100$ BLBC R0,110$ ; Get text CLRQ -(SP) ; space for descriptor MOVB #DSC$K_DTYPE_T,DSC$B_DTYPE(SP) ; set desc type MOVB #DSC$K_CLASS_D,DSC$B_CLASS(SP) ; set desc class MOVL SP,R2 PUSHL SP ; text descr PUSHL 4(AP) ; DCL symbol CALLS #2,CLI$GET_VALUE BLBC R0,110$ ; Convert text to value CLRL -(SP) PUSHL SP PUSHL R2 CALLS #2,@8(AP) POPL R1 BLBS R0,20$ ; Signal an argument format error PUSHL R0 ; Status PUSHL R2 ; parameter text PUSHL #1 ; one argument PUSHL #FTS$_Arg ; ARG signal CALLS #4,G^LIB$SIGNAL ; Signal it 20$: ; free the dynamic string memory PUSHQ R0 PUSHL R2 CALLS #1,G^STR$FREE1_DX BLBC R0,110$ POPQ R0 100$: RET 110$: PUSHL R0 CALLS #1,G^LIB$SIGNAL BRB 100$ ;++ ; Get_DCL_hex - convert DCL param from ascii hex into a value ; ; Input: ; 4(AP) - pntr to ASCID string with parameter name ; ; Output: ; R0 - Status ; R1 - hex value ;-- .entry Get_DCL_hex,^m PUSHAB G^OTS$CVT_TZ_L PUSHL 4(AP) CALLS #2,Get_DCL_value RET ;++ ; Get_DCL_dec - convert DCL param from ascii decimal into a value ; ; Input: ; 4(AP) - pntr to ASCID string with parameter name ; ; Output: ; R0 - Status ; R1 - hex value ; ; Note: can we combine this routine with Get_DCL_hex and save some space? ;-- .entry Get_DCL_dec,^m PUSHAB G^OTS$CVT_TU_L PUSHL 4(AP) CALLS #2,Get_DCL_value RET ;++ ; procname2pid - Convert Process name (or number) to a PID ; ; Input: ; 4(AP) - Process name descriptor ; 8(AP) - pntr to longword to hold PID ; ; Output: ; R0 - Status ; @8(AP) - PID ; ; Notes: We are ignoring the IOSB ;-- .entry procname2pid,^m ; set-up variables CLRQ -(SP) ; space for itemlst and PID MOVL SP,R2 ; pointer to PID ; First, see if it's a hexadecimal number PUSHL R2 ; pntr to PID PUSHL 4(AP) ; proc name CALLS #2,G^OTS$CVT_TZ_L ; cnvrt ascii hex to longword BLBC R0,20$ ; br on failure POPL @8(AP) ; Get PID BRB 100$ 20$: ; Call GetJPI system service CLRQ -(SP) ; ASTADR /ASTPRM CLRL -(SP) ; IOSB PUSHAL 4(R2) ; &item_list PUSHL 4(AP) ; proc name PUSHL R2 ; &PID CLRL -(SP) ; EFN CALLS #7,G^SYS$GETJPIW POPL @8(AP) ; Get PID 100$: RET ;++ ; Get_DCL_pid - convert DCL param from process name (or #) to a PID ; ; Input: ; 4(AP) - pntr to ASCID string with parameter name ; ; Output: ; R0 - Status ; R1 - PID ;-- .entry Get_DCL_pid,^m PUSHAB procname2pid ; convert name -> PID PUSHL 4(AP) CALLS #2,Get_DCL_value RET Prot_NA_str: .ASCIC /NA/ Prot_RESRV_str: .ASCIC /RESRV/ Prot_KW_str: .ASCIC /KW/ Prot_KR_str: .ASCIC /KR/ Prot_UW_str: .ASCIC /UW/ Prot_EW_str: .ASCIC /EW/ Prot_ERKW_str: .ASCIC /ERKW/ Prot_ER_str: .ASCIC /ER/ Prot_SW_str: .ASCIC /SW/ Prot_SREW_str: .ASCIC /SREW/ Prot_SRKW_str: .ASCIC /SRKW/ Prot_SR_str: .ASCIC /SR/ Prot_URSW_str: .ASCIC /URSW/ Prot_UREW_str: .ASCIC /UREW/ Prot_URKW_str: .ASCIC /URKW/ Prot_UR_str: .ASCIC /UR/ Prot_Tab: .LONG 16*2 .LONG Prot_ER_str, PRT$C_ER .LONG Prot_ERKW_str, PRT$C_ERKW .LONG Prot_EW_str, PRT$C_EW .LONG Prot_KR_str, PRT$C_KR .LONG Prot_KW_str, PRT$C_KW .LONG Prot_NA_str, PRT$C_NA .LONG Prot_RESRV_str, PRT$C_RESERVED .LONG Prot_SR_str, PRT$C_SR .LONG Prot_SREW_str, PRT$C_SREW .LONG Prot_SRKW_str, PRT$C_SRKW .LONG Prot_SW_str, PRT$C_SW .LONG Prot_UR_str, PRT$C_UR .LONG Prot_UREW_str, PRT$C_UREW .LONG Prot_URKW_str, PRT$C_URKW .LONG Prot_URSW_str, PRT$C_URSW .LONG Prot_UW_str, PRT$C_UW Mode_KERNEL_str: .ASCIC /KERNEL/ Mode_EXEC_str: .ASCIC /EXEC/ Mode_SUPER_str: .ASCIC /SUPER/ Mode_USER_str: .ASCIC /USER/ Mode_Tab: .LONG 4*2 .LONG Mode_EXEC_str, PSL$C_EXEC .LONG Mode_KERNEL_str, PSL$C_KERNEL .LONG Mode_SUPER_str, PSL$C_SUPER .LONG Mode_USER_str, PSL$C_USER Style_DEFAULT_str: .ASCIC /DEFAULT/ Style_NULL_str: .ASCIC /NULL/ Style_TGV_str: .ASCIC /TGV/ Style_UCX_str: .ASCIC /UCX/ Style_PSI_str: .ASCIC /PSI/ QIO_Style_Tab: .LONG 5*2 .LONG Style_DEFAULT_str, JASMON_K_DEFAULT .LONG Style_NULL_str, JASMON_K_NULL .LONG Style_PSI_str, JASMON_K_PSI .LONG Style_TGV_str, JASMON_K_TGV .LONG Style_UCX_str, JASMON_K_UCX Size_BYTE_str: .ASCIC /BYTE/ Size_CHAR_str: .ASCIC /CHAR/ Size_WORD_str: .ASCIC /WORD/ Size_SHORT_str: .ASCIC /SHORT/ Size_LONG_str: .ASCIC /LONG/ Byte_Size_Tab: .LONG 5*2 .LONG Size_BYTE_str, 1 .LONG Size_CHAR_str, 1 .LONG Size_LONG_str, 4 .LONG Size_SHORT_str, 2 .LONG Size_WORD_str, 2 ;++ ; Get_DCL_keyword - get a value corresponding to a keyword ; ; Input: ; 4(AP) - DCL parameter name ; 8(AP) - Keyword table ; ; Output: ; R0 - Status ; R1 - keyword value ;-- .entry Get_DCL_keyword,^m ; Set-up descriptor CLRQ -(SP) MOVB #DSC$K_DTYPE_T,DSC$B_DTYPE(SP) ; set desc type MOVB #DSC$K_CLASS_D,DSC$B_CLASS(SP) ; set desc class MOVL SP,R2 ; Fetch the symbol text PUSHL R2 PUSHL 4(AP) CALLS #1,G^CLI$GET_VALUE CMPL R0,#CLI$_ABSENT BEQL 100$ BLBC R0,110$ ; Lookup the keyword value MOVAL -(SP),R3 ; Space for value CLRQ -(SP) ; resultant keyword / length PUSHL R3 ; pntr to value PUSHL 8(AP) ; keyword table PUSHL R2 ; search string CALLS #5,G^LIB$LOOKUP_KEY POPL R1 ; Free up space for string PUSHQ R0 PUSHL R2 CALLS #1,G^STR$FREE1_DX POPQ R0 100$: RET 110$: ; Signal an error PUSHL R0 CALLS #1,G^LIB$SIGNAL BRB 100$ .entry Get_DCL_prot,^m PUSHAL Prot_Tab PUSHL 4(AP) CALLS #2,Get_DCL_keyword RET .entry Get_DCL_access,^m PUSHAL Mode_Tab PUSHL 4(AP) CALLS #2,Get_DCL_keyword RET .entry Get_DCL_qiostyle,^m PUSHAL QIO_Style_Tab PUSHL 4(AP) CALLS #2,Get_DCL_keyword RET .entry Get_DCL_size,^m ; Check for a keyword PUSHAL Byte_Size_Tab PUSHL 4(AP) CALLS #2,Get_DCL_keyword BLBS R0,100$ ; No luck with keywords. Check for a decimal number. PUSHL 4(AP) CALLS #1,Get_DCL_dec 100$: RET $DEFINI ITEM_LIST $DEF itm_lst_w_length .BLKW 1 $DEF itm_lst_w_item_code .BLKW 1 $DEF itm_lst_l_buff_addr .BLKL 1 $DEF itm_lst_l_ret_len .BLKL 1 $DEF itm_lst_c_length $DEFEND ITEM_LIST jasmon_logical: .ASCID /JASMON_DATABASE/ lntable: .ASCID /LNM$PROCESS_TABLE/ EXEC_mode: .LONG PSL$C_EXEC ;++ ; Get_Database ; ; Input: ; 4(AP) - pntr to longword to hold database address ; ; Output: ; R0 - Status ; @4(AP) - database address ; ; Note: We prevent JASMON from being loaded twice by defining a logical. ; We also use the local to store the address of the JASMON database (code). ; This is ugly. I mean, really ugly. We're talking butt ugly. And ; to make matters worse, I don't think we're even doing that right. ;-- .entry Get_Database,^m ; a buffer to hold the logical's text SUBL #20,SP ; buffer (20 chars) PUSHL SP ; dsc$a_pointer CLRL -(SP) ; return length MOVL SP,R2 ; save a pntr ; Build our item list CLRL -(SP) ; End of item list SUBL #itm_lst_c_length,SP MOVW #20,itm_lst_w_length(SP) MOVW #LNM$_STRING,itm_lst_w_item_code(SP) MOVAB 8(R2),itm_lst_l_buff_addr(SP) MOVL R2,itm_lst_l_ret_len(SP) ; Translate logical name PUSHL SP ; item list PUSHAL EXEC_Mode ; access mode PUSHAQ jasmon_logical ; Logical name PUSHAQ lntable ; Table name CLRL -(SP) ; ??? CALLS #5,G^SYS$TRNLNM BLBC R0,100$ ; Convert text to value PUSHL 4(AP) PUSHL R2 CALLS #2,G^OTS$CVT_TZ_L 100$: RET ;++ ; Get_Database ; ; Input: ; 4(AP) - pntr to longword to holding database address ; ; Output: ; R0 - Status ; ; Note: We prevent JASMON from being loaded twice by defining a logical. ; We also use the logical to store the address of the JASMON database (code). ; This is ugly. I mean, really ugly. We're talking butt ugly. And ; to make matters worse, I don't think we're even doing that right. ;-- .entry Set_Database,^m ; Allocate a buffer off of the stack SUBL #8,SP PUSHL SP PUSHL #8 MOVL SP,R2 ; If new address is zero, then delete the logical name TSTL 4(AP) BNEQ 20$ ; Delete the logical name PUSHAL EXEC_Mode ; access mode PUSHAQ jasmon_logical ; Logical name PUSHAQ lntable ; Table name CALLS #3,G^SYS$DELLNM BRB 100$ 20$: ; Convert text to value PUSHL #4 ; Size of long PUSHL #8 ; Maximum # of digits PUSHL R2 PUSHAL 4(AP) CALLS #4,G^OTS$CVT_L_TZ ; Build our item list CLRL -(SP) ; End of item list SUBL #itm_lst_c_length,SP MOVW #8,itm_lst_w_length(SP) MOVW #LNM$_STRING,itm_lst_w_item_code(SP) MOVAB 8(R2),itm_lst_l_buff_addr(SP) MOVL R2,itm_lst_l_ret_len(SP) ; Translate logical name PUSHL SP ; item list PUSHAL EXEC_Mode ; access mode PUSHAQ jasmon_logical ; Logical name PUSHAQ lntable ; Table name CLRL -(SP) ; ??? CALLS #5,G^SYS$CRELNM BLBC R0,100$ 100$: RET ;++ ; COMMAND: ALONONPAGED - Grab us some non-paged pool ; ; Note: We need to add an alignment flag (eg. /QUAD, /PAGE. etc...) ;-- Alloc_msg: .ASCID / Allocated !UW(^x!XL) bytes at !XL/ .entry FTS_AloNonPaged,^m ; Get one page by default MOVL #512,R3 ; get dcl argument - decimal value for block size PUSHAQ SIZE_str ; parameter name CALLS #1,G^CLI$PRESENT ; is it there? BLBC R0,20$ ; br if not CLRL -(SP) ; space for size PUSHL SP ; pointer to size PUSHAQ SIZE_str ; parameter name CALLS #2,Get_DCL_dec ; Get decimal # BLBC R0,110$ ; br on error POPL R3 ; new size 20$: ; Call exec to grab some npagdyn. CLRQ -(SP) ; space for values PUSHAL 4(SP) ; pntr to size PUSHAL 4(SP) ; pntr to address CALLS #2,MM_AloNonPaged ; call allocation routine POPL R2 ; Get address POPL R3 ; Get size BLBC R0,110$ ; Print a message PUSHL R2 ; Address PUSHL R3 ; Size PUSHL R3 ; size PUSHAB Alloc_msg ; message CALLS #4,Print_String ; print it out 100$: RET 110$: PUSHL R0 CALLS #1,G^LIB$SIGNAL BRB 100$ ;++ ; COMMAND: Crash ; ; Crash VMS. ;-- .EXTERNAL Crash_VMS .entry FTS_Crash,^m ; get dcl argument - hex ID for process to blame; into R2 CLRL R2 ; zero by default PUSHAQ PID_str ; parameter name CALLS #1,G^CLI$PRESENT ; is it there? BLBC R0,20$ ; br if not CLRL -(SP) ; space for size PUSHL SP ; pointer to size PUSHAQ PID_str ; parameter name CALLS #2,Get_DCL_dec ; Get decimal # BLBC R0,110$ ; br on error POPL R2 ; new size 20$: ; Call crash code in kernel mode PUSHL R2 PUSHL #1 PUSHL SP PUSHAB Crash_VMS CALLS #2,G^SYS$CMKRNL BLBC R0,110$ 100$: RET 110$: PUSHL R0 CALLS #1,G^LIB$SIGNAL BRB 100$ ;-- ; COMMAND: CretVA ; ; Create some virtual addresses in specified range ; ;-- STARTVA_str: .ASCID /STARTVA/ ENDVA_str: .ASCID /ENDVA/ ACCESS_str: .ASCID /ACCESS/ CRETVA_msgstr: .ASCID /Mapping VA [!XL,!XL] to mode !UL/ CRETVA_success_msgstr: .ASCID /Mapped VA [!XL,!XL] to mode !UL/ .entry FTS_CretVA,^m ; Get the starting VA into R2. PUSHAQ STARTVA_str CALLS #1,Get_DCL_hex BLBC R0,110$ MOVL R1,R2 ; Get the ending VA into R3. PUSHAQ ENDVA_str CALLS #1,Get_DCL_hex BLBC R0,110$ MOVL R1,R3 ; get dcl argument - page protection into R4 MOVL #PSL$C_KERNEL,R4 ; Kernel mode default PUSHAQ ACCESS_str CALLS #1,Get_DCL_access BLBC R0,100$ MOVL R1,R4 ; Print information message PUSHL R4 ; access mode PUSHL R3 ; end VA PUSHL R2 ; start VA PUSHL CRETVA_msgstr CALLS #4,Print_String ; Call system service to map the new VA CLRQ -(SP) ; retaddr space PUSHL R3 ; end VA PUSHL R2 ; start VA MOVL SP,R5 PUSHL R4 ; access mode PUSHAL 8(R5) ; ret addr pntr PUSHL R5 ; inaddr pntr CALLS #3,G^SYS$CRETVA BLBC R0,110$ ; Print success message POPQ R0 ; Lose inaddr POPQ R0 ; get retaddr PUSHL R4 ; access mode PUSHL R0 ; Push retadr PUSHAQ CRETVA_success_msgstr CALLS #5,Print_String 100$: RET 110$: ; Signal an error PUSHL R0 CALLS #1,G^LIB$SIGNAL BRB 100$ ;++ ; COMMAND: DEANONPAGED ; ; Free some non-paged pool ; ;-- Dealloc_msg: .ASCID / Deallocated !UW(^x!XL) bytes at !XL/ .entry FTS_DeaNonPaged,^m ; Get the virtual address into R2 PUSHAQ ADDR_str ; parameter name CALLS #1,Get_DCL_hex ; read in a hex number BLBC R0,110$ ; br on error MOVL R1,R2 ; Save addres in R2 ; get dcl argument - decimal value for block size in R3 CLRL R3 ; zero by default CLRL -(SP) ; space for size PUSHL SP ; pointer to size PUSHAQ SIZE_str ; parameter name CALLS #2,Get_DCL_dec ; Get decimal # BLBS R0,20$ ; br on error POPL R3 ; new size 20$: ; Call exec to free npagdyn. PUSHL R3 ; size PUSHL SP ; pntr to size PUSHL R2 ; pntr to address CALLS #2,MM_DeaNonPaged ; call deallocation routine BLBC R0,110$ POPL R3 ; Get size ; Print a message PUSHL R2 ; Address PUSHL R3 ; Size PUSHL R3 ; size PUSHAB Dealloc_msg ; message CALLS #4,Print_String ; print it out 100$: RET 110$: PUSHL R0 CALLS #1,G^LIB$SIGNAL BRB 100$ ;++ ; COMMAND: Deposit ; ; Deposit a value at the specified memory location ; ;-- .EXTERNAL Deposit Deposit_trans_msg: .ASCID /Attempting to deposit !XL at !XL/ Deposit_success_msg: .ASCID /New value: !XL Old value: !XL/ Deposit_Error_msg: .ASCID /Access error = !XL/ .entry FTS_Deposit,^m ; get dcl argument - hex value for memory location into R2 PUSHAQ LOCATION_str CALLS #1,Get_DCL_hex BLBC R0,110$ MOVL R1,R2 ; get dcl argument - value for reference size into R3 MOVL #4,R3 ; Longword default PUSHAQ SIZE_str CALLS #1,Get_DCL_size BLBC R0,20$ MOVL R1,R3 20$: ; get dcl argument - hex value for PID into R4 CLRL R4 ; use this proc as default PUSHAQ PID_str CALLS #1,Get_DCL_pid BLBC R0,30$ MOVL R1,R4 30$: ; get dcl argument - hex value for value into R5 PUSHAQ VALUE_str CALLS #1,Get_DCL_hex BLBC R0,110$ MOVL R1,R5 ; Print attempt message PUSHL R2 PUSHL R5 PUSHAQ Deposit_trans_msg CALLS #3,Print_String ; Call Deposit routine PUSHL R5 ; value PUSHL SP ; buffer w/ value in it PUSHL R4 ; PID PUSHL R3 ; size (byte count) PUSHL R2 ; virtual address CALLS #4,Deposit BLBS R0,50$ ; Print error message PUSHL R0 PUSHAQ Deposit_error_msg CALLS #2,Print_String BRB 100$ 50$: ; Print success message PUSHL R5 PUSHAQ Deposit_success_msg CALLS #3,Print_String 100$: RET 110$: PUSHL R0 CALLS #1,G^LIB$SIGNAL BRB 100$ .entry FTS_DFWM,^m PUSHAQ Nothing_Here_msg CALLS #1,Print_String RET ;++ ; Description: ; ; A routine to handle people who enter silly things at the ; FTS> prompt ; ;-- .entry FTS_Directory,^m PUSHAQ Nothing_Here_msg CALLS #1,Print_String RET ;++ ; COMMAND: Examine ; ; Examine the specified memory location ;-- .EXTERNAL Examine Examine_success_msg: .ASCID /!XL/ Examine_error_msg: .ASCID /Access error = !XL/ .entry FTS_Examine,^m ; get dcl argument - hex value for memory location into R2 PUSHAQ LOCATION_str CALLS #1,Get_DCL_hex BLBC R0,110$ MOVL R1,R2 ; get dcl argument - value for reference size into R3 MOVL #4,R3 ; Longword default PUSHAQ SIZE_str CALLS #1,Get_DCL_size BLBC R0,20$ MOVL R1,R3 20$: ; get dcl argument - hex value for PID into R4 CLRL R4 ; use this proc as default PUSHAQ PID_str CALLS #1,Get_DCL_pid BLBC R0,30$ MOVL R1,R4 30$: ; Call Examine routine SUBL R3,SP ; Get a buffer PUSHL SP ; pntr to return value buffer PUSHL R4 ; PID PUSHL R3 ; byte count PUSHL R2 ; virtual address CALLS #4,Examine BLBS R0,40$ ; Print error message PUSHL R0 PUSHAQ Examine_error_msg CALLS #2,Print_String BRB 100$ 40$: ; Print success message PUSHAQ Examine_success_msg CALLS #2,Print_String 100$: RET 110$: PUSHL R0 CALLS #1,G^LIB$SIGNAL BRB 100$ ;++ ; Description: ; A CLI Dispatch routine to exit the FTS Utility. ; ; Note: ; As the End Of File condition must not be stopped. ;-- .entry Exit_FTS,^m MOVL #RMS$_EOF,R0 RET ;++ ; COMMAND: ForceX ; ; Forces exit of a given process. ; ;-- FORCEX_attempt_msg: .ASCID / Forcing exit of process !XL with RC=!XL./ .entry FTS_ForceX,^m ; get dcl argument - hex value for Process ID into R2 PUSHAQ PID_str CALLS #1,Get_DCL_pid BLBC R0,110$ MOVL R1,R2 ; get dcl argument - hex value for return code into R3 MOVL #SS$_NORMAL,R3 ; Success by default PUSHAQ RCODE_str CALLS #1,Get_DCL_hex CMPL R0,#CLI$_ABSENT BEQL 20$ BLBC R0,110$ MOVL R1,R2 20$: ; Print informational message PUSHL R3 ; return code PUSHL R2 ; PID PUSHAQ FORCEX_attempt_msg CALLS #3,Print_String ; Call system service to invoke the pocesses exit handler. PUSHL R2 ; PID MOVL SP,R2 ; self-ref PUSHL R3 ; return code CLRL -(SP) ; ??? PUSHL R2 ; PID CALLS #3,G^SYS$FORCEX BLBC R0,110$ 100$: RET 110$: ; Signal and error PUSHL R0 CALLS #1,G^LIB$SIGNAL BRB 100$ ;++ ; COMMAND: Halt ; ; HALT the VAX. ;-- .EXTERNAL Halt_VAX .entry FTS_HALT,^m ; Call HALT instruction in kernel mode PUSHL #0 PUSHL SP PUSHAB Halt_VAX CALLS #2,G^SYS$CMKRNL BLBC R0,110$ 100$: RET 110$: ; Signal an error PUSHL R0 CALLS #1,G^LIB$SIGNAL BRB 100$ ;++ ; JASMON_LOAD ; ; Description: ; Load the JASMON code into P1 space ;-- .EXTERNAL JASMON_Load .entry FTS_LOAD_JASMON,^m CLRL -(SP) ; database (wrt only) PUSHL SP ; pntr to database CALLS #1,JASMON_Load; RET ;++ ; FTS_LOAD_XDT ; ; Description: ; Invoke XDelta, loading it if necessary. ;-- .EXTERNAL LDXDT .entry FTS_LOAD_XDT,^m CALLS #0,LDXDT RET ;++ ; COMMAND: HELP ; ; Will give user a little help. ;-- HLP1_str: .ASCID "!/Welcome to FTS, the Functionality Testing Suite (aka Futz)!/" HLP2_str: .ASCID "FTS is a collection of dangerous utility programs that would" HLP3_str: .ASCID "like nothing better than to crash your system. The authors of" HLP4_str: .ASCID "the various packages contained herein disavow any responsibility" HLP5_str: .ASCID "for the bone-headed things you are about to try.!/" HLP6_str: .ASCID "Some Commands: (Read FTS_PARSE.CLD for details)" HLP7_str: .ASCID "ALONONPAG | DEANONPAGED!_Alocate and free some npageddyn" HLP8_str: .ASCID "EXAM | DEPOSIT!_!_Examine or modify a memory location" HLP9_str: .ASCID "EXIT!_!_!_Leave the program" HLP10_str: .ASCID "FORCEX pid [/rcode]!_Force another process to exit" HLP11_str: .ASCID "[UN]LOAD JASMON!_!_start/stop the system service monitor" HLP12_str: .ASCID "LOAD XDT!_!_Invoke XDelta, loading it if necessary" HLP14_str: .ASCID "[UN]WATCH [SS|RMS] srvc!_Monitor a system service" HLP15_str: .ASCID "WATCH SS QIO[W] device!_Monitor $QIO calls to a given device" HLP16_str: .ASCID "WATCH DEVICE device!_Monitor FDT access to a given device" HLP17_str: .ASCID "VERSION!_!_!_Display info about authors and commands" HLP18_str: .ASCID "CRASH | HALT!_!_Cause the system to crash or halt." .entry FTS_Help,^m PUSHAQ HLP1_str CALLS #1,Print_String PUSHAQ HLP2_str CALLS #1,Print_String PUSHAQ HLP3_str CALLS #1,Print_String PUSHAQ HLP4_str CALLS #1,Print_String PUSHAQ HLP5_str CALLS #1,Print_String PUSHAQ HLP6_str CALLS #1,Print_String PUSHAQ HLP7_str CALLS #1,Print_String PUSHAQ HLP8_str CALLS #1,Print_String PUSHAQ HLP9_str CALLS #1,Print_String PUSHAQ HLP10_str CALLS #1,Print_String PUSHAQ HLP11_str CALLS #1,Print_String PUSHAQ HLP12_str CALLS #1,Print_String PUSHAQ HLP14_str CALLS #1,Print_String PUSHAQ HLP15_str CALLS #1,Print_String PUSHAQ HLP16_str CALLS #1,Print_String PUSHAQ HLP17_str CALLS #1,Print_String PUSHAQ HLP18_str CALLS #1,Print_String 100$: RET ;++ ; FTS_Set_Page ; ; Description: ; Modify a memory page ;-- .EXTERNAL Set_Page SetPage_msg: .ASCID /previous protection = !XL/ .entry FTS_Set_Page,^m ; get dcl argument - hex value for VA into R2 PUSHAQ ADDR_str CALLS #1,Get_DCL_hex BLBC R0,110$ MOVL R1,R2 ; get dcl argument - hex value for size into R3 MOVL #4,R3 PUSHAQ SIZE_str CALLS #1,Get_DCL_hex BLBC R0,20$ MOVL R1,R3 20$: ; get dcl argument - new page protection into R4 PUSHAQ PROTECTION_str CALLS #1,Get_DCL_prot BLBC R0,100$ MOVL R1,R4 ; Modify the page protection CLRL -(SP) ; space for previous protection PUSHL SP ; pntr to prev prot PUSHL R4 ; new protection PUSHL R3 ; size PUSHL R2 ; address CALLS #4,Set_Page BLBC R0,110$ ; Print success message PUSHAQ SetPage_msg CALLS #2,Print_String 100$: RET 110$: ; Signal an error PUSHL R0 CALLS #1,G^LIB$SIGNAL BRB 100$ ;++ ; COMMAND: SHOW DEFAULT ; ; Display the default directory for a given process. ;-- .EXTERNAL Show_Default ShoDef_msg: .ASCID /Default directory for PID !XL = !AC/ .entry FTS_Show_Default ,^m ; grab a buffer off the stack SUBL #128,SP MOVL SP,R3 ; get dcl argument - hex value for Process ID in R2 PUSHAQ PID_str CALLS #1,Get_DCL_pid BLBC R0,110$ MOVL R1,R2 ; Call Show_Default PUSHL #128 ; buffer size PUSHL R3 ; buffer address PUSHL R2 ; PID CALLS #3,Show_Default BLBC R0,110$ ; Print message PUSHL R3 PUSHL R2 PUSHAQ ShoDef_msg CALLS #3,Print_String 100$: RET 110$: ; Signal an error PUSHL R0 CALLS #1,G^LIB$SIGNAL BRB 100$ ;++ ; FTS_Show_Error ; ; Description: ; Evaluate a condition code ;-- .entry FTS_Show_Error,^m ; Get space for a signal array SUBL #CHF$S_CHFDEF2,SP MOVL SP,R3 ; get dcl argument - hex value for Return code in R2 PUSHAQ RCODE_str CALLS #1,Get_DCL_hex BLBC R0,110$ MOVL R1,R2 ; set up signal array CLRL chf$l_sig_args(R3) MOVL R2,chf$l_sig_name(R3) CLRL chf$l_sig_arg1(R3) ; Print the signal text CLRL -(SP) CLRL -(SP) CLRL -(SP) PUSHL R3 ; Signal block CALLS #4,G^SYS$PUTMSG 100$: RET 110$: ; Signal an error PUSHL R0 CALLS #1,G^LIB$SIGNAL BRB 100$ ;++ ; FTS_Show_Ether ; ; Description: ; Show EtherNet datalink information ;-- .entry FTS_Show_Ether,^m PUSHAQ NYI_msg CALLS #1,Print_String RET ;++ ; FTS_Show_Page ; ; Description: ; Display info about a memory page ;-- .EXTERNAL Show_Page ShowPage_msg: .ASCID /protection = !XL/ .entry FTS_Show_Page,^m MOVL #SS$_NORMAL,R0 BRB 100$ ; get dcl argument - hex value for VA into R2 PUSHAQ ADDR_str CALLS #1,Get_DCL_hex BLBC R0,110$ MOVL R1,R2 ; get dcl argument - hex value for size into R3 ; MOVL #4,R3 ; PUSHAQ SIZE_str ; CALLS #1,Get_DCL_hex ; BLBC R0,20$ ; MOVL R1,R3 ;20$: ; Get the page protection CLRL -(SP) ; space for previous protection PUSHL SP ; pntr to prev prot PUSHL R2 ; address CALLS #2,Show_Page BLBC R0,110$ ; Print success message PUSHAQ ShowPage_msg CALLS #2,Print_String 100$: RET 110$: ; Signal an error PUSHL R0 CALLS #1,G^LIB$SIGNAL BRB 100$ ;++ ; Functional Description: ; ; Call LIB$SPAWN. ;-- .entry Spawn,^m CLRL -(SP) CLRL -(SP) CLRL -(SP) CLRL -(SP) CLRL -(SP) CLRL -(SP) CLRL -(SP) CLRL -(SP) CLRL -(SP) CLRL -(SP) CLRL -(SP) PUSHL 4(AP) CALLS #12,G^LIB$SPAWN BLBC R0,110$ 100$: RET 110$: ; Signal an error PUSHL R0 CALLS #1,G^LIB$SIGNAL BRB 100$ ;++ ; FTS_Spawn ; ; Functional Description: ;-- Spawn_param_str: .ASCID /Command_line/ .entry FTS_Spawn,^m ; Set-up descriptor CLRQ -(SP) MOVB #DSC$K_DTYPE_T,DSC$B_DTYPE(SP) ; set desc type MOVB #DSC$K_CLASS_D,DSC$B_CLASS(SP) ; set desc class MOVL SP,R2 ; skip a line PUSHAQ blank_msg CALLS #1,Print_string ; Get command line PUSHL R2 PUSHAQ Spawn_param_str CALLS #2,Get_DCL_Switch CMPL R0,#CLI$_ABSENT BEQL 20$ BLBC R0,110$ 20$: ; Call Spawn() PUSHL R2 CALLS #1,Spawn MOVL #SS$_NORMAL,R0 100$: RET 110$: PUSHL #FTS$_No_Switch CALLS #1,G^LIB$SIGNAL BRB 100$ ;++ ; COMMAND: UnWaste - Get a process out of RWAST mode ;-- .entry FTS_UnWaste ,^m ; get dcl argument - hex value for Process ID */ PUSHAQ PID_str CALLS #1,Get_DCL_pid BLBC R0,110$ MOVL R1,R2 ; Print string PUSHAQ NYI_msg CALLS #1,Print_String 100$: RET 110$: ; Signal an error PUSHL R0 CALLS #1,G^LIB$SIGNAL BRB 100$ ;++ ; JASMON_UNLOAD ; ; Description: ; Unload the JASMON code from P1 space ;-- .EXTERNAL JASMON_Unload .entry FTS_UNLOAD_JASMON,^m CALLS #0,JASMON_Unload RET ;++ ; FTS_UNWATCH_RMS - stop monitoring an RMS service ; ;-- .EXTERNAL JASMON_UnWatch .entry FTS_UNWATCH_RMS,^m ; Set-up descriptor CLRQ -(SP) MOVB #DSC$K_DTYPE_T,DSC$B_DTYPE(SP) ; set desc type MOVB #DSC$K_CLASS_D,DSC$B_CLASS(SP) ; set desc class MOVL SP,R2 ; Get service name from DCL PUSHL R2 PUSHAQ SERVICE_str CALLS #2,Get_DCL_Switch BLBC R0,110$ ; Call JASMon code PUSHL R2 CALLS #1,JASMON_UnWatch 100$: RET 110$: ; Signal an error PUSHL R0 CALLS #1,G^LIB$SIGNAL BRB 100$ .entry FTS_UNWATCH_SS,^m ; Set-up descriptor CLRQ -(SP) MOVB #DSC$K_DTYPE_T,DSC$B_DTYPE(SP) ; set desc type MOVB #DSC$K_CLASS_D,DSC$B_CLASS(SP) ; set desc class MOVL SP,R2 ; Get service name from DCL PUSHL R2 PUSHAQ SERVICE_str CALLS #2,Get_DCL_Switch BLBC R0,110$ ; Call JASMon code PUSHL R2 CALLS #1,JASMON_UnWatch 100$: RET 110$: ; Signal an error PUSHL R0 CALLS #1,G^LIB$SIGNAL BRB 100$ ;++ ; Print information about current version of FTS.; ;-- VERS1_msg: .ASCID "!/Current FTS version is --." VERS2_msg: .ASCID "All comments should be directed to Bruce R. Miller (MILLER@TGV.COM)" VERS3_msg: .ASCID "Thanks go to TGV Inc. for allowing me to blow off work and play with this." VERS4_msg: .ASCID "Finacial compensations should be redirected to your company's beer fund.!/" VERS5_msg: .ASCID "Module!_!_Version!_Author" VERS6_msg: .ASCID "JASMON!_!_A1.0!_Bruce R. Miller (MILLER@TGV.COM)" VERS7_msg: .ASCID "DEVWATCH!_A1.0!_Bruce R. Miller (MILLER@TGV.COM)" VERS8_msg: .ASCID "LOADXDT!_!_V1.0!_Ken Johnson - Meridian Technology Corporation!/" VERS9_msg: .ASCID "Note: Contact author for latest version of software. Please!/" .entry FTS_Version,^m PUSHAQ VERS1_msg CALLS #1,Print_String PUSHAQ VERS2_msg CALLS #1,Print_String PUSHAQ VERS3_msg CALLS #1,Print_String PUSHAQ VERS4_msg CALLS #1,Print_String PUSHAQ VERS5_msg CALLS #1,Print_String PUSHAQ VERS6_msg CALLS #1,Print_String PUSHAQ VERS7_msg CALLS #1,Print_String PUSHAQ VERS8_msg CALLS #1,Print_String PUSHAQ VERS9_msg CALLS #1,Print_String RET ;++ ; COMMAND: Wake ; ; Call SYS$WAKE to wake the given process from hibernation. ;-- Wake_attempt_msg: .ASCID / Attempting to wake up process !XL./ .entry FTS_Wake ,^m ; get dcl argument - hex value for Process ID in R2 PUSHAQ PID_str CALLS #1,Get_DCL_hex BLBC R0,110$ MOVL R1,R2 ; Print attempt message PUSHAQ Wake_attempt_msg CALLS #1,Print_String ; Call system service to wake the pocesses PUSHL R2 CLRL -(SP) PUSHAL 4(SP) CALLS #2,G^SYS$WAKE BLBC R0,110$ 100$: RET 110$: ; Signal an error PUSHL R0 CALLS #1,G^LIB$SIGNAL BRB 100$ .EXTERNAL DevWatch FDT_str: .ASCID /FDT/ ALTSTART_str: .ASCID /ALTSTART/ STARTIO_str: .ASCID /STARTIO/ CANCEL_str: .ASCID /CANCEL/ IOPOST_str: .ASCID /IOPOST/ .entry FTS_WATCH_DEVICE,^m ; Set-up descriptor CLRQ -(SP) MOVB #DSC$K_DTYPE_T,DSC$B_DTYPE(SP) ; set desc type MOVB #DSC$K_CLASS_D,DSC$B_CLASS(SP) ; set desc class MOVL SP,R2 ; Get device name PUSHL R2 PUSHAQ DEVICE_str CALLS #2,Get_DCL_Switch BLBC R0,110$ ; push scratch value CLRL -(SP) PUSHL SP ; Push flags PUSHAQ IOPOST_str CALLS #1,G^CLI$PRESENT PUSHL R0 PUSHAQ CANCEL_str CALLS #1,G^CLI$PRESENT PUSHL R0 PUSHAQ STARTIO_str CALLS #1,G^CLI$PRESENT PUSHL R0 PUSHAQ ALTSTART_str CALLS #1,G^CLI$PRESENT PUSHL R0 PUSHAQ FDT_str CALLS #1,G^CLI$PRESENT PUSHL R0 PUSHL R2 ; Device descriptor CALLS #7,DevWatch BLBC R0,110$ ; free Device string PUSHL R0 PUSHL R2 CALLS #1,G^STR$FREE1_DX POPL R0 100$: RET 110$: ; Signal an error PUSHL R0 CALLS #1,G^LIB$SIGNAL BRB 100$ .EXTERNAL JASMON_Watch .entry FTS_WATCH_RMS,^m ; Set-up descriptor CLRQ -(SP) MOVB #DSC$K_DTYPE_T,DSC$B_DTYPE(SP) ; set desc type MOVB #DSC$K_CLASS_D,DSC$B_CLASS(SP) ; set desc class MOVL SP,R2 ; Get service name PUSHL R2 PUSHAQ SERVICE_str CALLS #2,Get_DCL_Switch BLBC R0,110$ ; Call JASMON_Watch() CLRL -(SP) ; database PUSHL SP ; pntr to database PUSHL R2 CALLS #2,JASMON_Watch 100$: RET 110$: ; Signal an error PUSHL R0 CALLS #1,G^LIB$SIGNAL BRB 100$ .entry FTS_WATCH_SS,^m ; Set-up descriptor CLRQ -(SP) MOVB #DSC$K_DTYPE_T,DSC$B_DTYPE(SP) ; set desc type MOVB #DSC$K_CLASS_D,DSC$B_CLASS(SP) ; set desc class MOVL SP,R2 ; Get service name PUSHL R2 PUSHAQ SERVICE_str CALLS #2,Get_DCL_Switch BLBC R0,110$ ; Call JASMON_Watch() CLRL -(SP) ; database PUSHL SP ; pntr to database PUSHL R2 CALLS #2,JASMON_Watch 100$: RET 110$: ; Signal an error PUSHL R0 CALLS #1,G^LIB$SIGNAL BRB 100$ .EXTERNAL JASMON_Watch_QIO STYLE_str: .ASCID /STYLE/ .entry FTS_WATCH_SS_QIO,^m ; Set-up descriptors CLRQ -(SP) MOVB #DSC$K_DTYPE_T,DSC$B_DTYPE(SP) ; set desc type MOVB #DSC$K_CLASS_D,DSC$B_CLASS(SP) ; set desc class MOVL SP,R2 CLRQ -(SP) MOVB #DSC$K_DTYPE_T,DSC$B_DTYPE(SP) ; set desc type MOVB #DSC$K_CLASS_D,DSC$B_CLASS(SP) ; set desc class MOVL SP,R3 ; Get the name of the system service (QIO[W]) PUSHL R2 PUSHAQ SERVICE_str CALLS #2,Get_DCL_Switch BLBC R0,110$ ; get the name of the device to monitor PUSHL R3 PUSHAQ DEVICE_str CALLS #2,Get_DCL_Switch BLBC R0,110$ ; Figure out the display style (device specific stuff) MOVL #JASMON_K_DEFAULT,R4 ; default by default PUSHAQ STYLE_str CALLS #1,Get_DCL_qiostyle ; get style param BLBC R0,20$ ; br if no style MOVL R1,R4 20$: ; Call JASMON_Watch_QIO(&service,&device,style) PUSHL R4 ; Style PUSHL R3 ; Device PUSHL R2 ; Service CALLS #3,JASMON_Watch_QIO ; Free up the dynamic strings PUSHL R0 PUSHL R2 CALLS #1,G^STR$FREE1_DX PUSHL R3 CALLS #1,G^STR$FREE1_DX POPL R0 100$: RET 110$: ; Signal an error PUSHL R0 CALLS #1,G^LIB$SIGNAL BRB 100$ ;++ ; Do nothing ;-- .entry FTS_NOOP,^m MOVL #SS$_NORMAL,R0 RET ;++ ; Hello - User said "Hi!" ;-- WHO_str: .ASCID "WHO" BRUCE_str: .ASCID "BRUCE" SAILOR_str: .ASCID "SAILOR" Hi_msg: .ASCID "Hi!!" Bruce_msg: .ASCID "Howdy,!/Call bruce at (408) 427-4366!/or send e-mail to MILLER@TGV.COM!/Have a day." .entry FTS_Hello,^m ; Set-up descriptor CLRQ -(SP) MOVB #DSC$K_DTYPE_T,DSC$B_DTYPE(SP) ; set desc type MOVB #DSC$K_CLASS_D,DSC$B_CLASS(SP) ; set desc class MOVL SP,R2 ; Get hello text PUSHL R2 PUSHAQ WHO_str CALLS #2,Get_DCL_Switch CMPL R0,#CLI$_ABSENT BEQL 10$ BLBC R0,110$ BRB 20$ 10$: ; Just hello PUSHAQ Hi_msg CALLS #1,Print_String MOVL #SS$_NORMAL,R0 BRB 90$ 20$: ; Hello Bruce? PUSHAQ BRUCE_str PUSHL R2 CALLS #2,G^STR$CASE_BLIND_COMPARE TSTL R0 BNEQ 30$ PUSHAQ Bruce_msg CALLS #1,Print_String MOVL #SS$_NORMAL,R0 BRB 90$ 30$: ; Hello Sailor? PUSHAQ SAILOR_str PUSHL R2 CALLS #2,G^STR$CASE_BLIND_COMPARE TSTL R0 BNEQ 50$ PUSHAQ Nothing_Here_msg CALLS #1,Print_String MOVL #SS$_NORMAL,R0 BRB 90$ 50$: PUSHAQ Nobody_msg CALLS #1,Print_String MOVL #SS$_NORMAL,R0 90$: ; Clean up and leave PUSHL R2 CALLS #1,G^STR$FREE1_DX 100$: RET 110$: ; Signal an error PUSHL R0 CALLS #1,G^LIB$SIGNAL BRB 100$ XYZZY_msg: .ASCID /You find yourself in a maze of twisty dollar signs, all alike./ .entry FTS_XYZZY,^m PUSHAQ XYZZY_msg CALLS #1,Print_String MOVL #RMS$_EOF,R0 RET .END