!LPUT63 language, version and release written to history records. !LPUT62 correct data init error with minstack !LPUT61 guarantee that all loaddata is in upper case !LPUT60 convergence of MOO annotation and MINSTACK processing - again! ! 14/09/83 !LPUT57 converted to IMP80 and removal of variables CODEBASE and CODEMAX !which apparently did nothing useful. RRM 13/10/82 !LPUT 55 ALLOW AREAS 8 AND 9 !LPUT 53 LENGTH OF STRING 'FILE CHANGED TO 18 CONSTINTEGER EMAS= 1 CONSTINTEGER YES = 1 CONSTINTEGER NO = 0 CONSTINTEGER VME= 0 CONSTINTEGER VERSION=EMAS IF VERSION=EMAS START EXTERNALSTRINGFNSPEC UCSTRING(STRING (255) S) SYSTEMROUTINESPEC NCODE(INTEGER I, J, K) SYSTEMROUTINESPEC SETFNAME(STRING (63) S) SYSTEMSTRINGFNSPEC FAILUREMESSAGE(INTEGER MESS) EXTERNALROUTINESPEC CHANGECONTEXT SYSTEMROUTINESPEC DUMP(INTEGER A, B) SYSTEMROUTINESPEC SSERR(INTEGER N) SYSTEMINTEGERMAPSPEC COMREG(INTEGER I) SYSTEMROUTINESPEC OUTFILE(STRING (15) S, INTEGER LENGTH, MAXBYTES, C PROTECTION, INTEGERNAME CONAD, FLAG) SYSTEMROUTINESPEC MOVE(INTEGER LEN, FROM, TO) SYSTEMROUTINESPEC FILL(INTEGER LEN, FROM, PATTERN) FINISH ELSE START ROUTINE MOVE(INTEGER LENGTH, FROM, TO) INTEGER I RETURN IF LENGTH<=0 I = X'18000000'!LENGTH *LSS_FROM *LUH_I *LDTB_I *LDA_TO *MV_ L = DR END ; !OF MOVE !* ROUTINE FILL(INTEGER LENGTH, FROM, FILLER) INTEGER I RETURN IF LENGTH<=0 I = X'18000000'!LENGTH *LDTB_I *LDA_FROM *LB_FILLER *MVL_L =DR END FINISH !* STRING (2)FN ITOS(INTEGER N) INTEGER SIGN STRING (2) S IF N<0 THENSTART SIGN = 1 N = -N FINISHELSE SIGN = 0 S = "" CYCLE S = TOSTRING((N-(N//10*10))+'0').S N = N//10 REPEAT UNTIL N=0 IF SIGN#0 THEN S = "-".S IF LENGTH(S)<2 THEN S = " ".S RESULT = S END !* ROUTINE DUMP CONSTS(INTEGER START, LENGTH, CA) ROUTINESPEC PR(INTEGER J) !* CONSTBYTEINTEGERARRAY HEX(0:15)= C '0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F' !* INTEGER I, J, L L = 0 WHILE L<LENGTH CYCLE CYCLE I = 16, -4, 0 PRINTSYMBOL(HEX((CA>>I)&15)) REPEAT SPACES(6) PR(INTEGER(START)) NEWLINE START = START + 4 L = L + 4 CA = CA + 4 REPEAT RETURN ! ROUTINE PR(INTEGER J) INTEGER I CYCLE I = 28, -4, 0 PRINTSYMBOL(HEX((J>>I)&15)) REPEAT END ; ! PR ! END ; ! DUMP CONSTS !* CONSTSTRING (11)ARRAY LANGS(0:16) = " UNNAMED", " IMP", " FORTRAN", " IOPT", " NASS", " ALGOL", " OPT CODE", " PASCAL", " SIMULA", " BCPL", " FORTRAN77", " C", "IMPORTEDOMF", " LINKER", " MODIFY", " PASCAL E", " DAP" !* CONSTSTRING (9)ARRAY MOO(0:15) = C "","SQRT","LOG","EXP","SIN/COS","SIN/COS","TAN","ATAN", "","DSQRT","DLOG","DEXP","DSIN/DCOS","DSIN/DCOS","DTAN","DATAN" !* 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, STRING (31) NAME) RECORDFORMAT RF6(INTEGER TYPE, INTEGERARRAY AREALEN(1:7), C INTEGER TOTLEN) RECORDFORMAT RF7(INTEGER TYPE, LINK, AREALOC, BASELOC) RECORDFORMAT RF8(INTEGER TYPE, LINK, CODEADDR, ADDRFIELD) RECORDFORMAT RF9(INTEGER TYPE, LINK, L, REFLINK, COUNT, STRING (31) NAME) RECORDFORMAT RF13(INTEGER LINK, A, DISP, LEN, REP, ADDR) RECORDFORMAT RF27(INTEGER TYPE, LINK, LINE, INF, STRING (32) NAME) RECORD (RF0) NAME R0 RECORD (RF1) NAME R1 RECORD (RF4) NAME R4 RECORD (RF6) NAME R6 RECORD (RF7) NAME R7 RECORD (RF8) NAME R8 RECORD (RF9) NAME R9 RECORD (RF13) NAME R13 RECORD (RF27) NAME R27 INTEGER I, J, K, L, FLAG OWNINTEGER TBASE, TON, TMAX, TYPE6, WORKAD, LMAX, WORKMAX OWNINTEGER FBASE, RECLEN OWNINTEGER NULLFLAG OWNINTEGERARRAY HEAD(11:25) OWNINTEGERARRAY H(0:14) OWNINTEGERARRAY BASE(1:9) OWNINTEGERARRAY AREALENGTH(1:9) OWNINTEGERARRAY AREASTART(1:9) OWNINTEGERARRAY AREAPROP(1:9) OWNINTEGER RCOUNT OWNINTEGER TYPE19NUM OWNSTRING (255) LANGVERS OWNSTRING (18) FILE OWNINTEGER STACKMODE OWNINTEGER LANGUAGE OWNINTEGER COMREG57 OWNINTEGER NAMESET OWNINTEGER NUMEXT OWNINTEGER NUMFIXUPS OWNINTEGER PACK5 OWNINTEGER DECODEHEAD, DECODETAIL, PROLOGUE OWNINTEGER PSEUDOSTACK INTEGER OBJLEN INTEGER LDSTART, LDDISP, LAST13 INTEGER CODE OFFSET, CONST OFFSET STRING (32) PREFIX, CHANGEDNAME, EPNAME, LEFTID, RIGHTID CONSTBYTEINTEGERARRAY CHANGE(0:49)= C 0(10),1(6),0,1,0(4),1,0,1,0(25) SWITCH EP(0:49) SWITCH LSW(0:49) IF TYPE=0 THEN START LANGUAGE = P1 STACKMODE = 0 IF VERSION=EMAS THENSTART { Create the history record string } IF P1<0 THENSTART IF P1#-1 THEN LANGVERS = "" ELSE LANGVERS = STRING(P3) FINISHELSESTART IF P1>16 THEN LANGVERS = " ".ITOS(P1) C ELSE LANGVERS = LANGS(P1) LANGVERS = LANGVERS." ".ITOS(P2)." ".ITOS(P3) FINISH FILE <- STRING(COMREG(52)) IF FILE=".NULL" THEN START NULLFLAG = 1 RETURN FINISH ELSE NULLFLAG = 0 WORKAD = COMREG(14) FINISH ELSE START NULLFLAG = NULLOBJ FBASE = TMPAREA WORKAD = WRKAREA FINISH 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, 9 BASE(I) = 0 AREAPROP(I) = 0 REPEAT COMREG57 = COMREG(57) NAMESET = 0 NUMEXT = 0 NUMFIXUPS = 0 PACK5 = COMREG(28)&1; ! NON-ZERO ONLY IN CE MODE DECODEHEAD = 0 DECODETAIL = 0 PROLOGUE = 0 IF COMREG(28)&X'4000'=0 THEN PSEUDOSTACK=NO C ELSE PSEUDOSTACK=YES RETURN FINISH RETURNUNLESS NULLFLAG=0 IF CHANGE(TYPE)=1 START CHANGEDNAME = STRING(P3) CHANGEDNAME=UCSTRING(CHANGEDNAME) IF CHANGEDNAME->LEFTID.("$").RIGHTID THEN START CHANGEDNAME = LEFTID."DOLLAR".RIGHTID FINISH IF VERSION=EMAS START IF CHANGEDNAME->PREFIX.("ICL9CM").EPNAME AND PREFIX="" THEN C CHANGEDNAME = "M#".EPNAME FINISH FINISH ->EP(TYPE) ! ROUTINE CHECKWORK(INTEGER N) INTEGER J, F IF TON+N>TMAX THEN START IF WORKMAX>X'40000' AND WORKMAX-X'40040'>N 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 IF VERSION=EMAS START SELECTOUTPUT(0) COMREG(24) = 1; !TO GIVE COMPILATION FAULTY MESSAGE PRINTSTRING("Work file too small") MONITOR STOP FINISH ELSE START LPUTERROR = 228 NULLFLAG = -1; ! WILL GENERATE FAILURE LATER TON = TBASE+40; ! AVOID ERROR MEANTIME FINISH FINISH FINISH END ; ! CHECKWORK ! EP(37): IF PSEUDOSTACK=YES THEN TYPE=33 ELSE STACKMODE = 1 EP(30): EP(31): EP(32): EP(33): EP(34): EP(35): EP(36): EP(38): EP(39): 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(47): IF PSEUDOSTACK=YES THEN TYPE=43 EP(40): EP(41): EP(42): EP(43): EP(44): EP(45): EP(46): EP(48): EP(49): 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" ELSE C EPNAME = CHANGEDNAME IF VERSION=EMAS START IF COMREG57#0 THEN START IF EPNAME="ICL9CEMAIN" OR P1>>31#0 THEN START COMREG(60) = COMREG(60)!2; ! EXISTENCE OF MAIN EP STRING(COMREG57) = EPNAME FINISH ELSE START IF NAMESET=0 THEN STRING(COMREG57) = EPNAME FINISH NAMESET = 1 FINISH FINISH ELSE START ; !VME VERSION IF EPNAME="ICL9CEMAIN" OR P1>>31#0 START MAINEPSET = 1 MAINEPNAME = EPNAME FINISH ELSE START IF NAMESET=0 THEN MAINEPNAME = EPNAME FINISH NAMESET = 1 FINISH L3: NUMEXT = NUMEXT+1 CHECKWORK(44) R1 == RECORD(TON) IF P1&7=0 THEN P1 = P1!2 IF P1<0 THEN P1 = P1!128; ! MAINEP BIT R1_LOC = P1<<24!(BASE(P1&7)+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 EP(22): ! 'DATA OR PROCEDURE' REFERENCE ->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 IF PSEUDOSTACK=YES THENSTART IF P1>>24=7 THEN P1=(P1<<8)>>8!X'03000000' FINISH 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 IF P1=8 THEN P2 = -P2 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 IF PSEUDOSTACK=YES THENSTART IF P1=7 THEN P1=3 IF P3=7 THEN P3=3 FINISH 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 AREAPROP(P1) = 1; !FOR AREA PROPERTIES RECORD 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(27): ! Note code section for decode !* P1 = -1 prologue !* -2 epilogue !* -3 consts !* -4 fill in prologue !* >0 line no !* 2 = len<<18 ! start !* P3 = addr(prologue name) !* IF P1=-4 THEN START ; ! fill in prologue IF PROLOGUE#0 THEN START R27 == RECORD(PROLOGUE) R27_INF = P2 MOVE(32, P3, PROLOGUE+16) PROLOGUE = 0 FINISH RETURN FINISH !* CHECKWORK(48) R27 == RECORD(TON) IF DECODEHEAD=0 THEN START DECODEHEAD = TON FINISH ELSE START IF P1=-2 THEN START ; ! epilogue may need to overwrite last statement IF INTEGER(DECODETAIL+12)<<14=P2<<14 THEN START ! overwrite R27 == RECORD(DECODETAIL) R27_LINE = -2 R27_INF = P2 RETURN FINISH FINISH INTEGER(DECODETAIL+4) = TON FINISH DECODETAIL = TON !* IF P1=-1 THEN START ; ! prologue I = 48; ! allow full string IF P3=0 THEN START ; ! to be filled in later PROLOGUE = TON FINISH ELSE START MOVE(32, P3, TON+16) FINISH FINISH ELSE I = 16 !* R27_TYPE = 27<<24!I R27_LINK = 0 R27_LINE = P1 R27_INF = P2 TON = TON+I RETURN !* EP(28): ! produce code listing !* P1 = PROLOGUE LENGTH WHILE DECODEHEAD#0 CYCLE R27 == RECORD(DECODEHEAD) I = R27_LINE J = R27_INF>>18; ! length IF J#0 THEN START ; ! WILL SKIP DUMMY PROLOGUE ENTRY K = (R27_INF<<14)>>14; ! address IF I>0 OR I=-2 THEN K = K+P1 NEWLINE IF I=-3 THEN START PRINTSTRING(" CONSTANT AREA ") DUMP CONSTS(FBASE+32+K, J, K) FINISH ELSE START IF I=-1 THEN START PRINTSTRING("PROLOGUE FOR ENTRY ".STRING(DECODEHEAD+16)) FINISH ELSE START IF I=-2 THEN START PRINTSTRING("EPILOGUE") FINISH ELSE START IF I<-10 THENSTART PRINTSTRING("CODE FOR ".MOO(-I-10)) FINISHELSESTART PRINTSTRING("LINE ") WRITE(I,1) FINISH FINISH FINISH NEWLINE NCODE(FBASE+32+K, FBASE+32+K+J, K) FINISH FINISH DECODEHEAD = R27_LINK REPEAT RETURN !* EP(7): ! END OF FILE IF VERSION=EMAS START IF NULLFLAG<0 THEN SSERR(228); !PROGRAM TOO LARGE FINISH IF P1>=32 THEN STACKMODE = 1 IF PSEUDOSTACK=YES AND STACKMODE=1 THENSTART INTEGER(P3+8)=INTEGER(P3+24);! size(3)=size(7) INTEGER(P3+24)=0;! size(7)=0 FINISH IF P1=40 THEN START ; ! F77 with prologue insertion CODE OFFSET = INTEGER(P3+32) CONST OFFSET = INTEGER(P3+36) FINISH ELSE START CODE OFFSET = 0 CONST OFFSET = 0 FINISH 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 IF PACK5#0 THEN OBJLEN = OBJLEN-BASE(5) IF VERSION=EMAS START OBJLEN = OBJLEN+LENGTH(LANGVERS) + 2; ! FOR LANGUAGE HISTORY RECORD OUTFILE(FILE, OBJLEN, 0, 0, FBASE, FLAG) IF FLAG#0 THEN START COMREG(24) = FLAG; ! To give 'Compilation faulty' SELECTOUTPUT(0) SETFNAME(FILE) PRINTSTRING("Create object file fails - ".FAILUREMESSAGE(FLAG)) COMREG(47) = 0; ! Overwrite 'no of statements' left by compiler STOP FINISH FINISH ELSE START IF OBJLEN>INTEGER(FBASE+8) THEN START LPUTERROR = 228 RETURN FINISH FINISH 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); !GLA AFTER PLT AREASTART(2) = AREASTART(3)+AREALENGTH(3); ! GLA AFTER PLT IF PACK5#0 THEN START AREASTART(5) = 0 AREASTART(6) = AREASTART(2)+AREALENGTH(2) FINISH ELSE START AREASTART(5) = AREASTART(2)+AREALENGTH(2); ! GLAST AFTER GLA AREASTART(6) = AREASTART(5)+AREALENGTH(5) FINISH 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 AREASTART(8) = AREASTART(1); ! prologue AREASTART(9) = AREASTART(1)+CONST OFFSET; ! const area AREASTART(1) = AREASTART(1)+CODE OFFSET 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, 9 BASE(I) = FBASE+AREASTART(I) REPEAT LDDISP = 132 LAST13 = ADDR(H(13)) ->LSWITCH LSW(40): LSW(41): LSW(42): LSW(43): LSW(44): LSW(45): LSW(46): LSW(47): LSW(48): LSW(49): R0 == RECORD(TON) J = R0_FILLER; ! NO. OF COPIES L = R0_DATALEN IF I=40 THEN START I = R0_LA>>24 R0_LA = R0_LA&X'FFFFFF' ->PACKCMN1 FINISH IF I=45 AND PACK5#0 THEN START I = 5 PACKCMN1: L = LDSTART+LDDISP INTEGER(LAST13) = L-FBASE; ! CHAIN FORWARD LAST13 = L R13 == RECORD(L) R13_LINK = 0 R13_A = I R13_DISP = R0_LA R13_LEN = R0_DATALEN R13_REP = J IF R13_LEN=1 THEN R13_ADDR = BYTEINTEGER(TON+16) ELSESTART R13_ADDR = L+24-FBASE MOVE(R13_LEN, TON+16, L+24) FINISH LDDISP = (LDDISP+R13_LEN+27)&X'FFFFFC' ->NEXT FINISH K = BASE(I-40)+R0_LA WHILE J>0 CYCLE MOVE(L, TON+16, K) K = K+L J = J-1 REPEAT ->NEXT LSW(30): R0 == RECORD(TON) J = R0_LA>>24; !AREA IDENT R0_LA = R0_LA&X'FFFFFF' ->PACKCMN2 LSW(31): LSW(32): LSW(33): LSW(34): LSW(35): LSW(36): LSW(37): LSW(38): LSW(39): I = I-30 LSW(1): LSW(2): LSW(3): LSW(4): LSW(5): J = I I = BASE(I) R0 == RECORD(TON) IF J=5 AND PACK5#0 THEN START PACKCMN2: L = LDSTART+LDDISP INTEGER(LAST13) = L-FBASE; ! CHAIN FORWARD LAST13 = L R13 == RECORD(L) R13_LINK = 0 R13_A = J R13_DISP = R0_LA IF R0_DATALEN<0 THEN START ; ! BYTE R13_LEN = 1 R13_REP = -R0_DATALEN R13_ADDR = R0_FILLER LDDISP = LDDISP+24 FINISH ELSE START R13_LEN = R0_DATALEN R13_REP = 1 IF R13_LEN=1 THEN R13_ADDR = BYTEINTEGER(TON+12) ELSESTART R13_ADDR = L+24-FBASE MOVE(R13_LEN, TON+12, L+24) FINISH LDDISP = (LDDISP+R13_LEN+27)&X'FFFFFC' FINISH ->NEXT FINISH 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(22): LSW(25): LSW(27): NEXT: TON = TON+RECLEN LSWITCH: IF VERSION=EMAS START IF BYTEINTEGER(TON)=X'81' START MONITOR DUMP(TON-20000, TON+32) STOP FINISH 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): IF VERSION=EMAS THEN CHANGECONTEXT; !FINISHED WITH COMPILER - LOSE 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+LDDISP; ! 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, 9; ! EXREF, DYNAMIC XREF IF I=9 THEN START ; ! 'DATA OR PROCEDURE' REFERENCE K = 11 J = HEAD(22) FINISH ELSE START K = I J = HEAD(I+5) FINISH WHILE J#0 CYCLE R1 == RECORD(J) INTEGER(L) = H(K) H(K) = L-FBASE IF R1_LOC>>24=9 THEN START ; ! ref from const area R1_LOC = X'01000000'!((R1_LOC<<8)>>8+CONST OFFSET) FINISH 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) K = R8_CODEADDR IF K>=0 THEN K = K+CODE OFFSET ELSE K = -K IF K<AREALENGTH(1)+CODE OFFSET THEN START I = FBASE+AREASTART(8)+K 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) IF R7_BASELOC>>24=9 THEN R7_BASELOC = (1<<24)!CONST OFFSET INTEGER(L) = R7_AREALOC INTEGER(L+4) = R7_BASELOC IF R7_BASELOC>>24=1 AND CODE OFFSET#0 THEN START I = FBASE+AREASTART(R7_AREALOC>>24)+(R7_AREALOC<<8)>>8 UNLESS INTEGER(I)=0 AND INTEGER(I-4)=X'E1000000' THEN C INTEGER(I) = INTEGER(I)+CODE OFFSET FINISH 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 AREASTART(1) = AREASTART(8) CYCLE I = 1, 1, 7 INTEGER(L) = AREASTART(I) INTEGER(L+4) = AREALENGTH(I) INTEGER(L+8) = AREAPROP(I) L = L+12 REPEAT IF VERSION=EMAS THENSTART IF LANGVERS#"" THENSTART I = LENGTH(LANGVERS) + 2 L = L + I; ! LANGUAGE HISTORY RECORD FINISH FINISH L = (L+11)&X'FFFFFFF8' INTEGER(FBASE) = L-FBASE H(2) = NUMEXT H(3) = NUMFIXUPS IF VERSION=EMAS THENSTART IF LANGVERS#"" THENSTART H(12) = L-FBASE-I-1; ! HISTORY RECORD POINTER BYTEINTEGER(L-I-1) = 9; ! LANGUAGE HISTORY RECORD MOVE(I-1,ADDR(LANGVERS),L-I) BYTEINTEGER(L-1) = 0; ! END OF HISTORY RECORDS FINISH FINISH MOVE(60, ADDR(H(0)), LDSTART) ! CHANGES ACCESS MODE RETURN END ; ! LPUT !* ENDOFFILE