EXTERNALROUTINESPEC CHANGECONTEXT
SYSTEMROUTINESPEC DUMP(INTEGER A, B)
SYSTEMROUTINESPEC PHEX(INTEGER I)
! UPDATED 27/07/78 15.30
!*
!*
!*2900
SYSTEMROUTINESPEC SSERR(INTEGER N)
!*
OWNINTEGER SSOPTION, SVFLAG
!*
!*
!*
!*
SYSTEMINTEGERMAPSPEC COMREG(INTEGER I)
!%SYSTEMROUTINESPEC SET WORK(%INTEGERNAME A, F)
!%SYSTEMROUTINESPEC WEXTEND(%INTEGERNAME LEN, FLAG)
SYSTEMROUTINESPEC OUTFILE(STRING (15) S, C
INTEGER LENGTH, MAXBYTES, PROTECTION, C
INTEGERNAME CONAD, FLAG)
!%SYSTEMROUTINESPEC PSYSMES(%INTEGER ROOT, FLAG)
SYSTEMROUTINESPEC MOVE(INTEGER LEN, FROM, TO)
SYSTEMROUTINESPEC FILL(INTEGER LEN, FROM, PATTERN)
SYSTEMROUTINE LPUT(INTEGER TYPE, P1, P2, P3)
RECORDFORMAT RF0(INTEGER TYPE, LA, DATALEN, FILLER)
RECORDFORMAT RF1(INTEGER TYPE, LINK, LOC, STRING (31) NAME)
RECORDFORMAT RF4(INTEGER TYPE, LINK, DISP, L, AREA, C
STRING (31) NAME)
RECORDFORMAT RF6(INTEGER TYPE, C
INTEGERARRAY AREALEN(1 : 7), INTEGER TOTLEN)
RECORDFORMAT RF7(INTEGER TYPE, LINK, AREALOC, BASELOC)
RECORDFORMAT RF8(INTEGER TYPE, LINK, CODEADDR, ADDRFIELD)
RECORDFORMAT RF9(INTEGER TYPE, LINK, L, REFLINK, COUNT, C
STRING (31) NAME)
RECORDNAME R0(RF0)
RECORDNAME R1(RF1)
RECORDNAME R4(RF4)
RECORDNAME R6(RF6)
RECORDNAME R7(RF7)
RECORDNAME R8(RF8)
RECORDNAME R9(RF9)
INTEGER I, J, K, L, FLAG
OWNINTEGER TBASE, TON, TMAX, TYPE6, WORKAD, LMAX, WORKMAX
OWNINTEGER FBASE, CODEBASE, CODEMAX, RECLEN
OWNINTEGER NULLFLAG
OWNINTEGERARRAY HEAD(11 : 25)
OWNINTEGERARRAY H(0 : 14)
OWNINTEGERARRAY BASE(1 : 7)
OWNINTEGERARRAY AREALENGTH(1 : 7)
OWNINTEGERARRAY AREASTART(1 : 7)
OWNINTEGER RCOUNT
OWNINTEGER TYPE19NUM
OWNSTRING (15) FILE
OWNINTEGER STACKMODE
OWNINTEGER LANGUAGE
OWNINTEGER COMREG57
OWNINTEGER NAMESET
OWNINTEGER NUMEXT
OWNINTEGER NUMFIXUPS
INTEGER OBJLEN
INTEGER LDSTART
STRING (31) CHANGEDNAME, EPNAME
CONSTBYTEINTEGERARRAY CHANGE(0 : 47) = C
0(10),1(6),0(8),1,0(23)
SWITCH EP(0 : 47)
SWITCH LSW(0 : 47)
IF TYPE = 0 THEN START
LANGUAGE = P1
STACKMODE = 0
!*EMAS; FILE <- STRING(COMREG(52))
!*EMAS; %IF FILE = '.NULL' %THEN %START
!*EMAS; NULLFLAG = 1
!*EMAS; %RETURN
!*EMAS; %FINISH %ELSE NULLFLAG = 0
!*2900 NULLFLAG=COMREG(40)
!*2900 FILE='SS#TMPOB'
CODEBASE = COMREG(15)+32
CODEMAX = CODEBASE+X'40000'
WORKAD = COMREG(14)
TBASE = WORKAD+32
TYPE6 = TBASE
TON = TBASE+40; ! RESERVE SPACE FOR TYPE6 RECORD RELATING TO 1ST RTN
WORKMAX = INTEGER(WORKAD+8); !SIZE OF WORK FILE
TMAX = WORKMAX
IF TMAX > X'40000' THEN TMAX = X'40000'
TMAX = WORKAD+TMAX-64
RCOUNT = 0; ! NO OF RELOCATION VALUES
TYPE19NUM = 0; ! NO OF GENERALISED RELOCATION RECORDS
LMAX = 144; ! SIZE OF LDATA+HEAD(16) RECORD
LMAX = LMAX+2048; !TEMPORARY - FAULT IN CALCULATION OF LMAX
CYCLE I = 11,1,25
HEAD(I) = 0
REPEAT
CYCLE I = 1,1,7
BASE(I) = 0
REPEAT
COMREG57 = COMREG(57)
NAMESET = 0
NUMEXT = 0
NUMFIXUPS = 0
RETURN
FINISH
RETURN UNLESS NULLFLAG = 0
IF CHANGE(TYPE) = 1 START
IF STRING(P3) -> ("ICL9CM").EPNAME C
THEN CHANGEDNAME = "M#".EPNAME C
ELSE CHANGEDNAME = STRING(P3)
FINISH
-> EP(TYPE)
ROUTINE CHECKWORK(INTEGER N)
INTEGER J, F
L1: IF TON+N > TMAX THEN START
IF WORKMAX > X'40000' THEN START
INTEGER(TON) = (WORKAD+X'40000'-TON)!X'19000000'
! TYPE/SIZE OF FILLER RECORD
!THIS MAKES A PSEUDO RECORD TYPE 25 TO BE SKIPPED
TMAX = WORKAD+WORKMAX-64
TON = WORKAD+X'40000'
WORKMAX = 0
FINISH ELSE START
SELECTOUTPUT(0)
COMREG(24)=1; !TO GIVE COMILATION FAULTY MESSAGE
PRINTSTRING("WORK FILE TOO SMALL")
MONITOR
STOP
NULLFLAG = -1; ! WILL GENERATE FAILURE LATER
TON = TBASE+40; ! AVOID ERROR MEANTIME
FINISH
FINISH
END ; ! CHECKWORK
MONITOR ; STOP
EP(37):
STACKMODE = 1
EP(31):
EP(32):
EP(33):
EP(34):
EP(35):
EP(36):
EP(1): ! CODE
EP(2): ! GLA
EP(3): ! PLT
EP(4): ! SST
EP(5): ! UST
CHECKWORK(P1+12)
R0 == RECORD(TON)
R0_LA = P2
IF 0 <= P3 < 256 THEN START
I = 20
R0_DATALEN = -P1
R0_FILLER = P3
FINISH ELSE START
I = (P1+15)&X'FFFFFFFC'
R0_DATALEN = P1
MOVE(P1,P3,TON+12)
FINISH
R0_TYPE = TYPE<<24!I; ! TYPE,RECLEN
TON = TON+I
RETURN
EP(41):
EP(42):
EP(43):
EP(44):
EP(45):
EP(46):
EP(47):
CHECKWORK(P1>>24+16)
R0 == RECORD(TON)
R0_LA = P2
I = (P1>>24+19)&X'FFFFFFFC'
R0_TYPE = TYPE<<24!I; ! TYPE,RECLEN
R0_DATALEN = P1>>24
R0_FILLER = (P1<<8)>>8; ! NO. OF COPIES
MOVE(P1>>24,P3,TON+16)
TON = TON+I
RETURN
EP(24): ! OLD STYLE ENTRY DEFN USED BY LINK
TYPE = 11
P2 = INTEGER(P2+8)
EP(11): ! ENTRY POINT DEFN
IF CHANGEDNAME = 'S#GO' THEN EPNAME = 'ICL9CEMAIN' C
ELSE EPNAME = CHANGEDNAME
IF COMREG57 # 0 THEN START
IF EPNAME = 'ICL9CEMAIN' OR P1>>31 # 0 THEN START
COMREG(60) = COMREG(60)!2; ! EXISTENCE OF MAIN EP
SET57: STRING(COMREG57) = EPNAME
FINISH ELSE START
IF NAMESET = 0 THEN -> SET57
FINISH
NAMESET = 1
FINISH
L3:NUMEXT = NUMEXT+1
CHECKWORK(44)
R1 == RECORD(TON)
IF P1&3 = 0 THEN P1 = P1!2
IF P1 < 0 THEN P1 = P1!128; ! MAINEP BIT
R1_LOC = P1<<24!(BASE(2)+P2)
LMAX = LMAX+44
R1_NAME <- CHANGEDNAME
I = (LENGTH(R1_NAME)+16)&X'FC'
R1_TYPE = TYPE<<24!I
R1_LINK = HEAD(TYPE)
HEAD(TYPE) = TON
TON = TON+I
RETURN
EP(12): ! EXTERNAL ROUTINE REF
EP(13): ! DYNAMIC ROUTINE REF
-> L3
EP(10): ! COMMON AREA REFERENCE
EP(15): ! DATA REF
!* P1 = AREA<<24 ! MIN LENGTH
!* P2 = LOC IN AREA OF REF
!* P3 = ADDR(DATA NAME)
!*
CHECKWORK(60); ! ALLOW FOR NEW HEAD + VALUE RECORD
I = HEAD(15)
WHILE I # 0 CYCLE
R9 == RECORD(I)
IF R9_NAME = STRING(P3) THEN START
EP15A: R9_COUNT = R9_COUNT+1
INTEGER(TON) = R9_REFLINK
INTEGER(TON+4) = (P1>>24)<<24!(P2+BASE(P1>>24))
R9_REFLINK = TON-WORKAD
TON = TON+8
J = (P1<<8)>>8
IF R9_L < J THEN R9_L = J
LMAX = LMAX+8
RETURN
FINISH
I = R9_LINK
REPEAT
R9 == RECORD(TON)
R9_L = 0
R9_REFLINK = 0
IF TYPE = 10 THEN J = X'80000000' ELSE J = 0
R9_COUNT = J
R9_NAME <- STRING(P3)
I = (LENGTH(R9_NAME)+24)&X'FC'
R9_TYPE = 15<<24!I
R9_LINK = HEAD(15)
HEAD(15) = TON
TON = TON+I
LMAX = LMAX+I-12
NUMEXT = NUMEXT+1
-> EP15A
!*
EP(14): ! DATA ENTRY IN GLA
K = P1>>24
P1 = P1&X'00FFFFFF'
-> A
EP(17): ! DATA ENTRY IN GLA ST
K = 5
TYPE = 14
A: CHECKWORK(52)
NUMEXT = NUMEXT+1
R4 == RECORD(TON)
LMAX = LMAX+52
R4_L = P1
R4_AREA = K
R4_NAME <- CHANGEDNAME
I = (LENGTH(R4_NAME)+28)&X'FC'
R4_TYPE = TYPE<<24!I
R4_LINK = HEAD(TYPE)
HEAD(TYPE) = TON
R4_DISP = BASE(R4_AREA&255)+P2
TON = TON+I
RETURN
EP(18): ! MODIFY 18 BIT ADDRESS FIELD
! P2 @ IN CODE AREA OF 32 BIT INSTRUCTION
! P3 18 BIT VALUE TO BE ADDED TO ADDRESS FIELD
CHECKWORK(16)
R8 == RECORD(TON)
R8_TYPE = (18<<24)!16
R8_LINK = HEAD(18)
HEAD(18) = TON
R8_CODEADDR = P2
R8_ADDRFIELD = P3&X'3FFFF'
TON = TON+16
RETURN
EP(20):
EP(21):
P1 = 2
P3 = TYPE-19
EP(19): ! RELOCATE WORD AT P2 IN AREA P1 BY BASE OF AREA P3
NUMFIXUPS = NUMFIXUPS+1
CHECKWORK(16)
R7 == RECORD(TON)
R7_TYPE = (19<<24)!16
R7_LINK = HEAD(19)
HEAD(19) = TON
R7_AREALOC = P1<<24!P2
R7_BASELOC = P3<<24
TON = TON+16
TYPE19NUM = TYPE19NUM+1
LMAX = LMAX+8
RETURN
EP(25): ! OLD STYLE RELOCATION BLOCK(16 BYTES/ENTRY)
P1 = (P1-4)>>1+4
EP(26): ! GENERALISED RELOCATION BLOCK
! P1 NO OF BYTES IN BLOCK
! P3 @ OF BLOCK
CHECKWORK(P1+8)
LMAX = LMAX+P1
R7 == RECORD(TON)
R7_TYPE = 25<<24!(P1+8)
R7_LINK = HEAD(25)
HEAD(25) = TON
IF TYPE = 25 THEN START
I = INTEGER(P3)
P3 = P3+4
INTEGER(TON+8) = I
J = TON+12
WHILE I # 0 CYCLE
INTEGER(J) = INTEGER(P3)<<24!INTEGER(P3+4)
INTEGER(J+4) = INTEGER(P3+8)<<24!INTEGER(P3+12)
J = J+8
P3 = P3+16
I = I-1
REPEAT
FINISH ELSE MOVE(P1,P3,TON+8)
I = INTEGER(TON+8)
J = TON+12
WHILE I # 0 CYCLE
K = INTEGER(J)
INTEGER(J) = K+BASE(K>>24)
K = INTEGER(J+4)
INTEGER(J+4) = K+BASE(K>>24)
J = J+8
I = I-1
REPEAT
TON = TON+P1+8
RETURN
EP(6): ! SUMMARY DATA FOR PREVIOUS ROUTINE
R6 == RECORD(TYPE6)
R6_TYPE = 6<<24!40
MOVE(32,P3,TYPE6+4)
IF STACKMODE = 0 THEN START
R6_TOTLEN = R6_AREALEN(6)
R6_AREALEN(6) = 0
R6_AREALEN(7) = 0
FINISH
RCOUNT = 0
CYCLE I = 1,1,7
BASE(I) = (BASE(I)+R6_AREALEN(I)+7)&X'FFFFFFF8'
REPEAT
CHECKWORK(40)
TYPE6 = TON
TON = TON+40; ! RESERVE SPACE FOR NEXT DESCRIPTOR
RETURN
EP(7): ! END OF FILE
IF NULLFLAG < 0 THEN SSERR(228); ! PROGRAM TOO LARGE
IF P1 = 32 THEN STACKMODE = 1
IF TYPE6 = TBASE THEN LPUT(6,32,0,P3)
R6 == RECORD(TYPE6)
R6_TYPE = 7<<24; ! TO TERMINATE LAYOUT
OBJLEN = LMAX+16
CYCLE I = 1,1,7
OBJLEN = OBJLEN+BASE(I)
REPEAT
OUTFILE(FILE,OBJLEN,0,0,FBASE,FLAG)
IF FLAG # 0 THEN SSERR(FLAG) ; ! PROGRAM TOO LARGE
CYCLE I = 1,1,7
AREALENGTH(I) = BASE(I)
REPEAT
AREASTART(1) = 32
AREASTART(4) = AREASTART(1)+AREALENGTH(1);! CST AFTER CODE
AREASTART(3) = AREASTART(4)+AREALENGTH(4);! PLT AFTER CST
AREASTART(2)=AREASTART(3)+AREALENGTH(3); !GLA AFTER PLT
AREASTART(5) = AREASTART(2)+AREALENGTH(2);! GLAST AFTER GLA
AREASTART(6) = AREASTART(5)+AREALENGTH(5)
AREASTART(7) = AREASTART(6)+AREALENGTH(6)
LDSTART = AREASTART(7)+AREALENGTH(7)
LDSTART = LDSTART+FBASE
INTEGER(FBASE+4) = AREASTART(1); ! START OF CODE
INTEGER(FBASE+12) = 1; ! OBJECT FILE CODE
INTEGER(FBASE+24) = LDSTART-FBASE; ! START OF LDATA
H(0) = 14
CYCLE I = 1,1,14
H(I) = 0
REPEAT
H(12) = LDSTART-FBASE+68; ! START OF OBJDATA RECORD
TON = TBASE
CYCLE I = 1,1,7
BASE(I) = FBASE+AREASTART(I)
REPEAT
-> LSWITCH
LSW(41):
LSW(42):
LSW(43):
LSW(44):
LSW(45):
LSW(46):
LSW(47):
R0 == RECORD(TON)
J = R0_FILLER; ! NO. OF COPIES
L = R0_DATALEN
K = BASE(I-40)+R0_LA
WHILE J > 0 CYCLE
MOVE(L,TON+16,K)
K = K+L
J = J-1
REPEAT
-> NEXT
LSW(31):
LSW(32):
LSW(33):
LSW(34):
LSW(35):
LSW(36):
LSW(37):
I = I-30
LSW(1):
LSW(2):
LSW(3):
LSW(4):
LSW(5):
I = BASE(I)
R0 == RECORD(TON)
IF R0_DATALEN < 0 THEN START ; ! FILL
FILL(-R0_DATALEN,R0_LA+I,R0_FILLER)
FINISH ELSE START
MOVE(R0_DATALEN,ADDR(R0_FILLER),R0_LA+I)
FINISH
LSW(11):
LSW(12):
LSW(13):
LSW(14):
LSW(15):
LSW(16):
LSW(18):
LSW(19):
LSW(25):
NEXT:
TON = TON+RECLEN
LSWITCH:
IF BYTEINTEGER(TON) = X'81' START
MONITOR
DUMP(TON-20000,TON+32)
STOP
FINISH
I = INTEGER(TON)
RECLEN = (I<<8)>>8
I = I>>24
-> LSW(I)
LSW(0):
TON = TON+8; ! DATA REF LIST ENTRY
-> LSWITCH
LSW(6):
LSW(7):
CHANGECONTEXT; !FINISHED WITH COMPILER - LOOSE FROM WORKING SET
UNLESS TON = TBASE THEN START ; ! NOTFIRST R6 REFERS TO LAST T6
CYCLE I = 1,1,7
BASE(I) = (BASE(I)+R6_AREALEN(I)+7)&X'FFFFFFF8'
REPEAT
FINISH
R6 == RECORD(TON)
-> NEXT UNLESS R6_TYPE>>24 = 7
L = LDSTART+132; ! SPACE FOR LISTHEADS+OBJDATA
J = HEAD(11)
WHILE J # 0 CYCLE
R1 == RECORD(J)
INTEGER(L) = H(1)
H(1) = L-FBASE
INTEGER(L+4) = R1_LOC
STRING(L+8) = R1_NAME
L = (L+12+LENGTH(R1_NAME))&X'FFFFFFFC'
J = R1_LINK
REPEAT
J = HEAD(14)
WHILE J # 0 CYCLE
R4 == RECORD(J)
INTEGER(L) = H(4)
H(4) = L-FBASE
MOVE(12,ADDR(R4_DISP),L+4)
STRING(L+16) = R4_NAME
L = (L+20+LENGTH(R4_NAME))&X'FFFFFFFC'
J = R4_LINK
REPEAT
CYCLE I = 7,1,8; ! EXREF, DYNAMIC XREF
J = HEAD(I+5)
WHILE J # 0 CYCLE
R1 == RECORD(J)
INTEGER(L) = H(I)
H(I) = L-FBASE
INTEGER(L+4) = R1_LOC
STRING(L+8) = R1_NAME
L = (L+12+LENGTH(R1_NAME))&X'FFFFFFFC'
J = R1_LINK
REPEAT
REPEAT
!*
J = HEAD(15); ! DATA REFS
WHILE J # 0 CYCLE
R9 == RECORD(J)
INTEGER(L) = H(9)
H(9) = L-FBASE
I = L+4
INTEGER(L+8) = R9_L
STRING(L+12) = R9_NAME
L = (L+16+LENGTH(R9_NAME))&X'FFFFFFFC'
K = R9_COUNT
INTEGER(I) = (L-FBASE)!(K>>31)<<31
K = (K<<1)>>1
INTEGER(L) = K
I = R9_REFLINK
WHILE I # 0 CYCLE
I = I+WORKAD
INTEGER(L+K<<2) = INTEGER(I+4);! STORE FROM END TO GIVE ORDERED ARRAY
I = INTEGER(I)
K = K-1
REPEAT
L = L+INTEGER(L)<<2+4
J = R9_LINK
REPEAT
!*
J = HEAD(18); ! MODIFY ADDRESSES IN CODE
WHILE J # 0 CYCLE
R8 == RECORD(J)
IF R8_CODEADDR < AREALENGTH(1) THEN START
I = FBASE+AREASTART(1)+R8_CODEADDR
IF I&2 = 0 THEN START ; ! 1 WORD ALLIGNED
K = (INTEGER(I)<<14+R8_ADDRFIELD<<14)>>14
INTEGER(I) = (INTEGER(I)&X'FFFC0000')!K
FINISH ELSE START
K = ((INTEGER(I-2)&3)<<30)!(INTEGER(I+2)>>2)
K = (K+R8_ADDRFIELD<<14)>>14
INTEGER(I-2) = (INTEGER(I-2)&X'FFFFFFFC')!(K>>16)
INTEGER(I+2) = (INTEGER(I+2)&X'0000FFFF')!(K<<16)
FINISH
FINISH
J = R8_LINK
REPEAT
!*
J = HEAD(19); ! INDIVIDUAL RELOCATION BLOCKS
IF J # 0 THEN START
H(14) = L-FBASE
INTEGER(L) = 0
INTEGER(L+4) = TYPE19NUM
L = L+8
FINISH
WHILE J # 0 CYCLE
R7 == RECORD(J)
INTEGER(L) = R7_AREALOC
INTEGER(L+4) = R7_BASELOC
L = L+8
J = R7_LINK
REPEAT
J = HEAD(25); ! GENERALISED RELOCATION BLOCKS
WHILE J > 0 CYCLE
R7 == RECORD(J)
INTEGER(L) = H(14)
H(14) = L-FBASE
K = INTEGER(J+8)<<3+4
MOVE(K,J+8,L+4)
L = L+K+4
J = R7_LINK
REPEAT
!******* AREA SUMMARY
INTEGER(FBASE+28) = L-FBASE
INTEGER(L) = 7; ! NO. OF AREAS
L = L+4
CYCLE I = 1,1,7
INTEGER(L) = AREASTART(I)
INTEGER(L+4) = AREALENGTH(I)
INTEGER(L+8) = 0
L = L+12
REPEAT
L = (L+11)&X'FFFFFFF8'
INTEGER(FBASE) = L-FBASE
! OBJDATA_LENGTH = 68
! LENGTH OF CURRENT RECORD FORMAT
! MOVE(68,ADDR(OBJDATA_LENGTH),LDSTART+68)
H(2) = NUMEXT
H(3) = NUMFIXUPS
MOVE(60,ADDR(H(0)),LDSTART)
RETURN
END ; ! LPUT
!*
ENDOFFILE