.TITLE SIMGLD .IDENT /MXB-11-00/ ; ; ############################################################### ; # (C) Copyright 1985 Auto-trol Technology Corporation # ; # # ; # This program is the sole property of Auto-trol Technology # ; # Corporation and is considered a trade secret and/or a # ; # proprietary product of Auto-trol Technology Corporation. # ; # Use or disclosure of this program by other than Auto-trol # ; # Technology Corporation and its assigned licensees and # ; # customers is strictly forbidden by law. # ; # # ; # Use, duplication or disclosure by the Government is subject # ; # to restrictions as set forth in subdivision (b)(3)(ii) of # ; # the Rights in Technical Data and Computer Software clause # ; # at 252.227.7013. # ; ############################################################### ; /BEGIN MODULE HEADER/ /STANDARD MODULE HEADER/ ; ; NAME -- SIMGLD ; ; PURPOSE -- ; Dynamic Shareable Image Load Routine ; Called by Dynamic Image Load VECTOR ; ; ; INTERNAL DESCRIPTION AND DESIGN CONSIDERATIONS -- ; ; Loads the required shareable image, locates the symbol, ; and after re-building the "dynamic" transfer vector calls ; required module. ; Since the transfer vector is re-build using the called ; procedure entry mask and JMP to real first routine entry, ; the overhead on subsequent calls is limited to that of ; standard shareable image transfer vector. ; If the shareable image contains a static transfer vector, its ; information is used when building dynamic one, thus bypassing ; the original transfer vector on subsequent calls. ; ; NOTES -- ; ; Since the USER ERROR routine may use dynamic load again, this ; routine must be re-entrant to this extent. Another re-entrancy ; may happen when calling target routine for the first time. ; ; HISTORY -- ; MM/DD/YY,SDRC,functional spec number,initials,comments ; 08/26/87,,,MXB, Re-entrant code upgrade, case-blind compare ; 03/18/86,,,MXB, Initial definition ; ; /END MODULE HEADER/ /STANDARD MODULE HEADER/ ; ***************************************************************** ; LIB$_ACTIMAGE=^X1512BA ; Not-yet defined VMS status (1381050 dec) (VMS 4.5) ; STPEND = 0 ; Request pending (build problems within image) STPROG = -6 ; Program not found (error activating image) STRESX = -10 ; Resources exceeded (insufficiant virtual space) STIFIS = -1002 ; Invalid filespec (not a logical name) STFATL = -1063 ; Fatal AUOSI error (unable to decode VMS status) STNCOM = -1075 ; Component not found (entry not found) ; ; The folowing offsets define our transfer vector, generated ; by the DYNXFER macro (11+entry_length bytes long) ; XV_MSK = 0 ; .WORD 0 XV_JMP = 2 ; JSB @#SIMGLD+2 to be re-built to JMP @#entry+2 XV_ADR = 4 ; SIMGLD+2 address to be re-built XV_ERR = 8 ; Offset to addr of user error routine, image descriptor (word) XV_LEN = 10 ; Module name length (byte) XV_NAM = 11 ; Module name start ; ; The following offsets define local data allocated on stack ; to allow for re-entrancy. We pass the data pointer to our ; exception handler via DATPTR prior call LIB$FIND_IMAGE_SYMBOL. ; IASTAT = 0 ;.BLKL 1 ; AUOSI status code USRERR = 4 ;.BLKL 1 ; User Error handler addr. save EPTDSC = 8 ;.BLKL 2 ; Entry Name descriptor SYMADR = 16 ;.BLKL 1 ; Symbol address save ERRSAV = 20 ;.BLKL 1 ; VMS error status or SS$_NORMAL IMGPTR = 24 ;.BLKL 1 ; Pointer to image name descriptor REGSAV = 28 ;.BLKL 2 ; Save for registers R0,R2 LOCDAT = 36 ; ; Local data block size ; .PSECT $LOCAL,PIC,CON,REL,LCL,NOSHR,NOEXE,RD,WRT,LONG ; ; The non-reentrant data are used: ; - to pass data pointer to the exception handler (non-recursive op) ; - to check the DEBUG request (translated only once) ; DATPTR: .LONG 0 ; Exception handler data pointer ; ; Only valid for exception handler ! DBGEPL: .LONG -1 ; Debug entry point name length ; ; (-1 flags not inquired yet) DBGSYM: .ASCID /ATTC_DEBUG_IMAGE_ENTRY/; DCL symbol name to translate ; ; to breakpoint entry name DBGEPT: .ASCID /012345678901234567890123456789012/ ; Translated DCL ; ; symbol buffer (entry name) ; ; The actual dynamic image load subroutine ; .PSECT $CODE,PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG ; ; We get here by JSB SIMGLD+2, thus the (SP) conatains the addres ; next to our instruction: XV_ERR .ENTRY SIMGLD,^M ; Formal entry, never called MOVL (SP),R2 ; Get the address of XV_IMG SUBL2 #LOCDAT,SP ; Get Local data structure on stack MOVQ R0,REGSAV(SP) ; Save R0,R1 for BAD user code MOVL SP,R1 ; Set up data pointer MOVL R2,R0 ; Copy address of XV_IMG MOVAL -XV_ERR(R0),R2 ; Get the Xfer vector start addr MOVAL EPTDSC(R1),R0 ; Address for ENTRY NAME descriptor MOVAB XV_NAM(R2),4(R0) ; Build Entry NAME descriptor MOVZBL XV_LEN(R2),(R0) ; from data in Xfer vector CVTWL XV_ERR(R2),R0 ; Get Error routine addr offset ADDL2 R2,R0 ; Compute error routine addr. address MOVL (R0)+,USRERR(R1) ; Get user error routine address MOVAL (R0),IMGPTR(R1) ; Get image name descriptor address CALLS #0,IMGLOA ; Call LIB$FIND_IMAGE_SYMBOL MOVL SP,R1 ; Restore local data pointer BLBS R0,120$ ; Regular return MOVL R0,ERRSAV(R1) ; Error return = save error 120$: MOVL SYMADR(R1),R0 ; Get the entry point addr BEQL 140$ ; EQL = sorry, no symbol available ; ; We found the symbol definition, rebuild our Xfer vector ; to jump as directly as possible into target routine code: MOVL R0,XV_ADR(R2) ; and load it as a new jump target MOVW (R0),XV_MSK(R2) ; Copy the entry mask ADDL2 #2,XV_ADR(R2) ; Update the target address MOVW #^X9F17,XV_JMP(R2) ; Replace JSB by JMP @#addr CMPW 2(R0),#^X9F17 ; Is target a JMP @#addr ? BNEQ 130$ ; Neq = other instruction MOVL 4(R0),XV_ADR(R2) ; Copy the absolute jump target BRB 140$ ; VECTOR updated 130$: CMPW 2(R0),#^XEF17 ; Is target a JMP L^offset ? BNEQ 140$ ; Neq = other instruction ADDL2 4(R0),XV_ADR(R2) ; Update absolute jump target ; Using offset from transfer vect. ADDL2 #6,XV_ADR(R2) ; and 2(JMP) and 4 (L^offset) ; ; Check if any error processing is required 140$: TSTL USRERR(R1) ; Any user error routine available ? BNEQ 144$ ; NEQ = yes, we have an entry 142$: BRW 180$ ; EQ = no, check for DEBUG request 144$: MOVL ERRSAV(R1),R0 ; Get our error symptoms from handler CMPL #SS$_NORMAL,R0 ; No errors / warnings ? BEQL 142$ ; EQL = no errors, check DEBUG ; ; For user routine we analyze any errors catched by the exception handler BISL #7,R0 ; Unify all the severity codes MOVL #STIFIS,IASTAT(R1) ; Invalid image file-specifier ? CMPL #7!SS$_IVLOGNAM,R0 ; (invalid logical name) BEQL 150$ ; MOVL #STPROG,IASTAT(R1) ; Image not found ? CMPL #7!LIB$_ACTIMAGE,R0 ; (error activating image) BEQL 150$ ; MOVL #STRESX,IASTAT(R1) ; Resources exceeded ? CMPL #7!LIB$_INSVIRMEM,R0 ; (Insufficient virtual memmory) BEQL 150$ ; MOVL #STNCOM,IASTAT(r1) ; No such component ? CMPL #7!LIB$_ILLMODNAM,R0 ; (illegal module name) BEQL 150$ ; CMPL #7!LIB$_KEYNOTFOU,R0 ; (non-existent module, key) BEQL 150$ ; MOVL #STPEND,IASTAT(R1) ; Request incomplete (warning) ? CMPL #7!LIB$_EOMERROR,R0 ; Compilation errors BEQL 150$ ; CMPL #7!LIB$_EOMFATAL,R0 ; Compilation fatal errors BEQL 150$ ; CMPL #7!LIB$_EOMWARN,R0 ; Compilation warnings BEQL 150$ ; MOVL #STFATL,IASTAT(R1) ; Fatal AUOSI error = unknown error ; ; User error handler call 150$: PUSHAL ERRSAV(R1) ; Arg #4 - VMS error status (ref) PUSHAL IASTAT(R1) ; Arg #3 - AUOSI error status (ref) PUSHAL EPTDSC(R1) ; Arg #2 - Entry name descriptor (ref) PUSHL IMGPTR(R1) ; Arg #1 - Image name descriptor (ref) CALLS #4,@USRERR(R1) ; Call user error handler ; ; Check any debugging requests (DCL symbol ATTC_DEBUG_ENTRY = "entry" ) 180$: TSTL DBGEPL ; Debugger entry point symbol known ? BGTR 190$ ; GTR = translation known, compare BEQL 200$ ; EQL = no translation (initially -1) CLRL DBGEPL ; Make sure we won't call again PUSHAL DBGEPL ; Arg #3 Length of returned symbol PUSHAL DBGEPT ; Arg #2 Returned translation PUSHAL DBGSYM ; Arg #1 DCL symbol name descriptor CALLS #3,G^LIB$GET_SYMBOL ; Get symbol translation MOVW DBGEPL,DBGEPT ; Update entry string descriptor BEQL 200$ ; ZERO = no breakpoint 190$: PUSHAL EPTDSC(SP) ; Current entry descriptor PUSHAL DBGEPT ; Entry to breakpoint at CALLS #2,G^STR$CASE_BLIND_COMPARE; Somebody types globals lowercase TSTL R0 ; Check status from COMPARE BNEQ 200$ ; NEQ = no, not a DEBUG entry CLRL DBGEPL ; Turn off checking for later calls PUSHL #SS$_DEBUG ; Signal DEBUGGER CALLS #1,G^LIB$SIGNAL ; exception - to cause a break ; 200$: MOVQ REGSAV(SP),R0 ; Restore registers R0,R1 for BAD code MOVL SYMADR(SP),R2 ; Get the entry point addr BEQL 240$ ; No entry point = dont' call 230$: CALLG (AP),(R2) ; Call the entry point first time 240$: RET ; and finish up ; ; ; LIB$FIND_IMAGE_SYMBOL caller. Set-up as a separate procedure ; to allow for simple stack unwind to it's caller. ; We have to use exception handler here, since LIB$FIND_IMAGE_SYMBOL ; signalls exceptions (and even access violation) ; Our data structure is passed via R1 here (directly) ; .ALIGN LONG ; Longword aligned IMGLOA: .WORD 0 ; Entry mask (use existing R1 value) MOVAL EXHAND,0(FP) ; Establish our local exception handler CLRL SYMADR(R1) ; Make sure symbol address undefined MOVL #SS$_NORMAL,ERRSAV(R1) ; Assume no errors catched yet MOVL R1,DATPTR ; Load data base for error handler ; We are NOT reentrant through RET PUSHAL SYMADR(R1) ;; Arg #3 - symbol address PUSHAL EPTDSC(R1) ;; Arg #2 - symbol name descriptor PUSHL IMGPTR(R1) ;; Arg #1 - image name descriptor CALLS #3,G^LIB$FIND_IMAGE_SYMBOL ;; Load image, Find symbol RET ;; ; ; Local exception handler routine is simple: ; - allow continuation on UNWIND ; - allow continuation on WARNINGS (but save error for user) ; - if no user routine available, re-signals error ; - if there is a user routine, unwind to SIMGLD to process error ; .ALIGN LONG ; Longword aligned EXHAND: .WORD 0 ; Procedure entry mask MOVL CHF$L_SIGARGLST(AP),R0 ; Get signal argument list MOVL CHF$L_SIG_NAME(R0),R0 ; Get condition name CMPL #SS$_UNWINDING,R0 ; Unwinding now ? BEQL 500$ ; EQL = yes, done here BITL #6,R0 ; Error or Severe error ? BEQL 500$ ; Neither - allow continuation MOVL DATPTR,R1 ; Get local data pointer MOVL R0,ERRSAV(R1) ; Save condition for main routine TSTL USRERR(R1) ; User error routine present ? BNEQ 400$ ; NEQ = yes MOVL #SS$_RESIGNAL,R0 ; Re-signal error RET ; 400$: MOVL CHF$L_MCHARGLST(AP),R0 ; Get mechanismus list MOVL #SS$_NORMAL,CHF$L_MCH_SAVR0(R0) ; Return success CALLS #0,G^SYS$UNWIND ; Unwind to establisher ; 500$: MOVL #SS$_CONTINUE,R0 ; Alow continuation RET .END