!* ALTERED TO COMF27B - 21/08/81 - ZEROISE SPARE BYTE IN AREA CHAIN ENTRIES
!* OF DIAGNOSTIC RECORDS. ALSO CORRECT FORMATION OF AREA CHAIN WORDS.
!* 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))<<12 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_SPARE1 = 0
ACE_IIN = AREA
J = J+1
ACE_AREA CHAIN = ((RP-LASTR(AREA))<<12)!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