$ ! First the documented way
$ fortran/object=z1 sys$input
       SUBROUTINE SUBBO
       INTEGER*4 I
       WRITE(*,*) 'ABCD'
       I=123456
       WRITE(*,*) I
       RETURN
       END
$
$ link/share z1+sys$input/opt
universal=subbo
$
$ fortran/object=z2 sys$input
       INTEGER*4 A
       CALL LIB$FIND_IMAGE_SYMBOL('Z1','SUBBO',A,'SYS$DISK:[].EXE')
       CALL DISP(%VAL(A))
       END
       SUBROUTINE DISP(R)
       EXTERNAL R
       CALL R
       RETURN
       END
$
$ link z2
$ r z2
$ ! And now a variant
$ fortran/object=z3 sys$input
       INTEGER*4 A
       CALL LIB$FIND_IMAGE_SYMBOL('Z1','SUBBO',A,)
       CALL DISP(%VAL(A))
       END
       SUBROUTINE DISP(R)
       EXTERNAL R
       CALL R
       RETURN
       END
$
$ link z3
$ define/nolog/user z1 sys$disk:[]z1.exe
$ r z3
$! Now we try the undocumented method - first with a simple example
$ macro/object=z4 sys$input
        .title  z4
        .library "SYS$LIBRARY:LIB"
        $IACDEF
        $IHADEF
        $IHDDEF
        .psect  $LOCAL quad,pic,con,lcl,noshr,noexe,wrt
argl_imgact:                            ; argumentlist SYS$IMGACT
        .long   8
        .blkl   1                       ; name
        .long   0                       ; dflnam
        .address header                 ; hdrbuf
        .long   IAC$M_SHAREABLE!IAC$M_MERGE!IAC$M_EXPREG ; imgctl
        .long   0                       ; inadr
        .address adr                    ; retadr
        .long   0                       ; ident
        .long   0                       ; acmode

adr:    .blkl   2                       ; address of image
header: .blkb   512                     ; image-header
        .psect  $CODE quad,pic,con,lcl,shr,exe,nowrt
;***************************************
;
;  LOADSHR ( FNM )
;
;  load shareable image
;
;***************************************
        .entry  loadshr,^m<r2>
        movl    B^4(ap),argl_imgact+4
        callg   argl_imgact,G^SYS$IMGACT ; activate image
        calls   #0,G^SYS$IMGFIX         ; make fixups
        movl    header,r1               ; first longword is address of IHD
        movzwl  W^IHD$W_ACTIVOFF(r1),r2
        addl2   r2,r1
        cmpl    adr,W^IHA$L_TFRADR3(r1) ; test if third transfer-address
        bgeq    100$
        calls   #0,@W^IHA$L_TFRADR3(r1) ; jump to third transfer-address
        ret
100$:   cmpl    adr,W^IHA$L_TFRADR2(r1) ; test if second transfer-address
        bgeq    200$
        calls   #0,@W^IHA$L_TFRADR2(r1) ; jump to second transfer-address
        ret
200$:   calls   #0,@W^IHA$L_TFRADR1(r1) ; jump to first transfer-address
        ret
;***************************************
;
;  LOADSHRX ( FNM , ADDR )
;
;  load shareable image
;
;***************************************
        .entry  loadshrx,^m<>
        movl    B^4(ap),argl_imgact+4
        callg   argl_imgact,G^SYS$IMGACT ; activate image
        calls   #0,G^SYS$IMGFIX         ; make fixups
        addl3   @B^8(ap),adr,r1
        calls   #0,(r1)                 ; jump to entry-point
        ret
        .end
$
$ fortran/object=z5 sys$input
       INTEGER*4 I
       WRITE(*,*) 'ABCD'
       I=123456
       WRITE(*,*) I
       END
$
$ link/share z5
$ fortran/object=z6 sys$input
       CALL LOADSHR('Z5')
       END
$
$ link z6+z4
$ define/nolog/user z5 sys$disk:[]z5.exe
$ run z6
$! Now let us try something that do not work quite as expected
$ link z5
$ define/nolog/user z5 sys$disk:[]z5.exe
$ run z6
$! Now to one of the more difficult cases (and this is really undocumented !)
$ macro/object=z7 sys$input
        .title  z7
        .library "SYS$LIBRARY:LIB"
        $IACDEF
        $IHADEF
        $IHDDEF
        $OBJDEF
