SUBROUTINE P$ABI INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) STORE(SP)=IABS(STORE(SP)) RETURN END SUBROUTINE P$ABR INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) STORER(SP)=ABS(STORER(SP)) RETURN END SUBROUTINE P$ADI INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) SP=SP-1 STORE(SP)=STORE(SP)+STORE(SP+1) RETURN END SUBROUTINE P$ADR INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) SP=SP-1 STORER(SP)=STORER(SP)+STORER(SP+1) RETURN END SUBROUTINE P$AND INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) SP=SP-1 IF((STORE(SP+1).NE.0))GOTO 10000 STORE(SP)=0 10000 RETURN END SUBROUTINE P$ATN INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) STORER(SP)=ATAN(STORER(SP)) RETURN END SUBROUTINE P$BRD(NUM) INTEGER NUM,I,J,FD,NRD,CODE,FILEB0,NR,MAPFD,MAPSU INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) FD=STORE(STORE(SP-1)) NR=NUM*2 IF(((FD.NE.-11).AND.(FD.NE.-13)))GOTO 10001 CALL P$BOMB('read on output file.') 10001 FILEB0=STORE(SP-1)+1 I=STORE(SP) J=0 GOTO 10004 10002 J=J+1 10004 IF((J.GE.NUM))GOTO 10003 STORE(I+J)=STORE(FILEB0+J) GOTO 10002 10003 CALL PRWF$$(:1,MAPFD(MAPSU(FD)),LOC(STORE(FILEB0)),NR,INTL(0),NRD, *CODE) IF((CODE.NE.1))GOTO 10005 STORE(FILEB0)=-1 GOTO 10006 10005 IF((NRD.EQ.NR))GOTO 10007 CALL P$BOMB('tried to read past end of file.') 10007 CONTINUE 10006 SP=SP-1 RETURN END SUBROUTINE P$BWR(NUM) INTEGER NUM,I,J,FD,NWR,CODE,FILEB0,NW,MAPSU,MAPFD INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) FD=STORE(STORE(SP-1)) NW=NUM*2 IF(((FD.NE.-10).AND.(FD.NE.-12)))GOTO 10008 CALL P$BOMB('write on input file.') 10008 FILEB0=STORE(SP-1)+1 I=STORE(SP) CALL PRWF$$(:2,MAPFD(MAPSU(FD)),LOC(STORE(I)),NW,INTL(0),NWR,CODE) J=0 GOTO 10011 10009 J=J+1 10011 IF((J.GE.NUM))GOTO 10010 STORE(FILEB0+J)=STORE(I+J) GOTO 10009 10010 IF(((NW.EQ.NWR).AND.(CODE.EQ.0)))GOTO 10012 CALL P$BOMB('error in writing to binary file.') 10012 SP=SP-1 RETURN END SUBROUTINE P$CFP(SIZE) INTEGER SIZE,I,J,LIMIT,ADR INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) ADR=STORE(SP) LIMIT=ADR+SIZE-1 I=INT(SIZE/2) IF((SIZE.EQ.I*2))GOTO 10013 STORE(LIMIT)=RT(STORE(I+1),16) LIMIT=LIMIT-1 10013 I=LIMIT GOTO 10016 10014 I=I-2 10016 IF((I.LT.ADR))GOTO 10015 J=INT((I-ADR)/2)+ADR STORE(I)=RT(STORE(J),16) STORE(I-1)=RS(STORE(J),16) GOTO 10014 10015 RETURN END SUBROUTINE P$CPF(SIZE) INTEGER SIZE,I,J,LIMIT,ADR INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) J=0 ADR=STORE(SP) LIMIT=ADR+SIZE-1 I=ADR GOTO 10019 10017 I=I+1 10019 IF((I.GT.INT(LIMIT/2)+1))GOTO 10018 J=J+2 IF((I+J.GT.LIMIT))GOTO 10020 STORE(I)=LS(STORE(ADR+J+1),16)+RT(STORE(ADR+J),16) GOTO 10017 10020 STORE(I)=RT(STORE(I+J),16) 10021 GOTO 10017 10018 RETURN END SUBROUTINE P$CHK(LB,UB) INTEGER * 4 LB,UB INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) IF((STORE(SP).LT.LB))GOTO 10023 IF((STORE(SP).GT.UB))GOTO 10023 GOTO 10022 10023 CALL PRINT(-15,'lb = *l, ub = *l, val = *l*n.',LB,UB,STORE(SP)) CALL P$BOMB('value out of range.') 10022 RETURN END SUBROUTINE P$CHKA(P,Q) INTEGER * 4 P,Q INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) IF((STORE(SP).LT.INTL(NP)))GOTO 10025 IF((STORE(SP).GT.Q))GOTO 10025 GOTO 10024 10025 CALL PRINT(-15,'heap = *i, ptr = *l*n.',NP,STORE(SP)) CALL P$BOMB('pointer out of range.') 10024 RETURN END SUBROUTINE P$CHR INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) STORE(SP)=STORE(SP)+128 RETURN END SUBROUTINE P$CLS INTEGER FD,CLOSE INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) FD=STORE(STORE(SP)) IF((FD.EQ.0))GOTO 10026 CALL CLOSE(FD) 10026 SP=SP-1 RETURN END SUBROUTINE P$COS INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) STORER(SP)=COS(STORER(SP)) RETURN END SUBROUTINE P$DAT(CODE) INTEGER CODE,STRING(10),ADR,I INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) CALL DATE(CODE,STRING) ADR=STORE(SP) I=0 GOTO 10029 10027 I=I+1 10029 IF((I.GE.8))GOTO 10028 STORE(ADR+I)=STRING(I+1) GOTO 10027 10028 SP=SP-1 RETURN END SUBROUTINE P$DEC(P,Q) INTEGER P INTEGER * 4 Q INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) STORE(SP)=STORE(SP)-Q RETURN END SUBROUTINE P$DIF INTEGER I INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) I=SP-8 GOTO 10032 10030 SP=SP-1 10032 IF((SP.LE.I))GOTO 10031 STORE(SP-8)=AND(STORE(SP-8),NOT(STORE(SP))) GOTO 10030 10031 RETURN END SUBROUTINE P$DVI INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) SP=SP-1 STORE(SP)=STORE(SP)/STORE(SP+1) RETURN END SUBROUTINE P$DVR INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) SP=SP-1 STORER(SP)=STORER(SP)/STORER(SP+1) RETURN END SUBROUTINE P$ELN INTEGER I,FD INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) FD=STORE(STORE(SP)) I=STORE(SP)+1 STORE(SP)=RT((STORE(I).EQ.138.OR.STORE(I).EQ.-1),32) RETURN END SUBROUTINE P$ENT(P,Q) INTEGER P,Q INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) IF((P.NE.1))GOTO 10033 SP=MP+Q IF((SP.LE.NP))GOTO 10035 CALL P$BOMB('stack overflow.') 10034 GOTO 10035 10033 EP=SP+Q IF((EP.LE.NP))GOTO 10036 CALL P$BOMB('store overflow.') 10036 CONTINUE 10035 RETURN END SUBROUTINE P$EOF INTEGER I INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) I=STORE(SP)+1 STORE(SP)=RT((STORE(I).EQ.-1),32) RETURN END SUBROUTINE P$EQU(P,Q) INTEGER P,Q INTEGER I LOGICAL BVAL LOGICAL P$COMP INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) SP=SP-1 IF((P.NE.4))GOTO 10037 SP=SP-14 BVAL=.TRUE. I=SP+7 GOTO 10040 10038 I=I-1 10040 IF(((I.LT.SP).OR.(.NOT.BVAL)))GOTO 10041 BVAL=STORE(I).EQ.STORE(I+8) GOTO 10038 10037 IF((P.NE.5))GOTO 10042 BVAL=P$COMP(Q,1) GOTO 10043 10042 BVAL=STORE(SP).EQ.STORE(SP+1) 10043 CONTINUE 10041 STORE(SP)=INTL(RT(BVAL,16)) RETURN END SUBROUTINE P$EXP INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) STORER(SP)=EXP(STORER(SP)) RETURN END SUBROUTINE P$FLO INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) STORER(SP-1)=STORE(SP-1) RETURN END SUBROUTINE P$FLT INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) STORER(SP)=STORE(SP) RETURN END SUBROUTINE P$FMS(MESSA0) INTEGER MESSA0(102) INTEGER Q INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) Q=STORE(STORE(SP)) IF((Q.EQ.0))GOTO 10044 CALL PRINT(-15,'*4i*p*n.',Q,MESSA0) 10044 SP=SP-1 RETURN END SUBROUTINE P$GEQ(P,Q) INTEGER P,Q INTEGER I LOGICAL BVAL LOGICAL P$COMP INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) SP=SP-1 IF((P.NE.0))GOTO 10045 CALL P$BOMB('illegal address comparison.') GOTO 10046 10045 IF((P.NE.2))GOTO 10047 BVAL=STORER(SP).GE.STORER(SP+1) GOTO 10048 10047 IF((P.NE.4))GOTO 10049 SP=SP-14 BVAL=.TRUE. I=SP+7 GOTO 10052 10050 I=I-1 10052 IF(((I.LT.SP).OR.(.NOT.BVAL)))GOTO 10053 BVAL=AND(STORE(I),STORE(I+8)).EQ.STORE(I+8) GOTO 10050 10049 IF((P.NE.5))GOTO 10054 BVAL=P$COMP(Q,3) GOTO 10055 10054 BVAL=STORE(SP).GE.STORE(SP+1) 10055 CONTINUE 10053 CONTINUE 10048 CONTINUE 10046 STORE(SP)=INTL(RT(BVAL,16)) RETURN END SUBROUTINE P$GET INTEGER I,FD INTEGER GETCH INTEGER C INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) I=STORE(SP)+1 FD=STORE(STORE(SP)) IF((FD.NE.-11))GOTO 10056 CALL P$BOMB('get on output file.') GOTO 10057 10056 IF((FD.NE.-13))GOTO 10058 CALL P$BOMB('get on prr file.') GOTO 10059 10058 STORE(I)=GETCH(C,FD) 10059 CONTINUE 10057 SP=SP-1 RETURN END SUBROUTINE P$GRT(P,Q) INTEGER P,Q LOGICAL BVAL LOGICAL P$COMP INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) SP=SP-1 IF((P.NE.0))GOTO 10060 CALL P$BOMB('illegal address comparison.') GOTO 10061 10060 IF((((P.NE.1).AND.(P.NE.3)).AND.(P.NE.6)))GOTO 10062 BVAL=STORE(SP).GT.STORE(SP+1) GOTO 10063 10062 IF((P.NE.2))GOTO 10064 BVAL=STORER(SP).GT.STORER(SP+1) GOTO 10065 10064 IF((P.NE.4))GOTO 10066 CALL P$BOMB('illegal set inclusion.') GOTO 10067 10066 BVAL=P$COMP(Q,4) 10067 CONTINUE 10065 CONTINUE 10063 CONTINUE 10061 STORE(SP)=INTL(RT(BVAL,16)) RETURN END SUBROUTINE P$INC(P,Q) INTEGER P INTEGER * 4 Q INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) STORE(SP)=STORE(SP)+Q RETURN END SUBROUTINE P$IND(P,Q) INTEGER P,Q INTEGER I INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) IF((P.NE.4))GOTO 10068 SP=SP-1 I=STORE(SP)+Q STORE(SP)=STORE(SP+1) CALL P$LDOS(I) GOTO 10069 10068 I=STORE(SP)+Q STORE(SP)=STORE(I) 10069 RETURN END SUBROUTINE P$INF INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) STORE(STORE(SP))=0 SP=SP-1 RETURN END SUBROUTINE P$INN INTEGER B,W LOGICAL BVAL INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP INTEGER * 4 MASKS(32) SAVE MASKS EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) DATA MASKS/:00000000001,:00000000002,:00000000004,:00000000010,:00 *000000020,:00000000040,:00000000100,:00000000200,:00000000400,:000 *00001000,:00000002000,:00000004000,:00000010000,:00000020000,:0000 *0040000,:00000100000,:00000200000,:00000400000,:00001000000,:00002 *000000,:00004000000,:00010000000,:00020000000,:00040000000,:001000 *00000,:00200000000,:00400000000,:01000000000,:02000000000,:0400000 *0000,:10000000000,:20000000000/ SP=SP-8 W=STORE(SP)/32 B=MOD(STORE(SP),32) BVAL=AND(STORE(SP+W+1),MASKS(B+1)).NE.0 STORE(SP)=INTL(RT(BVAL,16)) RETURN END SUBROUTINE P$INT INTEGER I INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) I=SP-8 GOTO 10072 10070 SP=SP-1 10072 IF((SP.LE.I))GOTO 10071 STORE(SP-8)=AND(STORE(SP-8),STORE(SP)) GOTO 10070 10071 RETURN END SUBROUTINE P$IOR INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) SP=SP-1 IF((STORE(SP+1).NE.1))GOTO 10073 STORE(SP)=1 10073 RETURN END SUBROUTINE P$IXA(Q) INTEGER Q INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) SP=SP-1 STORE(SP)=STORE(SP)+Q*STORE(SP+1) RETURN END SUBROUTINE P$LAO(Q) INTEGER Q INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) SP=SP+1 STORE(SP)=Q RETURN END SUBROUTINE P$LCA(Q) INTEGER Q INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) SP=SP+1 STORE(SP)=Q RETURN END SUBROUTINE P$LDA(P,Q) INTEGER P,Q INTEGER P$BASE INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) SP=SP+1 STORE(SP)=P$BASE(P)+Q RETURN END SUBROUTINE P$LDC(P,Q) INTEGER P INTEGER * 4 Q INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) IF((P.NE.0))GOTO 10074 SP=SP+1 STORE(SP)=32767 GOTO 10075 10074 IF((P.NE.4))GOTO 10076 CALL P$LDOS(INTS(Q)) GOTO 10077 10076 SP=SP+1 STORE(SP)=Q 10077 CONTINUE 10075 RETURN END SUBROUTINE P$LDO(P,Q) INTEGER P,Q INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) IF((P.NE.4))GOTO 10078 CALL P$LDOS(Q) GOTO 10079 10078 SP=SP+1 STORE(SP)=STORE(Q) 10079 RETURN END SUBROUTINE P$LDOS(Q) INTEGER Q INTEGER I,J,LO,HI INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) LO=RS(STORE(SP),8) HI=RT(STORE(SP),8) SP=SP-1 J=Q I=0 GOTO 10082 10080 I=I+1 10082 IF((I.GE.LO))GOTO 10085 SP=SP+1 STORE(SP)=0 GOTO 10080 10083 I=I+1 10085 IF((I.GT.HI))GOTO 10088 SP=SP+1 STORE(SP)=STORE(J) J=J+1 GOTO 10083 10086 I=I+1 10088 IF((I.GE.8))GOTO 10087 SP=SP+1 STORE(SP)=0 GOTO 10086 10087 RETURN END SUBROUTINE P$LEQ(P,Q) INTEGER P,Q INTEGER I LOGICAL BVAL LOGICAL P$COMP INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) SP=SP-1 IF((P.NE.0))GOTO 10089 CALL P$BOMB('illegal address comparison.') GOTO 10090 10089 IF((P.EQ.1))GOTO 10092 IF((P.EQ.3))GOTO 10092 IF((P.EQ.6))GOTO 10092 GOTO 10091 10092 BVAL=STORE(SP).LE.STORE(SP+1) GOTO 10093 10091 IF((P.NE.2))GOTO 10094 BVAL=STORER(SP).LE.STORER(SP+1) GOTO 10095 10094 IF((P.NE.4))GOTO 10096 SP=SP-14 BVAL=.TRUE. I=SP+7 GOTO 10099 10097 I=I-1 10099 IF(((I.LT.SP).OR.(.NOT.BVAL)))GOTO 10100 BVAL=AND(STORE(I),STORE(I+8)).EQ.STORE(I) GOTO 10097 10096 BVAL=P$COMP(Q,5) 10100 CONTINUE 10095 CONTINUE 10093 CONTINUE 10090 STORE(SP)=INTL(RT(BVAL,16)) RETURN END SUBROUTINE P$LES(P,Q) INTEGER P,Q LOGICAL BVAL LOGICAL P$COMP INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) SP=SP-1 IF((P.NE.0))GOTO 10101 CALL P$BOMB('illegal address comparison.') GOTO 10102 10101 IF((P.EQ.1))GOTO 10104 IF((P.EQ.3))GOTO 10104 IF((P.EQ.6))GOTO 10104 GOTO 10103 10104 BVAL=STORE(SP).LT.STORE(SP+1) GOTO 10105 10103 IF((P.NE.2))GOTO 10106 BVAL=STORER(SP).LT.STORER(SP+1) GOTO 10107 10106 IF((P.NE.4))GOTO 10108 CALL P$BOMB('illegal set inclusion.') GOTO 10109 10108 BVAL=P$COMP(Q,6) 10109 CONTINUE 10107 CONTINUE 10105 CONTINUE 10102 STORE(SP)=INTL(RT(BVAL,16)) RETURN END SUBROUTINE P$LOD(P,Q) INTEGER P,Q INTEGER P$BASE INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) SP=SP+1 STORE(SP)=STORE(P$BASE(P)+Q) RETURN END SUBROUTINE P$LODA(P,Q) INTEGER P,Q INTEGER P$BASE INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) SP=SP+1 STORE(SP)=STORE(P$BASE(P)+Q) RETURN END SUBROUTINE P$LODS(P,Q) INTEGER P,Q INTEGER P$BASE INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) CALL P$LDOS(P$BASE(P)+Q) RETURN END SUBROUTINE P$LOG INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) STORER(SP)=ALOG(STORER(SP)) RETURN END SUBROUTINE P$MOD INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) SP=SP-1 STORE(SP)=MOD(STORE(SP),STORE(SP+1)) RETURN END SUBROUTINE P$MOV(Q) INTEGER Q INTEGER I,I1,I2 INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) I1=STORE(SP-1) I2=STORE(SP) SP=SP-2 I=1 GOTO 10112 10110 I=I+1 10112 IF((I.GT.Q))GOTO 10111 STORE(I1)=STORE(I2) I1=I1+1 I2=I2+1 GOTO 10110 10111 RETURN END SUBROUTINE P$MPI INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) SP=SP-1 STORE(SP)=STORE(SP)*STORE(SP+1) RETURN END SUBROUTINE P$MPR INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) SP=SP-1 STORER(SP)=STORER(SP)*STORER(SP+1) RETURN END SUBROUTINE P$MST(P) INTEGER P INTEGER P$BASE INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) STORE(SP+2)=P$BASE(P) STORE(SP+3)=MP STORE(SP+4)=EP SP=SP+5 RETURN END SUBROUTINE P$MTS INTEGER LWB,UPB,LW,LB,UW,UB,I INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) LWB=STORE(SP-1) IF((LWB.LT.0))GOTO 10114 IF((LWB.GT.255))GOTO 10114 GOTO 10113 10114 CALL P$BOMB('mts lower bound out of range.') 10113 UPB=STORE(SP) IF((UPB.LT.0))GOTO 10116 IF((UPB.GT.255))GOTO 10116 GOTO 10115 10116 CALL P$BOMB('mts upper bound out of range.') 10115 SP=SP-2 LW=LWB/32 LB=MOD(LWB,32) UW=UPB/32 UB=MOD(UPB,32) I=0 GOTO 10119 10117 I=I+1 10119 IF((I.GE.LW))GOTO 10118 SP=SP+1 STORE(SP)=0 GOTO 10117 10118 IF((LW.GE.UW))GOTO 10120 SP=SP+1 STORE(SP)=LT(:37777777777,32-LB) I=LW+1 GOTO 10123 10121 I=I+1 10123 IF((I.GE.UW))GOTO 10122 SP=SP+1 STORE(SP)=:37777777777 GOTO 10121 10122 SP=SP+1 STORE(SP)=RT(:37777777777,UB+1) GOTO 10124 10120 SP=SP+1 STORE(SP)=LT(RT(:37777777777,UB+1),32-LB) 10124 I=UW+1 GOTO 10127 10125 I=I+1 10127 IF((I.GE.8))GOTO 10126 SP=SP+1 STORE(SP)=0 GOTO 10125 10126 RETURN END SUBROUTINE P$NEQ(P,Q) INTEGER P,Q INTEGER I LOGICAL BVAL LOGICAL P$COMP INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) SP=SP-1 IF((P.NE.4))GOTO 10128 SP=SP-14 BVAL=.FALSE. I=SP+7 GOTO 10131 10129 I=I-1 10131 IF(((I.LT.SP).OR.BVAL))GOTO 10132 BVAL=STORE(I).NE.STORE(I+8) GOTO 10129 10128 IF((P.NE.5))GOTO 10133 BVAL=P$COMP(Q,2) GOTO 10134 10133 BVAL=STORE(SP).NE.STORE(SP+1) 10134 CONTINUE 10132 STORE(SP)=INTL(RT(BVAL,16)) RETURN END SUBROUTINE P$NEW INTEGER I INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) NP=NP-STORE(SP) IF((NP.GT.EP))GOTO 10135 CALL P$BOMB('heap overflow.') GOTO 10136 10135 I=STORE(SP-1) STORE(I)=NP SP=SP-2 10136 RETURN END SUBROUTINE P$NGI INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) STORE(SP)=-STORE(SP) RETURN END SUBROUTINE P$NGR INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) STORER(SP)=-STORER(SP) RETURN END SUBROUTINE P$NOT INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) IF((STORE(SP).NE.0))GOTO 10137 STORE(SP)=1 GOTO 10138 10137 STORE(SP)=0 10138 RETURN END SUBROUTINE P$ODD INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) STORE(SP)=RT(STORE(SP),1) RETURN END SUBROUTINE P$ORD(P) INTEGER P INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) IF((P.NE.6))GOTO 10139 STORE(SP)=STORE(SP)-128 10139 RETURN END SUBROUTINE P$PAG INTEGER FD,I,PUTCH INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) I=STORE(SP)+1 FD=STORE(STORE(SP)) IF((STORE(I).EQ.138))GOTO 10140 CALL PUTCH(138,FD) 10140 CALL PUTCH(140,FD) CALL PUTCH(138,FD) SP=SP-1 RETURN END SUBROUTINE P$PUT INTEGER I,FD,PUTCH INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) I=STORE(SP)+1 FD=STORE(STORE(SP)) CALL PUTCH(INTS(STORE(I)),FD) SP=SP-1 RETURN END SUBROUTINE P$RDC INTEGER I,J,FD INTEGER GETCH INTEGER C INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) J=STORE(SP) I=STORE(SP-1)+1 FD=STORE(STORE(SP-1)) IF((FD.NE.-12))GOTO 10141 STORE(I)=GETCH(C,FD) IF((STORE(I).NE.138))GOTO 10142 STORE(J)=160 GOTO 10144 10142 STORE(J)=STORE(I) 10143 GOTO 10144 10141 IF((STORE(I).NE.138))GOTO 10145 STORE(J)=160 GOTO 10146 10145 STORE(J)=STORE(I) 10146 STORE(I)=GETCH(C,FD) 10144 SP=SP-1 RETURN END SUBROUTINE P$RDI INTEGER GETCH,BUFFER(12) INTEGER C INTEGER I,J,K,FD INTEGER * 4 GCTOL INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) FD=STORE(STORE(SP-1)) I=STORE(SP-1)+1 J=STORE(SP) IF((FD.NE.-12))GOTO 10147 STORE(I)=GETCH(C,FD) GOTO 10148 10147 C=STORE(I) 10148 CONTINUE 10149 IF(((STORE(I).NE.160).AND.(STORE(I).NE.138)))GOTO 10150 STORE(I)=GETCH(C,FD) GOTO 10149 10150 BUFFER(1)=C K=2 GOTO 10153 10151 K=K+1 10153 IF((K.GE.12))GOTO 10152 IF((GETCH(BUFFER(K),FD).EQ.-1))GOTO 10152 IF((BUFFER(K).LT.176))GOTO 10152 IF((BUFFER(K).GT.185))GOTO 10152 GOTO 10151 10152 STORE(I)=BUFFER(K) BUFFER(K)=0 K=1 STORE(J)=GCTOL(BUFFER,K,10) IF((BUFFER(K).EQ.0))GOTO 10156 CALL P$BOMB('illegal character in input.') 10156 SP=SP-1 RETURN END SUBROUTINE P$RDR INTEGER GETCH,BUFFER(21) INTEGER C INTEGER I,J,K,FD REAL CTOR INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) J=STORE(SP) I=STORE(SP-1)+1 FD=STORE(STORE(SP-1)) C=STORE(I) 10157 IF(((C.NE.160).AND.(C.NE.138)))GOTO 10158 CALL GETCH(C,FD) GOTO 10157 10158 BUFFER(1)=C K=2 GOTO 10161 10159 K=K+1 10161 IF((K.GE.21))GOTO 10160 IF((GETCH(BUFFER(K),FD).EQ.-1))GOTO 10160 IF((BUFFER(K).LT.176))GOTO 10160 IF((BUFFER(K).GT.185))GOTO 10160 GOTO 10159 10160 IF(((BUFFER(K).NE.174).OR.(K.GE.21)))GOTO 10164 K=K+1 GOTO 10167 10165 K=K+1 10167 IF((K.GE.21))GOTO 10166 IF((GETCH(BUFFER(K),FD).EQ.-1))GOTO 10166 IF((BUFFER(K).LT.176))GOTO 10166 IF((BUFFER(K).GT.185))GOTO 10166 GOTO 10165 10166 CONTINUE 10164 IF((BUFFER(K).EQ.229))GOTO 10171 IF((BUFFER(K).EQ.197))GOTO 10171 GOTO 10170 10171 K=K+1 BUFFER(K)=GETCH(C,FD) K=K+1 GOTO 10174 10172 K=K+1 10174 IF((K.GE.21))GOTO 10173 IF((GETCH(BUFFER(K),FD).EQ.-1))GOTO 10173 IF((BUFFER(K).LT.176))GOTO 10173 IF((BUFFER(K).GT.185))GOTO 10173 GOTO 10172 10173 CONTINUE 10170 STORE(I)=BUFFER(K) BUFFER(K)=0 K=1 STORER(J)=CTOR(BUFFER,K) SP=SP-1 RETURN END SUBROUTINE P$REM(Q,PATH) INTEGER PATH(1) INTEGER PATHN0(102) INTEGER P,Q,REMOVE INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) P=STORE(SP) IF((STORE(P).EQ.0))GOTO 10177 IF((Q.EQ.0))GOTO 10178 CALL P$MKPN(Q,PATH,PATHN0) GOTO 10179 10178 CALL PTOC(PATH,187,PATHN0,102) 10179 CALL REMOVE(PATHN0) STORE(P)=0 10177 SP=SP-1 RETURN END SUBROUTINE P$RES(FLEV,NUM,PATHN0) INTEGER PATHN0(1) INTEGER C,PATH(102) INTEGER P,FD,FLEV,NUM,NRD,CODE,LEV,NR INTEGER OPEN,GETCH,CLOSE,MAPFD,MAPSU INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) P=STORE(SP) FD=STORE(P) IF((FD.EQ.0))GOTO 10180 CALL CLOSE(FD) 10180 IF((FLEV.EQ.0))GOTO 10181 LEV=FLEV CALL P$MKPN(LEV,PATHN0,PATH) GOTO 10182 10181 CALL PTOC(PATHN0,187,PATH,102) 10182 FD=OPEN(PATH,1) STORE(P)=FD IF((FD.NE.-3))GOTO 10183 CALL P$BOMB('file could not be opened for reading.') GOTO 10184 10183 IF((NUM.NE.0))GOTO 10185 STORE(P+1)=GETCH(C,FD) GOTO 10186 10185 NR=NUM*2 CALL PRWF$$(:1,MAPFD(MAPSU(FD)),LOC(STORE(P+1)),NR,INTL(0),NRD *,CODE) IF((NR.NE.NRD))GOTO 10188 IF((CODE.NE.0))GOTO 10188 GOTO 10187 10188 CALL P$BOMB('error in reading binary file.') 10187 CONTINUE 10186 CONTINUE 10184 SP=SP-1 RETURN END SUBROUTINE P$RLN INTEGER I,FD INTEGER GETCH INTEGER C INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) I=STORE(SP)+1 FD=STORE(STORE(SP)) IF((STORE(I).NE.138))GOTO 10189 IF((FD.EQ.-12))GOTO 10189 STORE(I)=GETCH(C,FD) GOTO 10190 10189 CONTINUE 10191 IF(((STORE(I).EQ.138).OR.(STORE(I).EQ.-1)))GOTO 10192 STORE(I)=GETCH(C,FD) GOTO 10191 10192 IF(((STORE(I).EQ.-1).OR.(FD.EQ.-12)))GOTO 10193 STORE(I)=GETCH(C,FD) 10193 CONTINUE 10190 SP=SP-1 RETURN END SUBROUTINE P$RST INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) NP=STORE(SP) SP=SP-1 RETURN END SUBROUTINE P$RWR(FLEV,PATHN0) INTEGER PATHN0(1) INTEGER PATH(102) INTEGER P,FD,FLEV,LEV INTEGER CREATE,CLOSE INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) P=STORE(SP) FD=STORE(P) IF((FD.EQ.0))GOTO 10194 CALL CLOSE(FD) 10194 IF((FLEV.EQ.0))GOTO 10195 LEV=FLEV CALL P$MKPN(LEV,PATHN0,PATH) GOTO 10196 10195 CALL PTOC(PATHN0,187,PATH,102) 10196 FD=CREATE(PATH,2) STORE(P)=FD IF((FD.NE.-3))GOTO 10197 CALL P$BOMB('could not open file for writing.') 10197 SP=SP-1 RETURN END SUBROUTINE P$SAV INTEGER I INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) I=STORE(SP) STORE(I)=NP SP=SP-1 RETURN END SUBROUTINE P$SBI INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) SP=SP-1 STORE(SP)=STORE(SP)-STORE(SP+1) RETURN END SUBROUTINE P$SBR INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) SP=SP-1 STORER(SP)=STORER(SP)-STORER(SP+1) RETURN END SUBROUTINE P$SGS INTEGER I,W,B INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP INTEGER * 4 MASKS(32) SAVE MASKS EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) DATA MASKS/:00000000001,:00000000002,:00000000004,:00000000010,:00 *000000020,:00000000040,:00000000100,:00000000200,:00000000400,:000 *00001000,:00000002000,:00000004000,:00000010000,:00000020000,:0000 *0040000,:00000100000,:00000200000,:00000400000,:00001000000,:00002 *000000,:00004000000,:00010000000,:00020000000,:00040000000,:001000 *00000,:00200000000,:00400000000,:01000000000,:02000000000,:0400000 *0000,:10000000000,:20000000000/ IF(((STORE(SP).GE.0).AND.(STORE(SP).LE.255)))GOTO 10198 CALL P$BOMB('set element out of range.') 10198 W=STORE(SP)/32 B=MOD(STORE(SP),32) SP=SP-1 I=0 GOTO 10201 10199 I=I+1 10201 IF((I.GE.W))GOTO 10200 SP=SP+1 STORE(SP)=0 GOTO 10199 10200 SP=SP+1 STORE(SP)=MASKS(B+1) I=I+1 GOTO 10204 10202 I=I+1 10204 IF((I.GE.8))GOTO 10203 SP=SP+1 STORE(SP)=0 GOTO 10202 10203 RETURN END SUBROUTINE P$SIN INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) STORER(SP)=SIN(STORER(SP)) RETURN END SUBROUTINE P$SQI INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) STORE(SP)=STORE(SP)*STORE(SP) RETURN END SUBROUTINE P$SQR INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) STORER(SP)=STORER(SP)*STORER(SP) RETURN END SUBROUTINE P$SQT INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) STORER(SP)=SQRT(STORER(SP)) RETURN END SUBROUTINE P$SRO(P,Q) INTEGER P,Q INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) IF((P.NE.4))GOTO 10205 CALL P$SROS(Q) GOTO 10206 10205 STORE(Q)=STORE(SP) SP=SP-1 10206 RETURN END SUBROUTINE P$SROS(Q) INTEGER Q INTEGER I,J,LO,HI INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) I=Q J=SP-8 LO=J+RS(STORE(SP),8) HI=J+RT(STORE(SP),8) GOTO 10209 10207 J=J+1 10209 IF((J.GE.LO))GOTO 10208 IF((STORE(J).EQ.0))GOTO 10207 CALL P$BOMB('set too large.') 10210 GOTO 10207 10208 J=HI+1 GOTO 10213 10211 J=J+1 10213 IF((J.GE.SP))GOTO 10212 IF((STORE(J).EQ.0))GOTO 10211 CALL P$BOMB('set too large.') 10214 GOTO 10211 10212 J=LO GOTO 10217 10215 J=J+1 10217 IF((J.GT.HI))GOTO 10216 STORE(I)=STORE(J) I=I+1 GOTO 10215 10216 SP=SP-9 RETURN END SUBROUTINE P$STO(P) INTEGER P,I INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) IF((P.NE.4))GOTO 10218 I=STORE(SP-9) CALL P$SROS(I) SP=SP-1 GOTO 10219 10218 I=STORE(SP-1) STORE(I)=STORE(SP) SP=SP-2 10219 RETURN END SUBROUTINE P$STP CALL SWT END SUBROUTINE P$STR(P,Q) INTEGER P,Q INTEGER I INTEGER P$BASE INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) I=P$BASE(P)+Q STORE(I)=STORE(SP) SP=SP-1 RETURN END SUBROUTINE P$STRA(P,Q) INTEGER P,Q INTEGER I INTEGER P$BASE INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) I=P$BASE(P)+Q STORE(I)=STORE(SP) SP=SP-1 RETURN END SUBROUTINE P$STRS(P,Q) INTEGER P,Q INTEGER P$BASE INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) CALL P$SROS(P$BASE(P)+Q) RETURN END SUBROUTINE P$TRC INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) STORE(SP)=STORER(SP) RETURN END SUBROUTINE P$UJC INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) CALL P$BOMB('case statement error.') RETURN END SUBROUTINE P$UNI INTEGER I INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) I=SP-8 GOTO 10222 10220 SP=SP-1 10222 IF((SP.LE.I))GOTO 10221 STORE(SP-8)=OR(STORE(SP-8),STORE(SP)) GOTO 10220 10221 RETURN END SUBROUTINE P$WLN INTEGER I,FD,PUTCH INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) I=STORE(SP)+1 FD=STORE(STORE(SP)) CALL PUTCH(138,FD) STORE(I)=138 SP=SP-1 RETURN END SUBROUTINE P$WRC INTEGER BUFP,WIDTH,FD INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) BUFP=STORE(SP-2) FD=STORE(BUFP) WIDTH=STORE(SP) GOTO 10225 10223 WIDTH=WIDTH-1 10225 IF((WIDTH.LE.1))GOTO 10224 CALL PUTCH(160,FD) GOTO 10223 10224 STORE(BUFP+1)=STORE(SP-1) CALL PUTCH(INTS(STORE(BUFP+1)),FD) SP=SP-2 RETURN END SUBROUTINE P$WRI INTEGER BUFP,FD INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) BUFP=STORE(SP-2) STORE(BUFP+1)=STORE(SP-1) FD=STORE(BUFP) CALL PRINT(FD,'*#l.',INTS(STORE(SP)),STORE(BUFP+1)) SP=SP-2 RETURN END SUBROUTINE P$WRR INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP INTEGER I,J,K,FD EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) FD=STORE(STORE(SP-3)) I=STORE(SP-3)+1 J=STORE(SP-1) K=STORE(SP) CALL PRINT(FD,'*#,#r.',J,K,STORER(SP-2)) STORER(I)=STORE(SP-2) SP=SP-3 RETURN END SUBROUTINE P$WRS INTEGER FD,I,J,K,L,P INTEGER GCHAR,PUTCH INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) FD=STORE(STORE(SP-3)) I=STORE(SP-3)+1 L=STORE(SP-2) K=STORE(SP-1) J=STORE(SP) IF((K.LE.J))GOTO 10226 P=1 GOTO 10229 10227 P=P+1 10229 IF((P.GT.K-J))GOTO 10230 CALL PUTCH(160,FD) GOTO 10227 10226 J=K 10230 P=0 GOTO 10233 10231 CONTINUE 10233 IF((P.GE.J))GOTO 10232 CALL PUTCH(GCHAR(LOC(STORE(L)),P),FD) GOTO 10231 10232 P=P-1 STORE(I)=GCHAR(LOC(STORE(L)),P) SP=SP-3 RETURN END INTEGER FUNCTION P$BASE(LD) INTEGER LD INTEGER LLD,AD INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) AD=MP LLD=LD GOTO 10236 10234 LLD=LLD-1 10236 IF((LLD.LE.0))GOTO 10235 AD=RT(STORE(AD+1),16) GOTO 10234 10235 P$BASE=AD RETURN END LOGICAL FUNCTION P$COMP(LENGTH,REL) INTEGER LENGTH,REL INTEGER I,L,I1,I2,R INTEGER * 4 S1,S2 INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP INTEGER AAAAA0 EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) I1=STORE(SP) I2=STORE(SP+1) L=LENGTH/4 R=MOD(LENGTH,4) I=1 GOTO 10239 10237 I=I+1 10239 IF(((I.GT.L).OR.(STORE(I1).NE.STORE(I2))))GOTO 10238 I1=I1+1 I2=I2+1 GOTO 10237 10238 IF((I.LE.L))GOTO 10240 IF((R.NE.0))GOTO 10241 I=1 GOTO 10247 10241 S1=LT(STORE(I1),R*8) S2=LT(STORE(I2),R*8) IF((S1.NE.S2))GOTO 10243 I=1 GOTO 10244 10243 IF((S1.GE.S2))GOTO 10245 I=6 GOTO 10246 10245 I=4 10246 CONTINUE 10244 CONTINUE 10242 GOTO 10247 10240 IF((STORE(I1).LE.STORE(I2)))GOTO 10248 I=4 GOTO 10249 10248 I=6 10249 CONTINUE 10247 AAAAA0=REL GOTO 10250 10251 P$COMP=I.EQ.1 GOTO 10252 10253 P$COMP=I.NE.1 GOTO 10252 10254 P$COMP=I.EQ.1.OR.I.EQ.4 GOTO 10252 10255 P$COMP=I.EQ.4 GOTO 10252 10256 P$COMP=I.EQ.1.OR.I.EQ.6 GOTO 10252 10257 P$COMP=I.EQ.6 GOTO 10252 10250 GOTO(10251,10253,10254,10255,10256,10257),AAAAA0 10252 RETURN END SUBROUTINE P$DBUG(MSG) INTEGER I,J,B,BASE(3),MSG(1),PUTCH INTEGER C INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) DATA BASE/-8,10,-16/ CALL PRINT(-15,'*n*p*n*nmp=*i, sp=*i, ep=*i, np=*i*n*n.',MSG,MP,SP *,EP,NP) DO 10258 B=1,3 CALL PRINT(-15,'Local stack contents in base *i? .',IABS(BASE(B) *)) CALL T1IN(C) CALL TONL IF(((C.NE.249).AND.(C.NE.217)))GOTO 10260 J=0 CALL TONL I=MP GOTO 10263 10261 I=I+1 10263 IF((I.GT.SP))GOTO 10262 CALL PRINT(-15,'*12,#l.',BASE(B),STORE(I)) J=J+1 IF((J.LT.6))GOTO 10261 J=0 CALL PUTCH(138,-15) 10264 GOTO 10261 10262 IF((J.LE.0))GOTO 10265 CALL PUTCH(138,-15) 10265 CONTINUE 10260 CONTINUE 10258 CONTINUE 10259 RETURN END SUBROUTINE P$INIT(J) INTEGER GETCH,I,J INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) MP=0 SP=-1 EP=5 NP=23176 STORE(5)=-10 STORE(7)=-11 STORE(9)=-12 STORE(11)=-13 IF((J.NE.1))GOTO 10266 STORE(6)=GETCH(I,-10) 10266 RETURN END SUBROUTINE P$MKPN(LEV,PATHN0,PN) INTEGER I,LEV,IND,PATHN0(1) INTEGER PN(102) INTEGER PTOC,ITOC INTEGER * 4 STORE(1),STOREX(32767) REAL STORER(1) COMMON /CSTORE/STOREX INTEGER SP,MP,EP,NP COMMON /SP/SP COMMON /MP/MP COMMON /EP/EP COMMON /NP/NP EQUIVALENCE (STOREX(2),STORE(1),STORER(1)) IND=STORE(SP) I=PTOC(PATHN0,187,PN,102) I=3+ITOC(LEV,PN(3),3) I=I+ITOC(IND,PN(I),5) PN(I)=0 RETURN END C ---- Long Name Map ---- C message messa0 C pathname pathn0 C filebuf fileb0