Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-02 - decus/20-0068/impm.imc
There are 2 other files named impm.imc in the archive. Click here to see a list.
TWOSEG;
# THIS IS FILE IMPM, DRIVER PROGRAM AND A FEW UTILITY SUBRS #

!.JBVER! IS COMMON; !.JBVER!_200105777777B;
FINAM IS COMMON,6 LONG;
FREL,FLST,GREL,GLST ARE 2 LONG;
8R IS RESERVED,SCRATCH;

IMPSMD IS COMMON;
BHEAD IS COMMON,3 LONG;
BUF IS 262 LONG; BF IS 17 LONG;
CALLI(0,0); BHEAD_LOC(BUF)+1;
BUF[1]_LOC(BUF)+132+129 LS 18;
BUF[132]_LOC(BUF)+1+129 LS 18;

DEV_'DSK'; FINAM_'SYNTAX'; FINAM[1]_'SYNTAX'[1];
(FINAM[2]_SEXTS[I]; LEXIN()=0=>GO TO GOTCHA) FOR I FROM 1;
MSG(!'CAN'T FIND FILE: SYNTAX.!); CALLI(12B,0);
REMOTE SEXTS: DATA('IMP','IMC');
GOTCHA: IMPSEM(0); CODEI(0); FINCSET(0,20);
RSYN(0);
TMPFL(PNA,'IMP'); PRINT FILE PNA.'TMP';
DD_CALLI(14B,0);
GOTFILE_1;
LET TBUF=IMPSMD;
(IMPSMD[8R]_0) FOR 8R FROM 127;


AGAINSAM: T0_CALLI(27B,0); HITHERE_'IMP 0'; HITHERE[1]_'.0   ';

DATE(HITHERE[2],DD); REMOTE HITHERE: DATA('IMP 0.0    11-OCT-72');
HITHERE_HITHERE OR 36B AND !.JBVER! RS 23;
HITHERE[1]_HITHERE[1] OR 360000000B AND !.JBVER! LS 4;
!.JBVER!<R>=>HITHERE[1]<21,1>_('(@)' RS 15) + !.JBVER!<5,0> LS 7;
HITHERE[3]_(HITHERE[3] RS 7) OR (377B AND HITHERE[2]) LS 28;
HITHERE[2]_' ' OR HITHERE[2] RS 7;

          CUSP => GETMP(BF);
          CUSP=0 => (MSG(HITHERE); GETTY(BF);
		BF<7,29>=R'?'=>(MSG('TYPE /H FOR HELP.');
				GO TO AGAINSAM));
          READCMD(BF,FINAM,GREL,GLST,DEV,RPGM);
          FINAM[5] AND 200B => (HELP(0); GO TO AGAINSAM);
          FINAM[5] AND 10B => (LOC(HELPD) => HELPD(0); GO TO AGAINSAM);
          GREL => (FREL_GREL; FREL[1]_GREL[1]);
          GLST => (FLST_GLST; FLST[1]_GLST[1]);
          FINAM=0 => FINAM[5]=0 => RPGM => RUNPGM(RPGM);

FINAM => (LEXIN() NE 0 => GO TO AGAINSAM;
	    GOTFILE_1;
          PNA,LCL ARE 3 LONG; TMPFL(PNA,'IMP');
          PRINT FILE PNA.'TMP', STG 0,'   ',HITHERE,'      ',
                FINAM;  FINAM[2] => PRINT '.',FINAM[2];
          J_CALLI(24B,0); PRINT '[', OCT 0,J RS 18, STG 0,',',
                OCT 0,J AND 777777B, STG 0,']      ';
          DATE(LCL,CALLI(14B,0)); PRINT LCL,'   '; TIME(LCL); PRINT LCL,/,/;
          CUSP => (OUTSTR('IMP10: '); OUTSTR(FINAM);
                   FINAM[2] => (OUTSTR('.'); OUTSTR(FINAM[2]));
                   OUTSTR(' ')));