TRUE=-1
FALSE=0
EXE$C_MODULE=^x000000BC
EXE$C_ENTRYPOINT=^x000000BE
EXE$C_MACRO=0
EXE$C_FORTRAN=1
EXE$C_PASCAL=6
EXE$C_C=7
        .psect  $CODE quad,pic,con,lcl,shr,exe,nowrt
;***************************************
;
;  FNDDBGTAB ( HEADER , DBGTABADR , DBGTABLEN )
;
;  find debug-symbol-table
;
;***************************************
        .entry  fnddbgtab,^m<iv,r2>
        movl    B^4(ap),r1
        movl    B^4(r1),r1
        movzwl  W^IHD$W_SYMDBGOFF(r1),r2
        addl2   r2,r1
        movl    (r1),@B^8(ap)
        movzwl  B^8(r1),@B^12(ap)
        ret
;***************************************
;
;  FNDGLBTAB ( HEADER , GLBTABADR , GLBTABLEN )
;
;  find global-symbol-table
;
;***************************************
        .entry  fndglbtab,^m<iv,r2>
        movl    B^4(ap),r1
        movl    B^4(r1),r1
        movzwl  W^IHD$W_SYMDBGOFF(r1),r2
        addl2   r2,r1
        movl    B^4(r1),@B^8(ap)
        movzwl  B^10(r1),@B^12(ap)
        ret
;***************************************
;
;  FNDSYM1 ( RECORD , SYMBOL , SYMBOLLEN , ADDRESS , OK )
;
;  find symbol in record
;
;***************************************
        .entry  fndsym1,^m<iv,r2,r3,r4,r5>
        movl    B^4(ap),r1
        movl    B^4(r1),r1
        movl    B^8(ap),r2
        cmpb    (r1),#EXE$C_MODULE
        bneq    100$
;        movl    B^2(r1),language
;        cvtbl   B^6(r1),modulelen
;        movc3   modulelen,B^7(r1),module
        movl    #FALSE,@B^20(ap)
        ret
100$:   cmpb    (r1),#EXE$C_ENTRYPOINT
        bneq    200$
        movl    B^2(r1),@B^16(ap)
        cvtbl   B^6(r1),@B^12(ap)
        movc3   @B^12(ap),B^7(r1),@B^4(r2)
        movl    #TRUE,@B^20(ap)
        ret
200$:   movl    #FALSE,@B^20(ap)
        ret
;***************************************
;
;  FNDSYM2 ( RECORD , OK )
;
;  find symbol in record
;
;***************************************
        .entry  fndsym2,^m<iv>
        movl    B^4(ap),r1
        movl    B^4(r1),r1
        cmpb    (r1),#OBJ$C_GSD
        bneq    100$
        movl    #TRUE,@B^8(ap)
        ret
100$:   movl    #FALSE,@B^8(ap)
        ret
;***************************************
;
;  FNDSYM3 ( RECORD , SYMBOL , SYMBOLLEN , ADDRESS , RECL , OK )
;
;  find symbol in record
;
;***************************************
        .entry  fndsym3,^m<iv,r2,r3,r4,r5>
        movl    B^4(ap),r1
        movzwl  (r1),r0
        movl    B^4(r1),r1
        movl    B^8(ap),r2
        cmpb    B^GPS$B_GSDTYP(r1),#GSD$C_PSC
        bneq    100$
        addl2   #GPS$T_NAME,@B^20(ap)
        cvtbl   B^GPS$B_NAMLNG(r1),r0
        addl2   r0,@B^20(ap)
        movl    #FALSE,@B^24(ap)
        ret
100$:   cmpb    B^SDF$B_GSDTYP(r1),#GSD$C_SYM
        bneq    200$
        addl2   #SDF$T_NAME,@B^20(ap)
        cvtbl   B^SDF$B_NAMLNG(r1),r0
        addl2   r0,@B^20(ap)
        movl    #FALSE,@B^24(ap)
        ret
