%CONTROL X'0FFFFFFF' !!************************************************************* !! !! OMFOUT !! !! EDINBURGH'S IMP MODULE OMF8 !! ADAPTED FOR USE IN BSV35/KSV17 PASCAL SYSTEM (PASCAL 20) !! !! T.MOORE MARCH '80 !! !!************************************************************* !! !!****************************************** !! * !! 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) %EXTERNALINTEGERFNSPEC ICL9HNCREATEALIAS ( %C %INTEGER NAMEDRO,NAMEDR1,DUMDRO,DUMDR1) %EXTERNALINTEGERFNSPEC ICL9HNOUTPUTRECORD(%INTEGER BUFFERDRO,BUFFERDR1) !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! INTERNAL ROUTINES !!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! %ROUTINESPEC MOVE (%INTEGER LENGTH,FROM,TO) %ROUTINESPEC PHEX (%INTEGER N) %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) %INTEGERFNSPEC OMFRECORD (%INTEGER BUFFDRO,BUFFDR1) %ROUTINESPEC EXITOMFOUT (%INTEGER RESULTVALUE) !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! 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 OMF FILE WRITE FAILURE = 1000000 %CONSTINTEGER OMF CREATEALIAS FAILURE = 1000001 !! %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 %INTEGER LNB OF OMFOUT !! !! !################################ !# # !# BEGIN HERE # !# # !################################ ! INITIALISATION OF VARIABLES *STLN_LNB OF OMFOUT 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 !! !************************************************* ! 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'D3D7D7D4'; ! LPPM D(J+3) = X'D7D9D6C3'; ! PROC ME_ENTRYSIZE = J+4-DP 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 ******************************* !*********************************************************** !! !!*********** !! MOVE !! %ROUTINE MOVE (%INTEGER LENGTH,FROM,TO) %INTEGER I %RETURNIF LENGTH <= 0 I = X'18000000'!LENGTH *LSS_FROM *LUH_I *LDTB_I *LDA_TO *MV_%L=%DR %END !! !!*********** !! PHEX !! %CONSTINTEGERARRAY HX(0 : 15) = %C '0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F' %ROUTINE PHEX (%INTEGER N) %INTEGER I,J,H H = ADDR(N) %CYCLE I = 0,1,3 J = BYTEINTEGER(I+H) PRINTSYMBOL(HX(J>>4)) PRINTSYMBOL(HX(J&15)) %REPEAT %END !! !************************************************** ! 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 %AND MAXAREAIIN>=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 %C 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) %STRING (32) SEBCDIC FP_NAME USE = FP_NAME USE!2 %RETURN %IF S = MODULENAME; ! MODULENAME = MAJOR SYNONYM SEBCDIC = S ITOE (ADDR(SEBCDIC)+1, LENGTH(SEBCDIC)) I = ICL9HNCREATEALIAS (X'18000000'!LENGTH(SEBCDIC), %C ADDR(SEBCDIC)+1, 0, 0) %IF I>0 %THEN EXITOMFOUT(OMF CREATEALIAS FAILURE) %END !! !! !!************************************** !! PROCEDURE TO WRITE OMF RECORD !! %INTEGERFN OMFRECORD (%INTEGER BUFFDRO,BUFFDR1) %INTEGER RC RC = ICL9HNOUTPUTRECORD(BUFFDRO,BUFFDR1) EXIT OMFOUT(OMF FILE WRITE FAILURE) %IF RC > 0 %RESULT=0 %END !! !!***************************************** !! PROCEDURE TO FORCE EXIT FROM OMFOUT !! %ROUTINE EXIT OMFOUT (%INTEGER RESULT VALUE) *LSS_RESULT VALUE *LLN_LNB OF OMFOUT *EXIT_-64 %END %RESULT = 0 WORKFILEFULL: %RESULT = 1 %END; ! OF OMF %ENDOFFILE