PDP-10 Archive: 43,50306/code2.imc from decuslib10-03

Google Enter your search terms Submit search form

Web pdp-10.trailing-edge.com

---

Trailing-Edge - PDP-10 Archives - decuslib10-03 - 43,50306/code2.imc

---

There are 2 other files named code2.imc in the archive. Click here to see a list.

---

# THIS IS FILE CODE2, HOLDING OVERFLOW FROM FILE CODE, Q.V. FOR DOCUMENTATION #
TWOSEG;
CO,NCO,CONST ARE COMMON;
SUBR CODE2I(NIL) IS (
 DSEM('DEWFUN',DEWFUN);
 DSEM('HOOK',HOOK);
 DSEM('FREEZE',FREEZE);
 DSEM('SUBRCALL',SUBRCALL);
 DSEM('RETURN',RETURN);
 DSEM('SUBRPAR',SUBRPAR);
 DSEM('CONOP',CONOP);
 DSEM('FLOAT',FLOAT);
 DSEM('FIX',FIX);
 DSEM('PRINCAL',PRINCAL);
 DSEM('PRINPAR',PRINPAR);
 DSEM('OJUMPOP',OJUMPOP);
 DSEM('DATAST',DATAST);
 DSEM('ADDR',ADDR);
 DSEM('COPY',COPPY);
 MALAMUD_DIR('IFIX');
 CODE3I(0);
 0);
SUBR HOOK(D,A,B) IS (
 FREES(D,FREE(B)); FREES(D+1,FREE(B+1));
 (J_FREE(B+2))=0=>(FREES(D+2,FREE(A+2)); GO TO HEX);
 (K_FREE(A+2))=0=>(FREES(D+2,J); GO TO HEX);
 FREES(CO+K AND 777777B,400000000000B OR J RS 18);
 FREES(D+2,(K AND 777777000000B) OR J AND 777777B);
 HEX: D);
SUBR CONOP(S,T,I,V,W) IS (
 CO1_FREE(S+1); T=>CO2_FREE(T+1);
 GO TO (C0,C1,C2,C3,C4,C5,C6,C7,C8,C9,C10,C11,C12,C13,C14,
 C15,C16,C17,C18,C19) I AND 777777B;
 C0: CO1_-CO1; GO TO CX;
 C1: CO1_CO1+CO2; GO TO CX;
 C2: CO1_CO1-CO2; GO TO CX;
 C3: CO1_CO1*CO2; GO TO CX;
 C4: CO1_CO1/CO2; GO TO CX;
 C5: CO1_CO1 LS CO2; GO TO CX;
 C6: CO1_NOT CO1; GO TO CX;
 C7: CO1_CO1 AND CO2; GO TO CX;
 C8: CO1_CO1 OR CO2; GO TO CX;
 C9: CO1_(CO1<CO2); GO TO CX;
 C10:CO1_(CO1=CO2); GO TO CX;
 C11:CO1_(CO1 LE CO2); GO TO CX;
 C12: # THIS SPACE AVAILABLE - CALL (314) 159-2656 #
 C13:CO1_(CO1 GE CO2); GO TO CX;
 C14:CO1_(CO1 NE CO2); GO TO CX;
 C15:CO1_(CO1>CO2); GO TO CX;
 C16:CO1_CO1 ALS CO2; GO TO CX;
 C17:CO1_CO1 LROT CO2; GO TO CX;
 C18:CO1_CO1 XOR CO2; GO TO CX;
 C19:CO1_CO1 EQV CO2; GO TO CX;
 CX: (I_I RS 18)=>(# SPECIAL DEALIE FOR CONDITIONALS #
 I=1=>(CO1=0=>GO TO CXC;
 FREES(S+I,FREE(V+I)) FOR I FROM 2;
 GO TO CXT);
 I=2=>(CO1=0=>(FREES(S+I,FREE(W+I)) FOR I FROM 2)
 ELSE(FREES(S+I,FREE(V+I)) FOR I FROM 2);
 GO TO CXT));
 CXC: FREES(S+1,CO1);
 J_FREE(S); FREES(S,J AND 777777B);
 T=>HOOK(S,T,S);
 CXT: S);
SUBR FREEZE(S) IS (
 T_ENSTACK(0);
 ADDCODE(T,203000000000B,0);
 ADDCODE(S,204000000000B,0);
 HOOK(S,T,S));
SUBR SUBRCALL(T) IS (
 SUBPR0(0);
 TT_FREE(T); DSE_TT RS 18;
 DPROP('COM',DSE) NE 2=>DPROPS('COM',DSE,1);
 DEWOP(266B,AREG(16B),DEWFUN(T,1,15B));
 TT_FREE(T); FREES(T,2 OR TT AND NOT 77B);
 J_AREG1(140B,0); FREES(T+1,J LS 18);
 T);
SUBR RETURN(S) IS (
 DEWOP(200B,-AREG1(100B,0),S);
 J_NSUBP(0);
 K_AREG(16B);
 ADDCODE(S,26700000000B OR K OR K LS 12,J LS 18);
 S);
