Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

# THIS IS FILE CODE3, HOLDING OVERFLOW FROM CODE2 #
TWOSEG;

CO,NCO,CONST ARE COMMON;

SUBR CODE3I(NIL) IS (DSEM('SUBSCRIPT',SUBSCRIPT);
		       DSEM('SUBCALL',SUBCALL);
                     DSEM('BYTEP',BYTEP));

SUBR SUBCALL(A,B) IS (
 A_SUBRCALL(NAME(A));
 WHILE GETLIST(B) DO A_SUBRPAR(A,B);
 DEWFUN(A,2,REGOF(A),SUBPR0(1));
 A);

SUBR SUBSCRIPT(S,T) IS (
 TTY_FREE(T) AND 77B;
 TTY=2 => REG0(3777B AND FREE(T+1) RS 18) => GO TO L46;
 TTY=20B => FREE(T+1)<0 => (L46: DEWOP(200B,AREG1(1,15B),T); TTY_2);
 S=0 => (TTY NE 2 => TTY NE 4 => (FREE(T+1)<0=>(DEWOP(200B,AREG1(1,15B),T);
                                  TTY_20B;
                                  FREES(T,20B OR FREE(T) AND 77B)) ELSE
                        FREES(T+1,FREE(T+1) OR 1 LS 35));
         TE_20B OR FREE(T) AND NOT 77B;
         TTY=4 => (TE_10B OR TE AND 777700B;
                   FREES(T+1,FREE(T+1) AND 777777B));
         FREES(T,TE); RETURN T);
 TTY NE 2 => TTY NE 4 => (DEWOP(200B,AREG1(1,15B),T); TTY_2);
 STY_FREE(S) AND 77B;
 STY=20B => FREE(S+1)<0 => (DEWOP(201B,AREG1(1,15B),S); STY_20B;
                            FREES(S,20B OR FREE(S) AND NOT 77B));
 STY=2 => (ERROR(1,'SUBSCRIPTED REGISTER - IGNORED. '); RETURN S);
 STY=4 => (SE_FREE(S) AND NOT 77B;
           (SE RS 18)=0 => (ERROR(2,'CALCULATED CONSTANT IS SUBSCRIPTED. ');
                            I_STCON(FREE(S+1));
                            SE_(I LS 18) OR SE AND 777777B);
           FREES(S,SE OR 10B); FREES(S+1,0));
 TTY=2 => (STY NE 20B => (FREES(S,20B OR FREE(S) AND NOT 77B);
                          FREES(S+1,FREE(S+1) OR REGOF(T) LS 18))
           ELSE ADDCODE(S,(270B LS 24)+(REGOF(S) LS 12)+(1 LS 11),REGOF(T)));
 TTY=4 => (SC_((FREE(S+1) AND 777777B)+FREE(T+1)) AND 777777B;
           FREES(S+1,SC OR FREE(S+1) AND NOT 777777B));
 HOOK(S,T,S));

SUBR BYTEP(A,S,P,FLAG) IS (
 # MAKES A REMOTE BYTE POINTER FOR A<S,P> #
 TD_NEWNAME('BYTE');
 T_ENSTACK(TD);
 NAME(T); TAG(T);
 DEWFUN(T,11,0);
 B_C_GG_R_0;
 #GET P POINTER #
 PTY_77B AND PE_FREE(P);
 PTY=4=>(B_B OR (77B AND J_GG_FREE(P+1)) LS 27; C_C+1; GO TO L12);
 # IF NOT CONSTANT, STORE IT IN WORD #
 R_REGOF(FETCH(P));
 ADDCODE(P,024200000000B OR R LS 12,36000000B);
 # NOW GET S POINTER - IF CONST, MUST FUDGE IT INTO REGISTER FIELD. #
 L12: STY_77B AND SE_FREE(S);
 STY=4=>(B_B OR (70B AND J_FREE(S+1)) LS 21; C_C+1;
	 GG_GG OR J;
         B_B OR AREG(2*J AND 7) LS 12; GO TO L13);
 J_REGOF(FETCH(S));
 ADDCODE(S,024200000000B OR J LS 12,30000000B);
 R=>DEWOP(434B,R,S) ELSE R_J;
 L13: # IF THIS WON'T FIT IN UNINDEXED ADDRESS FIELD, PUT IN PTR. #
 (77B AND FREE(A)) NE 4=>FREE(A+1) RS 18=>(
	FLAG=>FREE(A+1) GE 0=>GO TO L14;
	DEWOP((R=>541B ELSE (R_AREG1(1,13); 551B)),R,A);
	C=2=>(	ADDCODE(A,050500000000B OR R LS 12,((77B AND FREE(P+1)) LS 30)
			OR (77B AND FREE(S+1)) LS 24);
		RETURN A);
	FREES(A,110B); FREES(A+1,0); GO TO L14A);
 L14: GG_-1;
 L14A: FREES(T,FREE(A)); FREES(T+1,FREE(A+1));
 GG=>(DEWOP(0,0,T);
 J_CO+FREE(T+2)<R>-2;
 K_FREE(J); FREES(J,K OR B);
 REMOT(FREEZE(T)));
 HOOK(A,HOOK(P,P,S),A);
 R=>(	GG=0=>RETURN A;
	J_NAME(ENSTACK(TD));
	DEWOP(434B,R,J);
	RETURN HOOK(A,A,J));
 FREES(A+1,0); FREES(A,110B OR TD LS 18); A);

SUBR PCODE(S,NS) IS (
 LOC(PCODE1) => J_PCODE1(S,NS)
           ELSE (PCO0CNT=0 => (PCO0CNT_1; J_0;
                               ERROR(2,'PCODE1 DEBUGGING  PGM NOT PRESENT')));
 J)%%