200$:   cmpb    B^EPM$B_GSDTYP(r1),#GSD$C_EPM
        bneq    300$
        addl2   #EPM$T_NAME,@B^20(ap)
        cvtbl   B^EPM$B_NAMLNG(r1),r0
        addl2   r0,@B^20(ap)
        movl    B^EPM$L_ADDRS(r1),@B^16(ap)
        cvtbl   B^EPM$B_NAMLNG(r1),@B^12(ap)
        movc3   @B^12(ap),B^12(r1),@B^4(r2)
        movl    #TRUE,@B^24(ap)
        ret
300$:   cmpb    B^PRO$B_GSDTYP(r1),#GSD$C_PRO
        bneq    400$
        addl2   #PRO$T_NAME,@B^20(ap)
        cvtbl   B^PRO$B_NAMLNG(r1),r0
        addl2   r0,@B^20(ap)
        addl2   r1,r0
        addl2   #PRO$T_NAME,r0
        cvtbl   B^FML$B_MAXARGS(r0),r3
        addl2   #2,@B^20(ap)
        addl2   #2,r0
310$:   tstl    r3
        bleq    320$
        cvtbl   B^ARG$B_BYTECNT(r0),r4
        addl2   #2,@B^20(ap)
        addl2   #2,r0
        addl2   r4,@B^20(ap)
        addl2   r4,r0
        decl    r3
        brb     310$
320$:   movl    B^PRO$L_ADDRS(r1),@B^16(ap)
        cvtbl   B^PRO$B_NAMLNG(r1),@B^12(ap)
        movc3   @B^PRO$T_NAME(ap),B^12(r1),@B^4(r2)
        movl    #TRUE,@B^24(ap)
        ret
400$:   addl2   r0,@B^20(ap)
        movl    #FALSE,@B^24(ap)
        ret
        .end
$
$ fortran/object=z8 sys$input
      SUBROUTINE LOAD_OVL(FNM,RNM)
      CHARACTER*(*) FNM
      CHARACTER*(*) RNM
C
C     Local variables
      INTEGER*4 MAX_SYM
      PARAMETER (MAX_SYM=2500)
      INTEGER*4 NSYM,LSYM(MAX_SYM),ADR(MAX_SYM),I
      CHARACTER*32 SYM(MAX_SYM)
C
C     Find entrypoint
      NSYM=0
      CALL READ_SYMTAB(FNM,NSYM,SYM,LSYM,ADR,0)
      DO 100 I=1,NSYM
        IF(SYM(I)(1:LSYM(I)).EQ.RNM) THEN
          CALL LOADSHRX(FNM,ADR(I))
          GOTO 200
        ENDIF
100   CONTINUE
200   CONTINUE
C
      RETURN
      END
C********************
      SUBROUTINE READ_SYMTAB(IMGNAM,NSYM,SYM,LSYM,ADR,IMGBAS)
      INTEGER*4 NSYM,LSYM(*),ADR(*),IMGBAS
      CHARACTER*(*) IMGNAM
      CHARACTER*(*) SYM(*)
C
C     Local variables
      INTEGER*4 IO
C
C     Open file
      IO=99
      OPEN(UNIT=IO,FILE=IMGNAM,STATUS='OLD',ACCESS='DIRECT',
     +     FORM='FORMATTED',RECORDTYPE='FIXED',RECORDSIZE=512)
C
C     Read debug-symbol-table
      CALL READ_SYMTAB1(IO,NSYM,SYM,LSYM,ADR,IMGBAS)
C
C     Read global-symbol-table
      CALL READ_SYMTAB2(IO,NSYM,SYM,LSYM,ADR,IMGBAS)
C
C     Close file
      CLOSE(UNIT=IO)
C
      RETURN
      END
C********************
      SUBROUTINE READ_SYMTAB1(IO,NSYM,SYM,LSYM,ADR,IMGBAS)
      INTEGER*4 IO,NSYM,LSYM(*),ADR(*),IMGBAS
      CHARACTER*(*) SYM(*)
C
C     Local variables
      INTEGER*4 BLKADR,BLKLEN,BASE,OFFS,BUFLEN,DUMINT
      LOGICAL*4 OK
      CHARACTER*4 DUMSTR
      CHARACTER*512 BUF
      EQUIVALENCE (DUMINT,DUMSTR)
C
C     Read image-header
      CALL GET_BYT(IO,BUF(1:512),1)
      CALL FNDDBGTAB(BUF,BLKADR,BLKLEN)
      BASE=(BLKADR-1)*512+1
      OFFS=0
