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) %%%