Trailing-Edge
-
PDP-10 Archives
-
decuslib20-02
-
decus/20-0068/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) %%%