100   IF(OFFS.LT.BLKLEN*512) THEN
        DUMINT=0
        CALL GET_BYT(IO,DUMSTR(1:1),BASE+OFFS)
        BUFLEN=DUMINT
        OFFS=OFFS+1
        CALL GET_BYT(IO,BUF(1:BUFLEN),BASE+OFFS)
        CALL FNDSYM1(BUF(1:BUFLEN),SYM(NSYM+1),
     +               LSYM(NSYM+1),ADR(NSYM+1),OK)
        ADR(NSYM+1)=ADR(NSYM+1)+IMGBAS
        IF(OK) NSYM=NSYM+1
        OFFS=OFFS+BUFLEN
        GOTO 100
      ENDIF
C
      RETURN
      END
C********************
      SUBROUTINE READ_SYMTAB2(IO,NSYM,SYM,LSYM,ADR,IMGBAS)
      INTEGER*4 IO,NSYM,LSYM(*),ADR(*),IMGBAS
      CHARACTER*(*) SYM(*)
C
C     Local variables
      INTEGER*4 BLKADR,BLKLEN,BASE,OFFS,BUFLEN,I,J,DUMINT,IX,NSYM2
      LOGICAL*4 OK
      CHARACTER*4 DUMSTR
      CHARACTER*5120 BUF
      EQUIVALENCE (DUMINT,DUMSTR)
C
C     Read image-header
      CALL GET_BYT(IO,BUF(1:512),1)
      CALL FNDGLBTAB(BUF,BLKADR,BLKLEN)
      BASE=(BLKADR-1)*512+1
      OFFS=0
      NSYM2=NSYM
      DO 100 I=1,BLKLEN
        DUMINT=0
        CALL GET_BYT(IO,DUMSTR(1:2),BASE+OFFS)
        BUFLEN=DUMINT
        OFFS=OFFS+2
        CALL GET_BYT(IO,BUF(1:BUFLEN),BASE+OFFS)
        CALL FNDSYM2(BUF(1:BUFLEN),OK)
        IF (OK) THEN
          IX=1
50        CALL FNDSYM3(BUF(IX+1:BUFLEN),SYM(NSYM+1),
     +                 LSYM(NSYM+1),ADR(NSYM+1),IX,OK)
          ADR(NSYM+1)=ADR(NSYM+1)+IMGBAS
          DO 75 J=1,NSYM2
            IF(SYM(NSYM+1)(1:LSYM(NSYM+1)).EQ.SYM(J)(1:LSYM(J)))
     +         OK=.FALSE.
75        CONTINUE
          IF(OK) NSYM=NSYM+1
          IF(IX.LT.BUFLEN) GOTO 50
        ENDIF
        OFFS=OFFS+BUFLEN+(BUFLEN.AND.1)
100   CONTINUE
C
      RETURN
      END
C*******************
      SUBROUTINE GET_BYT(IO,STR,N)
      INTEGER*4 IO,N
      CHARACTER*(*) STR
C
      INTEGER*4 R1,RN,I,IX,L,LL
      CHARACTER*512 REC
C
      L=0
      R1=(N-1)/512+1
      RN=(N+LEN(STR)-2)/512+1
      READ(UNIT=IO,REC=R1,FMT='(A512)') REC
      IX=N-(R1-1)*512
      LL=MIN(LEN(STR),512-IX+1)
      STR(L+1:L+LL)=REC(IX:IX+LL-1)
      L=L+LL
      DO 100 I=R1+1,RN-1
        READ(UNIT=IO,REC=I,FMT='(A512)') REC
        LL=512
        STR(L+1:L+LL)=REC(1:512)
        L=L+LL
100   CONTINUE
      IF(RN.GT.R1) THEN
        READ(UNIT=IO,REC=RN,FMT='(A512)') REC
        LL=LEN(STR)-L
        STR(L+1:L+LL)=REC(1:LL)
        L=L+LL
      ENDIF
C
      RETURN
      END
$
$ fortran/object=z9 sys$input
      CALL LOAD_OVL('Z1','SUBBO')
      END
$
$ link z9+z8+z7+z4
$ define/nolog/user z1 sys$disk:[]z1.exe
$ run z9
$ exit