FINAM[5] AND 40000000B => GPRINT(0);
FINAM[5] AND  2000000B => TPRINT(0);
FINAM[5] AND  1000000B => SEMPER(0);
FINAM[5] AND       40B => (FTRACE(2); FMAP(-1));
FINAM[5] AND 14000000B => (!.JBSA! IS COMMON;
                           !.JBSA!<R>_LOC(LRESTART);
                           !.JBVER!<R>_!.JBVER!<R>+1;
			   HISEG IS 6 LONG; HISEG[1]_CALLI_0;
			   (FINAM[5] AND 10000000B)=>((777777B AND
				J_CALLI(41B,XWD -1,14B))=>CALLI=0=>
				(J AND 1 LS 34)=>(
		# SET UP HISEG FOR SHARABLE HIGH SEGMENT #
		J_J<R>;
		HISEG_CALLI(41B,XWD J,24B);
		HISEG[1]_CALLI(41B,XWD J,3);
		HISEG[2]_HISEG[3]_HISEG[5]_0;
		HISEG[4]_CALLI(41B,XWD J,2));
			HISEG[1]=0=>MSG('CAN''T SHARE OLD HIGH SEG.'));
                           MSG('** SSAVE COMPILER **');
			   DD_CALLI(14B,0);
                           CUSP_0; FINI(-1);
			   GO TO LOWSEGCODE;

REMOTE (LOWSEGCODE:
	HISEG[1]=>CALLI(11B,XWD 1,0); #DELETE HIGH SEG#
	CALLI(12B,0); # AND EXIT #

HSWD: DATA(777777000014B);
TTCALL: DATA(051140000000B);
TTMSG: DATA(TTMSGG);
TTMSGG: DATA('?? HIGH SEGMENT MISSING');

     LRESTART:
	CUSP_-1; CUSP_CUSP+1;
	CALLI(0,0);
	CALLI_0;
	(777777B AND CALLI(41B,HSWD))=0=>CALLI=0=>(
		# MUST GET HIGH SEGMENT #
		CALLI_0; CALLI(40B,LOC(HISEG));
		CALLI=>(EXECUTE(TTCALL+TTMSG);
			CALLI(12B,0)));
	GO TO RESTART);

     RESTART: BULLDOG_(CALLI(41B,XWD 20B,11B)=230B);
	GMATR(-1);
	BSTATS(0);
	GOTFILE_0;  GO TO AGAINSAM);

GOTFILE=0=>GO TO AGAINSAM;
ERR_0; STINIT(0); COTREE(0);
PARSE('#PG'); CKDONE(0);

FIN: SW_FINAM[5] AND NOT 110400004B;
SW => (PST_PSTATS(0);
	PST_(PST*1000)/TPT_CALLI(27B,0)-T0;
	PRINT STG 0,'COMPILATION TIME ',IGR 0,TPT,STG 0,' MSEC.; ',
		IGR 0,PST,STG 0,' TOKENS/SEC.',/;
	FINAM[5] AND NOT 114440005B=>( K_GMATR(-1);
	       K=>PRINT STG 0,'GRAPH MATRIX CONSTRUCTION TIME ',
	             IGR 0,K, STG 0,' MSEC ',/;
	       DSTATS(0); BSTATS(1));
	FSTATS(0));
FINAM[5] AND 4 => GO TO AGAINSAM;
#MARK('** COMPILATION COMPLETED,');#
FINI(-1); C_5; INIT(C,14);
SW => LOOKUP(C,FLST,'LST',0,0)=0 => RENAME(C,0,0,0,0);
LOOKUP(C,PNA,'TMP',0,0)=0 => (SW =>
	 RENAME(C,FLST,'LST',0,0) ELSE RENAME(C,0,0,0,0));
CORE(FORG); CUSP => RUNPGM(RPGM); SW=>PEEKAT(); FINI(0);


