!!****************************************** !! * !! OMF CONVERTER : ERCC TYPE OBJECT * !! FILE INTO ICL TYPE OBJECT FILE. * !! * !!****************************************** !! * !! PRODUCES A SQ FILE OF MAX RECORD SIZE 4K. !! THIS IS HANDLED VIA THE COMPILER ENVIRONMENT !! INTERFACE. AND THEN ON EMAS VIA WRITEBTAPE !! INTO MEF B ARCHIVE TAPE FORMAT OR VIA KTAPE !! INTO 'K' COPY OUT TAPE FORMAT. !! ( THIS WORK IS BASED ON SID D425) !! !! THIS PROGRAM SHOULD RUN ON EMAS 2900, VME/B OR VME/K. !! !! !!***************************************************** !! * !! OPTIONS FOR OMFOUT ARE HELD IN CONTROL AS BITS. * !! THEY ARE SET BY CALLING THE ROUTINE OMF PARM, * !! OR BY THE SUBSYSTEM. * !! * !! BIT 0 - STACK AREA MODE * !! BIT 1 - " " * !! BIT 2 - CODE SYMBOL TABLES AREA MODE * !! BIT 3 - " " * !! BIT 4 - GLA AREA MODE * !! BIT 5 - " " * !! BIT 6 - CODE AREA MODE * !! BIT 7 - " " * !! BIT 8 - 25 FREE * !! BIT 26 - SHARE=YES (PURE) * !! BIT 27 - LIBRARY * !! BIT 28 - INHIBIT CASCADE LOADING * !! BIT 29 - MAXKEYS * !! BIT 30 - FIXUPS (GIVE LIST OF RELOCATIONS * !! BIT 31 - MAP (GIVE NAME MAP OF OBJECT) * !! * !!***************************************************** SYSTEMINTEGERFN OMFOUT( C INTEGER OP SYS, ATEMP, AWRK, CONTROL, LANG CODE, ADATE, C ATIME, STRING (7) SUBNAME, STRING (4) VERSION, C STRING (32) MODULE NAME, STRING (32) MRTPREFIX, CEPREFIX) !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! SYSTEM ROUTINES !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! SYSTEMROUTINESPEC ITOE(INTEGER AD, L) SYSTEMROUTINESPEC MOVE(INTEGER LEN, FROMAD, TOAD) SYSTEMROUTINESPEC SSMESSA(INTEGER N, STRING (32) MESSS) SYSTEMROUTINESPEC PHEX(INTEGER N) SYSTEMINTEGERFNSPEC SET ALIAS(INTEGER DR0, DR1) SYSTEMINTEGERFNSPEC OMFRECORD(INTEGER DR0, DR1) !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! INTERNAL ROUTINES !!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! ROUTINESPEC OUTRECORD(INTEGER IIN, FROM, TO, NEXT) ROUTINESPEC FIXUP(INTEGER AREACODE, TYPE, BASECODE, AREADISP, C BASEDISP) INTEGERFNSPEC OUTPUT RELOCATED AREA( C INTEGER H, B, AREAIIN, RECORDARRAYNAME F, C STRING (5) AREA) ROUTINESPEC BLOCKOUT(INTEGER IIN, FROM, TO) INTEGERFNSPEC FINDDXREF(STRING (31) IDEN) ROUTINESPEC EXTRA NAME ENTRY(INTEGER OFFSET, C STRING (32) S, INTEGER L) ROUTINESPEC AREA MAP ENTRY(INTEGER LENGTH, IIN, C STRING (32) S) ROUTINESPEC SETNAME(STRINGNAME S INTEGER A,TYPE) ROUTINESPEC KEY(STRING (32) S) !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! ERCC LOADER DATA RECORD FORMATS !!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! RECORDFORMAT RFM(INTEGER AREALOC, BASELOC) RECORDFORMAT DEPFM(INTEGER LINK, DISP, L, A, C STRING (31) IDEN) RECORDFORMAT EPFM(INTEGER LINK, LOC, STRING (31) IDEN) RECORDFORMAT EXTRFFM(INTEGER LINK, REFLOC, STRING (31) IDEN) RECORDFORMAT DEXTRFM(INTEGER LINK, REFARRAY, L, C STRING (31) IDEN) RECORDFORMAT DREFFM(INTEGER N, INTEGERARRAY REFLOC(1 : 1000)) RECORDFORMAT INITFM(INTEGER LINK, A, DISP, LEN, REP, ADDR) RECORDNAME DREF(DREFFM) RECORDNAME INIT(INITFM) RECORDNAME EP(EPFM); ! LIST1 ENTRY POINTS RECORDNAME DEP(DEPFM); ! LIST4 DATA ENTRY POINT RECORDNAME LER, ER(EXTRFFM); ! LIST7 EXT REF LIST RECORDNAME DTREF(DEXTRFM); ! LIST9 DATA REF LIST RECORDNAME RRB(RFM); ! LIST 14 RELOCATION REQUEST BLOCK RECORDFORMAT ATTR(INTEGER START, L, PROP) RECORDARRAYFORMAT AAFM(1 : 7)(ATTR) RECORDARRAYNAME AA(ATTR) RECORDFORMAT FHEADFMT(INTEGER TSIZE, HSIZE, PSIZE, TYPE, C DATE, TIME, DISPLDATA, DISPATTR) RECORDNAME FHEAD(FHEADFMT) INTEGERARRAYNAME LISTHEAD; ! LDATA HEADER BLOCK !! !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! CONSTANTS !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! !! !! ERROR CODES GENERATED BY THIS PROGRAM !! CONSTINTEGER CORRUPT OBJECT FILE = 226 CONSTINTEGER CORRUPT FIXUP = 243 CONSTINTEGER TOO MANY CHS = 244 CONSTINTEGER OMF WORKFILE FULL = 248 !! CONSTINTEGER EMAS = 0 ! %CONSTINTEGER VMEB=1,VMEK=2 !! !! EMAS AREA NUMBERS !! CONSTINTEGER CODE = 1, GLA = 2, UST = 5, SST = 4, COM = 6, C STACK = 7 CONSTINTEGER MAXKEYS = 4, LIBRARY = 16;! MASKS TO COMREG 26 CONSTINTEGER NOCASCADE = 8, SHARE = 32 CONSTSTRING (6) ICLPREFIX = 'ICL9CE' CONSTSTRING (6) ARRAY TYPS(0 : 3) = C C 'MODULE','AREA ','ENTRY ','XREF ' !! CONSTINTEGER B64K = X'10000' CONSTINTEGER B70K = X'11800' CONSTINTEGER B128K = X'20000' CONSTINTEGER B320K = X'50000' CONSTINTEGER EXCL = 1 CONSTINTEGER MAXF = 12288; ! MAX FIXUPS OF EACH TYPE. CONSTINTEGER BYTEDR = X'18000000' !! !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! OMF ENTRY RECORD FORMATS !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! RECORDFORMAT FIXED PART FM( C BYTEINTEGER TYPE, PROPERTIES, HALFINTEGER ENTRY SIZE, C IIN, BYTEINTEGER NAME USE, STRING (32) NAME) RECORDNAME FP(FIXED PART FM) RECORDFORMAT MAP MODULE ENTRY FM( C BYTEINTEGER TYPE, LANGUAGE, HALFINTEGER ENTRY SIZE, C INTEGER CHAIN, VERSION, D1, D2, HALFINTEGER D3, T1, C T2,T3,T4, BYTEINTEGER NAME USE, STRING (32) NAME) RECORDNAME ME(MAP MODULE ENTRY FM) RECORDFORMAT AEFM(BYTEINTEGER TYPE, PROPERTIES, HALFINTEGER C ESIZE, INTEGER AREA CHAIN, DISPLACEMENT, C BYTEINTEGER SIZE0, SIZE1, SIZE2, IIN0, IIN1, IIN2, C NAME USE, STRING (32) NAME) RECORDFORMAT XNEFM(BYTEINTEGER TYPE, REASONS, HALFINTEGER ESIZE, C INTEGER CHAIN, OFFSET, C BYTEINTEGER SPARE1, SPARE2, NAME USE, STRING (32) NAME) RECORDFORMAT ACEFM(BYTEINTEGER TYPE, SPARE1, HALFINTEGER IIN, C INTEGER AREA CHAIN) RECORDNAME AE(AEFM) RECORDNAME XNE(XNEFM) RECORDNAME ACE(ACEFM) RECORDFORMAT MCRFM(BYTEINTEGER TYPE, LASTENTRY, C HALFINTEGER IIN, INTEGER INC, C LENCOPS, DISP) !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! INTERNAL FORMATS AND MAPPINGS !!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! INTEGERARRAYNAME PR; ! PROPERTIES RECORD INTEGERARRAYNAME D; ! DIAGNOSTIC RECORD INTEGERARRAYNAME IINTAB RECORDFORMAT PDEFM(BYTEINTEGER RECORD, HALFINTEGER DISP) RECORDARRAYFORMAT PDEAFM(1 : 10000)(PDEFM) RECORDARRAYNAME PDE(PDEFM) INTEGERARRAYFORMAT IFM(0 : 1000000) RECORDFORMAT FFM(INTEGER TYPE, C INTEGER BASECODE, AREADISP, BASEDISP) RECORDARRAYFORMAT FAFM(1 : 12228)(FFM) RECORDARRAYNAME GLF, STF(FFM); ! FOR STORING RELOCATION INFORMATION RECORDFORMAT BHEADFM(HALFINTEGER TYPEANDFLAG,IIN, C INTEGER DISP,LEN) RECORDNAME BHEAD(BHEADFM) !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! VARIABLES !!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! STRING (40) S STRING (32) REST, DS STRING (32) MODULEPREFIX; ! MODULE ENTRY PREFIX INTEGER LASTUIIN; ! LAST UNSHARED AREA IIN INTEGER MAXAREAIIN; ! LARGEST TYPE 1 IIN INTEGER ENTRY START, GLASIZE BYTEINTEGERNAME LARGEST TYPE1IIN; ! STORE MAXAREAIIN HERE AT END. INTEGER K, XREF, LXREF INTEGER I, J, L, IIN, LINK, LASTLINK INTEGER GLFP, STFP; ! POINTERS INTO FIXUP ARRAY INTEGER DP, PRP; ! PTRS TO DIAG AND PROPS. RECORDS. INTEGER NDRECS INTEGER LCL; ! LENGTH OFLARGEST COMMON BYTEINTEGERNAME SUFFIX INTEGER CBASE, ADB, NEXT INTEGER ENTRYSIZE, TYPE, ACES, COFFSET INTEGER LASTBLOCKLEN BYTEINTEGERARRAY B(0 : 4096); ! OUTPUT BUFFER RECORD MCR(MCRFM); ! MULTIPLE COPY RECORD INTEGER INLIST13 !! !! !################################ !# # !# BEGIN HERE # !# # !################################ ! INITIALISATION OF VARIABLES INLIST13 = 0 GLFP = 1 STFP = 1 DP = 1 PRP = 1 LASTBLOCKLEN = 0 CBASE = 0 NDRECS = 0 ADB = ADDR(B(0)) BHEAD == RECORD(ADB) !! !! !! ASSIGN DEFAULT MAIN ENTRY POINT NAME IF MODULENAME = '' THEN MODULENAME = 'ICL9CEMAIN' !! !######################################### !! FHEAD == RECORD(ATEMP); ! MAP ONTO EMAS OBJECT FILE HEADER RESULT = CORRUPT OBJECT FILE C IF FHEAD_TSIZE <= 32 OR FHEAD_TYPE # 1 !! LISTHEAD == ARRAY(FHEAD_DISPLDATA+ATEMP,IFM) ! MAP ONTO LDATA LISTHEADS J = FHEAD_DISPATTR+ATEMP; ! ADDRESS OF ATRIBUTES TABLE AA == ARRAY(J+4,AAFM) I = INTEGER(J); ! NUMBER OF AREAS IN ATTRIBUTES MAP !! SET START ADDRESSES ABSOLUTE RESULT = CORRUPT OBJECT FILE IF I > 9 UNTIL I = 0 THEN AA(I)_START = AA(I)_START+ATEMP C AND I = I-1 !! !!######################################### !! SS#WRK IS ALLOCATED THUS !! !! 0K -> 64K - PROPERTIES RECORD / THEN PDE ARRAY !! 64K -> 70K - XREF IIN TABLE !! 70K -> 128K - DIAGNOSTIC RECORD !! 128K -> 320K - GLA FIXUPS !! 320K -> 512K - STACK FIXUPS !! !! !! !! MAP WORK SPACE ONTO SS#WRK !! GLF == ARRAY(AWRK+B128K,FAFM) STF == ARRAY(AWRK+B320K,FAFM) PR == ARRAY(AWRK,IFM) D == ARRAY(AWRK+B70K,IFM) PDE == ARRAY(AWRK,PDEAFM) IINTAB == ARRAY(AWRK+B64K,IFM) !! !! !########################################## !***DO PROPERTIES RECORD*** !! ! TYPE 0 MAIN MODULE NAME !! ! IIN TO START AT ZERO, AFTER INCREMENTING IIN = -1 SETNAME(MODULENAME,0,0) IF CONTROL&NOCASCADE # 0 THEN FP_PROPERTIES = X'20' ! INHIBIT CASCADE LOAD ! PREPARE SPACE TO RECORD IIN OF LAST AREA PR(PRP) = 1<<24 LARGEST TYPE 1 IIN == BYTEINTEGER(ADDR(PR(PRP))+3) ! POINTER BACK TO IT PRP = PRP+1 !! MODULEPREFIX = "EMPTY" I = LENGTH(CEPREFIX) IF I = 0 THEN MODULEPREFIX = MRTPREFIX C AND I = LENGTH(MRTPREFIX) ELSE MODULEPREFIX = CEPREFIX IF I # 0 START ; ! SET A MODULE PREFIX PR(PRP) = X'FF010000'!(I<<8)!((I+3)>>2) MOVE(I,ADDR(MODULEPREFIX)+1,ADDR(PR(PRP+1))) ITOE(ADDR(PR(PRP+1)),I) PRP = PRP+1+((I+3)>>2) FINISH !! FP_ENTRY SIZE = PRP-1 S = MODULENAME.'-C'; ! USE SUFFIX TO DENOTE AREA L = LENGTH(S) SUFFIX == BYTEINTEGER(ADDR(S)+L) !! !! !************************************************ ! TYPE 1 ENTRY FOR CODE !! IF AA(CODE)_L > 0 START ENTRY START = PRP FP == RECORD(ADDR(PR(PRP))) FP = 0 FP_TYPE = 1 FP_IIN = 1 ! THE PROPERTY PURE ALLOWS PUBLIC LOADING WHEN REQD. IF CONTROL&SHARE # 0 THEN FP_PROPERTIES = B'01101000' C ELSE FP_PROPERTIES = B'00101000' ! PURE?/EPB/READ FP_NAME USE = X'40'; ! LOCAL/PERM FP_NAME = S PRP = PRP+3+(L+3)>>2 PR(PRP-1) = AA(CODE)_L; ! 0 - AREA SIZE ! SET AREA PROPERTIES 2 IF REQD TO SHOW MODE OF USE AND EXCLUSIVE IF CONTROL&X'3000000' # 0 OR OPSYS = EMAS START PR(PRP) = X'3000000'!((CONTROL&X'03000000')>>6) IF OPSYS = EMAS THEN PR(PRP) = PR(PRP)!EXCL PRP = PRP+1 FINISH FP_ENTRY SIZE = PRP-ENTRY START FINISH !! !************************************************* ! TYPE 1 ENTRY FOR GLA - INCORPORATING UNSHARED SYMBOL TABLES. !! GLASIZE = AA(GLA)_L+AA(UST)_L IF GLASIZE > 0 START ENTRYSTART = PRP FP == RECORD(ADDR(PR(PRP))) FP = 0 FP_TYPE = 1 FP_PROPERTIES = B'00011100'; ! WRITE/READ/PLT FP_IIN = 2 FP_NAME USE = X'40'; ! LOCAL/PERM/NOT SYS/NOT KEY SUFFIX = 'G' FP_NAME = S PRP = PRP+3+((L+3)>>2) PR(PRP-1) = GLASIZE; ! 0 - AREA SIZE IF OPSYS = EMAS OR CONTROL&X'C000000' # 0 START PR(PRP) = X'3000000'!((CONTROL&X'0C000000')>>8) IF OPSYS = EMAS THEN PR(PRP) = PR(PRP)!EXCL PRP = PRP+1 FINISH FP_ENTRY SIZE = PRP-ENTRYSTART FINISH !! !! !!***********************************************************: !! !! TYPE 1 ENTRY FOR CODE SYMBOL TABLES (SHARED TABLES) !! IF AA(SST)_L > 0 START ENTRYSTART = PRP FP == RECORD(ADDR(PR(PRP))) FP = 0 FP_TYPE = 1 IF CONTROL&SHARE # 0 THEN FP_PROPERTIES = B'01001000' C ELSE FP_PROPERTIES = B'00001000' ! PURE?/READ FP_IIN = SST FP_NAMEUSE = X'40' SUFFIX = 'T' FP_NAME = S PRP = PRP+3+((L+3)>>2) PR(PRP-1) = AA(SST)_L; ! 0 - AREA SIZE IF OPSYS = EMAS OR CONTROL&X'30000000' # 0 START PR(PRP) = X'3000000'!((CONTROL&X'30000000')>>10) IF OPSYS = EMAS THEN PR(PRP) = PR(PRP)!EXCL PRP = PRP+1 FINISH AREA MAP ENTRY(AA(SST)_L,SST,S) FP_ENTRYSIZE = PRP-ENTRYSTART FINISH !! !******************************************************** ! TYPE 1 ENTRY FOR STACK AREA !! IF AA(STACK)_L > 0 START ENTRYSTART = PRP FP == RECORD(ADDR(PR(PRP))) FP = 0 FP_TYPE = 1 FP_PROPERTIES = B'10011001'; ! STACK WRITE !! READ ALIGN=1(2WRD) FP_IIN = 7 FP_NAME USE = X'40' SUFFIX = 'S' FP_NAME = S PRP = PRP+3+((L+3)>>2) PR(PRP-1) = AA(STACK)_L; ! 0 - AREA SIZE IF CONTROL&X'C0000000' # 0 START PR(PRP) = X'3000000'!((CONTROL&X'C0000000')>>12) PRP = PRP+1 FINISH FP_ENTRY SIZE = PRP-ENTRY START AREA MAP ENTRY(AA(STACK)_L,STACK,S) FINISH !! MAXAREAIIN = FP_IIN; ! BIGGEST TYPE 1 IIN SO FAR IIN = 9 SUFFIX = 'G' IF AA(GLA)_L > 0 THEN AREA MAP ENTRY(GLASIZE,GLA,S) !! !! !************************************************* ! COMMON ENTRY POINTS PROCESS LIST 4 LINK = LISTHEAD(4)+ATEMP WHILE LINK > ATEMP THEN CYCLE DEP == RECORD(LINK) IF DEP_A = 6 OR DEP_A >= 10 START ; ! COMMON IF DEP_A >= 10 THEN IIN = DEP_A-1 S = DEP_IDEN SETNAME(S,0,1); ! AREA ENTRY PRP = PRP+1 FP_PROPERTIES = B'00011010'; ! WRITE/READ ! ALIGNED FOUR WORD BOUNDARY FP_NAME USE = B'11011100' ! SCOPE/PERM/COMMON/EVERY INIT/UNIQUE COMMON PR(PRP-1) = DEP_L; ! AREASIZE DEP_A = DEP_A!(IIN<<16); ! REMEMBER GIVEN IIN !! NON - STANDARD USE OF DEP_A FIELD FP_ENTRY SIZE = PRP-ENTRYSTART FINISH LINK = DEP_LINK+ATEMP REPEAT IIN = MAXAREAIIN IIN=9 IF IIN<9 !! !************************************************* ! DATA ENTRY POINTS PROCESS LIST 4 LINK = LISTHEAD(4)+ATEMP WHILE LINK > ATEMP THEN CYCLE DEP == RECORD(LINK) IF DEP_A < 10 AND DEP_A # 6 START ; ! NOT A COMMON S = DEP_IDEN SETNAME(S,0,2) PRP = PRP+1 IF DEP_A = UST THEN J = AA(GLA)_L ELSE J = 0 FP_NAME USE = X'C0'; ! EXTERNAL/PERM/ PR(PRP-1) = 128<<24+DEP_DISP+DEP_L+J; ! LAST BYTE OF AREA PR(PRP) = 129<<24+DEP_DISP+J; ! FIRST BYTE PR(PRP+1) = X'85000002'; ! 133 - TYPE 1 IIN IF CONTROL&MAXKEYS # 0 THEN KEY(DEP_IDEN) EXTRA NAME ENTRY(DEP_DISP+J,FP_NAME,DEP_L) PRP = PRP+2 DEP_A = DEP_A!IIN<<16; ! REMEMBER GIVEN IIN !! NON - STANDARD USE OF DEP_A FIELD FP_ENTRY SIZE = PRP-ENTRYSTART FINISH LINK = DEP_LINK+ATEMP REPEAT !************************************************** ! EXTERNAL DATA ENTRY POINT REFERENCES LIST 9 !! LINK = LISTHEAD(9)+ATEMP WHILE LINK > ATEMP THEN CYCLE DTREF == RECORD(LINK) DREF == RECORD((DTREF_REFARRAY&X'7FFFFFFF')+ATEMP) IF LISTHEAD(4) > 0 START DEP == RECORD(LISTHEAD(4)+ATEMP) WHILE DEP_LINK # 0 AND DEP_IDEN # DTREF_IDEN C THEN DEP == RECORD(DEP_LINK+ATEMP) DS = DEP_IDEN FINISH ELSE DS = "" IF DS # DTREF_IDEN THEN START ; ! REF NOT INTERNALLY SATISFIABLE DREF == RECORD((DTREF_REFARRAY&X'7FFFFFFF')+ATEMP) S = DTREF_IDEN I = FINDDXREF(S) IF S = 'F#BLCM' THEN S = 'ICL9LFBC'; ! BLANK COMMON IF I < 0 START ; ! FIRST OCCURRENCE IIN = IIN+1 DREF_N = DREF_N!(IIN<<16); ! REMEMBER IIN IF DTREF_REFARRAY>>31 = 1 START ; ! COMMON SETNAME(S,0,1); ! AREA ENTRY FP_PROPERTIES = B'00011010' ! READ WRITE,ALIGN 4 WORD BOUND FP_NAME USE = B'11011100' ! SCOPE/PERM/COMMON/EVERY INIT/UNIQUE COMMON !! ALIGNMENT ON 4 WORD BOUNDARY AREA MAP ENTRY(LCL,IIN,S) FINISH ELSE SETNAME(S,0,3) IF DTREF_REFARRAY>>31 = 1 C THEN PR(PRP) = LCL AND PRP = PRP+1 FP_ENTRYSIZE = PRP-ENTRY START I = IIN FINISH J = 0; ! BASEDISP FINISH ELSE START ! INTERNAL REFERENCE IF DTREF_REFARRAY>>31 = 1 C THEN I = DEP_A>>16 AND J = 0 C ELSE I = DEP_A&X'FFFF' AND J = DEP_DISP FINISH K = DREF_N&X'FFFF' WHILE K > 0 THEN CYCLE FIXUP(DREF_REFLOC(K)>>24,0,I,DREF_REFLOC(K)&X'FFFFFF', C J) K = K-1 REPEAT LINK = DTREF_LINK+ATEMP REPEAT !! !************************************************* ! PROCESS EXTERNAL REFERENCES IN LIST 7 !! XREF = 1 LINK = LISTHEAD(7)+ATEMP WHILE LINK > ATEMP THEN CYCLE ER == RECORD(LINK) ! SEARCH ENTRY LIST IF LISTHEAD(1) > 0 START EP == RECORD(LISTHEAD(1)+ATEMP) WHILE EP_LINK # 0 AND EP_IDEN # ER_IDEN C THEN EP == RECORD(EP_LINK+ATEMP) DS = EP_IDEN FINISH ELSE DS = "" IF DS # ER_IDEN THEN START ; ! NO SUCH ENTRY ! EXTERNAL REFERENCE !! SEE IF IT IS THE FIRST OCCURRENCE LER == RECORD(LISTHEAD(7)+ATEMP) LXREF = 1 WHILE LER_LINK # ER_LINK C AND ER_IDEN # LER_IDEN C THEN LER == RECORD(LER_LINK+ATEMP) C AND LXREF = LXREF+1 IF LER_LINK = ER_LINK START ; ! FIRST OCCCURRENCE !! DUMP TYPE 3 ENTRY !! CTM REFERENCES SHORT CUT THE LIBRARY !! SEARCH MECHANISM BY HAVING AN IDENTIFYING !! BIT ACT AS A PREFIX. S = ER_IDEN IF S -> ("M#").REST THEN S = "ICL9CM".REST IF S -> ('ICLCTM').REST C OR S -> ('CTM').REST C THEN FP_PROPERTIES = X'40' AND S = REST IF S -> ('ICL9CE').REST AND CEPREFIX # "" C THEN FP_PROPERTIES = X'80' J = LENGTH(MRTPREFIX) IF S -> ("ICL9CM").REST AND J # 0 START IF MRTPREFIX = MODULEPREFIX C THEN FP_PROPERTIES = X'80' C ELSE FP_PROPERTIES = X'C0' S = REST FINISH SETNAME(S,0,3) IF IIN > 1530 THEN I = 3 AND -> WORKFILE FULL IINTAB(XREF) = IIN; ! STORE IIN IF FP_PROPERTIES&X'C0' = X'C0' START ! PREFIX OPTIONAL FIELD PR(PRP) = X'FF010000'!(J<<8)!((J+3)>>2) MOVE(J,ADDR(MRTPREFIX)+1,ADDR(PR(PRP+1))) ITOE(ADDR(PR(PRP+1)),J) PRP = PRP+1+(BYTEINTEGER(ADDR(PR(PRP))+3)) FINISH FP_ENTRYSIZE = PRP-ENTRYSTART FINISH FIXUP(ER_REFLOC>>24,3,IINTAB(LXREF),ER_REFLOC& C X'FFFFFF',0) FINISH ELSE START ! INTERNAL REFERENCE !! TO REDUCE THE NUMBER OF DIFFERENT TYPES OF FIXUPS !! RATHER THAN USE A PARTIAL DESCRIPTOR HERE THE !! DR HEAD IS FILLED IN EXPLICITLY AS A DESCRIPTOR- !! DESCRIPTOR AND A SINGLE WORD RELOCATION PREPARED !! FOR THE DR ADDRESS. !! INTEGER((ER_REFLOC&X'FFFFFF')+AA(GLA)_START) = C X'B1000000' FIXUP(ER_REFLOC>>24,0,2,(ER_REFLOC&X'FFFFFF')+4,EP_ C LOC&X'FFFFFF') FINISH LINK = ER_LINK+ATEMP XREF = XREF+1 REPEAT IF AA(CODE)_L > 0 THEN AREA MAP ENTRY(AA(CODE)_L,CODE, C MODULENAME."-C") !! !************************************************** ! TYPE 2 ENTRIES - PROCESS LIST 1 !! LINK = LISTHEAD(1)+ATEMP WHILE LINK > ATEMP THEN CYCLE EP == RECORD(LINK) COFFSET = INTEGER(AA((EP_LOC>>24)&X'7F')_START+(EP_LOC& C X'FFFFFF')+4) S = EP_IDEN SETNAME(S,EP_LOC,2) !! SETNAME SETS I=1 IF IT FINDS AN S# ENTRY FP_NAME USE = B'11000000' IF (OPSYS = EMAS AND I = 1) OR CONTROL&MAXKEYS # 0 C OR FP_NAME = MODULENAME THEN KEY(FP_NAME) ! NAME USE = EXTERNAL/ PERM / KEYED? PR(PRP) = 129<<24+COFFSET ! 129 - CODE ENTRY POINT PR(PRP+1) = X'82000002'; ! 130 - PLT IIN PR(PRP+2) = 131<<24+(EP_LOC&X'FFFFFF');! PLT DISPLACEMENT PR(PRP+3) = X'85000001'; ! 133 - TYPE 1 IIN PRP = PRP+4 FP_ENTRY SIZE = PRP-ENTRYSTART EXTRA NAME ENTRY(COFFSET,FP_NAME,2); ! JUST TO GET NAME REMEMBERED LINK = EP_LINK+ATEMP REPEAT !! !! !!****************************************** !! FINISHED PROPERTIES - TIDY UP !! PR(2) = PR(2)!(IIN<<16); ! LARGEST IIN IF MAXAREAIIN = 4 THEN LASTUIIN = 2 C ELSE LASTUIIN = MAXAREAIIN LARGESTTYPE1IIN = MAXAREAIIN; ! LAST IN NUMERIC ORDER ! NOT IN OUTPUT ORDER FP_NAME USE = FP_NAMEUSE!1; ! LAST ENTRY IN PROPERTIES !! !! !********************************************** ! RELOCATION 14 !! JUST RECORD A FIXUP FOR EACH RELOCATION ENTRY IN THE CHD. TABLES !! LINK = LISTHEAD(14)+ATEMP WHILE LINK > ATEMP CYCLE ; ! CHN THRU TABLES J = (INTEGER(LINK+4)-1)<<3 CYCLE I = 0,8,J; ! PROCESS INDIVIDUAL TABLE RRB == RECORD(LINK+I+8) FIXUP(RRB_AREALOC>>24,0,RRB_BASELOC>>24,RRB_AREALOC& C X'FFFFFF',RRB_BASELOC&X'FFFFFF') REPEAT LINK = INTEGER(LINK)+ATEMP REPEAT !! IF GLFP > MAXF OR STFP > MAXF C THEN I = 4 AND -> WORKFILEFULL !! !! !!************************************************ !! BLOCK OUT PROPERTIES RECORD !! EACH BLOCK MUST CONTAIN A WHOLE !! NUMBER OF ENTRIES - NO SPANNING! !! IF ADDR(PR(PRP)) > AWRK+B64K THEN I = 1 AND -> WORKFILEFULL LINK = 1 LASTLINK = 1 I = 0 IF CONTROL&3 # 0 THEN PRINTSTRING(" KEY IIN TYPE NAME ") CYCLE ; ! THROUGH PROPERTIES ENTRIES FP == RECORD(ADDR(PR(LINK))) IF CONTROL&3 > 0 START ; ! PRINT DETAILS OF PROPERTIES RECORD IF FP_NAME USE&2 > 0 THEN PRINTSYMBOL('*') ELSE SPACE WRITE(FP_IIN,5) SPACE PRINTSTRING(TYPS(FP_TYPE)." ".FP_NAME) IF FP_NAME USE&X'10' > 0 THEN PRINTSTRING(' CMN ') NEWLINE FINISH ITOE(ADDR(FP_NAME)+1,LENGTH(FP_NAME)) IF I+(FP_ENTRYSIZE<<2) > 4076 START I = OMFRECORD(BYTEDR!((LINK-LASTLINK)<<2),ADDR(PR( C LASTLINK))) LASTLINK = LINK I = 0 FINISH ELSE I = I+(FP_ENTRYSIZE<<2) EXIT IF FP_NAME USE&1 = 1 LINK = LINK+FP_ENTRYSIZE REPEAT !! PUT OUT LAST INCOMPLETE PROPERTIES RECORD IF I # 0 THEN I = OMFRECORD(BYTEDR!((LINK-LASTLINK+FP_ C ENTRYSIZE)<<2),ADDR(PR(LASTLINK))) !! !! !***************************************************** ! FIXUPS - AND OUTPUT RELOCATED AREAS I = OUTPUT RELOCATED AREA(GLFP,AA(GLA)_START,GLA,GLF,'GLA') RESULT = I IF I # 0 I = OUTPUT RELOCATED AREA(STFP,AA(STACK)_START,STACK,STF, C 'STACK') RESULT = I IF I # 0 !!*************************** !! OUTPUT THE COMMON BODY AREAS !! IF AA(COM)_L > 0 START LINK = LISTHEAD(4)+ATEMP WHILE LINK > ATEMP CYCLE DEP == RECORD(LINK) CBASE = AA(COM)_START+DEP_DISP IF DEP_A&15 = 6 THEN BLOCK OUT(DEP_A>>16,CBASE,DEP_ C L) IF DEP_A&15 = 6 OR DEP_A&15 > 9 C THEN AREA MAP ENTRY(DEP_L,DEP_A>>16,DEP_IDEN) LINK = DEP_LINK+ATEMP REPEAT FINISH !! !! !!************************************************** !! INITIALISATION RECORDS IN LIST 13 !! IF LISTHEAD(13) # 0 START INLIST13 = 1 !! !! FIND OUT WHICH RECORD CARRIES LAST INITIALISATION FOR EACH AREA. !! LINK = LISTHEAD(13)+ATEMP WHILE LINK > ATEMP CYCLE INIT == RECORD(LINK) IF INIT_A = 5 THEN INIT_A = 2 C AND INIT_DISP = INIT_DISP+AA(GLA)_L IINTAB(INIT_A) = LINK LINK = INTEGER(LINK)+ATEMP REPEAT !! !! PRODUCE INITIALISATION BODY RECORDS FOLLOWED BY MULTIPLE COPY RECORDS. !! LINK = LISTHEAD(13)+ATEMP WHILE LINK > ATEMP CYCLE INIT == RECORD(LINK) CBASE = INIT_ADDR+INIT_DISP IF INIT_LEN = 1 START IF LINK = IINTAB(INIT_A) AND INIT_REP = 1 C THEN NEXT = 3 ELSE NEXT = 0 OUTRECORD(INIT_A,ADDR(INIT_ADDR)+3,INIT_LEN,NEXT) FINISH ELSE BLOCKOUT(INIT_A,ATEMP+INIT_ADDR,INIT_ C LEN) !! IF INIT_REP > 1 START MCR_TYPE = 10; ! MULTIPLE COPY RECORD IF IINTAB(INIT_A) = LINK C THEN MCR_LASTENTRY = 3 ELSE MCR_LASTENTRY = 0 MCR_IIN = INIT_A MCR_INC = INIT_LEN; ! MAX 4096 MCR_LENCOPS = (INIT_LEN<<20)!(INIT_REP-1) MCR_DISP = INIT_DISP I = OMFRECORD(X'18000010',ADDR(MCR_TYPE)) FINISH !! LINK = INTEGER(LINK)+ATEMP REPEAT INLIST13 = 0 FINISH !!************************************* !! !! FURTHER BODIES SHARED/PURE BLOCKOUT(4,AA(SST)_START,AA(SST)_L) BLOCKOUT(1,AA(CODE)_START,AA(CODE)_L) !! !!################################ !! !! DIAGNOSTIC MAP RECORD - MODULE ENTRY !! !! !! ICL LANGUAGE CODES ARE - !! COBOL(RCO) = 'D' / FORTRAN(RCO) = 'G' !! ALGOL(RCO) = 'L' / UNDEFINED = 'X' !! PASCAL = 'P' !! !! EMAS LANGUAGE CODES !! 1 - IMP !! 2 - FORTE !! 3 - IMPS !! 4 - NASS !! 5 - ALGOL !! 6 - OPTIMISED IMP !! 7 - PASCAL !! !! ME == RECORD(ADDR(D(DP))) ME = 0 ME_TYPE = 16; ! MODULE ENTRY ME_LANGUAGE = LANG CODE MOVE(4,ADDR(VERSION)+1,ADDR(ME_VERSION)) MOVE(10,ADATE,ADDR(ME_D1)) MOVE(8,ATIME,ADDR(ME_T1)) ME_NAME = MODULE NAME ITOE(ADDR(ME_NAME)+1,LENGTH(ME_NAME)) J = DP+(32+LENGTH(ME_NAME)+3)>>2 D(J) = X'FF010003'; ! OPTIONAL ENTRY ERROR PROCEDURE NAME D(J+1) = X'C9C3D3F9'; ! ICL9 D(J+2) = X'C3C5D9D9'; ! CERR D(J+3) = X'D7D9D6C3'; ! PROC I = (LENGTH(SUBNAME)+3)//4 D(J+4) = X'FF020000'!I; !OPTIONAL ENTRY - SUBNAME MOVE(LENGTH(SUBNAME),ADDR(SUBNAME)+1,ADDR(D(J+5))) ME_ENTRYSIZE = J+5-DP+I ME_CHAIN = -1; ! ONLY ONE MODULE DP = ME_ENTRYSIZE+DP !! !! DO AREA CHAIN ENTRIES !! - ONE FOR EACH AREA ENTRY !! PRP = 1 ACES = X'20000000' CYCLE ; ! THROUGH THE PROPERTIES RECORD FP == RECORD(ADDR(PR(PRP))) IF FP_TYPE = 1 START ACE == RECORD(ADDR(D(DP))) ACE = 0 ACES = ACES+1 ACE_TYPE = 19 ACE_IIN = FP_IIN DP = DP+2 FINISH EXIT IF FP_NAME USE&1 = 1 PRP = PRP+FP_ENTRYSIZE REPEAT !! !! TERMINATOR ENTRY !! D(DP) = ACES; ! TYPE : COUNT OF CHAIN ENTRIES DP = DP+2 !! !! OUTPUT THE DIAGNOSTICS !! !! IF ADDR(D(DP)) > AWRK+B128K THEN I = 2 AND -> WORKFILEFULL LINK = 1 LASTLINK = 1 I = 0 CYCLE TYPE = BYTEINTEGER(ADDR(D(LINK))) IF 16 <= TYPE <= 18 THEN ENTRYSIZE = (D(LINK)&X'FFFF') C ELSE ENTRYSIZE = 2 IF (I+ENTRYSIZE<<2) > 4076 START I = OMFRECORD(BYTEDR!((LINK-LASTLINK)<<2),ADDR( C LASTLINK)) NDRECS = NDRECS+1 LASTLINK = LINK I = 0 FINISH ELSE I = I+(ENTRYSIZE<<2) IF TYPE = 17 THEN START AE == RECORD(ADDR(D(LINK))); ! AREA ENTRY IIN = ((AE_IIN1&15)<<8)!AE_IIN2 PDE(IIN)_RECORD = NDRECS J = (LINK<<2)-4 PDE(IIN)_DISP = J FINISH IF TYPE = 19 START ACE == RECORD(ADDR(D(LINK))) ACE_AREA CHAIN = ((NDRECS-PDE(ACE_IIN)_RECORD)<<12)! C PDE(ACE_IIN)_DISP FINISH IF TYPE = 32 THEN D(LINK+1) = NDRECS+1 AND EXIT LINK = LINK+ENTRYSIZE REPEAT IF I # 0 THEN I = OMFRECORD(BYTEDR!((LINK-LASTLINK+ C ENTRYSIZE)<<2),ADDR(D(LASTLINK))) !! !! !! !********************************************************** !********* SUBROUTINES ******************************* !*********************************************************** !! !************************************************** ! THIS ROUTINE TEMPORARILY STORES RELOCATION IMFORMATION IN TWO ! RECORD ARRAYS - ONE FOR THE GLA AND ONE FOR THE STACK. ! THE IMFORMATION IS DERIVED FROM THE LOAD DATA LISTS ! AND WILL BE SORTED AND THEN FIXED UP , ! BY THE INTEGERFN PLACE RELOCATION DATA. !! ROUTINE FIXUP(INTEGER AREACODE, TYPE, BASECODE, AREADISP, C BASEDISP) RECORDARRAYNAME F(FFM) INTEGERNAME FP IF AREACODE=2 THEN F==GLF AND FP==GLFP ELSEC F==STF AND FP==STFP IF BASECODE = 5 THEN BASECODE = 2 C AND BASEDISP = AA(GLA)_L+BASEDISP MOVE(16,ADDR(TYPE),ADDR(F(FP)_TYPE)) FP = FP+1 END !! !************************************************************** !! RELOCATION INFORMATION IS STORED MAINLY IN CHAINS LINKING !! THE TARGET WORDS. CHAIN HEADERS AND VALUES TOO LARGE TO !! BE ACCOMODATED WITHIN THE TARGET WORDS HAVE A RECORD TO !! THEMSELVES FOLLOWING THE BODY RECORD. !! RELOCATION HAS BEEN REDUCED TO ONLY TWO TYPES TO SIMPLIFY !! THE PROGRAMMING. !! COMPLETE DESCRIPTOR REQUESTS - USED FOR CODE XREFS. !! EXTENDED ADDRESS - SINGLE WORD RELOCATION ON !! EVERYTHING ELSE. !! !! SINCE THE COMPLETE DESCRIPTOR FIXUPS HAVE TWO WORDS IN WHICH TO !! CODE INFORMATION, THE FIELDS ARE LARGER AND THE CHAIN POINTER IS !! SUFFICIENTLY LARGE THAT THERE NEED ONLY EVER BE A SINGLE SUCH !! CHAIN IN ANY BODY RECORD. !! !! IN CONTRAST A NUMBER OF EXTENDED ADDRESS CHAINS MAY BE ACTIVE AT ANY !! TIME. - BEING INTERWOVEN. EACH IS CHARACTERISED BY A !! PARTICULAR MODIFIER PREFIX - (MODIFIER>>14) !! !! THE FIXUPS ARE SORTED IN ORDER OF TARGET WORDS WITHIN THE AREA BODY. !! THIS ENABLES A MINIMUM OF CHAINS TO BE USED, ALL OF WHICH ARE !! FORWARD. !! !! INTEGERFN OUTPUT RELOCATED AREA( C INTEGER HFP, BASE, AREAIIN, RECORDARRAYNAME F, C STRING (5) AREA) INTEGERARRAY LASTEA(0 : 16) INTEGER A, MOD, B, LASTFRP, NEXT, L, MODPREFIX, I, FRP, C LASTCDA, LASTEAA, INA, LF INTEGER TYPE, BASECODE, AREADISP, BASEDISP INTEGERARRAY FR(1 : 4096) ROUTINESPEC QKSORT(INTEGER A, B) OWNINTEGER GRECSIZE = 4076 RECORDSPEC F(FFM) !! ROUTINE SPHEX(INTEGER N) SPACE PHEX(N) END !! ROUTINE CLEAR INTEGER I CYCLE I = 0,1,16 LASTEA(I) = -1 REPEAT LASTCDA = -1 FRP = 2 END !! !! LF = (CONTROL>>1)&1; ! OUTPUT CONTROL RESULT = 0 IF HFP = 1; ! NO FIXUPS REQUIRED B = BASE QKSORT(1,HFP-1) CLEAR IF LF = 1 THEN START ; ! PRINT OUT HEADER NEWLINES(3) WRITE(HFP-1,1) PRINTSTRING(' RELOCATIONS TO THE '.AREA) PRINTSTRING(' BASE BDISP ADISP TFP MOD TARGET WORDS CHD ') FINISH FR(1) = X'09000000'!AREAIIN !! CYCLE I = 1,1,HFP-1; ! PROCESS RELOCATIONS MOVE(16,ADDR(F(I)),ADDR(TYPE)) !! PROCESS DATA INTO 4K CHUNKS UNTIL A FIXUP IS ENCOUNTERED !! - IE. NOT ALL BODY RECORDS WILL BE FOLLOWED BY FIXUP RECORDS. WHILE BASE+AREADISP >= B+4076 THEN CYCLE IF FRP > 2 THEN NEXT = 4 ELSE NEXT = 0 ! MARK NEXT RECORD FIXUPS OUTRECORD(AREAIIN,B,GRECSIZE,NEXT) IF LF = 1 THEN PRINTSTRING(' * ') ELSE SPACE IF FRP > 2 THEN OUTRECORD(0,ADDR(FR(1)),(FRP-1)<< C 2,0) CLEAR B = B+GRECSIZE GRECSIZE = 4076 REPEAT LASTFRP = FRP A = AREADISP+BASE; ! GET ADDRESS OF TARGET WORD INA = INTEGER(A); ! ORIGINAL CONTENTS TO BE RELOCATED MOD = BASEDISP+INA !! IF TYPE = 0 START ; ! EXTENDED ADDRESS !! - INCLUDES ADDRESS FXS , EXT=0 IF IMOD(INA)>>24 # 0 THEN I = -1 AND LF = 1 ! BAD CONTENTS MODPREFIX = MOD>>14 IF 0 <= MODPREFIX <= 16 C THEN LASTEAA = LASTEA(MODPREFIX) C AND LASTEA(MODPREFIX) = A ELSE LASTEAA = -1 IF IMOD(A-LASTEAA)//2 > 31 OR LASTEAA = -1 START !! NEED NEW CHAIN FR(FRP) = AREADISP>>2<<12+MODPREFIX<<24>>21 FRP = FRP+1 FINISH ELSE START !! LINK ON END OF OLD CHAIN INTEGER(LASTEAA) = INTEGER(LASTEAA)!((IMOD(A- C LASTEAA)>>2)<<26) IF LF = 1 THEN SPHEX(INTEGER(LASTEAA)) FINISH INTEGER(A) = MOD<<18>>6+BASECODE FINISH IF TYPE = 3 START ; ! COMPLETE DESCRIPTOR IF LASTCDA = -1 START ; ! FIRST SUCH - BEGIN CHAIN FR(FRP) = (AREADISP)>>2<<12+3 FRP = FRP+1 FINISH ELSE START ; ! ADD TO CHAIN INTEGER(LASTCDA) = (A-LASTCDA)>>2 IF LF = 1 THEN SPHEX(INTEGER(LASTCDA)) FINISH LASTCDA = A INTEGER(A+4) = BASECODE IF A = B+4072 THEN GRECSIZE = 4080; !ALLOW FOR DR ON BOUNDARY FINISH IF LF = 1 THEN START NEWLINE WRITE(BASECODE,3) SPHEX(BASEDISP) SPHEX(AREADISP) IF LASTFRP = FRP THEN SPACES(9) C ELSE SPHEX(FR(LASTFRP)) IF TYPE < 2 THEN SPHEX(MOD) ELSE SPACES(9) SPHEX(INTEGER(A)) IF TYPE < 2 THEN SPACES(10) C ELSE SPACE AND SPHEX(INTEGER(A+4)) RESULT = CORRUPT FIXUP IF I = -1 FINISH REPEAT ! BLOCKOUT REMAINDER OF AREA L = (BASE+AA(AREAIIN)_L)-B IF AREAIIN = GLA AND AA(UST)_START > ATEMP C THEN L = L+AA(UST)_L IF FRP > 2 THEN NEXT = 4 ELSE NEXT = 0 IF L <= 4076 START !! MARK LAST INITIALISATION RECORD FOR THIS AREA UNLESS AREAIIN = 2 AND AA(5)_START = ATEMP START IF FRP > 2 THEN FR(1) = FR(1)!(3<<16) ELSE NEXT = 3 FINISH I = L FINISH ELSE I = 4076 OUTRECORD(AREAIIN,B,I,NEXT); ! UP TO AND INCLUDEING LAST FIX !! LAST FIXUP RECORD IF ANY OUTRECORD(0,ADDR(FR(1)),(FRP-1)<<2,0) IF FRP > 2 IF L > 4076 THEN BLOCKOUT(AREAIIN,B+4076,L-4076) ! BLOCK OUT REMAINING AREA - FREE OF FIXUPS IF LF = 1 THEN NEWLINE RESULT = 0 !! !! !********************************************************* ! ROUTINE TO SORT FIXUP TABLE ROUTINE QKSORT(INTEGER A, B) INTEGER L, U, E RECORD EKEEP(FFM) RETURN IF A >= B L = A U = B E = F(U)_AREADISP EKEEP = F(U) -> FIND UP: L = L+1 -> FOUND IF L = U FIND: -> UP UNLESS F(L)_AREADISP > E F(U) = F(L) DOWN: U = U-1 -> FOUND IF L = U -> DOWN UNLESS F(U)_AREADISP < E F(L) = F(U) -> UP FOUND: F(U) = EKEEP QKSORT(A,L-1) QKSORT(U+1,B) END END ; ! OF OUTPUT RELOCATED AREA !! !!************************************************** !! WRITE OUT SINGLE RECORD !! ROUTINE OUTRECORD(INTEGER IIN, FROM, L, NEXT) INTEGER I, J !! !! BODY RECORD (DATA) X'FF0' + 4 BYTE RCW + 3 WORD HEADER !! UNLESS IIN = 0 START I = 12 ! CHECK FOR END OF LAST UNSHAREABLE AREA IF NEXT = 3 AND IIN = LASTUIIN THEN NEXT = 2 ! CHECK FOR VERY LAST INITIALISATION BODY RECORD IF (NEXT = 3 OR NEXT = 2) AND IIN = CODE C THEN NEXT = 1 IF IIN < 10 AND (AA(IIN)_START = ATEMP C OR (IIN = 2 AND AA(5)_START = ATEMP)) C AND INLIST13 = 0 THEN NEXT = NEXT&X'FFFFFFFC' IF INLIST13 = 1 START ; ! REP INITS. ENDED BY MULT REC? IF IINTAB(IIN) # LINK OR INIT_REP > 1 THEN NEXT = 0 FINISH BHEAD_TYPEANDFLAG = X'800'!NEXT BHEAD_IIN = IIN IF IIN > 7 THEN BHEAD_DISP = FROM-CBASE C ELSE BHEAD_DISP = FROM-AA(IIN)_START IF INLIST13 = 1 THEN BHEAD_DISP = INIT_DISP BHEAD_LEN = L FINISH ELSE I = 0 MOVE(L,FROM,ADB+I) I = OMFRECORD(X'18000000'!(L+I),ADB) END !! !! !!****************************************************** !! BLOCK THE AREAS OUT TO THE SQFILE IN K CHUNKS !! ROUTINE BLOCK OUT(INTEGER IIN, FROM, L) INTEGER TO !! TO = FROM+L WHILE TO-FROM > 4080 CYCLE OUTRECORD(IIN,FROM,4080,0); ! LEAVE 3 WRDS FOR HEADER + 1 ALIGN FROM = FROM+4080 REPEAT IF TO-FROM > 0 THEN OUTRECORD(IIN,FROM,TO-FROM,3) END ; ! OF BLOCK OUT !! !!***************************************************** !! THE LIST OF !! EXTERNAL DATA REFERENCES IS SEARCHED . IF AN INSTANCE OF !! THE GIVEN NAME IS FOUND PRIOR IN THE LIST THEN A POSITIVE !! INDEX IS RETURNED TO IT AND THE DXREF WILL BE MAPPED ONTO THIS FIRST !! INSTANCE. IF THE NAME IS FOUND TO BE THE FIRST INSTANCE !! THEN A NEGATIVE RESULT IS RETURNED. !! MAPPING TOGETHER COMMON DXREFS LIKE THIS REQUIRES YOU TO KNOW THE !! MAXIMUM LENGTH CLAIMED BY ANY OF THE MULTIPLE DXREFS TO A !! GIVEN AREA. SO HAVING FOUND THE FIRST INSTANCE OF !! A COMMON THE REST OF THE LIST IS STILL SEARCHED AND THE MAX. !! LENGTH RECORDED IN LCL.(LARGEST COMMON LENGTH) !! INTEGERFN FINDDXREF(STRING (31) IDEN) INTEGER XLINK, KEEPI RECORDNAME DTREF(DEXTRFM) XLINK = LISTHEAD(9)+ATEMP LCL = 0 CYCLE DTREF == RECORD(XLINK) IF XLINK = LINK THEN LCL = DTREF_L AND KEEPI = -1 IF DTREF_IDEN = IDEN START IF LCL = 0 THEN RESULT = INTEGER(DTREF_REFARRAY)>>16 IF DTREF_L > LCL THEN LCL = DTREF_L FINISH XLINK = DTREF_LINK+ATEMP IF XLINK = ATEMP THEN RESULT = KEEPI REPEAT END !! !! !!************************************************************ !! !! SUBROUTINES GENERATING DIAGNOSTIC RECORDS !! !! !!******************************** !! EXTRA NAME ENTRIES !! ROUTINE EXTRA NAME ENTRY(INTEGER OFFSET, C STRING (32) S, INTEGER L) INTEGER I !! XNE == RECORD(ADDR(D(DP))) XNE = 0 XNE_TYPE = 18 XNE_REASONS = B'10000000'; ! COMPILED NAME XNE_OFFSET = OFFSET ! NAME USE = 0 IE. CORRESPONDING TYPE 2 PROPERTIES ENTRY XNE_NAME = S I = LENGTH(S) ITOE(ADDR(XNE_NAME)+1,I) XNE_ESIZE = (23+I)>>2; ! ENTRYSIZE IN WORDS XNE_CHAIN = -1; ! SCAN FORWARD FOR MODULE MAP ENTRY DP = DP+XNE_ESIZE D(DP-1) = (1<<24)!L; ! SIZE OF OBJECT END ; ! OF EXTRA NAME ENTRY !! !************************************ !! AREA MAP ENTRY !! ROUTINE AREA MAP ENTRY(INTEGER LEN, IIN, STRING (32) S) !! INTEGER IINS, I !! AE == RECORD(ADDR(D(DP))) AE = 0 AE_TYPE = 17 IF IIN = 1 THEN AE_PROPERTIES = 1<<7 !! IF THIS CODE AREA ACCESSES STATIC STACK SET BIT IF IIN = 1 AND AA(STACK)_L > 0 C THEN AE_PROPERTIES = X'88' IF CONTROL&LIBRARY # 0 THEN AE_PROPERTIES = AE_ C PROPERTIES!X'20' IINS = IIN<<12+IIN MOVE(3,ADDR(LEN)+1,ADDR(AE_SIZE0)) MOVE(3,ADDR(IINS)+1,ADDR(AE_IIN0)) IF IIN > 9 THEN AE_NAMEUSE = 16;! COMMON AE_NAME = S I = LENGTH(S) ITOE(ADDR(AE_NAME)+1,I) AE_ESIZE = (23+I)>>2 DP = DP+AE_ESIZE AE_AREA CHAIN = -1; ! ONLY AREA IN THIS AREA END ; ! OF AREA MAP ENTRY !! !! !!************************************************************** !! ROUTINE TO PROCESS NAMES !! ROUTINE SETNAME(STRINGNAME S, INTEGER A, TYPE) STRING (32) REST INTEGER L, MAXCHS !! IF S -> ("S#").REST THEN S = ICLPREFIX."Z".REST IF S -> ("ICL9CE").REST THEN I = 1 ELSE I = 0 IF A>>31 = 1 AND OPSYS # EMAS THEN S = MODULENAME L = LENGTH(S) IF S = MODULENAME THEN MAXCHS = 28 ELSE MAXCHS = 30 IF L > MAXCHS THEN SSMESSA(TOO MANY CHS,S) C AND LENGTH(S) = MAXCHS ENTRYSTART = PRP FP == RECORD(ADDR(PR(PRP))) FP = 0 FP_NAME = S PRP = PRP+2+((L+3)>>2) IIN = IIN+1 FP_IIN = IIN FP_TYPE = TYPE IF TYPE = 1 AND IIN > MAXAREAIIN THEN MAXAREAIIN = IIN END !! !!******************************************************************* !! - KEYS ARE STORED TWICE !! - ONCE EXTERNALLY IN LIBRARY FILE DIRECTORY !! - ONCE INTERNALLY AS BIT IN NAME USE IN PROPERTIES REC. !! ROUTINE KEY(STRING (32) S) FP_NAME USE = FP_NAME USE!2 RETURN IF S = MODULENAME; ! MODULENAME = MAJOR SYNONYM I = SET ALIAS(X'18000000'!LENGTH(S),ADDR(S)+1) END !! !! RESULT = 0 CONSTSTRING (1) ARRAY FA(1 : 4) = C "P","D","I","F" WORKFILEFULL: SSMESSA(OMF WORKFILE FULL,FA(I)) RESULT = 1 END ; ! OF OMF ENDOFFILE