$! Creates a fake RTL from an input shareable image $! $! Alpha and IA64 version $! $! Author: $! John Gillings $! Software Systems Consultant, OpenVMS Ambassador $! Hewlett-Packard Pty Limited $! OpenVMS Group, Customer Support Centre $! Sydney, Australia $! $! @FAKE_RTL [name] [start-phase] [options] $! $! Phases are: $! $! DEF - Define fake rtl environment $! COPY - Make a copy of the original shareable image $! VECTOR - Analyze the symbol vector $! GEN - Generate MACRO code $! COMPILE - Compile MACRO code $! LINK - Link fake RTL $! USE - Define logical names to use image $! $! Options are: $! DEBUG - Compile and link with /DEBUG $! FORCE - Force creation of files, even if apparently unnecessary $! $! $ exp=p2.NES."" $ IF .NOT.exp THEN p2="DEF" $ IF p1.EQS."" $ THEN $ endphase="DEF" $ ELSE $ endphase="USE" $ img=F$SEARCH(F$PARSE(p1,"SYS$SHARE:",".EXE")) $ IF img.EQS."" THEN EXIT $ name=F$PARSE(img,,,"NAME") $ newimg="[]REAL_''name'.EXE;" $ ENDIF $ dbg=(p3.NES."".AND.F$LOCATE("DEBUG",p3).LT.F$LENGTH(p3)).OR.- F$TRNLNM("FAKE_OPTION_DEBUG") $ force=p4.NES."".AND.F$LOCATE("FORCE",p3).LT.F$LENGTH(p3).OR.- F$TRNLNM("FAKE_OPTION_FORCE") $ pid=F$GETJPI("","PID") $ arch=F$GETSYI("ARCH_NAME") $ IF arch.NES."Alpha".AND.arch.NES."IA64" $ THEN $ WRITE SYS$OUTPUT "Sorry, FAKE_RTL can't do ''arch'" $ EXIT $ ENDIF $ GOTO 'p2' $ $ DEF: $ IF force.OR.F$TRNLNM("FAKE_DIR").EQS."" $ THEN $ WRITE SYS$OUTPUT "Defining FAKE_RTL environment" $ ThisFile=F$ENVIRONMENT("PROCEDURE") $ ThisDisk=F$PARSE(ThisFile,,,"DEVICE") $ ThisDir=F$PARSE(ThisFile,,,"DIRECTORY") $ DEFINE/NOLOG FAKE_DIR 'ThisDisk''ThisDir' $ DEFINE/NOLOG FAKE_RTL FAKE_DIR:FAKE_RTL $ ENDIF $ IF force.OR.F$SEARCH("FAKE_RTL:.MAR").EQS."" THEN GOSUB CreateMac $ IF force.OR.F$SEARCH("FAKE_RTL:.OPT").EQS."" THEN GOSUB CreateOpt $ IF force.OR.F$SEARCH("FAKE_RTL:.OBJ").EQS."" $ THEN $ WRITE SYS$OUTPUT "Compiling FAKE_RTL.MAR" $ opt="" $ IF dbg THEN opt="/NOOPT/DEBUG" $ MACRO'opt' FAKE_RTL $ ENDIF $ IF force.OR.F$SEARCH("FAKE_RTL:.EXE").EQS."" $ THEN $ DEFINE/NOLOG REAL_LIBRTL FAKE_DIR:REAL_LIBRTL $ IF F$SEARCH("REAL_LIBRTL",".EXE").EQS."" THEN - COPY SYS$SHARE:LIBRTL.EXE REAL_LIBRTL $ DEFINE/NOLOG REAL_LIBOTS FAKE_DIR:REAL_LIBOTS $ IF F$SEARCH("REAL_LIBRTL",".EXE").EQS."" THEN - COPY SYS$SHARE:LIBOTS.EXE REAL_LIBOTS $ WRITE SYS$OUTPUT "Linking FAKE_RTL.OBJ" $ opt="" $ IF dbg THEN opt="/DEBUG" $ LINK/SHARE'opt' FAKE_RTL/OPT $ ENDIF $ ctx=1 $ ctxs=2 $ defloop: f=f$search("FAKE_DIR:REAL_*.EXE",ctx) $ IF f.EQS."" THEN GOTO EndDef $ f=f$element(0,";",f) $ n=F$PARSE(f,,,"NAME") $ r=n-"REAL_" $ DEFINE/NOLOG 'n' 'f' $ fake_'r'=="DEFINE/USER/NAME=CONFINE ''r' FAKE_DIR:FAKE_''r'" $ real_'r'=="DEASSIGN ''r'" $ GOTO defloop $ EndDef: $ IF endphase.EQS."DEF" THEN EXIT $ COPY: $ IF exp.OR.force.OR.F$SEARCH(newimg).EQS."" THEN COPY/LOG 'img' 'newimg' $ newimg=F$SEARCH(newimg) $ IF endphase.EQS."COPY" THEN EXIT $ VECTOR: $ ON WARNING THEN GOTO Cleanup $ ON CONTROL_Y THEN GOTO Cleanup $ IF .NOT.(exp.OR.force.or.F$SEARCH("''name'.VEC").EQS."") THEN GOTO GEN $ WRITE SYS$OUTPUT "Generating symbol vector for ''name' on ''arch'" $! $! Theory... $! $! The symbol vector and the GSMATCH information "define" a shareable image $! completely. On a VAX, the image identification information is critical $! and the programmer is expected to keep it up to date (by incrementing $! the minor ID whenever an entry is added to the transfer vector). On $! Alpha, the GSMATCH is considered, but there is an additional check made $! to ensure the symbol vector of the image being activated is at least $! the same size as the expected image. It is therefore reasonably common $! to find the GSMATCH values for shareable images never change. $! $! So, to check if two shareable images are compatible, first look at the $! EIHD$K_LIM section in the image header (IHD$K_LIM on VAX). Major ID $! MUST match. The minor ID is subject to the match control. Typically $! ISD$K_MATLEQ. This means the minor ID of the image being activated must $! be equal or greater than that of the image which was linked. $! $! Sample image header from Alpha ANALYZE/IMAGE: $! $!-------------------------------------------------------------------------- $! This is an OpenVMS Alpha image file $! $! IMAGE HEADER $! $! Fixed Header Information $! $! image format major id: 3, minor id: 0 $! header block count: 3 $! image type: shareable (EIHD$K_LIM) $! global section major id: %X'04', minor id: %X'0003E9' $! match control: ISD$K_MATLEQ $! I/O channel count: default $! $!-------------------------------------------------------------------------- $! $! $! Now to check the symbol vector. ANALYZE/IMAGE lists each symbol as a $! "Universal Symbol Specification". For example: $! $! 6) Universal Symbol Specification (EGSD$C_SYMG) $! data type: DSC$K_DTYPE_Z (0) $! symbol flags: $! (0) EGSY$V_WEAK 0 $! (1) EGSY$V_DEF 1 $! (2) EGSY$V_UNI 1 $! (3) EGSY$V_REL 1 $! (4) EGSY$V_COMM 0 $! (5) EGSY$V_VECEP 0 $! (6) EGSY$V_NORM 1 $! psect: 0 $! value: 592 (%X'00000250') $! symbol vector entry (procedure) $! %X'00000000 0005F9AC' $! %X'00000000 0008B980' $! symbol: "DBASIC$DATE_T" $! $! $! So here's how we do it... $ $ IF arch.EQS."IA64" THEN GOTO IA64Image $ IF arch.NES."Alpha" $ THEN $ WRITE SYS$OUTPUT "Sanity check failure. Architecture=''arch' - shouldn't get to here!" $ EXIT $ ENDIF $! $! Alpha specific $! Start with full analysis text $! $ ANALYZE/IMAGE/OUT=TMP_'pid'.ANL 'newimg' $! $! Find image ident and match control $ SEARCH/OUT=TMP_'pid'.GSM TMP_'pid'.ANL "global section major id:",- "match control:" $ OPEN/READ in TMP_'pid'.GSM $ what="Global section ID" $ READ/END=BadImg in line $ maj=F$ELEMENT(1,"'",line) $ min=F$ELEMENT(3,"'",line) $ what="Match control" $ READ/END=BadImg in line $ mat=F$ELEMENT(1,"_",line) $! $ dat="" $ CLOSE in $! $! Remove headers $ ff[0,8]=12 $ SEARCH/MATCH=NOR/EXACT/OUTPUT=TMP_'pid'.AN1 TMP_'pid'.ANL - "''ff'","''newimg'","Analyze Image ","ANALYZ " $! $! Get symbol blocks $ SEARCH/EXACT/NOHEAD/OUTPUT=TMP_'pid'.AN2 TMP_'pid'.AN1 "symbol: "/WINDOW=(5,0) $! $! Remove other junk $ SEARCH/EXACT/NOHEAD/OUTPUT=TMP_'pid'.AN3 TMP_'pid'.AN2 "symbol","%X" $ $! We should now have a list of symbol definitions like this: $! $! value: 0 (%X'00000000') $! symbol vector entry (constant) $! %X'00000000 00000000' $! %X'00000000 0035800C' (3506188) $! symbol: "C$_EPERM" $! $! $! Now parse the list. The objective is to produce a file with value, $! type, vector entry and symbol name on one line, then sort on value. $! $! There are 3 types of symbol - "constant", "procedure" and "data cell" $! For constants, we need the second symbol vector entry value - as it's $! the constant value. For data cells the symbol vector gives us the offset $! to the data from the start of the shareable image. If any data cell $! vector entries are present, we generate a file containing the symbol $! names and offsets, sorted on offset. This can be used to generate a $! replica data area in the fake image. $! $ OPEN/READ in TMP_'pid'.AN3 $ OPEN/WRITE out TMP_'pid'.VEC $ OPEN/WRITE dat TMP_'pid'.DATA $! $ genloop: READ/END=endgenloop in line $ line=F$EDIT(line,"COLLAPSE") $ IF F$LOCATE("value:",line).NE.0 THEN GOTO genloop $ val=F$ELEMENT(1,"'",line) $ READ/END=endgenloop in line $ type=F$EDIT(line,"COLLAPSE")-"symbolvectorentry" $ IF type.EQS.line THEN GOTO loop ! Read symbol vector values $ READ/END=endgenloop in line $ v1=F$ELEMENT(1,"'",line)-" " $ READ/END=endgenloop in line $ v2=F$ELEMENT(1,"'",line)-" " $ READ/END=endgenloop in line $ line=F$EDIT(line,"COLLAPSE") $ IF F$LOCATE("symbol:",line).NE.0 THEN GOTO loop $ sym=F$ELEMENT(1,"""",line) $ WRITE OUT "''val' ''v1' ''v2' ''sym' ''type'" $ IF type.EQS."(datacell)" $ THEN $ WRITE dat "''v2' ''sym'" $ dat="Data Present" $ ENDIF $ GOTO genloop $ endgenloop: $! $! Generate a match control string. Note required spaces at beginning $! of line to keep it at the top of the vector file even after sorting $! Add comment tag to indicate if data is present $! $ matall="ALWAYS" $ matequ="EQUAL" $ matleq="LEQUAL" $ matnev="NEVER" $ match=" GSMATCH="+'mat'+",%X''maj',%X''min' ! "+dat $ write out match $ SET NOON $ IF F$TRNLNM("OUT").NES."" THEN CLOSE/NOLOG out $ IF F$TRNLNM("DAT").NES."" THEN CLOSE/NOLOG dat $ IF F$TRNLNM("IN").NES."" THEN CLOSE/NOLOG in $ SORT TMP_'pid'.VEC 'name'.VEC $ SORT TMP_'pid'.DATA 'name'.DATA $ Cleanup: $ err=$status $ DELETE TMP_'pid'*.*;* $ IF F$TRNLNM("IN").NES."" THEN CLOSE/NOLOG in $ IF F$TRNLNM("OUT").NES."" THEN CLOSE/NOLOG out $ IF F$TRNLNM("DAT").NES."" THEN CLOSE/NOLOG dat $ IF .NOT.err THEN EXIT $ IF endphase.NES."VECTOR" THEN GOTO GEN $ EXIT $ BadImg: WRITE SYS$OUTPUT "Can't parse image ''what' -> ''line'" $ EXIT $ $ IA64Image: $ $ ANALYZE/IMAGE/NOPAGE/SECTION=SYMBOL_VECTOR/OUT=TMP_'pid'.ANL 'newimg' $ SEARCH/OUT=TMP_'pid'.GSM TMP_'pid'.ANL "Algorithm:","Major ID:","Minor ID:" $ $ OPEN/READ in TMP_'pid'.GSM $ what="Algorithm" $ READ/END=BadIA64Img in line $ algo=F$ELEMENT(1,":",F$EDIT(line,"COLLAPSE"))-"/" $ what="Major ID" $ READ/END=BadIA64Img in line $ maj=F$ELEMENT(1,":",F$EDIT(line,"COLLAPSE"))-"." $ what="Minor ID" $ READ/END=BadIA64Img in line $ min=F$ELEMENT(1,":",F$EDIT(line,"COLLAPSE"))-"." $ CLOSE/NOLOG in $ $! $! Find and parse the symbol vector. Note that the IA64 output is much closer $! to what we actually need than the Alpha output, but for historical reasons $! it will be "translated" back to the same format the Alpha code generates. $! $ OPEN/READ in TMP_'pid'.ANL $ OPEN/WRITE out TMP_'pid'.VEC $ OPEN/WRITE dat TMP_'pid'.DATA $ $ dat="" $ FindIA64SymVec: READ/END=NoIA64Vec in line $ IF F$LENGTH(line).EQ.0.OR.F$LOCATE("SYMBOL VECTOR",line).GT.0 THEN GOTO FindIA64SymVec $ READ/END=NoIA64Vec in line $ READ/END=NoIA64Vec in line $ IF F$LOCATE("FileAddr Offset",line).GT.0 THEN GOTO NoIA64Vec $ READ/END=NoIA64Vec in line $ $ IF p4.NES."" THEN SET VERIFY $ GenIA64loop: READ/END=EndIA64Vec in line $ IF F$LENGTH(line).EQ.0 THEN GOTO GenIA64loop $ IF F$LOCATE("The analysis",line).EQ.0 THEN GOTO EndIA64Vec $ FileAddr=F$EDIT(F$EXTRACT(0,8,line),"COLLAPSE") $ Offset=F$EDIT(F$EXTRACT(9,8,line),"COLLAPSE") $ indx=F$EDIT(F$EXTRACT(18,7,line),"COLLAPSE") $ val=F$EDIT(F$EXTRACT(28,16,line),"COLLAPSE") $ IF FileAddr.EQS."".OR.Offset.EQS."".OR.indx.EQS."" THEN GOTO GenIA64loop $ type=F$EDIT(F$EXTRACT(45,11,line),"COLLAPSE")-"("-")" $ IF type.EQS."" THEN type="SPARE" $ DATA="(datacell)" $ DATAABS="(constant)" $ PROCEDURE="(procedure)" $ SPARE="(spare)" $ type='type' $ gp=F$EDIT(F$EXTRACT(56,16,line),"COLLAPSE") $ IF gp.EQS."" THEN gp="0000000000000000" $ sym=F$EDIT(F$ELEMENT(1,"""",line),"COLLAPSE") $ IF sym.EQS."""" THEN sym="*spare*" $ WRITE OUT "''Offset' ''val' ''val' ''sym' ''type'" $ IF type.EQS."(datacell)" $ THEN $ WRITE dat "''val' ''sym'" $ dat="Data Present" $ ENDIF $ GOTO GenIA64loop $ EndIA64Vec: $! $! Generate a match control string. Note required spaces at beginning $! of line to keep it at the top of the vector file even after sorting $! Add comment tag to indicate if data is present $! $ ALWAYS="ALWAYS" $ EQUAL="EQUAL" $ LESSEQUAL="LEQUAL" $ NEVER="NEVER" $ match=" GSMATCH="+'algo'+",''maj',''min' ! "+dat $ write out match $ SET NOON $ IF F$TRNLNM("OUT").NES."" THEN CLOSE/NOLOG out $ IF F$TRNLNM("DAT").NES."" THEN CLOSE/NOLOG dat $ IF F$TRNLNM("IN").NES."" THEN CLOSE/NOLOG in $ SORT TMP_'pid'.VEC 'name'.VEC $ SORT TMP_'pid'.DATA 'name'.DATA $ CleanupIA64: $ err=$status $ IF F$TRNLNM("IN").NES."" THEN CLOSE/NOLOG in $ IF F$TRNLNM("OUT").NES."" THEN CLOSE/NOLOG out $ IF F$TRNLNM("DAT").NES."" THEN CLOSE/NOLOG dat $ DELETE TMP_'pid'*.*;* $ IF .NOT.err THEN EXIT $ IF endphase.NES."VECTOR" THEN GOTO GEN $ EXIT $ $ NoIA64Vec: $status=4 $ WRITE SYS$OUTPUT "Error - could not find symbol vector" $ GOTO CleanupIA64 $ $ BadIA64Img: WRITE SYS$OUTPUT "Can't parse image ''what' -> ''line'" $ EXIT $! $ GEN: $ VecEntrySize=16 $ IF arch.EQS."IA64" THEN VecEntrySize=8 $! $! Generate MACRO code and options file for the fake image $! $ v=F$PARSE("SYS$DISK:[]''name'.VEC") $ IF F$SEARCH(v).EQS."" $ THEN $ WRITE SYS$OUTPUT "Cannot find file ''name'.VEC" $ EXIT $ ENDIF $ IF .NOT.(exp.OR.force.OR.F$SEARCH("FAKE_''name'.MAR").EQS."") THEN GOTO COMPILE $ WRITE SYS$OUTPUT "Generating MACRO code for ''name'" $ ON WARNING THEN GOTO VecCleanup $ ON CONTROL_Y THEN GOTO VecCleanup $! $! Parse vector file $! $ OPEN/READ vec 'v' $ READ vec match ! First record is the match control string $ n=F$PARSE(v,,,"NAME") $ OPEN/WRITE opt FAKE_'n'.OPT $! $! Options file contains: $ WRITE opt match ! Match control string $ WRITE opt "FAKE_''n'" ! reference to FAKE_''n' object module $ WRITE opt "FAKE_RTL/SHARE" ! FAKE_RTL support image $! $! Check to see if data was found in the source image $ hasdata=F$LOCATE("Data Present",match).LT.F$LENGTH(Match) $! $! MACRO source contains a title $ OPEN/WRITE mac FAKE_'n'.MAR $ WRITE mac " .TITLE FAKE_''n'" $ WRITE mac " .PSECT RWData,RD,WRT,NOEXE,PAGE" ! read/write psect $ IF hasdata $ THEN ! If data present, we need to map it as an init routine $ WRITE mac " .EXTRN LIB$INITIALIZE" $ WRITE mac " .PSECT LIB$INITIALIZE,NOPIC,CON,REL,GBL,NOSHR,NOEXE,NOWRT,LONG" $ WRITE mac " .LONG MapData" $ ENDIF $ WRITE mac " .PSECT ROData,RD,NOWRT,NOEXE,PAGE" ! read only psect $! $! string containing the name of the real shareable image $ WRITE mac " .ALIGN LONG" $ WRITE mac " RealRTL: .ASCID /REAL_''n'/" $! $! Macros to define a normal routine call and a JSB call $! $ COPY SYS$INPUT mac $ DECK .PSECT $CODE,RD,NOWRT,EXE,PAGE .MACRO CallRoutine,Routine,Lab,Pref .PSECT ROData .ALIGN LONG ; string for routine name 'Pref'S_%EXTRACT(0,28,Routine) : .ASCID /'Routine'/ .PSECT RWData .ALIGN LONG ; storage for routine address init to 0 'Pref'A_%EXTRACT(0,28,Routine) : .LONG 0 .PSECT $CODE ; entry point be careful with registers! .CALL_ENTRY LABEL='Lab',- MAX_ARGS=127,HOME_ARGS=TRUE,- INPUT=,- OUTPUT=,- SCRATCH=<>,PRESERVE=<> PUSHL AP ; arg list PUSHAL 'Pref'A_%EXTRACT(0,28,Routine) ; address of routine PUSHAB 'Pref'S_%EXTRACT(0,28,Routine) ; name of routine PUSHAB RealRTL ; name of real shareable image CALLS #4,G^FAKE_LOGCALL ; dispatch to routine RET .ENDM .MACRO JSBRoutine,Routine,Lab,Pref .PSECT ROData .ALIGN LONG ; string for routine name 'Pref'S_%EXTRACT(0,28,Routine) : .ASCID /'Routine'/ .PSECT RWData .ALIGN LONG ; storage for routine address init to 0 'Pref'A_%EXTRACT(0,28,Routine) : .LONG 0 .PSECT $CODE; entry point be careful with registers! .CALL_ENTRY LABEL='Lab',- INPUT=,- OUTPUT=,- SCRATCH=<>,PRESERVE=<> MOVQ R21,-(SP) ; pass register arguments MOVQ R20,-(SP) MOVQ R19,-(SP) MOVQ R18,-(SP) MOVQ R17,-(SP) MOVQ R16,-(SP) PUSHAL 'Pref'A_%EXTRACT(0,28,Routine) ; address of routine PUSHAB 'Pref'S_%EXTRACT(0,28,Routine) ; name of routine PUSHAB RealRTL ; name of real shareable image CALLS #15,G^FAKE_LOGJSB ; dispatch to routine RET .ENDM $ EOD $ abort="FALSE" ! assume all will work $ NextAddr=0 ! set expected next vector address $ vec="SYMBOL_VECTOR=(" ! header for symbol vector entries $! $! Walk through the file $ vecloop: READ/END=EndVec vec rec $ Addr=%X'F$ELEMENT(0," ",rec)' ! get address $ v1=%X'F$ELEMENT(1," ",rec)' ! get vector values $ v2=%X'F$ELEMENT(2," ",rec)' ! $ SName=F$ELEMENT(3," ",rec) ! get symbol name $ Typ=F$ELEMENT(4," ",rec) ! get symbol type $ IF F$INTEGER(Addr).EQ.F$INTEGER(NextAddr) THEN GOTO AddrOK $! $! Not at expected location $! $ IF Addr.LT.NextAddr $ THEN $ ! This should never happen $ WRITE SYS$OUTPUT - "FATAL ERROR - vector overlap. Expecting ''NextAddr', got ''Addr'" $ WRITE SYS$OUTPUT "Jacketing not feasible!" $ abort="TRUE" $ GOTO EndVec $ ENDIF $! $ WRITE SYS$OUTPUT - "Warning - vector hole before ''sname'. Expecting ''NextAddr', got ''Addr'" $! $! Fill the vector with "spare" entries up to next entry $! $ FillLoop: IF NextAddr.GE.Addr THEN GOTO AddrOK $ va=F$FAO("!XL",NextAddr) $ NextAddr=NextAddr+VecEntrySize $ WRITE opt "''vec'SPARE) ! ''va' ***Fill to ''rec'" $ GOTO FillLoop $ AddrOK: $ NextAddr=NextAddr+VecEntrySize ! reset next expected address $ GOSUB GenSym ! generate the symbol name $ IF typ.EQS."(procedure)" $ THEN $! Options file entry is a PROCEDURE type symbol vector entry $! $ WRITE opt "''vec'''Lbl'=PROCEDURE) ! ''Addr'" $! $! OpenVMS naming convention is that JSB routines end with "_Rn" where $! "n" is the highest register modified. Check to see if this routine $! name ends in _Rn. If it does, generate a JSB entry instead of a $! CALL entry and issue a message. $! $ tag=F$EXTRACT(F$LENGTH(sName)-3,3,sName) $ rn=tag-"_R" $ IF f$EXTRACT(0,2,tag).EQS."_R".AND.(rn.GT.0).AND.(rn.LT.10) $ THEN $ WRITE SYS$OUTPUT "Assumed JSB routine ''sName'" $ WRITE mac "JSBRoutine ''sName', ''Lbl', ''Pref' ; ''Addr'" $ ELSE $ WRITE mac "CallRoutine ''sName', ''Lbl', ''Pref' ; ''Addr'" $ ENDIF $! $ ELSE IF typ.EQS."(constant)" $ THEN $! Options file entry is a DATA symbol vector entry $! $ WRITE opt "''vec'''Lbl'=DATA) ! ''Addr' CONST" $! $! MACRO code is jusr a global symbol definition $ WRITE mac "''Lbl'==''v2' ; ''Addr'" $! $ ELSE IF typ.EQS."(datacell)" $ THEN $! Options file entry is a DATA symbol vector entry $! $ WRITE opt "''vec'''Lbl'=DATA) ! ''Addr' VAR" $! $! Code will be generated later... see below $! $ ELSE IF typ.EQS."(spare)" $ THEN $ WRITE opt "''vec'SPARE) ! ''addr' SPARE" $ ELSE $! $! Shouldn't happen - flag the record $ WRITE SYS$OUTPUT "Error unexpected vector entry type /''rec'/" $ ENDIF $ ENDIF $ ENDIF $ ENDIF $ GOTO vecloop $ EndVec: $! $! Finished with vector file (input) and options file (output) $ CLOSE vec $ CLOSE opt $ IF abort THEN EXIT $ IF .NOT.hasdata THEN GOTO Finish $! $! Generate code for data - we read the data listing, which is sorted $! on offset $! $ d=F$PARSE("SYS$DISK:[]''name'.DATA") $ psize=8192 ! Page size in bytes (Alpha only!) $ OPEN/READ dat 'd' $ $! $! PSECT for exported data, aligned on Alpha page boundary $ WRITE mac ".PSECT MapData,RD,WRT,NOEXE,13" $ WRITE mac ".ALIGN 13" $! $! Loop through data symbols $! $ READ/END=EndDat dat rec $ b=0 $BlockLoop: ! $ b=b+1 $ WRITE SYS$OUTPUT "Start of data block ''b' ''rec'" $ WRITE mac "map''b'_start:" ! label at start of data block $ v=F$ELEMENT(0," ",rec) ! Get offset $ val=%X'v' ! translate to decimal $ i=val-(val/psize*psize) ! check alignment from beginning of page $ base=val-i ! calculate base offset $ hwm=val ! set high water mark $ IF i.GT.0 THEN WRITE mac ".BLKB ''i'" ! pad if not aligned $ sname=F$ELEMENT(1," ",rec)! get symbol name $ basesym'b'=sname ! generate name for string $ DatLoop: ! loop on data entries $ READ/END=EndDat dat rec ! get next entry $ v1=F$ELEMENT(0," ",rec) ! get offset $ val1=%X'v1' ! convert to decimal $ GOSUB GenSym ! generate symbol name $ alloc="" ! assume no allocation $ delta=val1-val ! calculate size $! If entry is non zero set allocation $ IF delta.GT.0.AND.delta.LT.psize THEN alloc=".BLKB ''delta'" $ WRITE mac "''Lbl':: ''alloc' ;''v'" ! declare symbol $ v=v1 ! set for next record offset (HEX) $ val=val1 ! set next record (decimal) $ sname=F$ELEMENT(1," ",rec) ! next record name $ IF delta.GT.psize ! Delta larger than page, start next block $ THEN $ WRITE SYS$OUTPUT "Hole in data exceeded threshold at ''rec'" $ GOSUB EndSec ! Fill end of data section $ WRITE mac ".ALIGN 13" $ GOTO BlockLoop ! next block $ ELSE $ hwm=val ! set highwater mark $ ENDIF $ GOTO DatLoop $ $ GenSym: $! This is needed to deal with upper and lower case symbol names $! since MACRO cannot generate lower case names, and images like DECC$SHR $! contain symbols which differ only in case, we need to generate "fake" $! names for lower case symbols that won't clash with upper case. $! Here we do that by prefixing the symbol with "L_" and truncating at $! 31 characters. Upper case only names go straight through. $! $ IF F$EDIT(sName,"UPCASE").NES.sName $ THEN $ Pref="L" $ Lbl=F$EXTRACT(0,31,"''Pref'_''sName'") $ ELSE $ Pref="U" $ Lbl=sName $ ENDIF $ RETURN $ $ EndSec: ! End of data section $ size=hwm-base ! calculate total data size $ pages=(size+psize)/psize ! work out size in pages $ pages'b'=pages ! save per block $ extra=pages*psize-size ! calculate padding at end $ alloc="" $ IF extra.GT.0 THEN alloc=".BLKB ''extra'" $ WRITE mac "map''b'_pad: ''alloc'" $ WRITE mac "map''b'_end:" ! label at end of section $ RETURN $ $ EndDat: ! End of all data $ CLOSE dat ! close input file $ GOSUB GenSym $ WRITE mac "''Lbl':: ;''v'" ! define last label $ GOSUB EndSec ! fill end of section $ WRITE mac "mapeop: .LONG" ! mark end of all data $! $! Now generate init routine $! $ WRITE mac " .PSECT $CODE " $ WRITE mac " .ENTRY MapData,^M<>" $ c=1 ! for each data block $ gsdloop: $ WRITE mac ";MAP GLOBAL SECTION ''n'''c'_DATA" ! comment $ sym=basesym'c' ! get symbol name $ WRITE mac " .PSECT ROData" ! define name of global section $ WRITE mac " .ALIGN LONG" $ WRITE mac " gsd''c':.ASCID /''n'''c'_DATA/" $ WRITE mac " .ALIGN LONG" ! define name of symbol in $! ! real image at start of block $ WRITE mac " bsym''c':.ASCID /''sym'/" $ $ pagelets=pages'c'*16 ! calculate pagelet size $ bytes=pages'c'*psize ! calculate size in bytes $ WRITE mac " .PSECT $CODE" $ WRITE mac " PUSHAL map''c'_end" ! address of end $ WRITE mac " PUSHAL map''c'_start" ! address of start $ WRITE mac " PUSHL #''pagelets'" ! size $ WRITE mac " PUSHAB bsym''c'" ! start symbol $ WRITE mac " PUSHAB gsd''c'" ! section name $ WRITE mac " PUSHAB RealRTL" ! real image name $ WRITE mac " CALLS #6,G^FAKE_MAP_DATA" ! map data $ c=c+1 ! repeat for next section $ IF c.LE.b THEN GOTO gsdloop $ WRITE mac "RET" ! end of init routine $ Finish: $ WRITE mac " .END" ! end of macro module $ CLOSE mac $ IF endphase.NES."VECTOR" THEN GOTO COMPILE $ EXIT $! $ VecCleanup: ! close any files that might be open $ IF F$TRNLNM("DAT").NES."" THEN CLOSE/NOLOG DAT $ IF F$TRNLNM("MAC").NES."" THEN CLOSE/NOLOG MAC $ IF F$TRNLNM("VEC").NES."" THEN CLOSE/NOLOG VEC $ IF F$TRNLNM("OPT").NES."" THEN CLOSE/NOLOG OPT $ EXIT $! $ COMPILE: $ IF exp.OR.force.OR.F$SEARCH("FAKE_''name'.OBJ").EQS."" $ THEN $ WRITE SYS$OUTPUT "Compiling FAKE_''name'" $ opt="" $ IF dbg THEN opt="/NOOPT/DEBUG" $ MACRO'opt' FAKE_'name' $ ENDIF $ IF endphase.EQS."COMPILE" THEN EXIT $ LINK: $ IF exp.OR.force.OR.F$SEARCH("FAKE_''name'.EXE").EQS."" $ THEN $ WRITE SYS$OUTPUT "Linking FAKE_''name'" $ opt="" $ IF dbg THEN opt="/DEBUG" $ LINK/SHARE'opt' FAKE_'name'/OPT $ ENDIF $ IF endphase.EQS."LINK" THEN EXIT $ USE: $ DEFINE/NOLOG REAL_'name' 'img' $ fake_img=F$ELEMENT(0,";",F$SEARCH("FAKE_''name'.EXE")) $ fake_'name'=="DEFINE/USER/NOLOG/NAME=CONFINE ''name' ''fake_img'" $ real_'name'=="DEASSIGN ''name'" $ EXIT $ $ CreateOpt: $! Options file for FAKE_RTL support routines $! $ CREATE/LOG FAKE_RTL:.OPT $ DECK GSMATCH=LEQUAL,42,1 ! arbitrary GSMATCH FAKE_RTL ! link FAKE_RTL.OBJ REAL_LIBRTL/SHARE ! link against real LIBRTL and LIBOTS (important!) REAL_LIBOTS/SHARE SYMBOL_VECTOR=(- FAKE_DOCALL=PROCEDURE,- ! dispatch to routine by CALL FAKE_LOGCALL=PROCEDURE,- ! log argument list and dispatch by CALL FAKE_DOJSB=PROCEDURE,- ! dispatch to routine by JSB FAKE_LOGJSB=PROCEDURE,- ! log argument list and dispatch by JSB FAKE_PUT=PROCEDURE,- ! write a string to log file FAKE_FIS=PROCEDURE,- ! jacket for LIB$FIND_IMAGE_SYMBOL FAKE_CALL=PROCEDURE,- ! jacket for CALLG (OTS$EMUL_CALL) FAKE_MOVE=PROCEDURE,- ! jacket for MOVC3 FAKE_OUT=PROCEDURE,- ! jacket for LIB$PUT_OUTPUT FAKE_LOG=PROCEDURE,- ! write to log file if logging enabled FAKE_MAP_DATA=PROCEDURE- ! map data area ) $ EOD $ RETURN $ $ CreateMac: $! Source code for FAKE_RTL - shareable image with support routines $! $ CREATE/LOG FAKE_RTL:.MAR $ DECK .TITLE FAKE_RTL ; ; Support routines for fake RTLs ; .PSECT ROData,RD,NOWRT,NOEXE,QUAD ; declare PSECTs .PSECT RWData,RD,WRT,NOEXE,QUAD .PSECT $CODE,RD,NOWRT,EXE .MACRO ASCIDStr name,val ; define ASCID string with alignment .PSECT ROData .align long 'name': .ASCID "'val'" .ENDM ; FAO control strings for logging ; ASCIDStr start, ^?!ASArg tracing started at !%D? ASCIDStr blank, ^?!/? ASCIDStr header, ^?!AS!AS at !%T? ASCIDStr argcnt, ^?!AS!AS called with !UL arg!%S? ASCIDStr argret, ^?!AS!AS returning !UL arg!%S? ASCIDStr JSBhead,^?!AS!AS JSB call at !%T? ASCIDStr return, ^?!AS!AS returned: !8XL at !%T? ASCIDStr valarg, ^?!AS !3UL !8XL? ASCIDStr refarg, ^?!AS !3UL !8XL => !XL? ASCIDStr dscarg, ^?!AS!17< !>!XL => !AS? ASCIDStr azsarg, ^?!AS!15< !>=/!AZ/? ASCIDStr strarg, ^?!AS!15< !>=/!AF/? ASCIDStr lstarg, ^?!AS!15< !>=/!AF...? ASCIDStr eol, ^?!ASexit status: !XL? ASCIDStr regs1, ^?!ASR0:!XL R1:!XL R2:!XL R3:!XL R4 :!XL R5: !XL? ASCIDStr regs2, ^?!ASR6:!XL R7:!XL R8:!XL R9:!XL R10:!XL R11:!XL? ASCIDStr JSBReg1,^?!ASR16:!XQ R17:!XQ R18:!XQ? ASCIDStr JSBReg2,^?!ASR19:!XQ R20:!XQ R21:!XQ? ASCIDStr MapData,^?!ASMapped Data !AS real:!XL:!XL => fake:!XL:!XL? ASCIDStr dumpargs, ; ; Init routine .EXTRN LIB$INITIALIZE .PSECT LIB$INITIALIZE,NOPIC,CON,REL,GBL,NOSHR,NOEXE,NOWRT,LONG .LONG FAKE_INIT .PSECT RWData .align long tracing:.LONG 0 ; set to 1 if tracing enabled skip: .LONG 0 ; block recursion depth: .LONG 0 ; nesting depth exhsta: ; exit handler .LONG 1 ; buffer for final status desblk: .LONG 0 ; Exit handler descriptor block hndadr: .LONG 0 ; handler address argc: .LONG 1 ; argument count staadr: .ADDRESS exhsta ; pointer to final status buffer .LONG 0 .ALIGN QUAD ; FAB and RAB for output file LogFAB: $FAB FNM=ARGDUMP , DNM= , RAT=CR LogRAB: $RAB FAB=LogFAB ; desriptors for formatting strings outlen: .WORD .ALIGN QUAD outdsc: .LONG ^X010E0000 .ADDRESS outbuf dscdsc: .LONG ^X010E0000 .ADDRESS dscbuf MaxPad=32 ; padding string for start of log strings Padding: .ASCID / / maxstr=48 outmax=128 ; buffer length for strings outbuf: .BLKB outmax dscbuf: .BLKB outmax $LIBDEF ; ; Macro to format and output a string using FAO ; Arguments are the FAO control string and corresponding FAO arguments .MACRO formout formstr, a1=#0,a2=#0,a3=#0,a4=#0,a5=#0,a6=#0,?OK MOVW Depth,Padding ; set length of pad string CMPW #MaxPad,Depth ; check max deptch BGTR OK MOVW #MaxPad,Padding ; limit to macimum 'OK': MOVW #outmax,outdsc ; set descriptor to maximum size $FAO_S CTRSTR=formstr, OUTLEN=outlen, OUTBUF=outdsc, - P1=#Padding,P2=a1,P3=a2,P4=a3,P5=a4,P6=a5,p7=a6 MOVW outlen,outdsc ; set descriptor to actual size PUSHAB outdsc CALLS #1,FAKE_PUT ; write to log file .ENDM .PSECT $CODE .ENTRY FAKE_EXIT,^M<> ; Exit handler BLBC tracing,NoClose ; skip if not tracing formout eol,exhsta ; Format final status string $CLOSE FAB=LogFAB ; Close log file NoClose:RET .ENTRY FAKE_INIT,^M<> ; setup log file PUSHAB dumpargs ; check logical name to see if tracing enabled CALLS #1,G^LIB$GET_LOGICAL ; existence only BLBC R0,NoTrace MOVL #1,tracing ; set tracing flag $CREATE FAB=LogFAB ; Create and connect log file BLBC R0,fail $CONNECT RAB=LogRAB BLBC R0,fail MOVAB FAKE_EXIT,hndadr ; init exit handler control block PUSHAB desblk $DCLEXH_S DESBLK=desblk ; declare exit handler formout start ; write start message NoTrace:RET .MACRO GetRoutineAddress,?Ready ; macro to check if a routine address is already known, and find ; it if not. Note we must preserve all registers! CMPL #0,@12(AP) ; is address zero? BNEQ Ready ; no, already known PUSHR #^M ; save R0 & R1 PUSHAL @12(AP) ; address buffer PUSHAL @8(AP) ; symbol name PUSHAL @4(AP) ; image name CALLS #3,G^LIB$FIND_IMAGE_SYMBOL POPR #^M ; restore registers 'ready': PUSHL @12(AP) ; return address on stack .ENDM .MACRO LogReturn,?done ; macro to log the return from a routine ; we must preserve all registers BLBC tracing,done ; skip if not tracing BLBS skip, done ; recursion block MOVL #1,skip ; protect from recursion PUSHR #^M ; save R0 & R1 PUSHL R0 ; log return value PUSHAB @8(AP) ; routine name CALLS #2,FAKE_RETURN ; write return record POPR #^M ; restore registers CLRL skip ; unblock recursion 'done': .ENDM .CALL_ENTRY,MAX_ARGS=4,HOME_ARGS=TRUE,LABEL=FAKE_DOCALL ; ; Args ; Image Name ; Routine Name ; Address of Routine Address ; AP ; GetRoutineAddress CALLG @16(AP),@(SP)+ ; note weird mode! RET .CALL_ENTRY,MAX_ARGS=4,HOME_ARGS=TRUE,LABEL=FAKE_LOGCALL ; ; Args ; Image Name ; Routine Name ; Address of Routine Address ; AP ; BLBC tracing,DoneEntry ; skip logging if not tracing BLBS skip, DoneEntry ; skip logging if recursing MOVL #1,skip ; block recursion PUSHR #^M ; preserve registers PUSHL #1 PUSHAL @16(AP) ; arg list PUSHAB @8(AP) ; routine name CALLS #3,FAKE_DUMPARGS POPR #^M ; restore registers CLRL skip ; unblock recursion DoneEntry: ADDW2 #2,depth ; increment nesting detch GetRoutineAddress ; get address CALLG @16(AP),@(SP)+ ; dispatch SUBW2 #2,depth ; restore nesting depth BLBC tracing,DoneExit ; skip logging if not tracing BLBS skip, DoneExit ; skip logging if recursing MOVL #1,skip ; block recursion PUSHR #^M ; preserve registers PUSHL #0 PUSHAL @16(AP) ; arg list PUSHAB @8(AP) ; routine name CALLS #3,FAKE_DUMPARGS POPR #^M ; restore registers CLRL skip ; unblock recursion DoneExit: LogReturn RET .CALL_ENTRY,MAX_ARGS=16,HOME_ARGS=TRUE,LABEL=FAKE_DOJSB ; ; Args ; Image Name ; Routine Name ; Address of Routine Address ; R16..R21 as quadwords ; GetRoutineAddress MOVQ 16(AP),R16 ; restore register arguments MOVQ 24(AP),R17 MOVQ 32(AP),R18 MOVQ 40(AP),R19 MOVQ 48(AP),R20 MOVQ 56(AP),R21 JSB @(SP)+ ; dispatch to routine RET .CALL_ENTRY,MAX_ARGS=16,HOME_ARGS=TRUE,LABEL=FAKE_LOGJSB ; ; Args ; Image Name ; Routine Name ; Address of Routine Address ; R16..R21 as quadwords ; BLBC tracing,DoneJSBEntry ; skip if not tracing BLBS skip, DoneJSBEntry ; skip if recursing MOVL #1,skip ; block recursion PUSHR #^M ; save registers PUSHAQ 16(AP) ; pass address of first register arg PUSHAB @8(AP) ; routine name CALLS #2,FAKE_JSBENTRY ; log the entry POPR #^M ; restore registers CLRL skip ; unblock recursion DoneJSBEntry: GetRoutineAddress ADDW2 #2,depth ; increment nesting depth MOVQ 16(AP),R16 ; restore register args MOVQ 24(AP),R17 MOVQ 32(AP),R18 MOVQ 40(AP),R19 MOVQ 48(AP),R20 MOVQ 56(AP),R21 JSB @(SP)+ ; dispatch to routine SUBW2 #2,depth ; restore nesting depth LogReturn RET .ENTRY FAKE_RETURN,^M ; writes routine name, return value and time stamp ; Arguments ; 4(AP) = String descriptor, routine name ; 8(AP) = return value ; PUSHR #^M ; save registers formout return,4(AP),8(AP),#0 POPR #^M ; restore registers formout regs1,r0,r1,r2,r3,r4,r5 ; dump registers formout regs2,r6,r7,r8,r9,r10,r11 formout blank RET .ENTRY FAKE_JSBENTRY,^M PUSHR #^M formout blank formout JSBhead,4(AP) ; write header POPR #^M formout regs1,r0,r1,r2,r3,r4,r5 ; dump registers formout regs2,r6,r7,r8,r9,r10,r11 MOVL 8(AP),R10 ; get address of first register arg CLRL R9 ; reset arg counter .DISABLE FLAGGING ; supress QUADMEMREF informationals MOVQ (R10)+,R2 ; dump arguments JSB DumpArg MOVQ (R10)+,R2 JSB DumpArg MOVQ (R10)+,R2 JSB DumpArg MOVQ (R10)+,R2 JSB DumpArg MOVQ (R10)+,R2 JSB DumpArg MOVQ (R10)+,R2 .ENABLE FLAGGING ; restore informationals JSB DumpArg RET .ENTRY FAKE_DUMPARGS,^M ; ; FAKE_DUMPARGS dumps argument list ; Arguments ; 4(AP) = String descriptor, routine name ; 8(AP) = Argument pointer ; 12(AP) = Flag 1=write header ; BLBC 12(AP),NoHead PUSHR #^M formout blank formout header,4(AP) ; write header (routine name & timestamp) POPR #^M formout regs1,r0,r1,r2,r3,r4,r5 ; dump registers formout regs2,r6,r7,r8,r9,r10,r11 NoHead: MOVL 8(AP),R8 ; get argument pointer PROBER #0,#4,(R8) ; readable? BNEQ DoArgs ; Arg list is readable formout argcnt,4(AP),#0 ; zero args passed or unreadable argument list RET DoArgs: MOVL (R8)+,R7 ; get argument count CLRL R9 ; init counter BLBC 12(AP),retargs formout argcnt,4(AP),R7 BICL #^XFFFFFF80,R7 ; sanity check to 127 args BRB ArgLoop retargs: formout argret,4(AP),R7 BICL #^XFFFFFF80,R7 ; sanity check to 127 args ArgLoop: SOBGEQ R7,MoreArg ; count down arguments RET MoreArg: MOVL (R8)+,R2 ; get next arg JSB DumpArg BRB ArgLoop DumpArg: .JSB_ENTRY input=,output= ; ; arg value in r2 ; arg number is in R9 (pre incremented and returned) ; ; Arguments are written in HEX. ; If address is valid, reference value will be written as a hex longword. ; If address looks like a valid descriptor the data will be converted to a ; string written ; If address looks like a printable ASCII string it will be written to ; a maximum of MAXSTR characters INCL R9 ; update counter PROBER #0,#4,(R2) ; readable? BEQL ByValue ; no, assume by value ; readable, assume by reference formout refarg,r9,r2,(r2) ; write initial reference ; ; We now want to see if the argument could be a descriptor. Use LIB$CVT_DX_DX ; to convert to string. If the call succeeds we had a valid descriptor and ; now have a string to display. ; In the vast majority of cases this will be a string descriptor, but ; LIB$CVT_DX_DX gives us all other scalar types for free. ; MOVW #maxstr,dscdsc ; set descriptor to maximum size PUSHAW outlen ; variable to receive output length PUSHAB dscdsc ; output descriptor PUSHL R2 ; input descriptor? CALLS #3,G^LIB$CVT_DX_DX ; convert BLBS R0,IsDescr ; conversion succeeded, valid descriptor CMPL R0,#LIB$_OUTSTRTRU ; conversion OK, but truncated BEQL IsDescr ; NotDescriptor, might be a string CLRL R3 ; init counter MOVL R2,R4 ; get copy of start address CMPB (R4),#32 ; GEQ space character? BLSSU finarg ; no, skip arg CMPB (R4)+,#126 ; printable? (and step to next character) BGTRU finarg ; no, skip arg chrloop:INCL R3 ; we now have at least one printable character PROBER #0,#4,(R4) ; check next character is readable BEQL str ; if not, write what we've found as a string CMPB (R4),#0 ; NUL? BEQL AZstr ; assume ASCIZ and write it CMPL R3,#maxstr ; more than threshold? BGEQ longstr ; yes, write maximum string CMPB (R4),#32 ; still printable? BLSSU str ; no, write what we've found CMPB (R4)+,#126 ; still printable? BGEQU str ; no, write what we've found BRB chrloop ; keep looking IsDescr:; valid descriptor MOVW outlen,dscdsc ; set output descriptor to actual length formout dscarg,4(R2),#dscdsc ; output string RSB str: ; string argument size in R3, address in R2 formout strarg,R3,R2 RSB longstr: ; long string size in R3, address in R2 formout lstarg,R3,R2 RSB AZstr: ; nul terminated string, address in R2 formout azsarg,R2 RSB ByValue: ; assume argument by value. count in R9, value in R2 formout valarg,r9,r2 finarg: RSB ; ; Routines to write the log file. Name is by logical name FAKE_ARGDUMP ; default is in current default directory, type ".LOG". File is created ; in FAKE_INIT and closed on image exit. Final status is written ; before closing. .ENTRY FAKE_PUT,^M ; ; Write one string to file, argument passed by descriptor ; MOVL 4(AP),R1 ; get desriptor address MOVW (R1), LogRAB+RAB$W_RSZ ; set size MOVL 4(R1),LogRAB+RAB$L_RBF ; set buffer address $PUT RAB=LogRAB ; write record RET .ENTRY FAKE_LOG,^M ; ; Write one string to file, if logging enabled argument passed by descriptor ; BLBC tracing,NoLog MOVL 4(AP),R1 ; get desriptor address MOVW (R1), LogRAB+RAB$W_RSZ ; set size MOVL 4(R1),LogRAB+RAB$L_RBF ; set buffer address $PUT RAB=LogRAB ; write record NoLog: RET fail: $EXIT_S R0 ; error exit RET .PSECT RWdata fadr_s: .LONG ; data address range for fake image fadr_e: .LONG radr_s: .LONG ; data address range for real image radr_e: .LONG .PSECT $CODE .ENTRY FAKE_MAP_DATA,^M<> ; ; Routine to map data. A range of new addresses is created as a global ; section. Data is copied from the old range to the global section, then ; the old range is mapped to the section. ; Args ; Image Name ; Section name ; base symbol name ; Number of pages ; start address ; end address ; MOVL 20(AP),fadr_s ; set fake address range MOVL 24(AP),fadr_e DECL fadr_e ; adjust to last byte on previous page $DELTVA_S inadr=fadr_s ; delete virtual addresses BLBC R0,MapFail ; ; Create global section $CRMPSC_S inadr=fadr_s, gsdnam=@8(AP),pagcnt=16(AP),- flags=#SEC$M_GBL!SEC$M_PAGFIL!SEC$M_WRT BLBC R0,MapFail PUSHAL radr_s ; find start of data PUSHAB @12(AP) ; symbol name PUSHAB @4(AP) ; image name CALLS #3,G^LIB$FIND_IMAGE_SYMBOL BICL #^X01FFF,radr_s ; page align MOVL 16(AP),radr_e ; get data size in pagelets MULL2 #512,radr_e ; convert to bytes MOVC3 radr_e,@radr_s,@fadr_s ; copy data ADDL2 radr_s,radr_e ; calculate end address DECL radr_e ; adjust to last byte on previous page $DELTVA_S inadr=radr_s ; delete address range BLBC R0,MapFail ; map to section $MGBLSC_S inadr=radr_s, gsdnam=@8(AP), - flags=#SEC$M_GBL!SEC$M_PAGFIL!SEC$M_WRT BLBC R0,MapFail BLBC tracing,NoLogMap ; If logging enabled, log mapping formout MapData,8(AP),radr_s,radr_e,fadr_s,fadr_e MOVL radr_s,R0 ; return real base address NoLogMap:RET MapFail: $EXIT_S R0 RET ; ; Jacket routines. ; These are placed in this module to allow "fake" RTLs to access them, even ; if it would imply a self reference. For example, a fake LIBRTL cannot call ; LIB$FIND_IMAGE_SYMBOL directly. This image is linked against REAL_LIBRTL and ; REAL_LIBOTS so it always uses the "real" routine. ; ; LIBRTL routines .CALL_ENTRY,MAX_ARGS=8,HOME_ARGS=TRUE,LABEL=FAKE_FIS CALLG (AP),G^LIB$FIND_IMAGE_SYMBOL RET .CALL_ENTRY,MAX_ARGS=8,HOME_ARGS=TRUE,LABEL=FAKE_OUT CALLG (AP),G^LIB$PUT_OUTPUT RET ; ; LIBOTS emulated instructions. .CALL_ENTRY,MAX_ARGS=2,HOME_ARGS=TRUE,LABEL=FAKE_CALL CALLG @8(AP),@4(AP) RET .CALL_ENTRY,MAX_ARGS=3,HOME_ARGS=TRUE,LABEL=FAKE_MOVE MOVC3 4(AP),@8(AP),@12(AP) RET .END $ EOD $ RETURN