          <<< NOTED::DISK$NOTES7:[NOTES$LIBRARY_7OF4]HACKERS.NOTE;1 >>>
                               -< ** Hackers ** >-
================================================================================
Note 402.59                TOGGLE VERIFY under VMS V5                   59 of 68
VIVIAN::RANCE "Stuart Rance"                        346 lines   8-JAN-1993 08:58
                              -< CONTROL_VFP.M64 >-
--------------------------------------------------------------------------------
; CONTROL_VFP.M64
;
; Stuart Rance @HHL, January 1993
;  (Entirely based on CONTROL_VFP.MAR in hackers notesfile 402.20 
;   by ???? Bailey)
;  
; MACRO /ALPHA CONTROL_VFP
; LINK /SYSEXE CONTROL_VFP
; RUN CONTROL_VFP      requires CMKRNL and LOG_IO privs
;
; Type ^V to enable/disable verify
; 
;


$psldef   ; Define access modes for sys$expreg and sys$setprt 
$prtdef   ; Define page protections for sys$setprt
$ssdef    ; System service return statuses (for SS$_VECINUSE)
$iodef	  ; I/O function code definitions
$brkdef   ; $BRKTHRU system service definitions

; Since there doesn't seem to be a DCLDEF.STB on OpenVMS AXP these 
; symbols have to be hard coded here!!
ppd$l_prc       =    8
prc_w_flags     =    104	; If this moves to a NON LONGWORD aligned
                                ; address then code changes will be needed
prc_b_flags2    =    175
prc_m_verify    =   ^X80
prc_m_verimage  =   ^X80   

; I can't find a $UCBDEF either!
ucb$l_tl_outband = ^XE0


; ++
; Macro to check for errors
; label   = branch destination if bit 0 of status is clear
; status  = Register containing status of operation
; scratch = Scratch register
; --

.macro check label, status=r0, scratch=r1

	and status, 1, scratch
	beq scratch, label
.endm



; ++
; control_V toggles verify on/off when ^V is typed
; --
        $routine control_V, kind=stack, -
                            saved_regs=<FP,R13,R12,R11,R10,R9,R8,R7,R1>

        $linkage_section
	clidata:	.address ctl$ag_clidata
        von:		.ascid "Verify is ON"
	voff:		.ascid "Verify is OFF "
	terminal:	.ascid "TT"
        band_offset = . - $LS
	band:		.long	0	; Will be UCB$L_TL_OUTBAND address
        $code_section
	mov 	r27, r13	; Save the procedure value in R13
	.base	r13, $LS

      ; Make room on the stack for local data
      ; 0(sp) = 8 byte IOSB

        exec_extra_stack = 8
	subl sp, exec_extra_stack, sp 
        
      ; Check that ^O is not enabled as an out of band AST,
      ; if it is then we have set host so just exit...
        ldl r12, band		; Get Outband mask address
	ldl r12, (r12)		; Get outband mask
        mov 1, r11              ; 
	sll r11, 15, r11        ; Bit 15 of r11 set
	and r11, r12, r11       ; check bit 15 of outband mask
	bne r11, control_v_exit ; if set then give up

      ; Fix up all the string descriptors
        lda r12, von	   	; Get descriptor address
	lda r11, 8(r12)         ; Get string address
	stl r11, 4(r12)		; Write string address to descriptor

        lda r12, voff   	; Get descriptor address
	lda r11, 8(r12)         ; Get string address
	stl r11, 4(r12)		; Write string address to descriptor

        lda r12, terminal   	; Get descriptor address
	lda r11, 8(r12)         ; Get string address
	stl r11, 4(r12)		; Write string address to descriptor


      ; Get current state of the flags word (for verify_procedure bit)
	ldl r12, clidata
 	ldl r12, ppd$l_prc(r12)
	ldl  r11, prc_w_flags(r12)

      ; Toggle the verify flag and write the result back to memory
        xor r11, prc_m_verify, r11
	stl r11, prc_w_flags(r12)

      ; Get current state of the flags2 byte (for verify_image bit)
      ; registers r7, r9, r10 and r12 must be preserved till we write this again
	ldl r12, clidata
	ldl r12, ppd$l_prc(r12)
        ldq_u r9, prc_b_flags2(r12)     ; Gets aligned longword into r9
	lda r10, prc_b_flags2(r12)      ; Gets byte address into r10
	extbl r9, r10, r7		; Gets the correct byte into r7

      ; Test the verify flag so we know what message to write out
        and r11, prc_m_verify, r11
	beq r11, 20$
        
      ; Verify is now on           
	bis r7, prc_m_verimage, r7   	; Set the verimage bit
        lda r11, von			; Point r11 to correct message
        br 30$
