!* ALTERED TO COMF27A - 17/08/81 - SET LISTHEAD(0) TO 15 IF DIAGNOSTIC !* RECORDS PRESENT, AND CORRECT OUTPUT FILE SIZE FOR LENGTH OF TERMINAL !* ENTRY !* MODIFIED 12/1/81 - USE @ FOR GENERATION !* ALTERED TO COMF27 - 16/12/80 - ACCEPT MODULE ENTRY IN ANY RECORD OF DIAGNOSTICS !* AND TO REDUCE OBJECT FILE SIZE UNTIL IT FITS !* ALTERED 12/12/80 - REMOVE GLA HEADER AGAIN. %AND COREECT IO !* ALTERED TO COMF 26 BY ALAN 24/10/80 !* SET NEW LIST FROM LDATA 6 TO REMEMBER GENERATION AND IO AREAS FOR ENGINEERS !* SET STANDARD GLA HEADER FOR DAVE STONE TO GET PROPER DIAGNOSTICS !* !********************************************************* !* !* I.C.L. OBJECT MODULE FORMAT CONVERTER !* !********************************************************** !! !! ROUTINESPEC DIAGPRINT(INTEGER RECADDR, RECLEN) EXTERNALROUTINE COMF(STRING (63) FILE) !! SYSTEMROUTINESPEC LPUT(INTEGER A, B, C, D) SYSTEMROUTINESPEC MOVE(INTEGER L, FROM, TO) SYSTEMROUTINESPEC PHEX(INTEGER N) SYSTEMROUTINESPEC FILL(INTEGER L, A, FILLER) SYSTEMROUTINESPEC CHANGE FILE SIZE(STRING (31) S, C INTEGER NEW SIZE, INTEGERNAME FLAG) SYSTEMROUTINESPEC CONNECT(STRING (15) S, C INTEGER ACCESS, MAXBYTES, PROT, RECORDNAME R, C INTEGERNAME F) RECORDFORMAT INRFM(INTEGER CONAD, A, B, C STRING (6) S, INTEGER C, D, E, F) RECORD R(INRFM) SYSTEMROUTINESPEC SSMESS(INTEGER N) SYSTEMROUTINESPEC OUTFILE(STRING (15) S, C INTEGER L, ML, P, INTEGERNAME CONAD, FLAG) SYSTEMROUTINESPEC ITOE(INTEGER AD, L) SYSTEMROUTINESPEC ETOI(INTEGER A, L) EXTERNALROUTINESPEC OPENOMF(STRING (32) S, INTEGER CH, MODE) EXTERNALROUTINESPEC READOMF(INTEGER CH, FROM, INTEGERNAME L) EXTERNALROUTINESPEC DEFINE(STRING (63) S) SYSTEMINTEGERMAPSPEC COMREG(INTEGER N) EXTERNALROUTINESPEC PROMPT(STRING (15) S) !! CONSTINTEGER TEMPORARY = X'40000000'; ! FILE PROPERTY CONSTINTEGER NORT = X'4E4F5254'; ! UNSATISFIED REFERENCE MARKER CONSTINTEGER ONESEGMENT = X'40000'; ! ONE NR SEGMENT CONSTINTEGER COMMONMASK = X'10'; ! ENTRY_NAME USE CONSTBYTEINTEGER SCOPE = X'80' ! LPUT ENTRIES CONSTINTEGER INITIALISE = 0, COMMONREF = 10, CODEENTRY = 11, C DATAENTRY = 14, DATAREF = 15, FIXUP = 19, ONEWORDREF = 22 CONSTSTRING (6) ARRAY EAREAS(1:7)= "CODE ","GLA ", C "PLT ","UST ","SST ","COMMON","STACK " !! INTEGER PRPSTART, PRP, FLAG, L, MAXIIN, MAXLEN, LEN, IIN, I, C MAXT1IIN, BUFFAD, FBUFFAD, C26, EMASAREA, OBJECT LIMIT INTEGER J, FIRST, MEP, K INTEGER OBJSIZE INTEGER AP2,NIOAREAS,EXTRASIZE,DIAGEND,EXTRASTART RECORDFORMAT IOFM(INTEGER LINK,TYPE,AREA,DISP,LEN) RECORDARRAY IOAREAS(1:20)(IOFM) INTEGER GENERATION INTEGER GIIN, BLEN, BDISP STRING (1) MODE STRING (64) REST, INFILE, OUTPUT, OUTLIST STRING (32) CMAINENTRY; ! COBOL NOMINATED MAIN ENTRY STRING (32) SE, SROOT OWNINTEGER CODE, GLA, DUM3, SST, DUM5, COMMON, STACK, TOTAL OWNSTRING (6) BLCM = "F#BLCM" STRING (32) MODULE NAME !! RECORDFORMAT ENTRYFM( C BYTEINTEGER TYPE, PROPS, HALFINTEGER SIZE,IIN, C BYTEINTEGER NAMEUSE, STRING (31) IDEN) INTEGERARRAY AREAPROPS(1 : 7) BYTEINTEGERARRAY BB(0 : 4095); ! RECORD BUFFER FOR BODY RECORDS BYTEINTEGERARRAY F(0 : 4095); ! RECORD BUFFER FOR FIXUP RECORDS BYTEINTEGERARRAYFORMAT BFM(0 : X'40000') BYTEINTEGERARRAYNAME B RECORDFORMAT BHEADFM( C BYTEINTEGER TYPE, LASTENTRY, HALFINTEGER IIN, C INTEGER DISP, LEN) RECORDNAME ENTRY(ENTRYFM) RECORD BHEAD(BHEADFM) !! INTEGERFNSPEC GET VAR(INTEGER N) ROUTINESPEC WARNING(INTEGER N) ROUTINESPEC ERROR(INTEGER N, M) !! ROUTINE MYLPUT(INTEGER A, B, C, D) IF COMREG(26)&256 # 0 THEN START PRINTSTRING(" LPUT( ") WRITE(A,1) SPACE PHEX(B) SPACE PHEX(C) SPACE PHEX(D) IF A = 22 THEN SPACE AND PRINTSTRING(STRING(D)) PRINTSTRING(") ") FINISH LPUT(A,B,C,D) END !! !! !!********************************** !! !! DEAL WITH PROPERTIES RECORD !! !!************************************ !! !************ !*BEGIN HERE* !************ C26 = COMREG(26) NIOAREAS = 0 EXTRASIZE=0 PRINTSTRING(" OMF CONVERTER V0.27 ") IF FILE ->FILE.("@") START PROMPT("GENERATION:") READ(GENERATION) EXTRASIZE=12 FINISH ELSE GENERATION = -1 UNLESS FILE -> INFILE.(",").REST THEN START PRINTSTRING(" FORMAT IS ' COMF(INPUT OMF FILE,OUTPUT EMAS OBJECT FILE) '. ") STOP FINISH UNLESS REST -> OUTPUT.(",").OUTLIST C THEN OUTPUT = REST AND OUTLIST = "" IF OUTLIST -> ("#").CMAINENTRY THEN OUTLIST = ".OUT" C ELSE CMAINENTRY = "" IF OUTLIST -> MODE.(",").OUTLIST THEN I = 0 IF OUTLIST = "S" THEN MODE = "S" AND OUTLIST = "" C ELSE MODE = "" IF OUTLIST = "" THEN OUTLIST = ".OUT" DEFINE("STREAM01,".OUTLIST) FILL(32,ADDR(CODE),0) !! ! - GET AREA TO COPY PROPERTIES INTO !! OUTFILE("T#OMFPROPS",ONESEGMENT,0,TEMPORARY,PRPSTART,FLAG) ERROR(1,FLAG) UNLESS FLAG = 0 B == ARRAY(PRPSTART,BFM) OPENOMF(INFILE,1,0) READOMF(1,ADDR(B(0)),L) ERROR(2,0) IF L <= 0 BUFFAD = ADDR(BB(0)) FBUFFAD = ADDR(F(0)) CYCLE I = 1,1,7 AREAPROPS(I) = 0 REPEAT !! I = X'80000' OUTFILE("T#WRK",I,0,0,J,FLAG) IF FLAG = 218 OR FLAG = 0 THEN COMREG(14) = J OBJSIZE=X'80000' CYCLE OUTFILE(OUTPUT,OBJSIZE,0,0,I,FLAG) EXIT IF FLAG=0 OR OBJSIZE<X'4000' OBJSIZE=OBJSIZE//2 REPEAT ERROR(6,FLAG) UNLESS FLAG = 0 COMREG(52) = ADDR(OUTPUT) COMREG(15) = I MYLPUT(INITIALISE,0,0,0) !! !! DO MODULE ENTRY !! ENTRY == RECORD(PRPSTART) ERROR(3,0) UNLESS ENTRY_TYPE = 0; ! FIRST ENTRY MUST BE 'MODULE' ETOI(ADDR(ENTRY_IDEN)+1,LENGTH(ENTRY_IDEN)) PRINTSTRING(" MODULE - ".ENTRY_IDEN) MAXIIN = ENTRY_IIN MODULE NAME = ENTRY_IDEN MAXT1IIN = GET VAR(1) IF MAXT1IIN = 0 THEN MAXT1IIN = MAXIIN PRP = PRPSTART+(ENTRY_SIZE<<2) !! BEGIN ROUTINESPEC MULTIPLE COPY RECORD ROUTINESPEC DUMPIINS ROUTINESPEC PBYTE(BYTEINTEGER N) ROUTINESPEC RELOCATION CONSTINTEGER IINSLENGTH = 36 RECORDFORMAT IINSFM(INTEGER PTR, AP2, DR0, ADDR, BYTE C INTEGER TYPE, PROPS, NAME USE, EMASAREA, C INTEGER REF POINT, MAXLEN, LINK, C BYTEINTEGER BODY, D1, D2, D3) RECORDARRAY IINS(0 : MAXIIN)(IINSFM) INTEGER NPOINT, PLTIIN, PLTDISP, TYPE1IIN INTEGER KILL CONSTBYTEINTEGER STRENGTH = X'40' !! FILL((MAXIIN+1)*IINSLENGTH,ADDR(IINS(0)),0);! ZERO TABLE !! OPENOMF(INFILE,1,0) !! !! READ THROUGH THE BODY RECORDS TO FIND OUT WHICH AREAS !! HAVE DATA ASSOCIATED WITH THEM. WE NEED TO KNOW !! PARTICULARLY TO DISTINGUISH COMMON REFERENCES FROM !! INITIALISED COMMONS. !! CYCLE READOMF(1,BUFFAD,L) ERROR(2,0) IF L <= 0 MOVE(12,BUFFAD,ADDR(BHEAD)) IF BHEAD_TYPE = 8 THEN IINS(BHEAD_IIN)_BODY = 1 EXIT IF BHEAD_LASTENTRY = 1 REPEAT !! OPENOMF(INFILE,1,0) READOMF(1,ADDR(B(0)),L) !! !! J = L CYCLE ; ! THROUGH THE PROPERTIES ENTRIES, CATEGORISING ENTRY == RECORD(PRP) ETOI(ADDR(ENTRY_IDEN)+1,LENGTH(ENTRY_IDEN)) IIN = ENTRY_IIN IINS(IIN)_PROPS = ENTRY_PROPS IINS(IIN)_PTR = PRP IINS(IIN)_TYPE = ENTRY_TYPE IINS(IIN)_AP2 = GET VAR(3) EXIT IF ENTRY_NAME USE&1 = 1;! LAST ENTRY MARKER PRP = PRP+(ENTRY_SIZE<<2) IF PRP >= ADDR(B(J-1)) START ! PROPERTIES RECORD MAY CONSIST OF MULTIPLE RECORDS READOMF(1,ADDR(B(J)),L) J = J+L FINISH REPEAT !************************************************** !! !! PROCESS AREA ENTRIES !! !************************************************* PRINTSTRING(" MAXIMUM IIN = ") WRITE(MAXIIN,1) SELECTOUTPUT(1) IF OUTLIST # ".OUT" THEN PRINTSTRING(" INPUT = ". C INFILE.", OUTPUT = ".OUTPUT." ") IF C26&1 = 1 THEN PRINTSTRING(" *************** MODULE MAP ****************** AREA NAME IIN DISP LEN PROPS AREA " C ) CYCLE IIN = 0,1,MAXT1IIN IF IINS(IIN)_TYPE = 1 START ENTRY == RECORD(IINS(IIN)_PTR) IF C26&1#0 START PRINTSTRING(" ".ENTRY_IDEN) SPACES(33-LENGTH(ENTRY_IDEN)) WRITE(IIN,3) SPACE FINISH LEN = GETVAR(0) OBJECT LIMIT = GETVAR(128) IF OBJECT LIMIT <= 0 THEN OBJECT LIMIT = LEN IF IINS(IIN)_AP2&8 > 0 THEN MAXLEN = GETVAR(2) C ELSE MAXLEN = 0 IF MAXLEN = 0 THEN MAXLEN = LEN MAXLEN = (MAXLEN+3)>>2<<2 IINS(IIN)_MAXLEN = MAXLEN IF IINS(IIN)_PROPS&X'20' # 0 START IINS(IIN)_EMASAREA = 1 IINS(IIN)_ADDR = CODE CODE = CODE+MAXLEN -> Q FINISH IF ENTRY_NAME USE&COMMONMASK # 0 START UNLESS ENTRY_IDEN = "ICL9LFBC" START SE = ENTRY_IDEN IF C26&1 # 0 THEN PRINTSTRING(" COMMON ") IINS(IIN)_EMASAREA = 6 IINS(IIN)_ADDR = COMMON IF IINS(IIN)_BODY = 1 THEN MYLPUT( C DATA ENTRY,(6<<24)!MAXLEN,COMMON,ADDR(SE C )) AND COMMON = COMMON+MAXLEN FINISH -> Q FINISH IF IINS(IIN)_PROPS&X'80' # 0 START IINS(IIN)_EMASAREA = 7 IINS(IIN)_ADDR = STACK STACK = STACK+MAXLEN -> Q FINISH IF IINS(IIN)_PROPS = X'48' THEN START IINS(IIN)_EMASAREA = 4 IINS(IIN)_ADDR = SST SST = SST+MAXLEN -> Q FINISH IINS(IIN)_EMASAREA = 2 IINS(IIN)_ADDR = GLA GLA = GLA+MAXLEN Q: AP2=GETVAR(3) IF C26&1=1 START PHEX(IINS(IIN)_ADDR) WRITE(LEN,6) SPACES(3) PBYTE(ENTRY_PROPS) IF IINS(IIN)_EMASAREA<8 THEN SPACES(4) ANDC PRINTSTRING(EAREAS(IINS(IIN)_EMASAREA)) ELSEC WRITE(IINS(IIN)_EMASAREA,10) SPACES(2) IF AP2#0 START IF AP2&4#0 THEN PRINTSTRING(" IO ") FINISH FINISH IF AP2&4#0 START NIOAREAS=NIOAREAS+1 ERROR(8,0) IF NIOAREAS>20 IOAREAS(NIOAREAS)_LINK=0 IOAREAS(NIOAREAS)_TYPE=1 IOAREAS(NIOAREAS)_AREA=IINS(IIN)_EMAS AREA IOAREAS(NIOAREAS)_DISP=IINS(IIN)_ADDR IOAREAS(NIOAREAS)_LEN = MAXLEN EXTRASIZE=EXTRASIZE+20 FINISH IINS(IIN)_REF POINT = GETVAR(1) IINS(IIN)_NAME USE = ENTRY_NAME USE IF IINS(IIN)_PROPS&X'10' # 0 C THEN AREAPROPS(IINS(IIN)_EMASAREA) = 1 ! IF WRITE THEN MARK UNSHAREABLE IF IINS(IIN)_PROPS&X'24' # 0 C THEN IINS(IIN)_DR0 = X'E1000000'!MAXLEN C ELSE IINS(IIN)_DR0 = X'18000000'!MAXLEN IF ENTRY_IDEN = MODULE NAME C THEN MODULENAME = "DUPLICATE" ! MAKE AREA NAMES VISIBLE AS DATA ENTRIES UNLESS MODE = "S" OR LENGTH(ENTRY_IDEN) = 0 C OR ENTRY_NAMEUSE&COMMONMASK # 0 C OR ENTRY_NAMEUSE&X'80' = 0 START IF ENTRY_PROPS&X'20'=0 THENC MYLPUT(DATA ENTRY,(IINS(IIN)_EMASAREA<<24) C !OBJECTLIMIT,IINS(IIN)_ADDR,ADDR(ENTRY_IDEN)) %C ELSE MY LPUT(CODE ENTRY, C IINS(IIN)_EMASAREA,IINS(IIN)_ADDR+GETVAR(129)+IINS(IIN)_REFPOINT C ,ADDR(ENTRY_IDEN)) IF C26&1 # 0 START PRINTSTRING(" *ENTRY*") IF OBJECT LIMIT # LEN THEN PRINTSTRING( C " LIMIT =") AND WRITE(OBJECT LIMIT,1) FINISH FINISH FINISH REPEAT !************************************************ !! !! DO THE ENTRIES !! !**************************************************** IF COMREG(26)&1 # 0 THEN PRINTSTRING(" *** ENTRIES *** ") CYCLE I = 0,1,MAXIIN ENTRY == RECORD(IINS(I)_PTR) IF IINS(I)_TYPE = 2 START IF ENTRY_IDEN -> ('ICL9CEZ').SROOT C THEN SE = "S#".SROOT ELSE SE = ENTRY_IDEN IF SE = "S#GO" OR (SE = CMAINENTRY C AND SE # "") THEN MEP = 1<<31 ELSE MEP = 0 EMASAREA = IINS(GETVAR(133))_EMASAREA NPOINT = GETVAR(129) PLTIIN = GETVAR(130) PLTDISP = GETVAR(131) TYPE1IIN = GETVAR(133) ! IF NO PLT (IE JUMP NOT CALL) THEN RESET TO CODE IF PLTIIN = -1 THEN PLTIIN = TYPE1IIN C AND PLTDISP = NPOINT IF ENTRY_NAMEUSE&STRENGTH # 0 C OR (ENTRY_NAMEUSE&SCOPE # 0 C AND C26&X'200000' = 0) START IF EMASAREA = 1 THEN MYLPUT(CODEENTRY,MEP! C IINS(PLTIIN)_EMASAREA,PLTDISP+IINS(PLTIIN)_ C REF POINT+IINS(PLTIIN)_ADDR,ADDR(SE)) C ELSE MYLPUT(DATAENTRY,(EMASAREA<<24)! C GETVAR(128),IINS(TYPE1IIN)_ADDR+NPOINT,ADDR C (SE)) KILL = 0 FINISH ELSE KILL = 1 IINS(I)_DR0 = GET VAR(128); ! OBJECT LIMIT IINS(I)_ADDR = NPOINT+IINS(TYPE1IIN)_ADDR IINS(I)_PROPS = IINS(TYPE1IIN)_PROPS IF COMREG(26)&1 # 0 START NEWLINE WRITE(I,8) SPACE PRINTSTRING(SE) SPACES(33-LENGTH(SE)) IF EMASAREA # 1 THEN PRINTSTRING("*DATA*") IF KILL = 1 THEN PRINTSTRING("*SUPPRESSED*") FINISH IF ENTRY_IDEN = MODULE NAME C THEN MODULE NAME = "DUPLICATE" FINISH REPEAT !! UNLESS MODE = "S" START IF MODULENAME = "DUPLICATE" AND C26&1 # 0 C THEN PRINTSTRING(" *WARNING* - MODULE NAME NOT PASSED AS DATA ENTRY BECAUSE A DUPLICATE EXISTS " C ) ELSE MYLPUT(DATA ENTRY,(2<<24)!MAXIIN,0,ADDR( C MODULE NAME)) FINISH !*************************************** !! !! REFERENCES !! !******************************************* NEWLINE FIRST = 0 CYCLE IIN = 0,1,MAXIIN IF IINS(IIN)_TYPE = 3 START ENTRY == RECORD(IINS(IIN)_PTR) CYCLE K = 0,1,MAXIIN IF IINS(K)_TYPE = 2 AND STRING(IINS(K)_PTR+7 C ) = ENTRY_IDEN START ! SATISFIABLE IINS(IIN)_LINK = IINS(K)_PTR IINS(IIN)_TYPE = 103 EXIT FINISH REPEAT IF FIRST = 0 AND COMREG(26)&1 # 0 C THEN PRINTSTRING(" *** REFERENCES *** ") C AND FIRST = 1 IF C26&1 = 1 THEN START WRITE(IIN,8) SPACE PRINTSTRING(ENTRY_IDEN) IF IINS(IIN)_TYPE = 103 START SPACES(32-LENGTH(ENTRY_IDEN)) PRINTSTRING("*SUPPRESSED*") FINISH NEWLINE FINISH IINS(IIN)_ADDR = NORT FINISH REPEAT !! !! !! !!************************************************ !! !! DEAL WITH THE BODY RECORDS !! !!************************************************* !! CYCLE ; ! THROUGH THE INITIALISATION RECORDS READOMF(1,BUFFAD,L) MOVE(12,BUFFAD,ADDR(BHEAD_TYPE)) IIN = BHEAD_IIN BHEAD_DISP = BHEAD_DISP+IINS(IIN)_REF POINT GIIN = IINS(IIN)_EMASAREA+30 IF BHEAD_TYPE = 8 START ; ! BODY RECORD BLEN = BHEAD_LEN BDISP = BHEAD_DISP+IINS(IIN)_ADDR IF BHEAD_LASTENTRY&4 = 4 START ;! FIXUP RECORD FOLLOWS READOMF(1,ADDR(F(0)),L) ERROR(4,0) IF F(0) # 9 AREAPROPS(IINS(IIN)_EMASAREA) = 1; ! IF RELOCATED SET UNSHAREABLE IF IINS(IIN)_EMASAREA = 1 C AND OUTLIST # ".OUT" C THEN PRINTSTRING("*** C ***") RELOCATION MOVE(12,ADDR(F(0)),ADDR(BHEAD_TYPE)) FINISH MYLPUT(GIIN,BLEN,BDISP,BUFFAD+12) FINISH IF BHEAD_TYPE = 10 THEN MULTIPLE COPY RECORD EXIT IF BHEAD_LASTENTRY = 1 REPEAT !! TOTAL = CODE+GLA+SST+COMMON+STACK DUM3 = 0 DUM5 = 0 MYLPUT(7,32,0,ADDR(CODE)) DUMPIINS IF COMREG(26)&2 # 0 !! IF AREAPROPS(1) # 0 START CONNECT(OUTPUT,0,0,0,R,I) ERROR(7,I) UNLESS I = 0 INTEGER(R_CONAD+INTEGER(R_CONAD+28)+12) = 1 PRINTSTRING(" *WARNING* - THIS MODULE CONTAINS UNSHAREABLE CODE. CONTACT ERCC FOR ADVICE " C ) FINISH !! !! !!*********************************************** !! !! AMEND THE DIAGNOSTIC RECORDS !! !!*********************************************** !! BEGIN EXTERNALSTRINGFNSPEC TIME EXTERNALSTRINGFNSPEC DATE INTEGERARRAY LASTR, LASTD(1 : 7);! POSN OF LAST ENTRY IN AREA CHAIN 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) RECORD ME(MAP MODULE ENTRY FM) RECORDFORMAT AEFM(BYTEINTEGER TYPE, PROPERTIES, HALFINTEGER C ENTRY SIZE, 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) RECORDFORMAT TERMFM(BYTEINTEGER TYPE, CHAIN1, CHAIN2, C CHAIN3, INTEGER RECORDS) RECORD LE(TERMFM) RECORD AE(AEFM) RECORD XNE(XNEFM) RECORD ACE(ACEFM) RECORD IN(INRFM) STRING (18) S INTEGER I, J, L, AREA, NEW SIZE, OLD SIZE, FLAG, K INTEGER AD; ! TOP OF DIAGNOSTICS IN WORK FILE INTEGERARRAY R(0 : 1000); ! START ADDRS OF RECORDS IN WORK ARRAY INTEGER NO DIAGNOSTICS INTEGER FUDGE FACTOR INTEGER FOUND INTEGER TOP INTEGER BIIN,OLDIIN BYTEINTEGER TYPE INTEGER RP; ! CURRENT TOP OF 'R' CONSTINTEGER END OF FILE = 20 CONSTINTEGER CHANGE FILE SIZE FAILS = 22 CONSTINTEGER MODULE CHAIN END MISSING = 23 CONSTINTEGER MAX R = 1000 CONSTINTEGER MODULE ENTRY = 16 CONSTINTEGER AREA ENTRY = 17 CONSTINTEGER AREA CHAIN ENTRY = 19 CONSTINTEGER TERMINAL ENTRY = 32 !! AD = COMREG(14); ! ADDR T#WRK NO DIAGNOSTICS=0 !! !!*********** FORM NEW MODULE ENTRY !! R(0) = AD+2 ME = 0 ME_TYPE = MODULE ENTRY ! LANGUAGE /VERSION ? !! RE-ARRANGE DATE AND TIME INTO ICL FORMAT S = "19".DATE.TIME J = ADDR(S) MOVE(2,J+3,ADDR(I)) MOVE(2,J+9,J+3) MOVE(2,ADDR(I),J+9) ITOE(J+1,18) MOVE(18,J+1,ADDR(ME_D1)) ME_NAME = OUTPUT ITOE(ADDR(ME_NAME)+1,LENGTH(ME_NAME)) I = (32+LENGTH(ME_NAME)+3)>>2 ME_CHAIN = -1 ME_ENTRYSIZE = I I = I<<2 HALFINTEGER(AD) = I+2 AD = AD+I MOVE(I,ADDR(ME),COMREG(14)+2) !! !!********** READ IN DIAGNOSTICS TO WORK AREA !! RP = 1 FOUND=0 CYCLE READOMF(1,AD+2,L) IF RP=1 AND L=0 THEN NODIAGNOSTICS=1 EXIT IF L <= 0 L = L+2 MOVE(2,ADDR(L)+2,AD); ! FILL IN RECORD LENGTH R(RP) = AD+2 IF COMREG(26)&128 # 0 START PRINTSTRING(" READ DIAG REC: ") PHEX(AD+2); SPACE PHEX(L) SPACE PBYTE(BYTEINTEGER(AD+2)) NEWLINE FINISH ! FIND END OF MODULE CHAIN IF FOUND=0 START I=AD+2 CYCLE MOVE(64,I,ADDR(ME)) IF BYTEINTEGER(I) = MODULE ENTRY START ERROR(MODULE CHAIN END MISSING,0) C UNLESS ME_CHAIN = -1 ME_CHAIN = RP<<12 ;! LINK TO NEW HEAD OF MODULE CHAIN MOVE(64,ADDR(ME),I) FOUND=1 EXIT FINISH EXIT UNLESS BYTEINTEGER(I)<19 I = I+(ME_ENTRYSIZE<<2) REPEAT UNTIL I>=AD+(L-2) FINISH AD = AD+L+L ;! LEAVE ROOM FOR EXPANSION RP = RP+1 REPEAT IF NO DIAGNOSTICS=0 START ERROR(MODULE CHAIN END MISSING,0) IF FOUND=0 !! !!********** RE-LINK AREA CHAINS AND ADJUST DISPLACEMENTS !! CYCLE AREA = 1,1,7 LASTR(AREA) = -1 LASTD(AREA) = -1 REPEAT !! J = 1 CYCLE I = R(J); K = I L = HALFINTEGER(I-2)-2 CYCLE TYPE = BYTEINTEGER(I) -> NEXTREC IF 24 <= TYPE <= 31 IF TYPE = AREA CHAIN ENTRY OR TYPE=TERMINAL ENTRY START AD = I; ! TRUNCATE TO LOSE OLD AREA CHAIN ENTRIES IF I=K THEN RP=RP-1 AND AD=AD-2 ELSEC HALFINTEGER(K-2) = I-K+2 -> THE END FINISH AE <- RECORD(I) IF TYPE = AREA ENTRY START OLDIIN=((AE_IIN1&15)<<8)!AE_IIN2 AREA=IINS(OLDIIN)_EMASAREA IF LASTR(AREA) = -1 THEN AE_AREA CHAIN = C -1 ELSE AE_AREA CHAIN = ((J-LASTR(AREA))<<20 C )!LASTD(AREA) BIIN=(AE_IIN0<<16)!(AE_IIN1>>4<<12)!AREA MOVE(3,ADDR(BIIN)+1,ADDR(AE_IIN0)) AE_DISPLACEMENT = AE_DISPLACEMENT+IINS(OLDIIN C )_ADDR LASTR(AREA) = J LASTD(AREA) = I-R(J) AE_ENTRYSIZE=AE_ENTRYSIZE+1 RECORD(I) <- AE FINISH I = I+(AE_ENTRY SIZE<<2) IF TYPE=AREA ENTRY START ;! EXPAND HALFINTEGER(K-2)=HALFINTEGER(K-2)+4 ;! INCREASE RECORD LENGTH BY ONE WORD TOP=K+L-2 WHILE TOP>=I-4 THEN CYCLE HALFINTEGER(TOP+4)=HALFINTEGER(TOP) TOP=TOP-2 REPEAT FUDGE FACTOR=X'32000000'!OLDIIN MOVE(4,ADDR(FUDGE FACTOR),I-4) L=L+4 FINISH EXIT IF I >= K+L REPEAT NEXTREC: J = J+1 ERROR(24,0) IF J > RP REPEAT THE END: !! !!********** FILL IN LAST RECORD !! ! RECORD CONTAINS AN AREA CHAIN ENTRY FOR EACH NON-ZERO LENGTH ! AREA IN THE EMAS OBJECT FILE AND A TERMINATOR RECORD. J = 0 I = AD AD = AD+2 R(RP)=AD CYCLE AREA = 1,1,7 IF LASTR(AREA) > -1 START ACE <- RECORD(AD) ACE_TYPE = AREA CHAIN ENTRY ACE_IIN = AREA J = J+1 ACE_AREA CHAIN = ((RP-LASTR(AREA))<<20)!LASTD(AREA) RECORD(AD) <- ACE AD = AD+8 FINISH REPEAT HALFINTEGER(I) = (AD-I)+8 ! FILL IN TERMINAL ENTRY LE <- RECORD(AD) LE = 0 LE_TYPE = TERMINAL ENTRY LE_CHAIN3 = J LE_RECORDS=RP+1 RECORD(AD) <- LE AD = AD + 8 !! !!********** EXTEND OBJECT FILE AND WRITE OUT DIAGNOSTICS !! ( IN REVERSE ORDER TO SIMULATE BACKWARD READ LATER) !! CONNECT(OUTPUT,0,0,0,IN,FLAG) ERROR(7,FLAG) UNLESS FLAG = 0 OLDSIZE = INTEGER(IN_CONAD) DIAG END = OLD SIZE+(AD-COMREG(14))+2 EXTRASTART = ((DIAGEND+3)>>2)<<2 NEW SIZE = EXTRASTART + EXTRASIZE CHANGEFILESIZE(OUTPUT,NEW SIZE,FLAG) ERROR(CHANGE FILE SIZE FAILS,FLAG) IF FLAG # 0 CONNECT(OUTPUT,3,0,0,IN,FLAG) ERROR(7,FLAG) UNLESS FLAG = 0 ! SET LISTHEAD(15) TO OLD SIZE INTEGER(INTEGER(IN_CONAD+24)+IN_CONAD+60) = OLD SIZE INTEGER(INTEGER(IN_CONAD+24)+IN_CONAD) = 15 INTEGER(IN_CONAD) = NEW SIZE I = IN_CONAD+OLDSIZE WHILE RP >= 0 THEN CYCLE J = R(RP)-2 L = HALFINTEGER(J) MOVE(L,J,I) DIAGPRINT(I+2,L-2) IF COMREG(26)&128#0 I = I+L RP = RP-1 REPEAT HALFINTEGER(IN_CONAD+DIAGEND-2) = 0;! TERMINATOR !*( IF EXTRASIZE#0 START !SET LDATA 6 INTEGER(INTEGER(IN_CONAD+24)+IN_CONAD+24)=EXTRASTART !* SET LINKS I=EXTRASTART J=1 WHILE J<NIOAREAS THEN CYCLE IOAREAS(J)_LINK=I+20 I=I+20 J=J+1 REPEAT !* MOVE(NIOAREAS*20,ADDR(IOAREAS(1)),IN_CONAD+EXTRASTART) !* IF GENERATION #-1 START ;! REMEMBER GENERATION FOR ENGINEERS I=IN_CONAD+EXTRASTART+(NIOAREAS*20) INTEGER(I-20)=I-IN_CONAD ;! RESET PREVIOUS LINK INTEGER(I)=0 ;! NEW TERMINATING LINK INTEGER(I+4)=2 ;! TYPE = GENERATION INTEGER(I+8)=GENERATION FINISH FINISH FINISH !! END !! !! !*************************************************************************** !! ROUTINE DUMP BHDR NEWLINE PBYTE(BHEAD_TYPE) SPACE PBYTE(BHEAD_LASTENTRY) SPACE PBYTE(BYTEINTEGER(ADDR(BHEAD_IIN))) PBYTE(BYTEINTEGER(ADDR(BHEAD_IIN)+4)) SPACE PHEX(BHEAD_LEN) SPACE PHEX(BHEAD_DISP) END !! !! !!********************************* !! !! RELOCATION !! !*********************************** ! THIS ROUTINE DEALS WITH A SINGLE FIXUP RECORD. ! ALL TYPES OF FIXUP CHAIN ARE GONE THROUGH, !! SPECIFYING THROUGH LPUT WHAT REFERENCES AND !! RELOCATIONS ARE REQUIRED. !! ROUTINE RELOCATION INTEGERNAME F1, F2 SWITCH CHTYPE(0 : 7) INTEGER DISP, TDISP INTEGER I, FCP, RIIN, A, TYPE, C, MODEXT, M, BND, J, C BASEAD INTEGER NAMEDPOINT STRING (32) S, TAIL !! IF COMREG(26)&2 # 0 THEN PRINTSTRING(" ****** FIXUP RECORDS ****** ") I = FBUFFAD+4 UNTIL I = FBUFFAD+L THEN CYCLE FCP = INTEGER(I) IF COMREG(26)&2 # 0 START NEWLINE PRINTSTRING("NEW CHAIN - ") PHEX(FCP) NEWLINE FINISH DISP = FCP>>12<<2 IF FCP < 0 THEN DISP = DISP!X'FFC00000' DISP = DISP+IINS(IIN)_REF POINT A = BUFFAD+12+(DISP-BHEAD_DISP) BASEAD = BUFFAD+12-BHEAD_DISP TDISP = A-BASEAD+IINS(IIN)_ADDR TYPE = FCP&7 IF TYPE = 0 OR TYPE = 4 C THEN MODEXT = FCP<<21>>24 ELSE MODEXT = 0 CYCLE ; ! THROUGH THE FIXUP CHAIN F1 == INTEGER(A); ! WORDS TO BE RELOCATED F2 == INTEGER(A+4) IF 0 <= TYPE <= 1 THEN RIIN = F1&X'FFF' C ELSE RIIN = F2&X'FFF' IF COMREG(26)&2 # 0 START NEWLINE PHEX(TDISP); SPACES(2) PHEX(F1) IF 0 <= TYPE <= 1 THEN SPACES(9) C ELSE SPACE AND PHEX(F2) FINISH IF IINS(RIIN)_TYPE = 2 AND TYPE # 3 START ! IF ENTRY AND NOT COMPLETE DESCRIPTOR ENTRY == RECORD(IINS(RIIN)_PTR) NAMED POINT = IINS(RIIN)_ADDR RIIN = GETVAR(133) FINISH ELSEC NAMED POINT = IINS(RIIN)_ADDR -> CHTYPE(TYPE) ! ADDRESS OR EXTENDED ADDRESS FIXUPS CHTYPE(0): CHTYPE(1): C = F1>>26 IF C&X'20' # 0 THEN C = C!X'FFFFFFC0' M = (F1<<6>>18)!(MODEXT<<14) IF TYPE = 1 AND M&X'2000' # 0 C THEN M = M!X'FFFFC000' IF TYPE = 0 AND M&X'200000' # 0 C THEN M = M!X'FFC00000' ABOVE: M = M+IINS(RIIN)_REF POINT ! CHECK FOR NAMED COMMON REFERENCES IF IINS(RIIN)_EMASAREA = 6 C AND IINS(RIIN)_BODY = 0 C THEN MYLPUT(COMMON REF,((GIIN-30)<<24)! C IINS(RIIN)_MAXLEN,TDISP,IINS(RIIN)_PTR+7 C ) AND -> FIX ! CHECK FOR BLANK COMMON REFERENCES. IF STRING(IINS(RIIN)_PTR+7) = "ICL9LFBC" C THEN MYLPUT(COMMON REF,((GIIN-30)<<24)! C IINS(RIIN)_MAXLEN,TDISP,ADDR(BLCM)) C AND -> FIX IF NAMED POINT = NORT START IF 0 <= TYPE <= 1 THEN F1 = M C ELSE F2 = M MYLPUT(ONE WORD REF,GIIN-30,TDISP,IINS( C RIIN)_PTR+7) -> DONE FINISH ELSE MYLPUT(FIXUP,GIIN-30,TDISP, C IINS(RIIN)_EMASAREA) FIX: IF 0 <= TYPE <= 1 THEN F1 = M+NAMED POINT C ELSE F2 = M+NAMEDPOINT C AND TDISP = TDISP-4 -> DONE ! PARTIAL DESCRIPTOR FIXUPS CHTYPE(2): C = F2>>12 IF C&X'80000' # 0 THEN C = C!X'FFF00000' M = F1&X'FFFFFF' F1 = F1&X'FF000000' ! SET UP BOUND FIELD IF BCI IS CLEAR UNLESS (F1>>24)&1 = 1 THEN BND = IINS( C RIIN)_DR0&X'FFFFFF' ELSE BND = 0 ! SCALE BOUND FIELD ACCORDING TO DR BITS IF F1<<6>>31 # 1 START J = F1<<2>>29 IF J = 0 THEN BND = BND>>3;! BITS IF 5 <= J <= 7 THEN BND = BND<<(J-3) FINISH F1 = F1!BND ! F2=NAMED POINT TDISP = TDISP+4 -> ABOVE ! COMPLETE DESCRIPTOR FIXUP CHTYPE(3): C = F1 ENTRY == RECORD(IINS(RIIN)_PTR) IF ENTRY_IDEN -> ('ICL9CEZ').TAIL C THEN S = "S#".TAIL ELSE S = ENTRY_IDEN IF ENTRY_TYPE = 3 START MYLPUT(12,GIIN-30,TDISP,ADDR(S)) ! CODE XREF F1 = 0 F2 = 0 FINISH ELSE START ! INTERNALLY SATISFIABLE F1 = X'B1000000' IF ENTRY_TYPE = 103 THEN ENTRY == C RECORD(IINS(RIIN)_LINK) MYLPUT(FIXUP,GIIN-30,TDISP+4,IINS(GETVAR C (130))_EMASAREA) F2 = GETVAR(131)+IINS(GETVAR(130))_ C REFPOINT+IINS(GETVAR(130))_ADDR FINISH -> DONE ! DESCRIPTOR ADDRESS AND EXTENDED DESCRIPTOR ADDRESS FIXUPS CHTYPE(4): CHTYPE(5): C = F2>>26 IF C&X'20' # 0 THEN C = C!X'FFFFFFC0' M = (F2<<6>>18)!(MODEXT<<14) TDISP = TDISP+4 -> ABOVE ! TYPE 6 NOT DEFINED ! COMPLETE DESCRIPTOR TEMPLATE FIXUP CHTYPE(7): C = F1 F1 = 0 F2 = 0 WARNING(1); ! NOT IMPLEMENTED DONE: IF COMREG(26)&2 # 0 START SPACE PHEX(F1) UNLESS 0 <= TYPE <= 1 THEN SPACE C AND PHEX(F2) FINISH EXIT IF C = 0 A = A+(C*4) TDISP = A-BASEAD+IINS(IIN)_ADDR REPEAT I = I+4 REPEAT END ; ! OF RELOCATION !! !!****************************** !! !! MULTIPLE COPY RECORD !! !!****************************** !! ROUTINE MULTIPLE COPY RECORD RECORDFORMAT MCEFM(INTEGER INC, LENNUM, DISP) RECORDNAME MCE(MCEFM) INTEGER LEN, NUM, I !! I = 4 WHILE I < L THEN CYCLE ; ! THROUGH MULTIPLE COPY ENTRIES MCE == RECORD(BUFFAD+I) NUM = MCE_LENNUM<<12>>20 LEN = MCE_LENNUM>>20 WHILE NUM > 0 THEN CYCLE PRINTSTRING(" WARNING - MULTIPLE COPY RECORD ENCOUNTERED ") ! MOVE(LEN,IINS(IIN)_ADDR+MCE_DISP,IINS(IIN)_ %C ! ADDR+MCE_DISP+MCE_INC) MCE_DISP = MCE_DISP+MCE_INC NUM = NUM-1 REPEAT I = I+12 REPEAT END ; ! OF MULTIPLE COPY RECORD !!******************************* !! ! PRINTING ROUTINES !! !!******************************** !! ROUTINE PBYTE(BYTEINTEGER N) CONSTBYTEINTEGERARRAY HX(0 : 15) = C '0','1','2','3','4', C '5','6','7','8','9','A','B','C','D','E','F' PRINTSYMBOL(HX(N>>4)) PRINTSYMBOL(HX(N&15)) END ROUTINE DUMPIINS INTEGER I PRINTSTRING(" ***** DUMP OF IIN LINK TABLE ******* IIN TYPE PROPS EA PTR ADDR REF PT MAXLEN BODY " C ) CYCLE I = 0,1,MAXIIN WRITE(I,3) SPACES(3) PBYTE(IINS(I)_TYPE) SPACES(2) PBYTE(IINS(I)_PROPS) SPACES(2) PBYTE(IINS(I)_EMASAREA) SPACES(2) PHEX(IINS(I)_PTR) SPACE PHEX(IINS(I)_ADDR) SPACE PHEX(IINS(I)_REF POINT) SPACE PHEX(IINS(I)_MAXLEN) SPACE PBYTE(IINS(I)_BODY) NEWLINE REPEAT END !! END ; ! OF INNER BLOCK !! !!************************************ !! !! GET VAR !! !!************************************* ! LOOK THROUGH THE VARIABLE NUMBER OF OPTIONAL FIELDS FOLLOWING ! THE FIXED PART OF A PROPERTIES RECORD ENTRY FOR ONE FIELD IN ! PARTICULAR. THE OPTIONAL FIELD IDENTIFIER IS IN THE LEADING BYTE. ! IF 255 THEN OPTIONAL FIELD LENGTH IS (4+BYTE2) BYTES. !! INTEGERFN GET VAR(INTEGER N) INTEGER L, OPT !! L = 2+((LENGTH(ENTRY_IDEN)+3)>>2); ! LENGTH OF FIXED PART WHILE L < ENTRY_SIZE THEN CYCLE ; ! THROUGH OPTIONAL FIELDS OPT = INTEGER(ADDR(ENTRY_TYPE)+(L<<2)) IF OPT>>24 = N THEN START OPT = OPT&X'FFFFFF' IF OPT&X'800000' # 0 THEN OPT = OPT!X'FF000000' RESULT = OPT FINISH IF OPT>>24 = 255 THEN L = L+1+((OPT<<8>>24)+3)>>2 C ELSE L = L+1 REPEAT IF N=130 THEN RESULT =-1 ;! MAY BE PLTIIN=0 RESULT = 0 END !! !!******************************** !! !! WARNINGS !! !!******************************* !! ROUTINE WARNING(INTEGER N) SWITCH W(1 : 10) OWNINTEGERARRAY WR(1 : 10) = C C C 0(10) NEWLINE WR(N) = WR(N)+1 -> W(N) UNLESS WR(N) > 1 W(1): PRINTSTRING(" TEMPLATE FIXUPS NOT SUPPORTED ") -> END END: END ; ! OF WARNING !! !!********************************* !! !! ERRORS !! !!********************************** !! ROUTINE ERROR(INTEGER N, M) SWITCH TS(1 : 24) SELECTOUTPUT(99) PRINTSTRING(" OMF CONVERTER ABORTS / ") IF N > 19 THEN PRINTSTRING(" ( IN DIAGNOSTICS ) ") -> TS(N) TS(1): PRINTSTRING(" OUTFILE FAILS ") -> WEND TS(2): PRINTSTRING(" PREMATURE END OF FILE ") -> END TS(3): PRINTSTRING(" FIRST ENTRY WAS NOT A MODULE ") -> END TS(4): PRINTSTRING(" WRONG RECORD SEQUENCE ") -> END TS(5): PRINTSTRING(" FAILED TO CREATE LPUT WORK FILE") -> WEND TS(6): PRINTSTRING(" FAILED TO CREATE OBJECT FILE ") -> WEND TS(7): PRINTSTRING(" FAILED TO CONNECT OUT PUT FILE ") -> WEND TS(8): PRINTSTRING(" TOO MANY IO AREAS ") ->END TS(20): PRINTSTRING(" MISSING TERMINATOR ") -> END TS(22): PRINTSTRING(" CHANGE FILE SIZE FAILS, FLAH = ") -> WEND TS(23): PRINTSTRING(" MISSING MODULE CHAIN LINK ") -> END TS(24): PRINTSTRING(" MISSING AREA CHAIN ENTRIES ") -> END WEND: SSMESS(M) END: STOP END ; ! OF ERROR !! END ; ! OF OMFLOAD EXTERNALROUTINE DIAGPRINT(INTEGER RECADDR, RECLEN) !************************************************************ !* THIS ROUTINE PRINTS OUT THE CONTENTS OF AN OMF !* DIAGNOSTIC RECORD IN HEX AND ENGLISH. !************************************************************* !* SYSTEMROUTINESPEC PHEX(INTEGER N) BYTEINTEGER TYPE INTEGER ENTRYSIZE, I, J !* ROUTINE PBYTE(BYTEINTEGER N) CONSTBYTEINTEGERARRAY H(0 : 15) = C '0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F' PRINTSYMBOL(H(N>>4)) PRINTSYMBOL(H(N&15)) END !* PRINTSTRING(" DIAG RECORD OF LENGTH ") PHEX(RECLEN) NEWLINE J = 0 UNTIL J >= RECLEN THEN CYCLE TYPE = BYTEINTEGER(RECADDR) IF 24<=TYPE<=31 START PRINTSTRING(" PRIVATE RECORD ") WRITE(TYPE,1) NEWLINE RETURN FINISH IF TYPE=32 OR TYPE=19 THEN ENTRYSIZE=8 C ELSE ENTRYSIZE = HALFINTEGER(RECADDR+J+2)<<2 NEWLINE PRINTSTRING(" ENTRYSIZE = ") PHEX(ENTRY SIZE) PRINTSTRING(" DISP = ") PHEX(J) NEWLINE CYCLE I = 0,1,ENTRYSIZE-1 PBYTE(BYTEINTEGER(RECADDR+J+I)) REPEAT NEWLINE J = J+ENTRYSIZE REPEAT END ENDOFFILE