! ALAN ANDERSON - 29/9/77
!*********************************************************
!*
!* I.C.L. OBJECT MODULE FORMAT LOADER
!*
!**********************************************************
!! USES COMREG 26 AS CONTROL PARM FIELD
!!
!!
!!
SYSTEMROUTINESPEC MOVE(INTEGER L, FROM, TO)
SYSTEMROUTINESPEC PHEX(INTEGER N)
SYSTEMROUTINESPEC FILL(INTEGER L, A, FILLER)
SYSTEMROUTINESPEC CONNECT(STRING (15) S, C
INTEGER ACCESS, MAXBYTES, PROTECTION, C
RECORDNAME R, INTEGERNAME J)
RECORDFORMAT INRFM(INTEGER CONAD, FILESIZE, C
BYTEINTEGER DUM1, DUM2, DUM3, DUM4, C
STRING (6) DUM5, INTEGER TYPEDUM6, C
INTEGER DATASTART, DATAEND, DUM7)
SYSTEMROUTINESPEC OUTFILE(STRING (15) S, C
INTEGER L, ML, P, INTEGERNAME CONAD, FLAG)
SYSTEMROUTINESPEC ETOI(INTEGER A, L)
SYSTEMROUTINESPEC LOAD(STRING (32) ENTRY, C
INTEGER TYEP, INTEGERNAME FLAG)
SYSTEMROUTINESPEC SSMESS(INTEGER N)
SYSTEMROUTINESPEC FINDENTRY(STRING (32) ENTRY, C
INTEGER TYPE, DAD, STRINGNAME FILE, C
INTEGERNAME DR0, DR1, FLAG)
EXTERNALROUTINESPEC OPENOMF(STRING (32) S, INTEGER N, MODE)
EXTERNALROUTINESPEC READOMF(INTEGER CHAN, C
INTEGER FROM, INTEGERNAME L)
SYSTEMROUTINESPEC DESTROY(STRING (63) S, INTEGERNAME FLAG)
SYSTEMINTEGERMAPSPEC COMREG(INTEGER N)
ROUTINESPEC ERROR(INTEGER M, N)
!!
!!----------------------------------------------
!! CONSTANTS
!!----------------------------------------------
CONSTINTEGER TEMPORARY = X'40000000'; ! FILE PROPERTY
CONSTINTEGER NORT = X'4E4F5254'; ! UNSATISFIED REFERENCE MARKER
CONSTINTEGER ONESEGMENT = X'40000'; ! ONE NR SEGMENT
RECORDFORMAT ITEMFM(STRING (32) S, INTEGER DR0, DR1, FLAG)
!!
EXTERNALINTEGERFN OMFLOAD(STRING (32) INFILE)
!!
INTEGER PRPSTART, PRP, FLAG, L, MAXIIN, MAXLEN, LEN, TO, IIN, C
I, MAXT1IIN, BUFFAD, DR0, DR1, C26
STRING (1) DUMMY
INTEGER T1, NAMEDPOINT, OBJLIM, PLT, J, ESIZE
OWNSTRING (9) AREANAME = 'OMFAREAA'
STRING (32) XREF
OWNINTEGER NSEGS = 0
INTEGERNAME NUMENTS
RECORDARRAYFORMAT ITEMAFM(0:100)(ITEMFM)
RECORDARRAYNAME ITEM(ITEMFM)
!!
RECORDFORMAT ENTRYFM( C
BYTEINTEGER TYPE, PROPS, SIZE0, SIZE1, IIN0, IIN1, C
NAMEUSE, STRING (32) IDEN)
BYTEINTEGERARRAY B(0 : 4120)
BYTEINTEGERARRAYFORMAT BUFFFM(0 : X'40000')
BYTEINTEGERARRAYNAME BUFF
RECORDFORMAT BHEADFM( C
BYTEINTEGER TYPE, LASTENTRY, IIN0, IIN1, C
INTEGER DISP, LEN)
RECORDNAME ENTRY(ENTRYFM)
RECORD BHEAD(BHEADFM)
RECORDFORMAT SEGFM(INTEGER ADDR, LEFT, BYTEINTEGER PROPS)
RECORDARRAY SEGS(1 : 20)(SEGFM)
!!
INTEGERFNSPEC GET VAR(INTEGER N)
ROUTINESPEC WARNING(INTEGER N)
!!
!!
!!**********************************
!!
!! DEAL WITH PROPERTIES RECORD
!!
!!************************************
!!
!************
!*BEGIN HERE*
!************
C26 = COMREG(26)
PRINTSTRING('
OMF LOADER V0.3 ')
!!
!! GET FILE TO KEEP ENTRY IMFORMATION UNTIL PRELOAD AVAILABLE
!!
OUTFILE('OMFITEMS',X'1000',0,TEMPORARY,I,FLAG)
ERROR(1,FLAG) IF FLAG#0
NUMENTS==INTEGER(I+32)
IF FLAG=0 THEN NUMENTS=0
ITEM==ARRAY(I+36,ITEMAFM)
!!
!!
! - GET AREA TO COPY PROPERTIES RECORD INTO
OUTFILE('OMFPROPS',ONESEGMENT,0,TEMPORARY,PRPSTART,FLAG)
ERROR(1,FLAG) UNLESS FLAG = 0
!!
BUFF == ARRAY(PRPSTART,BUFFFM)
!!
OPEN OMF(INFILE,1,0)
!!
READOMF(1,ADDR(BUFF(0)),L)
ERROR(2,0) IF L = 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)
NEWLINES(2)
MAXIIN = (ENTRY_IIN0<<8)+ENTRY_IIN1
MAXT1IIN = GET VAR(1)
IF MAXT1IIN = 0 THEN MAXT1IIN = MAXIIN
ESIZE = ENTRY_SIZE0<<8+ENTRY_SIZE1
PRP = PRPSTART+(ESIZE<<2)
!!
!!
!!
BEGIN
ROUTINESPEC DUMPBHDR
ROUTINESPEC MULTIPLE COPY RECORD
ROUTINESPEC DUMPIINS
ROUTINESPEC PBYTE(BYTEINTEGER N)
ROUTINESPEC RELOCATION
INTEGERFNSPEC GET BASE ADDR
ROUTINESPEC REMEMBER(STRING (32) NAME, C
INTEGER DR0, DR1, FLAG)
INTEGER BLENT, BTYPE
RECORDFORMAT IINSFM(INTEGER PTR, AP2, DR0, ADDR, BYTE C
INTEGER TYPE, PROPS, SP1, SP2)
RECORDARRAY IINS(0 : MAXIIN)(IINSFM)
!!
FILL((MAXIIN+1)*20,ADDR(IINS(0)),0); ! ZERO TABLE
J = L
CYCLE ; ! THROUGH THE PROPERTIES ENTRIES, CATEGORISING
ENTRY == RECORD(PRP)
ETOI(ADDR(ENTRY_IDEN)+1,LENGTH(ENTRY_IDEN))
IIN = (ENTRY_IIN0<<8)+ENTRY_IIN1
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
ESIZE = ENTRY_SIZE0<<8+ENTRY_SIZE1
PRP = PRP+(ESIZE<<2)
IF PRP >= ADDR(BUFF(J-1)) START
! PROPERTIES RECORD MAY CONSIST OF MULTIPLE RECORDS
READOMF(1,ADDR(BUFF(J)),L)
ERROR(2,0) IF L = 0
J = J+L
FINISH
REPEAT
!!
!! *** PROCESS AREA ENTRIES ***
!!
IF C26&1 # 0 THEN PRINTSTRING('
*************** MODULE MAP ******************
AREA NAME IIN ADDR LEN MLEN PROPS
' 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
IINS(IIN)_ADDR = GET BASE ADDR+GETVAR(1)
! ADD IN REF. POINT
IF C26&1 # 0 START
PHEX(IINS(IIN)_ADDR)
WRITE(LEN,5)
WRITE(MAXLEN,5) UNLESS MAXLEN = 0
SPACES(3)
PBYTE(ENTRY_PROPS)
IF ENTRY_PROPS&32 # 0 THEN PRINTSTRING( C
" - CODE ")
IF ENTRY_PROPS&128 # 0 THEN PRINTSTRING( C
" - STACK ")
IF ENTRY_PROPS&4 # 0 THEN PRINTSTRING( C
" - PLT ")
NEWLINE
FINISH
IF IINS(IIN)_PROPS&X'24' # 0 C
THEN IINS(IIN)_DR0 = X'E1000000'!MAXLEN C
ELSE IINS(IIN)_DR0 = X'18000000'!MAXLEN
FINISH
REPEAT
!!
!! *** FORM DESCRIPTORS FOR NAMES (TYPE 2 ENTRIES) ***
!!
IF COMREG(26)&1 # 0 THEN PRINTSTRING('
*** ENTRIES ***
')
CYCLE I = 0,1,MAXIIN
IF IINS(I)_TYPE = 2 START
ENTRY == RECORD(IINS(I)_PTR)
T1 = GETVAR(133)
NAMEDPOINT = GETVAR(129)
OBJLIM = GETVAR(128)
IF IINS(T1)_PROPS&X'20' # 0 START
! CODE AREA ENTRY
PLT = GETVAR(130)
IF PLT = -1 START
! NO PLT
IF OBJLIM = 0 THEN IINS(I)_DR0 = C
X'E0000000' ELSE IINS(I)_DR0 = C
X'E1000000'!OBJLIM
IINS(I)_ADDR = IINS(T1)_ADDR+NAMEDPOINT
FINISH ELSE START
! PLT USED FOR ACCESS
IINS(I)_DR0 = X'B1000000'
IINS(I)_ADDR = IINS(PLT)_ADDR+GETVAR(131)
FINISH
FINISH ELSE START ; ! NOT CODE
IINS(I)_DR0 = IINS(T1)_DR0!OBJLIM
IF OBJLIM = 0 THEN IINS(I)_DR0 = X'19000000'
IINS(I)_ADDR = IINS(T1)_ADDR+NAMEDPOINT
FINISH
IF ENTRY_NAMEUSE&X'80' # 0 C
THEN REMEMBER(ENTRY_IDEN,IINS(I)_DR0,IINS(I)_ C
ADDR,0)
IF COMREG(26)&1 # 0 START
NEWLINE
PRINTSTRING(ENTRY_IDEN)
SPACES(33-LENGTH(ENTRY_IDEN))
PHEX(IINS(I)_DR0)
SPACE
PHEX(IINS(I)_ADDR)
SPACE
FINISH
FINISH
REPEAT
!!
!!
!! *** SATISFY REFERENCES ***
!!
NEWLINES(3) UNLESS C26&X'FF' = 0
CYCLE IIN = 0,1,MAXIIN
IF IINS(IIN)_TYPE = 3 START
ENTRY == RECORD(IINS(IIN)_PTR)
!!
!!
! LOOK FOR AN INTERNAL SATISFACTION
!!
I = 1
WHILE I < IIN THEN CYCLE
IF IINS(I)_TYPE # 0 AND ENTRY_IDEN = STRING( C
IINS(I)_PTR+7) THEN -> FND
I = I+1
REPEAT
!!
IF ENTRY_IDEN -> ("ICL9CEZ").XREF C
THEN XREF = "S#".XREF ELSE XREF = ENTRY_IDEN
FINDENTRY(XREF,0,0,DUMMY,DR0,DR1,FLAG)
IF FLAG # 0 START
LOAD(XREF,0,FLAG)
IF FLAG = 0 THEN FINDENTRY(XREF,0,0,DUMMY,DR0, C
DR1,FLAG)
FINISH
IF FLAG = 0 START ; ! FOUND
IINS(IIN)_DR0 = DR0
IINS(IIN)_ADDR = DR1
FINISH ELSE START
IINS(IIN)_DR0 = IIN
IINS(IIN)_ADDR = NORT
FINISH
FINISH
FND: REPEAT
!!
!!
!!
!!************************************************
!!
!! DEAL WITH THE BODY RECORDS
!!
!!*************************************************
!!
NSEGS = 0
BUFFAD = ADDR(B(0))
CYCLE ; ! THROUGH THE INITIALISATION RECORDS
READOMF(1,ADDR(B(0)),L)
ERROR(2,0) IF L = 0
FUDGE: MOVE(12,BUFFAD,ADDR(BHEAD_TYPE))
BTYPE = BHEAD_TYPE
BLENT = BHEAD_LASTENTRY
DUMP BHDR IF COMREG(26)&16 # 0
IIN = (BHEAD_IIN0<<8)+BHEAD_IIN1
IF BTYPE = 8 START ; ! BODY RECORD
TO = IINS(IIN)_ADDR+BHEAD_DISP
MOVE(L-12,BUFFAD+12,TO)
IF BLENT&4 = 4 START ; ! FIXUP RECORD FOLLOWS
READOMF(1,ADDR(B(0)),L)
ERROR(2,0) IF L = 0
-> FUDGE IF BYTEINTEGER(BUFFAD) # 9
RELOCATION
MOVE(12,BUFFAD,ADDR(BHEAD_TYPE))
FINISH
FINISH
IF BTYPE = 10 THEN MULTIPLE COPY RECORD
EXIT IF BHEAD_LASTENTRY&1 = 1
REPEAT
!!
DUMPIINS IF COMREG(26)&2 # 0
!!
ROUTINE REMEMBER(STRING (32) NAME, INTEGER DR0, DR1, FLAG)
NUMENTS = NUMENTS+1
IF NUMENTS > 100 THEN ERROR(6,0)
ITEM(NUMENTS)_S = NAME
ITEM(NUMENTS)_DR0 = DR0
ITEM(NUMENTS)_DR1 = DR1
ITEM(NUMENTS)_FLAG = FLAG
END
ROUTINE DUMP BHDR
NEWLINE
PBYTE(BHEAD_TYPE)
SPACE
PBYTE(BHEAD_LASTENTRY)
SPACE
PBYTE(BHEAD_IIN0)
PBYTE(BHEAD_IIN1)
SPACE
PHEX(BHEAD_DISP)
END
!!
!!***********************************
!!
!! NEW SEG
!!
!!***********************************
! NOTE/ MORE WORK REQUIRED FOR ON STACK AREAS
INTEGERFN NEW SEG(INTEGER SIZE)
INTEGER CONAD
!!
OUTFILE(AREANAME,SIZE,0,TEMPORARY,CONAD,FLAG)
IF FLAG # 0 THEN PRINTSTRING(' AREA NAME = '. C
AREANAME) AND ERROR(1,FLAG)
BYTEINTEGER(ADDR(AREANAME)+LENGTH(AREANAME)) C
= BYTEINTEGER(ADDR( C
AREANAME)+LENGTH(AREANAME))+1
NSEGS = NSEGS+1
SEGS(NSEGS)_ADDR = CONAD+MAXLEN
SEGS(NSEGS)_LEFT = ONESEGMENT-MAXLEN
SEGS(NSEGS)_PROPS = ENTRY_PROPS
RESULT = CONAD
END
!!
!!********************************
!!
!! GET BASE ADDR
!!
!!********************************
!!
INTEGERFN GET BASE ADDR
CONSTBYTEINTEGERARRAY AL(0 : 2) = 1,2,4
INTEGER A, I, J, K, M
!!
!! MAXIMUM LENGTH OPTIONAL FIELD IS ONLY VALID IF THE
!! EXTENDABLE SEGMENT BIT IN AREA PROPERTIES 2 IS SET.
!!
LEN = GET VAR(0)
IF IINS(IIN)_AP2&8 > 0 THEN MAXLEN = GET VAR(2) C
ELSE MAXLEN = 0
IF MAXLEN < LEN THEN MAXLEN = LEN
!! IF ITS A COMMON LOOK FOR EARLIER INSTANCE
!!
IF ENTRY_NAMEUSE&X'10' # 0 START ; ! COMMON
CYCLE I = 0,1,NUMENTS
IF ITEM(I)_S = ENTRY_IDEN C
AND ITEM(I)_FLAG&1 # 0 C
THEN RESULT = ITEM(I)_DR1
REPEAT
FINISH
!!
! IF AREA IS NOT MEANT TO BE CONCATENATED GET IT A NEW SEGMENT
!!
IF IINS(IIN)_AP2&1 = 1 OR ENTRY_PROPS&3 = 3 C
THEN RESULT = NEWSEG(MAXLEN)
! IS THERE A PLACE FOR IT TO BE COMPOUNDED WITH AN EXISTING AREA
!!
I = ENTRY_PROPS&X'FC'
J = 1
WHILE J < NSEGS THEN CYCLE
IF I = SEGS(J)_PROPS START
IF MAXLEN+4 < SEGS(J)_LEFT START
A = SEGS(J)_ADDR
K = ENTRY_PROPS&3
M = 0
IF K # 0 START
WHILE A&(AL(K)-1) # 0 THEN A = A+1 C
AND M = M+1
! ALIGN
FINISH
SEGS(J)_ADDR = SEGS(J)_ADDR+(MAXLEN+M)
SEGS(J)_LEFT = SEGS(J)_LEFT-(MAXLEN+M)
RESULT = A
FINISH
FINISH
J = J+1
REPEAT
!!
IF MAXLEN > ONESEGMENT THEN J = MAXLEN C
ELSE J = ONESEGMENT
! NO PLACE
RESULT = NEWSEG(J)
END ; ! OF GET BASE ADDR
!!
!!*********************************
!!
!! RELOCATION
!!
!***********************************
! THIS ROUTINE DEALS WITH A SINGLE RELOCATION RECORD.
! ALL FIXUP CHAINS ARE GONE THROUGH, FILLING IN
! REAL ADDRESSES AND DESCRIPTORS AS SPECIFIED.
!!
!! NOTE/ RELOCATES IN ANY AREA INCLUDING CODE
!!
ROUTINE RELOCATION
INTEGERNAME F1, F2
SWITCH CHTYPE(0 : 7)
INTEGER I, FCP, IIN, A, TYPE, C, MODEXT, M, BND, J, FPTR
!!
IF COMREG(26)&2 # 0 THEN PRINTSTRING('
****** FIXUP RECORDS ******
ADDR BEFORE AFTER
' C
)
FPTR = BUFFAD+4
UNTIL FPTR = BUFFAD+L THEN CYCLE
FCP = INTEGER(FPTR)
IF COMREG(26)&2 # 0 START
NEWLINE
PRINTSTRING('NEW CHAIN - ')
PHEX(FCP)
NEWLINE
FINISH
A = IINS(BHEAD_IIN1)_ADDR+(FCP>>12<<2)
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 IIN = F1&X'FFF' C
ELSE IIN = F2&X'FFF'
IF COMREG(26)&2 # 0 START
NEWLINE
PHEX(A)
SPACE
PHEX(F1)
IF 0 <= TYPE <= 1 THEN SPACES(9) C
ELSE SPACE AND PHEX(F2)
FINISH
-> 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)
F1 = IINS(IIN)_ADDR
UNLESS F1 = NORT THEN F1 = F1+M
-> 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 FIELDIF BCI IS CLEAR
UNLESS (F1>>24)&1 = 1 THEN BND = IINS(IIN)_ C
DR0&X'FFFFFF'
! 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 = IINS(IIN)_ADDR+M
-> DONE
! COMPLETE DESCRIPTOR FIXUP
CHTYPE(3):
C = F1
F1 = IINS(IIN)_DR0
F2 = IINS(IIN)_ADDR
-> 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)
F2 = IINS(IIN)_ADDR+M
-> DONE
! TYPE 6 NOT DEFINED
! COMPLETE DESCRIPTOR TEMPLATE FIXUP
CHTYPE(7):
C = F1
F1 = 0
F2 = 0
WARNING(1); ! NOT IMPEMENTED
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)
REPEAT
FPTR = FPTR+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
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
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 PTR ADDR
')
CYCLE I = 0,1,MAXIIN
WRITE(I,3)
SPACES(3)
PBYTE(IINS(I)_TYPE)
SPACES(2)
PBYTE(IINS(I)_PROPS)
SPACES(2)
PHEX(IINS(I)_PTR)
SPACE
PHEX(IINS(I)_ADDR)
NEWLINE
REPEAT
END ; ! OF DUMPIINS
!!
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_SIZE1 THEN CYCLE ; ! THROUGH OPTIONAL FIELDS
OPT = INTEGER(ADDR(ENTRY_TYPE)+(L<<2))
IF OPT>>24 = N THEN RESULT = OPT&X'FFFFFF'
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 ;! BOTCH FOR PLT IIN=0
RESULT = 0
END
!!
!!********************************
!!
!! WARNINGS
!!
!!*******************************
!!
ROUTINE WARNING(INTEGER N)
SWITCH W(1 : 10)
OWNINTEGERARRAY WR(1 : 10) = 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
!!
!!
DESTROY("OMFPROPS",FLAG)
PRINTSTRING("
LOAD OK
")
RESULT = 0
END ; ! OF OMFLOAD
!!
!*********************************************************************************
!*********************************************************************************
!!
!!
!!*********************************
!!
!! ERRORS
!!
!!**********************************
!!
EXTERNALROUTINE ERROR(INTEGER N, FLAG)
SWITCH TS(1 : 20)
PRINTSTRING('
OMF LOADER FAILS / ')
-> TS(N)
TS(1):
PRINTSTRING(' OUTFILE FAILS ')
WRITE(FLAG,1)
-> END
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(' ENTRY NOT FOUND ')
-> END
TS(6): PRINTSTRING(" CANNOT CONNECT ENTRY FILE
HAVE YOU LOADED CORRECTLY ? ")
->END
END:
NEWLINE
SSMESS(FLAG)
NEWLINES(2)
STOP
END ; ! OF ERROR
!!
!**************************************
!*
!* FIND OMF ENTRY
!*
!***************************************
!*
EXTERNALROUTINE FIND OMF ENTRY(STRING (32) ENTRY, C
INTEGERNAME DR0, DR1)
RECORDARRAYFORMAT ITEMAFM(0:100)(ITEMFM)
RECORDARRAYNAME ITEM(ITEMFM)
INTEGER FLAG
RECORD IN(INRFM)
INTEGERNAME NUMENTS
INTEGER I
!! GET ENTRY IMFORMATION FROM PREVIOUDS LOADS
!!
CONNECT("OMFITEMS",0,0,0,IN,FLAG)
ERROR(6,FLAG) IF FLAG#0
NUMENTS==INTEGER(IN_CONAD+32)
ITEM==ARRAY(IN_CONAD+36,ITEMAFM)
CYCLE I = 0,1,NUMENTS
IF ITEM(I)_S = ENTRY START
DR0 = X'B1000000'
DR1 = ITEM(I)_DR1
RETURN
FINISH
REPEAT
DR0 = -1
END ; ! OF FIND OMF ENTRY
!!
!!***************************************
!!
!! OMF RUN
!!
!!****************************************
!!
ROUTINESPEC OMFENTER(STRING (64) S)
EXTERNALROUTINE OMFRUN(STRING (64) S)
INTEGER FLAG
STRING (32) INFILE, ENTRY
UNLESS S -> INFILE.(",").ENTRY C
THEN PRINTSTRING("
FORM IS INPUT FILE,ENTRY
") AND RETURN
FLAG = OMFLOAD(INFILE)
RETURN IF FLAG # 0
OMFENTER(ENTRY) UNLESS ENTRY = ""
END ; ! OF OMFRUN
!!
!*********************************
!!
!! ENTER
!!
!!********************************
!!
EXTERNALROUTINE OMFENTER(STRING (63) S)
INTEGER I, L, J, K
INTEGER M, N
INTEGER IRET,IHP,ILP,IW
PRINTSTRING('
ENTERING OMF MODULE
')
FINDOMFENTRY(S,M,N); ! RETURNS PLT DESRIPTOR
IF S='ICL9IDMSCALC' START
IRET=0
IHP=1000
ILP=1
IW=X'0002C6F1'
FINISH
ERROR(5,0) IF M = -1
**M
*PUT_X'4998' ; ! S (TOS)
**N
*PUT_X'4998' ; ! ST (TOS)
*PUT_X'7998' ; ! LD_(TOS)
*PUT_X'5D98'; ! STLN_(TOS)
*PUT_X'6E04' ; ! ASF 4 - LEAVE ROOM FOR DR DR
IF S='ICL9IDMSCALC' START
I=X'28000001'
**I
*PUT_X'4998'
I=ADDR(IRET)
**I
*PUT_X'4998'
FINISHELSESTART
I = 0
**I
*PUT_X'4998' ; ! ST _ (TOS)
*PUT_X'4998' ; ! ST_ (TOS) - PUT NIL DR DR ON STACK
FINISH
*PUT_X'6C07' ; ! RALN 7
*PUT_X'1FDC' ; ! CALL @(DR)
IF S='ICL9IDMSCALC' START
PRINTSTRING('
RESULT = ')
WRITE(IRET,1)
NEWLINE
FINISH
END ; ! OF ENTER
ENDOFFILE