%RECORDFORMAT ESD DICTF( %C %RECORD(ESD DICTF)%NAME NEXT, {POINTS TO NEXT DICT. ENTRY} %STRING(31)%NAME NAME, {POINTS TO FULL NAME IN INPUT FILE} %STRING(8) IBMNAME, {HOLDS IBM NAME} %INTEGER OFFSET, {WITHIN COALESCED AREA OR AREA 6} ESDOFFSET, {WITHIN GENERATED SD} LNTH, {LENGTH OF ASSOC. OBJECT} TXT, {ADDRESS OF FIRST TXT RECORD OF SD} ESDID, {GIVES ID OF CSECT FOR LD} {OR ESD ID FOR SD OR ER OR CM} {FOR PROC ER } {+0 IS ENTRY PT} {+1 IS HEAD CODE} {+2 IS HEAD GLA} %BYTE ESDTYPE, {ESD ENTRY TYPE} OWNTYPE, {OWN TYPE PROC/DATA/COMMON} MAIN) {#0 => MAIN ENTRY PT} %CONSTBYTEINTEGER SD=0,LD=1,ER=2,CM=5; %CONSTBYTEINTEGER PROC=0,DATA=1,COMMON=2; %CONSTSTRING(1) NULL="",HASH="#",AT="@",CODE="^" ! ! ! %EXTERNALINTEGERSPEC ERRFLAG %EXTERNALROUTINESPEC OUT HEX(%INTEGER VL,WD) %EXTERNALROUTINESPEC DUMP ESD(%RECORD(ESD DICTF)%NAME RR) %EXTERNALROUTINESPEC ERROR %EXTERNALROUTINESPEC WARNING %EXTERNALSTRING(8)%FNSPEC IBM NAME(%STRING(1) PREFIX,%STRING(31)%NAME NAME) %SYSTEMROUTINESPEC MOVE(%INTEGER L,FROM,TO) %SYSTEMROUTINESPEC FILL(%INTEGER L,ADR,FILL) %SYSTEMROUTINESPEC ITOE(%INTEGER ADR,LNTH) ! ! ! %OWNRECORD(ESD DICTF)%NAME CSECT,HEAD ESD,END ESD %OWNINTEGER ICONAD %OWNINTEGERARRAYNAME BASEOF %OWNSTRING(80) BLANKS,EBLANKS,REC %OWNINTEGER FIRST ID,NEXT ITEM,OFILE,USED,OFFSET ! ! INIT OBJ GEN ! %EXTERNALROUTINE INIT OBJ GEN(%INTEGER ICONADF,OFILEAD, %RECORD(ESD DICTF)%NAME CS,HEAD,END, %INTEGERARRAYNAME XBASEOF) %INTEGER I ICONAD=ICONADF;OFILE=OFILEAD CSECT==CS; HEAD ESD==HEAD; END ESD==END BASEOF == XBASEOF BLANKS=" " BLANKS = BLANKS.BLANKS %FOR I=1,1,3 EBLANKS=BLANKS ITOE(ADDR(EBLANKS)+1,80) USED=0;OFFSET=0 %END ! ! WRITE RECORD ! %ROUTINE WRITE RECORD(%STRING(80)%NAME REC) %IF INTEGER(OFILE)+80>INTEGER(OFILE+8) %START SELECT OUTPUT(0) PRINT STRING("Output file too small"); NEWLINE %STOP %FINISH MOVE(80,ADDR(REC)+1,OFILE+INTEGER(OFILE)) INTEGER(OFILE) = INTEGER(OFILE)+80 %END ! ! REPORT ! %ROUTINE REPORT(%STRING(15) TYPE,%STRING(31)%NAME NAME) ERROR ERR FLAG=2 PRINT STRING("The ".TYPE." field for ".NAME." needs more than 24 bits") NEWLINE %END ! ! ADD ESD ! %ROUTINE ADD ESD(%RECORD(ESD DICTF)%NAME ESD) %OWNINTEGER ONE=1 %STRING(16) ITEM %INTEGER TYPE,ADDR ITEM ADDR ITEM = ADDR(ITEM) {WRITE RECORD IF FULL} %IF NEXT ITEM+16>73 %START %IF FIRST ID>=0 %THEN MOVE(2,ADDR(FIRST ID)+2,ADDR(REC)+15) NEXT ITEM = NEXT ITEM - 17 {DOWN TO NO OF BYTES OF ESD INFO} MOVE(2,ADDR(NEXT ITEM)+2,ADDR(REC)+11) WRITE RECORD(REC) FIRST ID = -1 NEXT ITEM =17 %FINISH {BUILD ITEM ENTRY} TYPE = ESD_ESDTYPE %IF FIRST ID<0 %AND TYPE#LD %THEN FIRST ID = ESD_ESDID ITEM = ESD_IBM NAME.TOSTRING(TYPE).SUBSTRING(EBLANKS,1,7) ITOE(ADDR ITEM+1,8) %IF TYPE=LD %OR TYPE=SD %START %IF ESD_ESDOFFSET&X'FF000000' # 0 %THEN REPORT("offset",ESD_NAME) MOVE(3,ADDR(ESD_ESDOFFSET)+1,ADDR ITEM+10) %IF TYPE=LD %THEN MOVE(3,ADDR(ONE)+1,ADDR ITEM+14) {ALL LD'S MUST BE IN SD 1} %FINISH %IF TYPE=SD %OR TYPE=CM %START %IF ESD_LNTH&X'FF000000' # 0 %THEN REPORT("length",ESD_NAME) MOVE(3,ADDR(ESD_LNTH)+1,ADDR ITEM+14) %FINISH MOVE(16,ADDR ITEM+1,ADDR(REC)+NEXT ITEM) NEXT ITEM = NEXT ITEM + 16 %END ! ! GEN ESD ! %EXTERNALROUTINE GEN ESD %RECORD(ESD DICTF)%NAME ESD NEXT ITEM=17; FIRST ID =-1 REC=TOSTRING(2)."ESD".SUBSTRING(EBLANKS,1,76) ITOE(ADDR(REC)+2,3) ADD ESD(CSECT) ESD == HEAD ESD %WHILE ESD##END ESD %CYCLE %IF ESD##CSECT %THEN ADD ESD(ESD) ESD == ESD_NEXT %REPEAT {THERE MUST ALWAYS BE AT LEAST ONE ITEM IN RECORD} FILL(73-NEXT ITEM,ADDR(REC)+NEXT ITEM,64) %IF FIRST ID>=0 %THEN MOVE(2,ADDR(FIRST ID)+2,ADDR(REC)+15) NEXT ITEM = NEXT ITEM - 17 {NO OF BYTES OF ESD DATA} MOVE(2,ADDR(NEXT ITEM)+2,ADDR(REC)+11) WRITE RECORD(REC) %END ! ! WRITE AREA ! %ROUTINE WRITE AREA(%INTEGER ID,BASE,LNTH) %INTEGER I,AREC,MVE AREC=ADDR(REC) I=0 %WHILE I56-USED MOVE(MVE,BASE+I,AREC+17+USED) USED = USED+MVE I = I+MVE OFFSET = OFFSET+MVE %IF USED=56 %START MOVE(2,ADDR(USED)+2,AREC+11) WRITE RECORD(REC) USED = 0 %FINISH %REPEAT %END ! ! GEN AREA ! %EXTERNALROUTINE GEN AREA(%RECORD(%INTEGER START,LNTH,PROP)%ARRAYNAME AREA) %INTEGER I %RECORD(ESD DICTF)%NAME ESD REC=TOSTRING(2)."TXT".SUBSTRING(EBLANKS,1,76) ITOE(ADDR(REC)+2,3) CSECT_TXT = OFILE+INTEGER(OFILE) OFFSET=0 USED=0 %FOR I= 1,1,4 %CYCLE WRITE AREA(1,ICONAD+AREA(I)_START,BASEOF(I+1)-BASEOF(I)) %REPEAT WRITE AREA(1,ICONAD+AREA(5)_START,BASEOF(7)-BASEOF(5)) WRITE AREA(1,ICONAD+AREA(7)_START,BASEOF(6)-BASEOF(7)) %IF USED>0 %START MOVE(2,ADDR(USED)+2,ADDR(REC)+11) WRITE RECORD(REC) USED=0 %FINISH {NOW DEAL WITH ANY INITIALISED COMMON BLOCKS } ESD == HEAD ESD %WHILE ESD##END ESD %CYCLE %IF ESD_ESDTYPE=SD %AND ESD_ESDID#1 %START ESD_TXT=OFILE+INTEGER(OFILE) OFFSET=0;USED=0 WRITE AREA(ESD_ESDID,ICONAD+AREA(6)_START+ESD_OFFSET,ESD_LNTH) %IF USED>0 %START MOVE(2,ADDR(USED)+2,ADDR(REC)+11) WRITE RECORD(REC) %FINISH %FINISH ESD == ESD_NEXT %REPEAT %END ! ! ADDRESS ! %BYTEMAP ADDRESS(%INTEGER ID,OFFSET) {RETURNS ADDRESS OF BYTE AT OFFSET BYTES} {FROM START OF SD NUMBERED ID} %RECORD(ESD DICTF)%NAME ESD %INTEGER L %IF ID=1 %THEN ESD==CSECT %ELSESTART ESD==HEAD ESD %WHILE ESD##END ESD %CYCLE %EXIT %IF ESD_ESDID=ID ESD == ESD_NEXT %REPEAT %IF ESD==END ESD %START ERROR PRINT STRING("Unable to find ESD for id of ") WRITE(ID,1) NEWLINE %STOP %FINISH %FINISH L= OFFSET//56 %RESULT==BYTEINTEGER(ESD_TXT+L*80+(OFFSET-L*56)+16) %END ! ! FIND ID ! %ROUTINE FIND ID(%INTEGER AREA,OFFSET,%INTEGERNAME ID,ESDOFFSET) {FIND ID AND OFFSET WITHIN CSECT WHICH} {CORRESPONDS TO AREA+OFFSET} %INTEGER DIST,DISP %RECORD(ESD DICTF)%NAME ESD,TARGET %IF AREA#6 %START ID=1 ESDOFFSET=BASEOF(AREA)+OFFSET %FINISHELSESTART TARGET==END ESD; DIST=X'7FFFFFFF' ESD == HEAD ESD %WHILE ESD##END ESD %CYCLE %IF ESD_ESDTYPE=SD %AND ESD_ESDID#1 %START {NAMED COMMON BLOCK FOUND} DISP=ESD_OFFSET-OFFSET %IF 0<=DISP<=DIST %START TARGET==ESD DIST=DISP %FINISH %FINISH ESD == ESD_NEXT %REPEAT %IF TARGET==END ESD %START ERROR PRINT STRING("Unable to find ESD entry for (area,offset) of ") WRITE(AREA,1); PRINT SYMBOL(','); WRITE(OFFSET,1) NEWLINE %STOP %FINISH ID = TARGET_ESDID OFFSET = DIST %FINISH %END ! ! PROCESS INIT ! %EXTERNALROUTINE PROCESS INIT(%INTEGER LINK) %RECORD(%INTEGER LINK,AREA,DISP,LNTH,REP,INIT ADDR)%NAME INIT %INTEGER I,ID,OFFSET,NEXT,J %WHILE LINK#0 %CYCLE INIT == RECORD(ICONAD+LINK) FIND ID(INIT_AREA,INIT_DISP,ID,OFFSET) %FOR I=1,1,INIT_REP %CYCLE %IF INIT_LNTH=1 %START ADDRESS(ID,OFFSET)=BYTE INTEGER(ICONAD+INIT_INIT ADDR) OFFSET = OFFSET + 1 %FINISHELSESTART %FOR J=0,1,INIT_LNTH-1 %CYCLE ADDRESS(ID,OFFSET+J) = BYTE INTEGER(ICONAD+INIT_INIT ADDR+J) %REPEAT OFFSET = OFFSET + INIT_LNTH %FINISH %REPEAT LINK = INIT_LINK %REPEAT %END ! ! ESD NAME ! %STRING(8)%FN ESD NAME(%INTEGER ID) %RECORD(ESD DICTF)%NAME ESD ESD==HEAD ESD %WHILE ESD##END ESD %CYCLE %IF ESD_ESDID=ID %START %RESULT=ESD_IBM NAME %FINISH ESD == ESD_NEXT %REPEAT %IF ESD==END ESD %THEN %RESULT="*UNKNOWN" %END ! ! ADD RLD ! %OWNINTEGER LAST R,LAST P,NEXT %ROUTINE ADD RLD(%INTEGER R,P,OFFSET) %INTEGER NEEDED %IF R=LAST R %AND P = LAST P %THEN NEEDED=4 %ELSE NEEDED=8 %IF USED+NEEDED>56 %START MOVE(2,ADDR(USED)+2,ADDR(REC)+11) WRITE RECORD(REC) USED=0 NEEDED=8 NEXT = ADDR(REC)+17 %FINISH %IF NEEDED=8 %START LAST R = R; LAST P = P MOVE(2,ADDR(LAST R)+2,NEXT) MOVE(2,ADDR(LAST P)+2,NEXT+2) NEXT=NEXT+4; USED=USED+4 %FINISHELSESTART BYTE INTEGER(NEXT-4)=BYTE INTEGER(NEXT-4)!X'01' %FINISH BYTEINTEGER(NEXT) = X'0C' {NON BRANCH,L=4BYTES,S=+,NEXT DIFERENT} %IF OFFSET&X'FF000000'#0 %START ERROR ERR FLAG=2 PRINT STRING("The offset of the 'descriptor' for ") PRINT STRING(ESD NAME(R)) PRINT STRING(" within the csect ") PRINT STRING(ESD NAME(P)) PRINT STRING(" needs more than 24 bits") NEWLINE %FINISH MOVE(3,ADDR(OFFSET)+1,NEXT+1) NEXT=NEXT+4 USED=USED+4 %END ! ! WORD ! %INTEGERFN WORD(%INTEGER ID,OFFSET) %RESULT = ADDRESS(ID,OFFSET)<<24 ! ADDRESS(ID,OFFSET+1)<<16 ! %C ADDRESS(ID,OFFSET+2)<<8 ! ADDRESS(ID,OFFSET+3) %END ! ! STORE ! %ROUTINE STORE(%INTEGER VALUE,ID,OFFSET) ADDRESS(ID,OFFSET ) = (VALUE>>24)&255 ADDRESS(ID,OFFSET+1) = (VALUE>>16)&255 ADDRESS(ID,OFFSET+2) = (VALUE>> 8)&255 ADDRESS(ID,OFFSET+3) = VALUE &255 %END ! ! PROCESS RELOC ! %EXTERNALROUTINE PROCESS RELOC(%INTEGER LINK) %RECORD(%INTEGER LINK,NO, %C %RECORD(%INTEGER ALOC,BLOC)%ARRAY R(1:4000))%NAME RELOC %INTEGER I,ALOC,BLOC,AA,BB,RID,ROFFSET,PID,POFFSET LAST R=-1 REC = TOSTRING(2)."RLD".SUBSTRING(EBLANKS,1,76) ITOE(ADDR(REC)+2,3) USED = 0 NEXT = ADDR(REC)+17 %WHILE LINK#0 %CYCLE RELOC == RECORD(ICONAD+LINK) %FOR I=1,1,RELOC_NO %CYCLE ALOC=RELOC_R(I)_ALOC; BLOC=RELOC_R(I)_BLOC AA=(ALOC>>24)&255; ALOC=ALOC&X'FFFFFF' BB=(BLOC>>24)&255; BLOC=BLOC&X'FFFFFF' {BB,BLOC CORRESPONDS TO PT IN MEMEORY RID,ROFFSET FROM} FIND ID(BB,BLOC,RID,ROFFSET) {AA,ALOC CORSPONDS TO POINT IN MEMORY PID,POFFSET FROM} FIND ID(AA,ALOC,PID,POFFSET) {HENCE WE NEED TO INCREMENT CURRENT CONTENTS OF PID+POFFSET } {BY ADDR(RID) + ROFFSET TO DO CORRESPONDING RELOCATE } STORE(WORD(PID,POFFSET)+ROFFSET,PID,POFFSET) {GENERATE RLD REQUEST TO DO ADN OF ADDR(RID)} ADD RLD(RID,PID,POFFSET) %REPEAT LINK = RELOC_LINK %REPEAT %END ! ! FIND ER ! %RECORD(ESD DICTF)%MAP FIND ER(%STRING(1) PREFIX,%STRING(31)%NAME ID) %RECORD(ESD DICTF)%NAME ENTRY %STRING(8) IDNAME IDNAME=IBM NAME(PREFIX,ID) ENTRY == HEAD ESD %WHILE ENTRY##END ESD %CYCLE %EXIT %IF ENTRY_IBM NAME=IDNAME %AND (ENTRY_ESDTYPE=ER %OR ENTRY_ESDTYPE=CM) ENTRY==ENTRY_NEXT %REPEAT %IF ENTRY==END ESD %START ERROR PRINT STRING("ESD entry for ") PRINT STRING(IDNAME) PRINT STRING(" not found when searching for ER entry") NEWLINE %STOP %FINISH %RESULT==ENTRY %END ! ! FIND ESD ! %RECORD(ESD DICTF)%MAP FIND ESD(%STRING(1) PREFIX,%STRING(31)%NAME ID) %RECORD(ESD DICTF)%NAME ENTRY %STRING(8) IDNAME IDNAME=IBM NAME(PREFIX,ID) ENTRY == HEAD ESD %WHILE ENTRY##END ESD %CYCLE %EXIT %IF ENTRY_IBM NAME=IDNAME ENTRY==ENTRY_NEXT %REPEAT %RESULT==ENTRY %END ! ! FIX FOR ! %RECORD(ESD DICTF)%MAP FIX FOR(%STRING(1) PREFIX,%STRING(31)%NAME NAME) %RECORD(ESD DICTF)%NAME ESD %INTEGER TYPE ESD == FIND ESD(PREFIX,NAME) TYPE=ESD_ESDTYPE ESD==END ESD %UNLESS TYPE=SD %OR TYPE=LD %RESULT==ESD %END ! ! PROCS RLD ! %EXTERNALROUTINE PROCS RLD(%INTEGER HEAD) %RECORDFORMAT PR REFF(%C %INTEGER LINK,ADISP, %STRING(31) ID) %RECORD(PR REFF)%NAME PRREF %RECORD(ESD DICTF)%NAME ESD,EPT,HCODE,HGLA %INTEGER LINK,AREA,OFFSET,OK,PID,POFFSET LINK = HEAD %WHILE LINK#0 %CYCLE PR REF == RECORD(LINK+ICONAD) LINK = PR REF_LINK {CHECK IF REF CAN BE FIXED UP INTERNALLY} EPT==FIX FOR(CODE,PR REF_ID) HCODE==FIX FOR(AT,PR REF_ID) HGLA==FIX FOR(HASH,PR REF_ID) AREA=(PR REF_ADISP>>24)&255 OFFSET = PR REF_ADISP&X'FFFFFF' FIND ID(AREA,OFFSET,PID,POFFSET) %IF EPT##END ESD %AND HCODE##END ESD %AND HGLA##END ESD %START {FIX UP INTERNALLY} STORE(0,PID,POFFSET) STORE(BASEOF(2{GLA}),PID,POFFSET+4) STORE(EPT_ESDOFFSET,PID,POFFSET+8) {NOW GENERATE RLD ENTRIES TO ADD HCODE TO EACH ONCE LOADED} ADD RLD(1,PID,POFFSET) ADD RLD(1,PID,POFFSET+4) ADD RLD(1,PID,POFFSET+8) %FINISHELSESTART {EXTERNAL REFERENCE TO BE FIXED UP} STORE(0,PID,POFFSET) STORE(0,PID,POFFSET+4) STORE(0,PID,POFFSET+8) {SET UP RLD ENTRIES} HCODE==FIND ER(AT,PR REF_ID) ADD RLD(HCODE_ESDID,PID,POFFSET) HGLA==FIND ER(HASH,PR REF_ID) ADD RLD(HGLA_ESDID,PID,POFFSET+4) EPT==FIND ER(CODE,PR REF_ID) ADD RLD(EPT_ESDID,PID,POFFSET+8) %FINISH %REPEAT %END ! ! DATAS RLD ! %EXTERNALROUTINE DATAS RLD(%INTEGER HEAD) %RECORDFORMAT DT REFF(%C %INTEGER LINK,DISP,LNTH, %STRING(31) ID) %RECORD(DT REFF)%NAME DTREF %RECORD(%INTEGER N,%INTEGERARRAY LOC(1:8000))%NAME REF %RECORD(ESD DICTF)%NAME ESD %INTEGER LINK,AREA,OFFSET,I,RID,ROFFSET,PID,POFFSET LINK = HEAD %WHILE LINK#0 %CYCLE DT REF == RECORD(LINK+ICONAD) LINK = DT REF_LINK {CHECK IF REF CAN BE FIXED UP INTERNALLY} ESD==FIX FOR(NULL,DT REF_ID) %IF ESD##END ESD %AND DT REF_DISP>=0 %START {FIX UP INTERNALLY IF NOT A COMMON REFERENCE} RID=ESD_ESDID ROFFSET=ESD_ESDOFFSET %FINISHELSESTART {EXTERNAL REFERENCE TO BE FIXED UP} ESD == FIND ER(NULL,DT REF_ID) RID = ESD_ESDID; ROFFSET=0 %FINISH {DO FIX UP FOR EACH REFERENCE} REF==RECORD(DT REF_DISP&X'7FFFFFFF' + ICONAD) %FOR I=1,1,REF_N %CYCLE OFFSET = REF_LOC(I) AREA = (OFFSET>>24)&255 OFFSET = OFFSET&X'FFFFFF' FIND ID(AREA,OFFSET,PID,POFFSET) %IF ROFFSET#0 %THEN STORE(WORD(PID,POFFSET)+ROFFSET,PID,POFFSET) {ADD ROFFSET TO LOCN-FOR INTERNAL FIX UP ONLY} ADD RLD(RID,PID,POFFSET) %REPEAT %REPEAT %END ! ! CLOSE RLD ! %EXTERNALROUTINE CLOSE RLD %IF USED>0 %START MOVE(2,ADDR(USED)+2,ADDR(REC)+11) WRITE RECORD(REC) %FINISH %END ! ! GEN END ! %EXTERNALROUTINE GEN END %RECORD(ESD DICTF)%NAME ESD REC=TOSTRING(2)."END".SUBSTRING(EBLANKS,1,76) ITOE(ADDR(REC)+2,3) ESD==HEAD ESD %WHILE ESD##END ESD %CYCLE %EXIT %IF ESD_MAIN#0 ESD == ESD_NEXT %REPEAT %IF ESD##END ESD %START MOVE(8,ADDR(ESD_IBM NAME)+1,ADDR(REC)+17) ITOE(ADDR(REC)+17,8) %FINISH WRITE RECORD(REC) %END %ENDOFFILE