Google
 

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