Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-02 - decus/20-0068/stack.imc
There are 2 other files named stack.imc in the archive. Click here to see a list.
TWOSEG;
#THIS IS FILE STACK, CONTAINING THE FOLLOWING ROUTINES FOR THE IMP COMPILER:

          STACK  -  THE SEMANTICS STACK PACKAGE.
          PUSHMI -  A HANDY-DANDY PUSHDOWN STACK PACK.
          BITS   -  THE GENERAL BIT MATRIX PACKAGE

THE STACK CONSISTS OF THREE WORD ENTRIES.
 THE STACK HANDLING ROUTINES ARE:
   STACK(N) - RETURNS FREE POINTER TO STACK POINTER + NTH ENTRY.
   STPOP(N) - WHICH POPS THE STACK UP N THREE-WORD ENTRIES.
   STPUSH(A,B,C) - WHICH PUSHES AN ENTRY A,B,C ONTO STACK AND SETS THE
              POINTER TO POINT TO IT.
   SETSTK(N,A,B,C) - SETS THE ENTRY AT POINTER+N ENTRIES (POINTER+3*N WORDS)    
              TO (A,B,C).
   STINIT(NIL) - INITIALIZES THE STACK TO EMPTY.
 ALL STACK ROUTINES RETURN THE POINTER TO THE WORD IN FREE STORAGE CONTAINING
   THE FIRST WORD OF THE ENTRY IT MAKES (STPOP - THE ENTRY AT THE NEW POINTER).#
SUBR STACK(N) IS (S_ST+STP+3*N; S);
SUBR STINIT(NIL) IS (
  INIT=0=>(INIT_1; ST_FALLOT('STACK',110));
  STP_-3; ST);
SUBR STPOP(N) IS (STP_STP-3*N; STP);
SUBR STPUSH(A,B,C) IS (STP_STP+3;
                       STN_STP+3; FLEN(ST) LE STN => FADDEX(ST,STN);
                       STX_FORG+ST+STP;
                       [STX]_A; [STX+1]_B; [STX+2]_C;
                       S_ST+STP; S);
SUBR SETSTK(N,A,B,C) IS (S_STN_STP+3*N;
                       FADD(ST,STN,A); FADD(ST,STN,B); FADD(ST,STN,C);
                       S_ST+S; S);

# THIS IS PUSHMI-PULLYU, A HANDY-DANDY STACK PACK FOR DOING RECURSIONS AND
   THE LIKE.  IT SITS ON TOP OF THE FREE STORAGE PACKAGE.
 PUSHMI(VALUE) PUTS VALUE ON TOP OF THE PD STACK.  PULLYU(SWITCH) RETURNS THE
   TOP VALUE, AND, IF SWITCH=0, POPS THE PD STACK.  #
SUBR PUSHMI(V) IS (
  PNIT=0=>(PNIT_1;
           STACKN_0; PSTACK_FALLOT('PSHMI',20));
  FADD(PSTACK,STACKN,V));
SUBR PULLYU(SW) IS (
  PNIT=0=>GO TO ERR;
  VAL_FREE(PSTACK+STACKN-1);
  SW=0=>(STACKN_STACKN-1;
         STACKN<0=>(ERR: ERROR(0,'** PUSHDOWN STACK UNDERFLOW ERROR')));
  VAL);

 #THIS IS BITS, THE BIT MATRIX PACKAGE.
  A BIT MATRIX IS DESCRIBED BY A THREE WORD USER-PROVIDED ARRAY A:
    A[0] - FREE STORAGE INDEX OF THE BIT MATRIX
    A[1] - NUMBER OF ROWS IN MATRIX (FIRST SUBSCRIPT, I)
    A[2] - (NUMBER OF COLUMNS, 2ND SUBSCRIPT, J) / 36 - I.E., NUMBER
              OF WORDS NEEDED TO REPRESENT A ROW (LESS 1).
    THE ARRAY A IS UPDATED BY THE BIT MATRIX PACKAGE, NEVER BY THE USER.
  THE CALLS TO ACCESS THE MATRIX ARE:
    BITS(A,I,J) - SETS THE (I,J) BIT OF THE MATRIX.  A IS THE DESCRIPTOR
      ARRAY.  ON THE INITIAL CALL, A, A[1] AND A[2] SHOULD ALL BE 0.  IF IT IS
      DESIRED TO ALLOCATE AN INITIAL MINIMUM SIZE, INITIALLY SET A[1] TO THE
      NUMBER OF ROWS DESIRED, AND A[2] TO THE NUMBER OF COLUMN WORDS LESS 1.
    BIT(A,I,J) - THE VALUE OF THE (I,J) BIT OF THE MATRIX.
    BITOR(A,I,J) - ORS THE JTH ROW OF THE BIT MATRIX A INTO THE ITH ROW.
      EACH ROW MUST ALREADY BE NONZERO SOMEWHERE.
    BITZ(A) - ZEROS THE BIT MATRIX A.
  THE MATRIX IS AUTOMATICALLY ENLARGED WHEN BITS IS CALLED WITH AN INDEX LARGER
    THAN THE CURRENT LIMITS. #

SUBR BITS(A,I,J) IS (QBITS_QBITS+1;
 COL_J/36;
 A=0=>(I GE A[1]=>(A[1]_10) LE I => A[1]_I+1;
       COL>A[2]=>A[2]_COL;
       FRELOT(A,'BITS',A[1]*A[2]+1,0));
 COL>A[2]=>(A_FALLOT(A,A[1]*COL+1);
            S_A+A[1]*A[2]+1; E_A+(A[1]*COL+1)-1;
            FREES(K,0) FOR K IN S,1,E;
            A[2]_COL);
 I GE A[1]=>(NEW_I+5;
             A_FALLOT(A,NEW*A[2]+1);
             (S_A+A[1]*K; DS_A+NEW*K;
              FREES(DS+L,0) FOR L IN NEW-1,-1,A[1];
              (Q_FREE(S+L); FREES(DS+L,Q)) FOR L FROM A[1]-1)
                                               FOR K FROM A[2];
             A[1]_NEW);
 S_A+I+A[1]*COL;
 K_FREE(S);
 FREES(S,K OR 1 LS J-36*COL));
#SUBR BIT(A,I,J) IS (QBIT_QBIT+1;
 VAL_0; I GE A[1]=>GO TO BITE;
 (COL_J/36)>A[2]=>GO TO BITE;
 K_FREE(A+I+A[1]*COL);
 VAL_1 AND K RS J-COL*36;
 BITE: VAL);#
SUBR BITZ(A) IS (
 A=>(L_(A[1]*A[2]+1)-1;
     FREES(A+K,0) FOR K TO L);
 0);
SUBR BITOR(A,I,J) IS (QBO_QBO+1;
 S_A+J; D_A+I;
 (L_FREE(S); K_FREE(D);
  FREES(D,L OR K);
  D_D+A[1];
  S_S+A[1]) FOR E TO A[2]);
SUBR BSTATS(I) IS (
 I=>PRINT IGR 0,QBITS,STG 0,' CALLS TO BITS, ',IGR 0,QBIT,
   STG 0,' CALLS TO BIT, ',IGR 0,QBO,STG 0,' CALLS TO BITOR.',/;
 QBO_QBIT_QBITS_0)%%