!* MODIFIED 02/09/81 !* %CONSTINTEGER ISO=0, EBCDIC=1 %CONSTINTEGER LISTFILE=0,DIAGFILE=1,LOGFILE=2,NOLIST=3 %CONSTINTEGER RTMARGIN=132 %CONSTINTEGER NL=10,NP=12 !* %EXTERNALLONGINTEGER ICL9CEAUXST !* !* %OWNINTEGER CURRENT OUTPUT %OWNINTEGER CHAR CODE ;!0 ISO !1 EBCDIC %OWNLONGINTEGER READ CARD,OUTPUT LINE,CSUPPORT;!DESCRIPTOR TO PROCEDURES %OWNINTEGER AETOI,AITOE %OWNINTEGER COMPILER LNB %OWNINTEGER OUTPTR %OWNBYTEINTEGERARRAY OUTBUFF(-2:131) %OWNINTEGERARRAY SSCOMREG(0:63) %OWNINTEGER WRKAREA,TMPAREA,AUXAREA %OWNINTEGER OPTIONS2 %OWNINTEGER OBJDATA %OWNINTEGER OPSYS ;!0 JOBBER ! 1 EMAS ! 2 VME/B ! 3 VME/K %OWNINTEGER NULLOBJ;! 0 OBJECT FILE REQUIRED ! ! NO OBJECT FILE REQUIRED - DUMMY LPUT ACTIVITY %OWNINTEGER MAINEPSET %OWNINTEGER ERLGIVEN,ERLREQ %OWNINTEGER LPUTERROR %OWNSTRING(32) MAINEPNAME %RECORDFORMAT OBJ FMT(%STRING(35) MODULE,%INTEGER MAINEP,I,J,K, %C ADATE,ATIME,OPTIONS2,EXTPROCS) !* !* %CONSTBYTEINTEGERARRAY ITOETAB(0 : 255) = %C 0, 1, 2, 3, 55, 45, 46, 47, 22, 5, 21, 11, 12, 13, 14, 15, 16, 17, 18, 19, 60, 61, 50, 38, 24, 25, 63, 39, 28, 29, 30, 31, 64, 79, 127, 123, 91, 108, 80, 125, 77, 93, 92, 78, 107, 96, 75, 97, 240, 241, 242, 243, 244, 245, 246, 247, 248, 249, 122, 94, 76, 126, 110, 111, 124, 193, 194, 195, 196, 197, 198, 199, 200, 201, 209, 210, 211, 212, 213, 214, 215, 216, 217, 226, 227, 228, 229, 230, 231, 232, 233, 74, 224, 90, 95, 109, 121, 129, 130, 131, 132, 133, 134, 135, 136, 137, 145, 146, 147, 148, 149, 150, 151, 152, 153, 162, 163, 164, 165, 166, 167, 168, 169, 192, 106, 208, 161, 7, 32, 33, 34, 35, 36, 37, 6, 23, 40, 41, 42, 43, 44, 9, 10, 27, 48, 49, 26, 51, 52, 53, 54, 8, 56, 57, 58, 59, 4, 20, 62, 225, 65, 66, 67, 68, 69, 70, 71, 72, 73, 81, 82, 83, 84, 85, 86, 87, 88, 89, 98, 99, 100, 101, 102, 103, 104, 105, 112, 113, 114, 115, 116, 117, 118, 119, 120, 128, 138, 139, 140, 141, 142, 143, 144, 154, 155, 156, 157, 158, 159, 160, 170, 171, 172, 173, 174, 175, 176, 177, 178, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, 191, 202, 203, 204, 205, 206, 207, 218, 219, 220, 221, 222, 223, 234, 235, 236, 237, 238, 239, 250, 251, 252, 253, 254, 255 %CONSTBYTEINTEGERARRAY ETOITAB(0 : 255) = %C 0, 1, 2, 3, 156, 9, 134, 127, 151, 141, 142, 11, 12, 13, 14, 15, 16, 17, 18, 19, 157, 10, 8, 135, 24, 25, 146, 143, 28, 29, 30, 31, 128, 129, 130, 131, 132, 133, 23, 27, 136, 137, 138, 139, 140, 5, 6, 7, 144, 145, 22, 147, 148, 149, 150, 4, 152, 153, 154, 155, 20, 21, 158, 26, 32, 160, 161, 162, 163, 164, 165, 166, 167, 168, 91, 46, 60, 40, 43, 33, 38, 169, 170, 171, 172, 173, 174, 175, 176, 177, 93, 36, 42, 41, 59, 94, 45, 47, 178, 179, 180, 181, 182, 183, 184, 185, 124, 44, 37, 95, 62, 63, 186, 187, 188, 189, 190, 191, 192, 193, 194, 96, 58, 35, 64, 39, 61, 34, 195, 97, 98, 99, 100, 101, 102, 103, 104, 105, 196, 197, 198, 199, 200, 201, 202, 106, 107, 108, 109, 110, 111, 112, 113, 114, 203, 204, 205, 206, 207, 208, 209, 126, 115, 116, 117, 118, 119, 120, 121, 122, 210, 211, 212, 213, 214, 215, 216, 217, 218, 219, 220, 221, 222, 223, 224, 225, 226, 227, 228, 229, 230, 231, 123, 65, 66, 67, 68, 69, 70, 71, 72, 73, 232, 233, 234, 235, 236, 237, 125, 74, 75, 76, 77, 78, 79, 80, 81, 82, 238, 239, 240, 241, 242, 243, 92, 159, 83, 84, 85, 86, 87, 88, 89, 90, 244, 245, 246, 247, 248, 249, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 250, 251, 252, 253, 254, 255 !* !* !*** %INTEGERFNSPEC READCARD(%INTEGER B0,B1,%LONGINTEGER SEQUENCE) !*** %INTEGERFNSPEC OUTPUTLINE(%INTEGER B0,B1) !*** %INTEGERFNSPEC CSUPPORT(%INTEGER SERVICE,P1,P2,P3) !* %EXTERNALROUTINESPEC ICL9CEF77 !* %ROUTINE QKSORT(%STRINGARRAYNAME X,%INTEGER A,B) %INTEGER L,U %STRING(32) D %RETURN %IF A>=B L=A U=B D=X(U) ->FIND UP: L=L+1 ->FOUND %IF L=U FIND: ->UP %UNLESS X(L)>D X(U)=X(L) DOWN: U=U-1 ->FOUND %IF L=U ->DOWN %UNLESS X(U)UP FOUND:X(U)=D QKSORT(X,A,L-1) QKSORT(X,U+1,B) %END;! QKSORT !* %ROUTINE ERL(%INTEGER AFILE,AWORK) %STRING(32)%ARRAYFORMAT SS(0:400) %STRINGARRAYNAME S %STRING(32) T,U,V %INTEGER LD,COUNT,A,REFS,EPS,I S==ARRAY(AWORK+32,SS) PRINTSTRING(" ") PRINTSTRING("EXTERNAL REFERENCES") NEWLINES(3) LD=AFILE+INTEGER(AFILE+24) EPS=INTEGER(LD+4) REFS=INTEGER(LD+28) COUNT=0 !* %WHILE REFS#0 %CYCLE REFS=REFS+AFILE T=STRING(REFS+8) REFS=INTEGER(REFS) I=COUNT %WHILE I>0 %CYCLE %IF S(I)=T %THEN ->IN I=I-1 %REPEAT %IF COUNT<400 %THENSTART I=EPS %WHILE I>0 %CYCLE I=I+AFILE %IF STRING(I+8)=T %THEN ->IN;! ON ENTRY LIST I=INTEGER(I) %REPEAT COUNT=COUNT+1 S(COUNT)=T %FINISH IN: %REPEAT !* !****** NOW SORT THE LIST !* QKSORT(S,1,COUNT) !* %RETURN %IF COUNT<1 %CYCLE I=1,1,COUNT %UNLESS BYTEINTEGER(ADDR(S(I))+2)='#' %THENSTART SPACES(12) PRINTSTRING(S(I)) NEWLINE %FINISH %REPEAT NEWPAGE %END;! ERL !* !* %EXTERNALINTEGERFN ICL9CEF77CSM(%LONGINTEGER INPUT,INPUT1,OUTPUT, %C OUTPUT1,SUPPORT,SUPPORT1, %C %INTEGER WRK,TEMP,AUX,OBJREC, %C SYSTEM,CODE,OPTIONS0,OPTIONS1,COM46,SPARE) %RECORDNAME OBJ(OBJ FMT) %INTEGER I !* %CYCLE I=0,1,63 SSCOMREG(I)=0 %REPEAT !* CURRENT OUTPUT=LISTFILE OUTPTR=0 AITOE=ADDR(ITOETAB(0)) AETOI=ADDR(ETOITAB(0)) NULLOBJ=0 !* READ CARD=INPUT OUTPUT LINE=OUTPUT CSUPPORT=SUPPORT WRKAREA=WRK TMPAREA=TEMP AUXAREA=AUX OBJDATA=OBJREC I=ADDR(ICL9CEAUXST) INTEGER(I)=X'28010000' INTEGER(I+4)=AUX !* OPSYS=SYSTEM CHAR CODE=CODE !* SSCOMREG(11)=AETOI SSCOMREG(12)=AITOE SSCOMREG(14)=WRK SSCOMREG(15)=TEMP SSCOMREG(22)=101 SSCOMREG(23)=99 SSCOMREG(24)=1 SSCOMREG(27)=OPTIONS0 SSCOMREG(28)=OPTIONS1 OBJ==RECORD(OBJDATA) %IF OPTIONS1&1#0 %THEN %START OPTIONS2=OBJ_OPTIONS2 SSCOMREG(57)=OBJ_EXTPROCS %FINISHELSESTART OPTIONS2=0; ! CE MODE ONLY SSCOMREG(57)=0 %FINISH %IF OPTIONS2&X'3F'#0 %THEN SSCOMREG(40)=106 %ELSE %C SSCOMREG(40)=-1 SSCOMREG(46)=COM46 SSCOMREG(48)=X'E000' SSCOMREG(53)=OPTIONS2 OBJ==RECORD(OBJDATA) SSCOMREG(54)=OBJ_ADATE SSCOMREG(55)=OBJ_ATIME SSCOMREG(56)=ADDR(OBJ_MODULE) !* %IF OPTIONS1&X'800'#0 %THEN CURRENTOUTPUT=NOLIST;! LISTINGS=NO %IF OPTIONS1&X'20'#0 %THEN NULLOBJ=1;! CODE=NO ERLREQ=OPTIONS1&X'80';! LISTINGS=ERL !* !*** INITIALISATION FOR LPUT !* NULLOBJ=0 MAINEPSET=0 LPUTERROR=0 MAINEPNAME="" ERLGIVEN=0 !* !*** INITIALISATION OF OBJECT FILE RECORD !* !*** SAVE COMPILER LNB FOR STOP SEQUENCE !* *STSF_I COMPILER LNB=I!4;! WILL BE FORCED TO ODD WORD BDY BY PRCL !* ICL9CEF77;! ENTER COMPILER !* !*** POST COMPILATION OF OBJECT FILE RECORD !* OBJ==RECORD(OBJDATA) OBJ_MODULE=MAINEPNAME OBJ_MAINEP=MAINEPSET %IF SSCOMREG(24)=0 %AND ERLREQ#0 %THENSTART %IF ERLGIVEN=0 %THEN ERL(TEMP,WRK) %FINISH %RESULT=SSCOMREG(24) %END;!ICL9CEFORGCSM !* %SYSTEMROUTINE SET COMP DATA(%LONGINTEGERNAME INPUT,OUTPUT, %C %INTEGERNAME CODE,OPTIONS0,OPTIONS1,SYSTEM,SPARE) INPUT=READ CARD OUTPUT=OUTPUT LINE CODE=CHAR CODE OPTIONS0=SSCOMREG(27) OPTIONS1=SSCOMREG(28) SYSTEM=OPSYS SPARE=0 %END;! SET COMP DATA !* %INTEGERFN SUPPORT(%INTEGER SERVICE,P1,P2,P3) !* INTERFACE TO ALL SERVICES OTHER THAN PRIMARY INPUT/OUTPUT %INTEGER I %LONGINTEGER REF *PRCL_4 *LSD_SERVICE *SLSD_P2 *ST_%TOS REF=CSUPPORT *LD_REF *RALN_9 *CALL_(%DR) *ST_I %RESULT=I %END;! SUPPORT !* %SYSTEMROUTINE SIGNAL(%INTEGER EP,P1,P2,%INTEGERNAME F) !* CALLED BY COMPILERS ON INITIAL ENTRY (SINCE THEY ARE IMP PROGRAMS) !* DUMMY FOR ALGOLE,FORTRANG AND IMP !* MAY REQUIRE SPECIAL ACTION IN PASCAL CONTEXT F=0 %END;! SIGNAL !* %SYSTEMROUTINE NDIAG(%INTEGER PCOUNT,LNB,FAULT,INF) !* SOFTWARE DETECTED ERRORS AND IMP %MONITOR WILL CALL THIS ROUTINE !* PASS CALL ON TO CSUPPORT WHICH WILL PROVIDE AN APPROPRIATE LEVEL OF DIAGS %INTEGER I I=SUPPORT(6,FAULT,INF,0) %END;!NDIAG !* %SYSTEMROUTINE GENOMF(%INTEGER N) %INTEGER I %RECORDNAME OBJ(OBJ FMT) %IF ERLREQ#0 %THENSTART ERL(SSCOMREG(15),SSCOMREG(14)) ERLGIVEN=1;! TO PREVENT REPETITION %FINISH OBJ==RECORD(OBJDATA) OBJ_MODULE=MAINEPNAME OBJ_MAINEP=MAINEPSET I=SUPPORT(4,N,0,0) %END;! GENOMF !* !* %SYSTEMLONGREALFN CPUTIME %RESULT=0 %END; ! CPUTIME !* !* %SYSTEMROUTINE ETOI(%INTEGER AD, L) %INTEGER I, J, K I = ADDR(ETOITAB(0)) %RETURNIF L <= 0 J = X'18000100' K = X'18000000'!L *LSS_I *LUH_J *LDTB_K *LDA_AD *TTR_%L=%DR %END; ! ETOI !* !*** ITOE !* %SYSTEMROUTINE ITOE(%INTEGER AD, L) %INTEGER I, J, K I = ADDR(ITOETAB(0)) %RETURNIF L <= 0 J = X'18000100' K = X'18000000'!L *LSS_I *LUH_J *LDTB_K *LDA_AD *TTR_%L=%DR %END; ! ITOE !* !* %SYSTEMROUTINE SIM2(%INTEGER EP,R1,R2,%INTEGERNAME R3) %INTEGER I,J,K %LONGINTEGER REF %OWNBYTEINTEGERARRAY B(0:133) !* %IF EP=0 %THENSTART;! READ LINE READ: *LSS_X'18000050' *PRCL_4 *SLSS_R1 *SLSD_0 *ST_%TOS REF=READ CARD *LD_REF *RALN_9 *CALL_(%DR) *ST_I %IF I=0 %THENSTART ;!SUCCESS TRANS: %IF CHAR CODE # ISO %THENSTART;! TRANSLATE K=AETOI *LSS_K *LUH_X'18000100' *LDTB_X'18000050' *LDA_R1 *TTR_%L=%DR %FINISH SETNL: BYTEINTEGER(R1+80)=NL R3=81 %RETURN %FINISHELSESTART %IF I=-3 %OR I=-2 %THENSTART;! END OF FILE LIST BYTEINTEGER(R1)=25 BYTEINTEGER(R1+1)=NL R3=2 %RETURN %FINISH %IF -4<=I<=1 %THEN -> READ;!END OF FILE (OTHER THAN LAST) %IF I = -255 %OR I=-509 %THEN -> TRANS;! OVERLENGTH RECORD %IF I = -511 %THEN -> SET BLANK ;! NOT TO BE COMPILED OR LISTED - BUT GIVE COMPILER A BLANK LINE %IF I = -512 %THENSTART;! NOT TO BE COMPILED (MAY NEED LISTING) ETOI(R1,80) SIM2(1,R1-1,80,I);! LIST THE LINE SET BLANK: %CYCLE I=0,1,79 BYTEINTEGER(R1+I)=' ' %REPEAT ->SETNL ->READ %FINISH %IF I = 256 %THENSTART ;! TRANSFER FAILURE !! MAY NEED SPECIAL ACTION %FINISH %MONITOR;%STOP %FINISH %FINISH %IF EP=1 %THENSTART;! WRITE LINE I = ADDR(B(2)) J = X'18000000'!R2 *LSS_R1 ;! ADDR(TEXT) *IAD_1 ;! SKIP CONTROL CHAR *LUH_J *LDA_I ;! TARGET ADDRESS *LDTB_J *MV_%L=%DR ;!COPY TO BUFFER (TO ENSURE 2 LEADING BYTES) %IF CHAR CODE #ISO %THENSTART;! TRANSLATE K=AITOE *LSS_K *LUH_X'18000100' *LDA_I *LDTB_J *TTR_%L=%DR %FINISH %IF CURRENT OUTPUT = LIST FILE %THENSTART;! STANDARD ROUTE *PRCL_4 *LSS_J *IAD_1 *SLSS_I *ISB_2 *ST_%TOS REF=OUTPUT LINE *LD_REF *RALN_7 *CALL_(%DR) %RETURN %FINISH %IF CURRENT OUTPUT=NOLIST %THEN %RETURN %IF CURRENT OUTPUT = LOGFILE %THENSTART LOG: K=SUPPORT(0,J-1,I,0);! PARAMS ARE DESCRIPTOR TO ACTUAL TEXT %RETURN %FINISH %IF CURRENT OUTPUT = DIAGFILE %THENSTART ! ACTION TO BE DEFINED -> LOG ;! PRO TEM %FINISH %MONITOR;%STOP %FINISH %IF EP=15 %THENSTART %IF R1=0 %THEN %RETURN ;! NO SELECTION TAKING EFFECT FOR INPUT %IF R2=99 %THEN CURRENT OUTPUT = LISTFILE %AND %RETURN %IF R2=100 %OR R2=107 %THEN CURRENT OUTPUT=LOGFILE %AND %RETURN %IF R2=87 %OR R2=106 %THENSTART CURRENT OUTPUT=DIAGFILE %RETURN %FINISH %FINISH %MONITOR;%STOP %END;!SIM2 !* %ROUTINE OUTPUT RECORD %INTEGER I,J,K %LONGINTEGER REF %IF OUTPTR=0 %THENSTART %IF CURRENT OUTPUT = LISTFILE %THENSTART;! USE NEWLINE INTERFACE K=SUPPORT(1,1,0,0) %RETURN %FINISHELSESTART OUTBUFF(0)=X'20' ;! SPACE OUTPTR=1 %FINISH %FINISH I = X'18000000'!OUTPTR OUTPTR=0 J = ADDR(OUTBUFF(0)) %IF CHAR CODE # ISO %THENSTART K=AITOE *LSS_K *LUH_X'18000100' *LDA_J *LDTB_I *TTR_%L=%DR %FINISH %IF CURRENT OUTPUT = LISTFILE %THENSTART *PRCL_4 *LSS_I *IAD_2 *SLSS_J *ISB_2 *ST_%TOS REF=OUTPUT LINE *LD_REF *RALN_7 *CALL_(%DR) %RETURN %FINISH %IF CURRENT OUTPUT=NOLIST %THEN %RETURN %IF CURRENT OUTPUT = LOGFILE %THENSTART LOG: K = SUPPORT(0,I,J,0) %RETURN %FINISH %IF CURRENT OUTPUT = DIAGFILE %THENSTART ! ACTION TO BE DEFINED ->LOG;! PRO TEM %FINISH %MONITOR; %STOP %END;!OUTPUT RECORD !* %SYSTEMINTEGERFN IOCP(%INTEGER EP,N) %INTEGER I,J,K,L %SWITCH SW(1:17) %UNLESS 0 SW(EP) !* !*** PRINT SYMBOL(N) SW(3): !* !*** PRINT CH(N) SW(5): %IF N=NL %OR N=NP %OR OUTPTR >= RTMARGIN %THENSTART OUTPUT RECORD %IF N=NP %AND CURRENT OUTPUT=LISTFILE %C %THEN I=SUPPORT(2,0,0,0) %FINISHELSESTART OUTBUFF(OUTPTR)=N&X'7F' OUTPTR=OUTPTR+1 %FINISH %RESULT=0 !* !*** PRINTSTRING(N) WHERE N IS ADRESS OF STRING SW(7):L=BYTEINTEGER(N) %IF L=0 %THEN %RESULT=0 %CYCLE I=1,1,L J=BYTEINTEGER(I+N)&X'7F' %IF J=NL %THEN OUTPUT RECORD %ELSESTART OUTBUFF(OUTPTR)=J OUTPTR=OUTPTR+1 %IF OUTPTR>=RTMARGIN %THEN OUTPUT RECORD %FINISH %REPEAT %RESULT = 0 !* !*** SELECT OUTPUT(N) SW(9):%IF OUTPTR>0 %THEN OUTPUT RECORD SIM2(15,1,N,K) %RESULT=0 !* !*** RESTRICTED PRINTSTRING. STRING MUST HAVE NO UNPRINTABLES OR !*** CONTROLS (EXCEPT LAST CHAR) AND MAY NOT EXCEED MARGINS SW(15):L = BYTEINTEGER(N)!X'18000000' I=ADDR(OUTBUFF(OUTPTR)) *LSS_N ;! ADDRESS OF STRING *IAD_1 ;! SKIP LENGTH BYTE *LUH_L *LDA_I ;! NEXT FREE BUFFER LOCATION *LDTB_L *MV_%L=%DR *INCA_-1 ;! EXAMINE LAST CHAR *LSS_(%DR) *ST_I OUTPTR=OUTPTR +(L&255) %IF I=10 %THEN OUTPTR=OUTPTR-1 %AND OUTPUT RECORD %RESULT=0 !* !*** MULTIPLE PRINT SYMBOL SW(17):I=N&127 J=N>>8 %IF N<0 %OR J=0 %THEN %RESULT=0 %IF I=NL %THENSTART %IF OUTPTR >0 %THEN I=IOCP(3,NL) %AND J=J-1;! FORCE OUT CURRENT LINE %IF J>0 %THEN I=SUPPORT (1,J,0,0);! CALL MULTIPLE NEWLINE INTERFACE %FINISHELSESTART %CYCLE L=1,1,J K=IOCP(3,I) %REPEAT %FINISH %RESULT=0 !* SW(1): ! READ SYMBOL SW(2): ! NEXT SYMBOL SW(4): ! READ CH SW(6): ! LINE RECONSTRUCTION SW(8): ! SELECT INPUT SW(10): ! ISO CARD SW(11): ! CLEAR BUFFER SW(12): ! SET INPUT MARGINS SW(13): ! SET OUTPUT MARGINS SW(14): ! ADDRESS OF INPUT RECORD %MONITOR ; %STOP %END;! IOCP !* %SYSTEMROUTINE WRITE(%INTEGER I,N) %STRING(16) S %INTEGER D0,D1,D2,D3,MINCHARS,J N=N&15 %IF I=0 %THENSTART %IF N=0 %THEN N=1 SPACES(N) PRINTSYMBOL('0') %RETURN %FINISH D0=X'18000010' D1=ADDR(S)+1 *LD_D0 *LSS_I *CDEC_0;! 15 DECIMAL DIGITS IN ACC *MPSR_X'20';! SET CC=0 *SUPK_%L=15,0,32;! UNPACK 15 DIGITS, LEADING ZEROS SUPPRESSED *STD_D0;! DESCRIPTOR TO END OF UNPACK AREA *LSD_%TOS *ST_D2;! DESCRIPTOR TO POTENTIAL SIGN POSITION %IF D1-D3<3 %THENSTART;! ZERO MINCHARS=2 ->SETLEN %FINISH %IF I<0 %THEN BYTEINTEGER(D3)='-' MINCHARS=D1-D3 SETLEN:SPACES(N-MINCHARS+1) J=MINCHARS+1 D1=D1-J *LD_D0 *LDB_J;! LENGTH OF STRING *LB_J *SBB_1 *MVL_%L=1;! INSERT LENGTH *MODD_1;! POINT TO FIRST DIGIT *MVL_%L=%DR,15,48;! SET TOP QUARTETS FOR ISO J=IOCP(15,D1);! FAST PRINTSTRING %END;! WRITE !* !* %SYSTEMINTEGERFN SUBHEADING (%STRING(255) TEXT, %INTEGER LINES,NEWPAGE) %INTEGER I,J,K %STRING(255) T T = TEXT I = LENGTH(T)!X'18000000' J = ADDR(T)+1 %IF CHAR CODE # ISO %THENSTART K = AITOE *LSS_K *LUH_X'18000100' *LDA_J *LDTB_I *TTR_%L=%DR %FINISH K=SUPPORT(3,ADDR(I),LINES,NEWPAGE) %RESULT = K %END;! SUBHEADING !* %SYSTEMROUTINE SUMMARY(%INTEGER ADDRSUMLINE) %INTEGER K K=SUPPORT(7,ADDRSUMLINE,0,0) %END;! SUMMARY !* %SYSTEMROUTINE DUMP(%INTEGER I,J) %END !* %SYSTEMROUTINE SSMESS(%INTEGER I) %END !* %SYSTEMINTEGERMAP COMREG(%INTEGER N) %RESULT = ADDR(SSCOMREG(N)) %END;! COMREG !* %SYSTEMROUTINE STOP !* CALLED BY COMPILER ON TERMINATION (SUCCESSFUL OR OTHERWISE) %INTEGER I I = COMPILER LNB ;! NOTED BEFORE ENTRY TO COMPILER *LLN_I *EXIT_-64 %END;! STOP ! UPDATED 28/03/79 !* !* !*EMAS %SYSTEMROUTINESPEC DUMP(%INTEGER A, B) !*EMAS %SYSTEMROUTINESPEC SSERR(%INTEGER N) !*EMAS %SYSTEMINTEGERMAPSPEC COMREG(%INTEGER I) !*EMAS %SYSTEMROUTINESPEC OUTFILE(%STRING (15) S, %C %INTEGER LENGTH, MAXBYTES, PROTECTION, %C %INTEGERNAME CONAD, FLAG) !* !* %ROUTINE MOVE(%INTEGER LENGTH, FROM, TO) %INTEGER I %RETURNIF 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 %RETURNIF LENGTH <= 0 I = X'18000000'!LENGTH *LDTB_I *LDA_FROM *LB_FILLER *MVL_%L=%DR %END !* !* %EXTERNALROUTINESPEC NCODE(%INTEGER I,J,K) !* %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>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 !* !* %EXTERNALROUTINE 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) %RECORDFORMAT RF13(%INTEGER LINK,A,DISP,LEN,REP,ADDR) %RECORDFORMAT RF27(%INTEGER TYPE,LINK,LINE,INF,%STRING(32) NAME) %RECORDNAME R0(RF0) %RECORDNAME R1(RF1) %RECORDNAME R4(RF4) %RECORDNAME R6(RF6) %RECORDNAME R7(RF7) %RECORDNAME R8(RF8) %RECORDNAME R9(RF9) %RECORDNAME R13(RF13) %RECORDNAME R27(RF27) %INTEGER I, J, K, L, FLAG, SAVEHEAD %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 : 9) %OWNINTEGERARRAY AREALENGTH(1 : 9) %OWNINTEGERARRAY AREASTART(1 : 9) %OWNINTEGERARRAY AREAPROP(1:9) %OWNINTEGER RCOUNT %OWNINTEGER TYPE19NUM %OWNSTRING (15) FILE %OWNINTEGER STACKMODE %OWNINTEGER LANGUAGE %OWNINTEGER COMREG57 %OWNINTEGER NAMESET %OWNINTEGER NUMEXT %OWNINTEGER NUMFIXUPS %OWNINTEGER PACK5 %OWNINTEGER DECODEHEAD,DECODETAIL,PROLOGUE %INTEGER OBJLEN %INTEGER LDSTART,LDDISP,LAST13 %INTEGER CODE OFFSET,CONST OFFSET %STRING (32) CHANGEDNAME, EPNAME,LEFTID,RIGHTID %CONSTBYTEINTEGERARRAY CHANGE(0 : 49) = %C 0(10),1(6),0(6),1,0,1,0(25) %SWITCH EP(0 : 49) %SWITCH LSW(0 : 49) %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 !*EMAS CODEBASE = COMREG(15)+32 !* !*VME; NULLFLAG=NULLOBJ !*VME; FBASE=TMPAREA !*VME; CODEBASE=FBASE+32 !* !* CODEMAX = CODEBASE+X'40000' !*VME; WORKAD=WRKAREA !*EMAS 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,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 %RETURN %FINISH %RETURN %UNLESS NULLFLAG = 0 !* %IF CHANGE(TYPE) = 1 %START !* !*EMAS %IF STRING(P3) -> ("ICL9CM").EPNAME %THENSTART !*EMAS CHANGEDNAME = "M#".EPNAME !*EMAS %FINISHELSESTART !* CHANGEDNAME = STRING(P3) !* !*EMAS %FINISH !* %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 !* !*EMAS SELECTOUTPUT(0) !*EMAS COMREG(24)=1; !TO GIVE COMILATION FAULTY MESSAGE !*EMAS PRINTSTRING("WORK FILE TOO SMALL") !*EMAS %MONITOR !*EMAS %STOP !* !*VME; LPUTERROR=228 !* NULLFLAG = -1; ! WILL GENERATE FAILURE LATER TON = TBASE+40; ! AVOID ERROR MEANTIME %FINISH %FINISH %END; ! CHECKWORK !* EP(37): 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(40): EP(41): EP(42): EP(43): EP(44): EP(45): EP(46): EP(47): 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 = 'ICL9HFMAIN' %C %ELSE EPNAME = CHANGEDNAME !* !*EMAS %IF COMREG57 # 0 %THEN %START !* %IF P1>>31 # 0 %THEN %START !* !*EMAS COMREG(60) = COMREG(60)!2; ! EXISTENCE OF MAIN EP !* !*VME; MAINEPSET=1 !* SETEPNAME: !* !*EMAS STRING(COMREG57) = EPNAME !* !*VME; MAINEPNAME=EPNAME !* %FINISHELSESTART %IF NAMESET = 0 %THEN -> SETEPNAME %FINISH NAMESET = 1 !* !*EMAS %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 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 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 %THENSTART;! fill in prologue %IF PROLOGUE#0 %THENSTART R27==RECORD(PROLOGUE) R27_INF=P2 MOVE(32,P3,PROLOGUE+16) PROLOGUE=0 %FINISH %RETURN %FINISH !* CHECKWORK(48) R27==RECORD(TON) %IF DECODEHEAD=0 %THENSTART DECODEHEAD=TON %FINISHELSESTART %IF P1=-2 %THENSTART;! epilogue may need to overwrite last statement %IF INTEGER(DECODETAIL+12)<<14=P2<<14 %THENSTART;! overwrite R27==RECORD(DECODETAIL) R27_LINE=-2 R27_INF=P2 %RETURN %FINISH %FINISH INTEGER(DECODETAIL+4)=TON %FINISH DECODETAIL=TON !* %IF P1=-1 %THENSTART;! prologue I=48;! allow full string %IF P3=0 %THENSTART;! to be filled in later PROLOGUE=TON %FINISHELSESTART MOVE(32,P3,TON+16) %FINISH %FINISHELSE 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 SAVEHEAD=DECODEHEAD %WHILE DECODEHEAD#0 %CYCLE R27==RECORD(DECODEHEAD) I=R27_LINE J=R27_INF>>18;! length %IF J#0 %THENSTART K=(R27_INF<<14)>>14;! address %IF I>0 %OR I=-2 %THEN K=K+P1 NEWLINE %IF I=-3 %THENSTART PRINTSTRING(" CONSTANT AREA ") DUMP CONSTS(FBASE+32+K,J,K) %FINISHELSESTART %IF I=-1 %THENSTART PRINTSTRING("PROLOGUE FOR ENTRY ".STRING(DECODEHEAD+16)) %FINISHELSESTART %IF I=-2 %THENSTART PRINTSTRING("EPILOGUE") %FINISHELSESTART PRINTSTRING("LINE ") WRITE(I,1) %FINISH %FINISH NEWLINES(2) NCODE(FBASE+32+K,FBASE+32+K+J,K) %FINISH %FINISH DECODEHEAD=R27_LINK %REPEAT DECODEHEAD=SAVEHEAD;! IN CASE CALLED A SECOND TIME FOR DISPLAY %RETURN !* EP(7): ! END OF FILE %IF P1 >= 32 %THEN STACKMODE = 1 %IF P1=40 %THENSTART;! F77 with prologue insertion CODE OFFSET=INTEGER(P3+32) CONST OFFSET=INTEGER(P3+36) %FINISHELSESTART 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) !* !*EMAS OUTFILE(FILE,OBJLEN,0,0,FBASE,FLAG) !*EMAS %IF FLAG # 0 %THEN SSERR(228); ! PROGRAM TOO LARGE !* !*VME; %IF OBJLEN>INTEGER(FBASE+8) %THENSTART !*VME; LPUTERROR=228 !*VME; %RETURN !*VME; %FINISH !* %CYCLE I = 1,1,7 AREALENGTH(I) = BASE(I) %REPEAT AREASTART(1) = 32 AREASTART(4) = AREASTART(1)+AREALENGTH(1);! CST AFTER CODE AREASTART(2) = AREASTART(4)+AREALENGTH(4);! GLA AFTER CST %IF PACK5#0 %THENSTART AREASTART(5)=0 AREASTART(6)=AREASTART(2)+AREALENGTH(2) %FINISHELSESTART 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 %THENSTART I=R0_LA>>24 R0_LA=R0_LA&X'FFFFFF' ->PACKCMN1 %FINISH %IF I=45 %AND PACK5#0 %THENSTART 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 %THENSTART 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 %THENSTART;! BYTE R13_LEN=1 R13_REP=-R0_DATALEN R13_ADDR=R0_FILLER LDDISP=LDDISP+24 %FINISHELSESTART 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: !* !*EMAS %IF BYTEINTEGER(TON) = X'81' %START !*EMAS %MONITOR !*EMAS DUMP(TON-20000,TON+32) !*EMAS %STOP !*EMAS %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): %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 %THENSTART;! 'DATA OR PROCEDURE' REFERENCE K=10 J=HEAD(22) %FINISHELSESTART 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 %THENSTART;! 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 %THENSTART 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 L = (L+11)&X'FFFFFFF8' INTEGER(FBASE) = L-FBASE H(2) = NUMEXT H(3) = NUMFIXUPS MOVE(60,ADDR(H(0)),LDSTART) ! CHANGES ACCESS MODE %RETURN %END; ! LPUT !* !* %ENDOFFILE