SUBR HELP(NIL) IS (
 MSG('TYPE FILENAME.EXT TO COMPILE FROM THAT FILE TO FILENAME.REL.');
 MSG(' DEFAULT EXTENSION IS EITHER NULL OR IMP.');
 MSG(' FILE NAME MAY BE FOLLOWED BY /A/B/C... WHERE A,B,C ARE');
 MSG('       SINGLE LETTER SWITCHES AS FOLLOWS:');
 MSG('A = PRODUCE AN ASSEMBLY LISTING');
 MSG('C = CONTINUE BY COMPILING ANOTHER FILE AFTER THIS ONE');
 MSG('H = TYPE THIS LIST OF SWITCHES');
 MSG('L = PRODUCE A SOURCE LISTING');
 MSG('R = GENERATE A RE-ENTRANT SEGMENT OF CODE');
 MSG('U = EXIT TO SAVE COMPILER.');
 MSG('V = EXIT TO SAVE COMPILER, KEEPING SAME HIGH SEG.');
 MSG('Y = LIST SOURCE ON TTY');
 MSG('NULL FILENAME MEANS KEEP GOING ON CURRENT FILE'));

SUBR MSG(M) IS (OUTSTR(M); OUTSTR(64240000000B));

SUBR ERROR(N,E) IS (
 N LE 1=>FINAM[5]_FINAM[5] OR 4000B;
 BULLDOG=>OUTCHR(7);
 E=>(N<2=>(OUTSTR('** ERROR - ');
           PRINT STG 0,'** ERROR - ');
     N=2=>(OUTSTR('** ADVISORY - ');
           PRINT STG 0,'** ADVISORY - ');
     MSG(E); PRINT STG 0,E,/);
 ERR_-1; N=0 => (FINAM[5]_FINAM[5] AND NOT 4; GO TO FIN));

#SUBR MARK(S) IS (
 T_CALLI(27B,0); BULLDOG=>OUTCHR(7);
 S=>(PRINT STG 0,S,'  TIME='; OUTSTR(S); OUTSTR('  TIME=');
     T0_T-T0; BAS_10000000;
     L91: BAS>1000=>BAS>T0=>(BAS_BAS/10; GO TO L91);
     L92: BAS=100=>(PRINT '.'; OUTSTR('.'));
          K_T0/BAS; J_K+60B; OUTCHR(J); PRINT J LS 29;
          T0_T0-K*BAS; (BAS_BAS/10)=>GO TO L92;
          PRINT ' SEC. ',/; MSG(' SEC.'));
 T0_T);#

SUBR PEEKAT() IS (BULLDOG=0 => RETURN 0;
                  P_BYTEP FLST<7,36>; OP_BYTEP PNA<7,36>;
                  P1: (I_<+P>) => (<+OP>_I; GO TO P1);
                  PF=0=>(PF_-1; P_BYTEP '.LST'<7,36>; GO TO P1);
                  PNA[2]_0; PEEK(PNA));

SUBR DATE(A,JJ) IS (
 J_JJ;
 K_J/31; DAY_1+J-31*K;
 J_K/12; MO_K-12*J;
 YR_64+J;
 A_MOS[MO];
 A[1]_A LS 21;
 A_'00' OR A RS 14;
 K_YR/10; YR_YR-10*K;
 A[1]_A[1]+((60B+K) LS 15)+(60B+YR) LS 8;
 K_DAY/10; DAY_DAY-10*K;
 A_A+(K LS 29)+DAY LS 22;
 K=0=>A_A-20B LS 29);
 MOS: DATA ('-JAN--FEB--MAR--APR--MAY--JUN--JUL--AUG--SEP--OCT--NOV--DEC-');

SUBR TIME(A) IS (
 J_CALLI(23B,0)/60000;
 HR_J/60; MIN_J-60*HR;
 J_HR/10; K_HR-10*J;
 A_((060B+J) LS 29)+((060B+K) LS 22)+(072B LS 15);
 J_MIN/10; K_MIN-10*J;
 A_A+((060B+J) LS 8)+((060B+K) LS 1);
 A[1]_0);

SUBR OUTCHR(M) IS  (DATA(051076000000B); 0);