20$:
      ; Verify is now off
	bic r7, prc_m_verimage, r7	; Clear the verimage bit
        lda r11, voff			; Point r11 to correct message

30$:
      ; Write the flags2 byte, with the new verimage flag, back to memory
	insbl r7, r10, r6		; Move byte to correct offset
	mskbl r9, r10, r9		; Clear correct byte from r9
        or r9, r6, r9			; Set the new byte value in r9
	stq_u r9, prc_b_flags2(r12)     ; Write the data to memory

      ; Write the Verify is OFF or Verify is ON message to the terminal
        $call sys$brkthruw,  args=< 0/a, 		-	; EFN
                                     (r11)/a,		-	; Msgbuf
				     terminal/a,	-	; Sendto
				     brk$c_device/a,	-	; Sendtyp
				     0(sp)/a,		-	; IOSB
				     20/a,		-	; Carcon
				     0/a,		-	; Flags
				     brk$c_dcl/a,	-	; Reqid
				     0/a,		-	; Timout
				     0/a,		-	; Astadr
				     0/a		-	; Astprm
                                   >
control_v_exit:
        addl sp, exec_extra_stack , sp		; Clear local data off the stack
        mov ss$_normal, r0			; Set success status
        $return
        contv_code_size = . - $CS
        $linkage_section
	contv_data_size = . - $LS
        $end_routine control_V


       ; Kernel mode routine to allocate permanent region, copy code and
       ; linkage section to P1 space, fixup procedure descriptor and establish
       ; exec mode out of band AST routine to activate code

	$routine kernel_code, kind=stack, -
                 saved_regs=<FP,R13,R12,R11,R10,R9,R8,R7,R6,R5,R4,R1>

	$linkage_section
	ctl_basva:	.address ctl$gl_ctlbasva
	ctl_sitespec:	.address ctl$gl_sitespec
        searchdev:	$linkage_pair ioc$searchdev
	contv_mask:	.long	0
			.long	^X400000
	qio_func:	.long	io$_setchar ! io$m_outband
        device:		.ascid "TT"

	$code_section

	mov 	r27, r13	; Save the procedure value in R13
	.base	r13, $LS

      ; Make room on the stack for system service arguments

      kernel_extra_stack = 64
      ;  0(SP) = RETADR for sys$expreg
      ;  0(SP) = High address of RETADR for sys$expreg
      ;  4(SP) = Low address of RETADR for sys$expreg
      ;  8(SP) = I/O channel to sys$command for ^V processing
      ; 12(SP) = I/O channel to sys$command for ^F processing
      ; 16(SP) = I/O channel to sys$command for ^P processing
      ; 20(SP) = 8 byte IOSB

	subl sp, kernel_extra_stack, sp 
        
      ; Test CTL$GL_SITESPEC to see if we have already run this code
        ldl   r12, ctl_sitespec
        ldl   r12, (r12)
        beq   r12, 5$                ; This is the first time through this code
        mov   ss$_vecinuse, r0       ; Already been here, return Vector in use
        br    kernel_code_exit

5$:

      ; Assign an EXEC mode channel to our terminal for Cntl V

        $call sys$assign args=< device/a,        -	; Device name
                                8(SP)/a,         -      ; Returned channel
                                psl$c_exec/a,    -      ; Access mode
                                0/a,             -      ; Mailbox name
                                0/a>                    ; Flags
        check label=kernel_code_exit

      ; Expand P1 space to hold the code used as the exec AST routines
	$call sys$expreg args=< 10/a, 		 -	; Number of Pagelets
                                sp/a,            -      ; Retadr
                                psl$c_exec/a,    -      ; Access Mode
                                1/a>                    ; 1 = P1 region
	check label=kernel_code_exit

      ; Set protection on the new EXEC mode pages to prevent USER access
	$call sys$setprt args=< sp/a, 		 -	; Inadr
                                0/a, 		 -	; Retadr
                                psl$c_exec/a, 	 -	; Access mode
                                prt$c_ew/a, 	 -	; Protection
                                0/a>                    ; Previous Protection
	check label=kernel_code_exit

      ; Copy current contents of CTL$GL_CTLBASVA to CTL$GL_SITESPEC
        ldl   r11, ctl_basva
        ldl   r12, ctl_sitespec
        ldl   r10, (r11)
	stl   r10, (r12)

      ; Store new value in CTL$GL_CTLBASVA (from low l/w of sys$expreg retadr)
        ldl   r12, 4(sp)
	stl   r12, (r11)

      ; Find the start address and length of the CONTROL_V code

        mov contv_data_size, r8		; Linkage section size
	lda r9, control_v		; Linkage section address
        mov contv_code_size, r10        ; Code size
	ldl r11, 8(r9)			; Code address

        mov r12, r7			; P1 buffer address

      ; Copy linkage section to address returned by sys$expreg
      ;  movc3 r9, (r8), (r7)