SUBR ONEWORD(S) IS (
 VAL_0; J_FREE(S+2);
 J=0=>GO TO ONEX;
 J_J RS 18;
 L1: J=>(T_FREE(CO+J); TY_T RS 34;
 TY=2=>(J_T AND 777777B; GO TO L1);
 TY=1=>GO TO ONEZ; # CAN'T TRUST SPECIAL FUNCTIONS #
 J_J+2; VAL=0=>(VAL_1; GO TO L1);
 ONEZ: VAL_0);
 ONEX: VAL);
SUBR COPPY(S) IS (
 W_ENSTACK(0);
 FREES(W,FREE(S)); FREES(W+1,FREE(S+1));
 FREES(W+2,FREE(S+2));
 FREE(W+2)=>COPYCO(W); W);
SUBR OPCODE(OP,R1,R2) IS (
 VAL_1;
 (OP GE [OPT[I]]=>OP LE [OPT[I]+1]=>(
 R1_[OPT[I]+2+(OP-[OPT[I]]) RS 2];
 (J_(R1 RS 29)-60B)>9=>(J_1) ELSE (R1_R1 LS 7);
 R2_SFT[(4*J)+3 AND OP];
 GO TO OPX)) FOR I TO 2;
 OP GE JPT=>OP LE JPT[1]=>(
 R1_JPT[2+(OP-JPT) RS 3];
 R2_JSFT[7 AND OP]; GO TO OPX);
 (OP=EXTB[I]=>(R1_EXTB[I+1]; R2_SFT; GO TO OPX)) FOR I IN 0,2,28;
 VAL_0;
 OPX: VAL);
 EXTB: DATA(133B,'IBP' , 134B,'ILDB' ,135B,'LDB', 136B,'IDPB', 137B,'DPB',
 240B,'LSH', 241B,'ROT', 242B,'LSH', 254B,'JRST', 266B,'JSA',
 267B,'JRA', 132B,'FSC',
	 256B,'XCT', 251B,'BLT',
	 047B,'CALLI' # DON'T INSERT ANY HERE #);
 OPT: DATA(OPT1,OPT2,OPT3);
 SFT: DATA(' ','L ','M ','B ');
 DATA(' ','I ','M ','B ');
 DATA(' ','I ','M ','S ');
 OPT1: DATA(140B,237B,
 '0FAD','1FADR0FSB','1FSBR0FMP','1FMPR0FDV',
 '1FDVR2MOVE2MOVS2MOVN2MOVM1IMUL1MUL','1IDIV1DIV');
 OPT2: DATA(270B,277B,'1ADD','1SUB');
 OPT3: DATA(400B,577B,
 'SETZ','AND','ANDCASETM','ANDCMSETA','XOR','OR',
 'ANDCBEQV','SETCAORCA','SETCMORCM','ORCB','SETO');
 DATA('2HLL','2HRL','2HLLZ2HRLZ2HLLO2HRLO2HLLE2HRLE2HRR',
 '2HLR', '2HRRZ2HLRZ2HRRO2HLRO2HRRE2HLRE');
 JSFT: DATA(' ','L ','E ','LE ','A ','GE ','N ','G ');
 JPT: DATA(300B,377B,
 'CAI','CAM','JUMP','SKIP','AOJ','AOS','SOJ','SOS');
SUBR ANYCODE(NIL) IS ANCO;
SUBR DEWFUN(S,I,J) IS (ANCO=0 => ANCO_-1;
 ADDCODE(S,200000000000B OR J OR I LS 27,0));
SUBR ADDCODE(S,W1,W2) IS (
 ANCO=-1 => ANCO_0 ELSE ANCO_1;
 (ATY_W1 RS 34)=3=>ATY_0;
 (SE2_FREE(S+2))=0=>(Z_NCO LS 18;
 GO TO L2);
 Z_SE2 AND NOT 777777B;
 (AD_SE2 AND 777777B)=(NCO-1)=>NCO_NCO-1 ELSE
 FREES(CO+AD,400000000000B+NCO);
 L2: FLEN(CO) LE NCO+3 => FADDEX(CO,NCO+3);
 FREES(CO+NCO,W1); NCO_NCO+1;
 ATY=0=>(FREES(CO+NCO,W2); NCO_NCO+1);
 Z_Z OR NCO;
 FREES(CO+NCO,400000000000B); NCO_NCO+1;
 FREES(S+2,Z);
 S);
SUBR FLOAT(S) IS (
 SF_FREE(S); (SF AND 300B) NE 200B=>(
 SF AND 77B=4=>(
	X IS REAL; X_FREE(S+1);
	X IS INTEGER; FREES(S+1,X);
	FREES(S,204B OR FREE(S) AND 777000B);
	RETURN S);
 FETCH(S);
 J_REGOF(S);
 ADDCODE(S,13200000000B OR J LS 12,233000000B);
 FREES(S,202B OR SF AND NOT 377B));
 S);
SUBR FIX(S) IS (
 SF_FREE(S); (SF AND 300B) NE 100B=>(
 SF AND 77B=4=>(
	X_FREE(S+1);
	X IS REAL; FREES(S+1,X);
	FREES(S,104B OR FREE(S) AND 777000B);
	RETURN S);
 T_NAME(ENSTACK(MALAMUD));
 SUBRCALL(T);
 DEWFUN(SUBRPAR(T,S),2,REGOF(T));
 SUBPR0(1);
 SF_FREE(T);
 FREES(S,100B OR SF AND NOT 300B);
 FREES(S+1,FREE(T+1)); FREES(S+2,FREE(T+2)));
 S);
SUBR DATAST(B) IS (
 A_ENSTACK(DIR('0')); FREES(A,4 OR FREE(A) AND NOT 77B);
 L6: GETLIST(B)=>(FREE(B+2)=>(
			ERROR(1,'NON-CONSTANT EXPRESSION IN DATA STATEMENT.');
			GO TO L6);
		I_FREE(B);
		I<6,0>=4=>I<L>=0=>(ADDCODE(A,600000000000B,FREE(B+1));
			GO TO L6);
		I_I<L>;
 (J_CONVC(I))=>(J<0=>(ADDCODE(A,600000000000B,CONST);
 GO TO L6);
 I_FREE(J);
 ADDCODE(A,600000000000B,FREE(J+K))
 FOR K IN 1,1,I;
 GO TO L6);
 HOOK(A,A,DEWOP(0,0,B));
 GO TO L6);
 A);
SUBR SUBRPAR(S,PP) IS (
 P_SUBARG(S,PP);
 TM_P RS 18;
 P_P AND 777777B;
 TM => ADDCODE(S,132000000000B,TM)
 ELSE (TM_FREE(P); AE_FREE(P+1);
 ADDCODE(S,32000000000B,(AE LS 18) OR TM RS 18));
 HOOK(S,P,S));
SUBR PRINPAR(N,AA,B,C,D) IS (A_AA;
 T_ENSTACK(0);
 N=5=>(AE_TM_0; GO TO L8);
 N=11=>(FREE(A)<6,0>=4=>FREE(B)<6,0>=4=>(
		FREE(A+1)<L>_FREE(B+1); FREE(A)<L>_0; GO TO PPR1);
	I_REGOF(DEWOP(540B,AREG1(1,13),A));
	HOOK(A,A,DEWOP(504B,I,B));
	PPR1: 0);
 A_SUBARG(T,A);
 TM_A RS 18;
 A_A AND 777777B;
 TM => AE_20000000B
 ELSE (TM_FREE(A) RS 18;
 AE_FREE(A+1) AND 777777B);
 L8: ADDCODE(T,600000000000B OR TM,AE OR N LS 24);
 N NE 6=>GO TO L9;
 S IS 3 LONG; S_B; S[1]_C; S[2]_D;
 (S[I]=0 => (S_AE_TM_0; GO TO L10);
 S_SUBARG(T,S[I]); TM_S RS 18; S_S AND 777777B;
 TM=>(AE_20000000B; GO TO L10);
 TM_FREE(S) RS 18; AE_FREE(S+1) AND 777777B;
 (FREE(S) AND 77B)=4=>(
 I=>(# CONVERT CONSTANT PJ,PN TO OCTAL #
 CONVC(TM); J_CONST;
 SH_0; TM_0; AE_0;
 L11: J=>(KK_J/10;
 (KK_J-10*KK)>7=>ERROR(1,'NON-OCTAL PJ OR PN **');
 AE_AE OR KK LS SH; SH_SH+3;
 J_J/10; GO TO L11));
 TM=0 => TM_STCON(AE);
 AE_0);
 L10: ADDCODE(T,600000000000B OR TM,AE OR N LS 24);
 S => HOOK(A,S,A)) FOR I TO 2;
 L9: FREES(A+1,FREE(T+2));
 # FUDGE TYPE OF STACK OBJECT TO 4 SO MATCHER DOESN'T INTERPRET
 WORD 2 #
 FREES(A,4);
 A);
SUBR PRINCAL(A,B) IS (
 C_ENSTACK(0); FREES(C+2,FREE(B+1));
 HOOK(B,B,HOOK(C,A,C));
 FREES(B,FREE(A)); FREES(B+1,FREE(A+1));
 SUBPR0(1);
 B);
SUBR OJUMPOP(I) IS (
 VAL_7 AND I+4;
 I GE 8=>(1 AND I)=>VAL_(2 AND I+2) OR 5 AND I;
 VAL);
SUBR ADDR(S) IS (
 AE_FREE(S); TSE_77B AND AE;
 TSE=4=>(FREES(S+1,FREE(S+1) AND 777777B); AE_AE AND 777777B)
 ELSE (TSE NE 2=>(FETCH(S); AE_FREE(S)));
 FREES(S,20B OR AE AND NOT 77B);
 S) %%%