SUBR OUTSTR(M) IS  (DATA(051176000000B); 0);

SUBR INCHWL(NIL) IS  (DATA(051200000000B); 0R);

SUBR CORE(N) IS (NRET_1; 8R_N;
                 DATA(047400000011B); NRET_0;
                 NRET);

SUBR TMPFL(F,N) IS (J_CALLI(30B,0); K_J/10; J_J-10*K;
                    F_'0'+((K+060B) LS 22)+((J+060B) LS 15);
                    F_F OR N RS 21; F[1]_N LS 14);

SUBR RUNPGM(N) IS (N => (RBK IS 6 LONG;
                         RBK_SIXBIT('SYS'); RBK[1]_N;
                         8R_LOC(RBK)+1 LS 18;
                         DATA(047400000035B);
                         OUTSTR('CANNOT RUN PROGRAM.');
                         FINI(0)));

SUBR TMPCOR(F,L) IS (TBK IS 2 LONG;
                     TBK_SIXBIT('I10');
                     TBK[1]_(-L LS 18)+LOC(TBUF)-1;
                     8R_LOC(TBK)+F LS 18;
                     DATA(047400000044B); 8R_0;
                     F NE 3 => L_8R);

SUBR RLEAS(CH) IS (8R_(071B LS 27) OR CH LS 23; EXECUTE 8R; 0);

SUBR GETMP(BF) IS (LCOR_128; TMPCOR(2,LCOR); K_LCOR;
                   LCOR=0 => (LST_(-128 LS 18)+LOC(TBUF)-1; LST[1]_0;
                              TFL IS 2 LONG; TMPFL(TFL,'I10');
                              K_128; CH_3; INIT(CH,14);
                              LOOKUP(CH,TFL,'TMP') => (CUSP_0; RETURN 0);
                              INPUT(CH,LST); RENAME(CH,0,0); RLEAS(CH));
                   K GE 128 => K_127; TBUF[K]_0;
                   P0_P_BYTEP TBUF<7,36>;
                   Q_BYTEP BF<7,36>; R IS REGISTER;
                   GT: R_<+P>;
                       R=041B => R_134B;
                       R GE 040B => <+Q>_R;
                       R => (R NE 015B => GO TO GT);
                   <+Q>_045B; Q_P0; K_0;
                   WHILE R_<+P> DO (<+Q>_R; R GE 040B => K_1);
                   <+Q>_0 FOR J FROM 9;
                   K=0 => (RPGM_0; RETURN 0);
                   RPGM_SIXBIT('IMP10');
                   LCOR => (LCOR_Q<R>-LOC(TBUF);
                            TMPCOR(3,LCOR); RETURN 0);
                   CH_4; INIT(CH,14);
                   ENTER(CH,TFL,'TMP');
                   OUTPUT(CH,LST); RLEAS(CH));

SUBR OPENOUT() IS (CH_2;
                   BU_BHEAD<R>; [BU]_[BU] AND NOT (1 LS 35);
                   BU_[BU]<R>; [BU]_[BU] AND NOT (1 LS 35);
                   INIT(CH,0,'DSK',BHEAD,'0'); BHEAD_BU OR 1 LS 35;
                   ENTER(CH,FREL,'REL',0,0) NE 0 =>
                                        ERROR(0,'CANNOT CREATE .REL FILE. ');
                   CH);

SUBR OPENIN() IS (CH_1;
                  BU_BHEAD<R>; [BU]_[BU] AND NOT (1 LS 35);
                  BU_[BU]<R>; [BU]_[BU] AND NOT (1 LS 35);
                  INIT(CH,0,DEV,'0',BHEAD); BHEAD_BU OR 1 LS 35;
                  LKUP: LOOKUP(CH,FINAM,FINAM[2],FINAM[3],FINAM[4])
                           => (FINAM[2]=0 => (FINAM[2]_'IMP'; GO TO LKUP);
                               MSG('? FILE NOT FOUND'); CH_0);
                  CH) %%%