!* CHANGED FROM OMF13S TO OMF14S - 12/2/81 !* !* NAMES BEGINNING "ICL9HE" AND "ICL9HD" !* ARE GIVEN THE MRT PREFIX LIKE "ICL9CM" !* COMMON RECEIVES PERMANENT STRENGTH. !* CHANGES FROM OMF11S TO OMF13S - ALAN - 16/10/80 !* !* STOP FIXINF 'CTM' REFERENCES !* FOR COMMON REFERENCES OF OVER TWO MEGABYTES PLACE !* A DATA ENTRY EVERY 2 MB. TO ACT AS A MARKER FOR !* RELOCATION. !* !* CHANGES FROM OMF9S TO OMF11S - ALAN - 21/4/80 !* !* REMOVE SPURIOUS MONITORING ABOUT LAST AREA LINE 230-235 !* COMMON ENTRIES LOSE STRENGTH ( ISSUED AS REP TO OMF9) !* CORRECTION FOR DYNAMIC REFERENCES - LINE 501 !* TRIVIAL CHANGE EP_LOC->LOC TO SAVE CODE IN PROCESS LIST 1. !* REMOVE REDUNDANT START/FINISH - LINE 643 + 652 !* WRITE AREA IIN ON CORRUPT FIXUP - LINE 955 !* MAX CHS IN NAMES, 30 FOR MODULE AND 32 FOR OTHERS. !* - NOTE AREA SUFFIX NEEDS 2 AND PREFIXES MAY EXPAND LENGTH. !* IF ENTRYNAME=MODULENAME THEN ENTRY IS 32 !* ITOE IN KEY ROUTINE ( ISSUED AS REP TO OMF9) !* !!****************************************** !! * !! 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 - OUTPUT TRACE ON EMAS * !! BIT 9 - 24 FREE * !! BIT 25 - EXCLUSIVE * !! 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, AF) 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 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 C 'MODULE','AREA ','ENTRY ','XREF ' !! CONSTINTEGER B64K = X'10000' CONSTINTEGER B70K = X'11800' CONSTINTEGER B128K = X'20000' CONSTINTEGER BYTEDR = X'18000000' CONSTINTEGER TWOMB = X'200000' CONSTINTEGER MASK = X'1FFFFF' !! !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! 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) RECORDFORMAT BHEADFM(HALFINTEGER TYPEANDFLAG,IIN, C INTEGER DISP,LEN) RECORDNAME BHEAD(BHEADFM) RECORDFORMAT AREAFM(INTEGER START, L, PROP, FP, AF) !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! VARIABLES !!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! STRING (40) S STRING (32) REST, DS STRING (32) FMODULENAME ;! FULL 32 CH MODULE NAME STRING (32) MODULEPREFIX; ! MODULE ENTRY PREFIX INTEGER LASTAREA, LASTUAREA 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 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 INTEGER MAXF; ! MAXIMUM FIXUPS PER AREA INTEGER NAREAS; ! NUMBER OF AREAS IN THE ERCC OBJECT RECORDARRAY AREA(1 : 9)(AREAFM) INTEGER EXCL; ! SEPERATE AREAS EXCL=1 INTEGER LIST INTEGER AD,CDISP,CL,CSL !! !! !################################ !# # !# BEGIN HERE # !# # !################################ ! INITIALISATION OF VARIABLES INLIST13 = 0 DP = 1 PRP = 1 LASTUAREA = 0 LASTAREA = 0 LASTBLOCKLEN = 0 CBASE = 0 NDRECS = 0 ADB = ADDR(B(0)) BHEAD == RECORD(ADB) EXCL = (CONTROL&32)>>6 !! !! !! 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 ATTRIBUTES TABLE NAREAS = INTEGER(J) RESULT = CORRUPT OBJECT FILE UNLESS 1 < NAREAS < 10 L = 0 CYCLE I = NAREAS,-1,1 AREA(I) = 0 MOVE(12,J+4+((I-1)*12),ADDR(AREA(I))) ! SET START ADDRESSES ABSOLUTE AREA(I)_START = AREA(I)_START+ATEMP IF I = 2 THEN AREA(I)_PROP = 1; ! TEMPORARY IF I = 7 AND AREA(I)_START > ATEMP THEN AREA(7)_PROP = 1 ! TEMP IF 5 # I # 6 AND AREA(I)_L > 0 C THEN LASTUAREA = LASTAREA AND LASTAREA = I IF AREA(I)_PROP&1 = 1 THEN L = L+1; ! COUNT UNSHAREABLE AREAS REPEAT !! !!######################################### !! SS#WRK IS ALLOCATED THUS !! !! 0K -> 64K - PROPERTIES RECORD / THEN PDE ARRAY !! 64K -> 70K - XREF IIN TABLE !! 70K -> 128K - DIAGNOSTIC RECORD !! 128K -> 512K - FIXUPS !! !! !! !! MAP WORK SPACE ONTO SS#WRK !! PR == ARRAY(AWRK,IFM) D == ARRAY(AWRK+B70K,IFM) PDE == ARRAY(AWRK,PDEAFM) IINTAB == ARRAY(AWRK+B64K,IFM) J = AWRK+B128K L = (384//L)*1024 CYCLE I = 1,1,NAREAS IF AREA(I)_PROP&1 = 1 START AREA(I)_AF = J; ! ADDRESS OF FIXUP SPACE FOR THIS AREA J = J+L AREA(I)_FP = 1; ! ARRAY INDEX TO START FINISH REPEAT MAXF = L//16 !! !! !########################################## !***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 FMODULENAME=MODULENAME ;! REMEMBER FULL 32 CH MODULE NAME IF LENGTH(MODULENAME)>30 THEN SSMESSA(TOO MANY CHS, C MODULENAME) AND LENGTH(MODULENAME)=30 S = MODULENAME.'-C'; ! USE SUFFIX TO DENOTE AREA L = LENGTH(S) SUFFIX == BYTEINTEGER(ADDR(S)+L) !! !! !************************************************ ! TYPE 1 ENTRY FOR CODE !! IF AREA(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) = AREA(CODE)_L; ! 0 - AREA SIZE ! SET AREA PROPERTIES 2 IF REQD TO SHOW MODE OF USE AND EXCLUSIVE IF CONTROL&X'3000020' # 0 C THEN PR(PRP) = X'3000000'!((CONTROL&X'03000000')>>6)! C EXCL AND PRP = PRP+1 FP_ENTRY SIZE = PRP-ENTRY START FINISH !! !************************************************* ! TYPE 1 ENTRY FOR GLA - INCORPORATING UNSHARED SYMBOL TABLES. !! GLASIZE = AREA(GLA)_L+AREA(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 CONTROL&X'C000020' # 0 C THEN PR(PRP) = X'3000000'!((CONTROL&X'0C000000')>>8)! C EXCL AND PRP = PRP+1 FP_ENTRY SIZE = PRP-ENTRYSTART FINISH !! !! !!***********************************************************: !! !! TYPE 1 ENTRY FOR CODE SYMBOL TABLES (SHARED TABLES) !! IF AREA(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) = AREA(SST)_L; ! 0 - AREA SIZE IF CONTROL&X'30000020' # 0 C THEN PR(PRP) = X'3000000'!((CONTROL&X'30000000')>>10)! C EXCL AND PRP = PRP+1 AREA MAP ENTRY(AREA(SST)_L,SST,S) FP_ENTRYSIZE = PRP-ENTRYSTART FINISH !! !******************************************************** ! TYPE 1 ENTRY FOR STACK AREA !! IF AREA(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) = AREA(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(AREA(STACK)_L,STACK,S) FINISH !! MAXAREAIIN = FP_IIN; ! BIGGEST TYPE 1 IIN SO FAR IIN = 9 SUFFIX = 'G' IF AREA(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/PERMANENT/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 = AREA(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 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 ! CAN ONLY HANDLE AREAS OVER 2MB. IN RELOCATION ! BY INSERTING DATA ENTRIES AS MARKERS EVERY 2MB. UNLESS DTREF_REFARRAY>>31=0 OR LCL<=TWOMB START CDISP = TWOMB ;! CURRENT DISPLACEMENT CL = LCL - TWOMB ;! CURRENT LENGTH WHILE CL>0 THEN CYCLE AD = ADDR(PR(PRP)) INTEGER(AD)=X'02000005' IIN=IIN+1 INTEGER(AD+4)=IIN<<16 IF CL<TWOMB THEN CSL=CL&MASK ELSEC CSL=TWOMB INTEGER(AD+8)= X'80000000'!CSL INTEGER(AD+12)= X'81000000'!CDISP INTEGER(AD+16)=X'85000000'!I PRP=PRP+5 CDISP=CDISP+TWOMB CL=CL-TWOMB REPEAT FINISH 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'S 7 AND 8. !! XREF = 1 CYCLE LIST = 7,1,8 LINK = LISTHEAD(LIST)+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(LIST)+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 -> SKIP IF S -> ('ICLCTM').REST C OR S -> ('CTM').REST THEN S = REST SKIP: SETNAME(S,0,3) IF S = REST THEN FP_PROPERTIES = X'40' IF S -> ('ICL9CE').REST C AND CEPREFIX # "" THEN FP_PROPERTIES = X'80' J = LENGTH(MRTPREFIX) IF (S -> ("ICL9CM").REST OR S->("ICL9HD").REST C OR S->("ICL9HE").REST ) AND J # 0 START IF MRTPREFIX = MODULEPREFIX C THEN FP_PROPERTIES = X'80' C ELSE FP_PROPERTIES = X'C0' FINISH 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 ! DELAY FIXUP IF DYNAMIC REFERENCE IF LIST = 8 THEN FP_PROPERTIES = FP_ C PROPERTIES!X'10' 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')+AREA(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 REPEAT IF AREA(CODE)_L > 0 THEN AREA MAP ENTRY(AREA(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(AREA((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 IF LANGCODE=X'C7' AND EP_LOC>>31=0 THEN FP_NAMEUSE=X'80' ELSEC FP_NAME USE = B'11000000' IF (OPSYS = EMAS AND I = 1) OR CONTROL&MAXKEYS # 0 C OR FP_NAME = FMODULENAME 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 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 !! CYCLE I = 1,1,NAREAS IF AREA(I)_FP > MAXF THEN I = 4 AND -> WORKFILEFULL REPEAT !! !! !!************************************************ !! 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 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))) !! !! !***************************************************** !! OUTPUT THE COMMON BODY AREAS !! LINK = LISTHEAD(4)+ATEMP WHILE LINK > ATEMP CYCLE DEP == RECORD(LINK) CBASE = AREA(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 !! !! !!************************************************** !! INITIALISATION RECORDS IN LIST 13 !! EITHER AN AREA IS WHOLLY INITIALISED FROM LIST 13 ENTRIES !! OR WHOLLY INITIALISED BY AREAS, NBUT NO MIXTURE OF THE TEO IS !! ACCEPTED. !! !! 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+AREA(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 ! GLA NEVER ENDS WITH MULT. INIT - ALWAYS AREA 2 IF IINTAB(INIT_A) = LINK AND INIT_A#GLA 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 !!************************************* !! AREA(GLA)_L = GLASIZE UNLESS AREA(UST)_START=ATEMP; ! INCLUDE UST NOW CYCLE I = NAREAS,-1,1 -> NXT IF 5 <= I <= 6 IF AREA(I)_FP > 1 THEN J = OUTPUT RELOCATED AREA(AREA( C I)_FP,AREA(I)_START,I,AREA(I)_AF) C ELSE BLOCKOUT(I,AREA(I)_START,AREA(I)_L) AND J = 0 RESULT = J IF J # 0 NXT: REPEAT !! !!################################ !! !! 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 = FMODULE 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(D( 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 ! RECORD ARRAYS - ! THE IMFORMATION IS DERIVED FROM THE LOAD DATA LISTS ! AND WILL BE SORTED AND THEN FIXED UP , ! BY THE INTEGERFN OUTPUT RELOCATED AREA. !! ROUTINE FIXUP(INTEGER AREACODE, TYPE, BASECODE, AREADISP, C BASEDISP) RECORDARRAYNAME F(FFM) F == ARRAY(AREA(AREACODE)_AF,FAFM) IF AREACODE = UST THEN AREACODE = GLA C AND AREADISP = AREADISP+AREA(GLA)_L IF BASECODE = UST THEN BASECODE = GLA C AND BASEDISP = AREA(GLA)_L+BASEDISP MOVE(16,ADDR(TYPE),ADDR(F(AREA(AREACODE)_FP)_TYPE)) AREA(AREACODE)_FP = AREA(AREACODE)_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, AF) INTEGERARRAY LASTEA(0 : 16) INTEGER A, MOD, B, LASTFRP, NEXT, L, MODPREFIX, I, FRP, C LASTCDA, LASTEAREA, INA, LF INTEGER TYPE, BASECODE, AREADISP, BASEDISP INTEGERARRAY FR(1 : 4096) ROUTINESPEC QKSORT(INTEGER A, B) OWNINTEGER GRECSIZE = 4076 RECORDARRAYNAME 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 !! !! F == ARRAY(AF,FAFM) LF = (CONTROL>>1)&1; ! OUTPUT CONTROL 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') WRITE(AREAIIN,1) 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(-AREAIIN,ADDR(FR(1)), C (FRP-1)<<2,(FR(1)&X'FF0000')>>16) 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 MOD>0 START ;! IF >2MB ADD TO IIN FOR COMMON MARKERS BASECODE=BASECODE+(MOD>>21) MOD=MOD<<11>>11 FINISH !! 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 LASTEAREA = LASTEA(MODPREFIX) C AND LASTEA(MODPREFIX) = A ELSE LASTEAREA = -1 IF IMOD(A-LASTEAREA)//2 > 31 OR LASTEAREA = -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(LASTEAREA) = INTEGER(LASTEAREA)!((IMOD C (A-LASTEAREA)>>2)<<26) IF LF = 1 THEN SPHEX(INTEGER(LASTEAREA)) 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)=0 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)) FINISH WRITE(AREAIIN,1) AND RESULT = CORRUPT FIXUP IF I = -1 REPEAT ! BLOCKOUT REMAINDER OF AREA L = (BASE+AREA(AREAIIN)_L)-B IF FRP > 2 THEN NEXT = 4 ELSE NEXT = 0 IF L <= 4076 START !! MARK LAST INITIALISATION RECORD FOR THIS AREA IF FRP > 2 THEN FR(1) = FR(1)!(3<<16) ELSE NEXT = 3 I = L FINISH ELSE I = 4076 OUTRECORD(AREAIIN,B,I,NEXT); ! UP TO AND INCLUDEING LAST FIX !! LAST FIXUP RECORD IF ANY OUTRECORD(-AREAIIN,ADDR(FR(1)),(FRP-1)<<2,(FR(1)& C X'FF0000')>>16) 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, LIIN !! !! BODY RECORD (DATA) X'FF0' + 4 BYTE RCW + 3 WORD HEADER !! ! CHECK FOR VERY LAST RECORD LIIN = IMOD(IIN) IF NEXT = 3 AND LIIN = LASTAREA THEN NEXT = 1 IF INLIST13 = 1 START ; ! REP INITS. ENDED BY MULT REC? IF IINTAB(LIIN) # LINK OR INIT_REP > 1 THEN NEXT = 0 FINISH ELSE START IF NEXT = 3 AND LIIN = LASTUAREA C AND LASTAREA = CODE THEN NEXT = 2 FINISH UNLESS IIN < 0 START I = 12 BHEAD_TYPEANDFLAG = X'800'!NEXT BHEAD_IIN = IIN IF IIN > 7 THEN BHEAD_DISP = FROM-CBASE C ELSE BHEAD_DISP = FROM-AREA(IIN)_START IF INLIST13 = 1 THEN BHEAD_DISP = INIT_DISP BHEAD_LEN = L FINISH ELSE START I = 0 INTEGER(FROM) = (INTEGER(FROM)&X'FF00FFFF')!(NEXT<<16) FINISH 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 AREA(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 !! 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 = FMODULENAME L = LENGTH(S) IF L > 32 THEN SSMESSA(TOO MANY CHS,S) C AND LENGTH(S) = 32 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 = FMODULENAME; ! MODULENAME = MAJOR SYNONYM ITOE(ADDR(S)+1,32) I = SET ALIAS(X'18000000'!LENGTH(S),ADDR(S)+1) END !! !! RESULT = 0 CONSTSTRING (1) ARRAY FA(1 : 4) = C C "P","D","I","F" WORKFILEFULL: SSMESSA(OMF WORKFILE FULL,FA(I)) RESULT = 1 END ; ! OF OMF ENDOFFILE