10$:
        ldq r6, (r9)			; Get next quadword
	stq r6, (r7)			; Write it to the P1 buffer
	ble  r8, 20$			; Finished?
        subl r8, 8, r8			; Decrement # bytes left to copy
	addl r9, 8, r9			; Point to next Quadword to read
        addl r7, 8, r7			;  "    "   "      "      " write
        br  10$
20$:
      ; Copy code to next part of P1 space buffer
      ;  movc3 r10, (r11), (r7)

        mov r7, r5			; Save new code address
30$:
        ldq r6, (r11)			; Get next quadword
	stq r6, (r7)			; Write it to the P1 buffer
	ble  r10, 40$			; Finished?
        subl r10, 8, r10		; Decrement # bytes left to copy
	addl r11, 8, r11		; Point to next Quadword to read
        addl r7, 8, r7			;  "    "   "      "      " write
        br  30$
40$:

      ; Fix up the procedure descriptor
      ; other fixups will be done in the EXEC mode out of band AST routine 

        stl r5, pdsc$l_entry(r12)	; Code address in Procedure Descriptor

      ; Get UCB address for the terminal and store it in BAND offset from 
      ; P1 linkage section for control_V routine

        lda r1, searchdev       	; Linkage pair for IOC$SEARCHDEV
	ldq r26, (r1)			; Code address
	ldq r27, 8(r1)			; Procedure Value
	lda r1,  device			; Device to search for
        jsr r26, r26			; Go look for it (R1 = UCB address)
	lda r1, ucb$l_tl_outband(r1)	; Get address of the outband mask
	stl r1, band_offset(r12)	; Store return address in P1 space





;+
; DEBUG code, creates a P1 space linkage pair and uses it to call the
; P1 space code whilst the image is still active...
; -

;      ; Create a P1 space linkage pair for the P1 space routine (Debug only
;	stq r5,  (r7)			; Code address
;	stq r12, 8(r7)			; Procedure Descriptor address
;
;      ; Execute the P1 space routine
;	ldq r26, (r7)			; Code address
;	ldq r27, 8(r7)                  ; Procedure Value
;	clr r25                         ; Argument count
;	jsr r26, r26                    ; GO do it.

      ; Queue an EXEC mode out of band AST routine for ^V
        $call sys$qiow, args=<  0/a,		-		; EFN
                                8(sp)/l, 	-		; Channel
				qio_func/l,  	-		; Function
                                20(sp)/a,	-		; IOSB
                                0/a,		-		; AST Address
				0/a,		-		; AST Param
				(r12)/a,	-		; P1 (AST addr)
				contv_mask/a,	-		; P2 (Mask)
				psl$c_exec/a,	-               ; P3 (Acc Mode)
				0/a,		-		; P4
				0/a,		-		; P5
				0/a		-		; P6
                             >
        check label=kernel_code_exit    ; Check status return in R0
        ldl r0, 20(sp)			; Copy IOSB status to R0	
        check label=kernel_code_exit    ; Check status return in R0
kernel_code_exit:
        addl sp, kernel_extra_stack , sp	; Clear local data off the stack
        $return
        $end_routine kernel_code


; ++
;
;  Main routine CONTROL_VFP calls kernel mode code and returns to caller
; --
	$routine CONTROL_VFP, kind=stack, saved_regs=<FP,R13,R12,R11,R1>

	$linkage_section
	$code_section

	mov 	r27, r13            ; Save the procedure value in R13
	.base	r13, $LS

        $call sys$cmkrnl, args=<kernel_code/a, 0/a>
	check label=main_exit

main_exit:
        $return

        $end_routine CONTROL_VFP

	.end CONTROL_VFP
             
