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!=>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!_LOC(LRESTART); !.JBVER!_!.JBVER!+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; 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-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; [BU]_[BU] AND NOT (1 LS 35); BU_[BU]; [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; [BU]_[BU] AND NOT (1 LS 35); BU_[BU]; [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) %%%