Trailing-Edge
-
PDP-10 Archives
-
decuslib10-02
-
43,50242/phelp.bli
There are no other files named phelp.bli in the archive.
00100 MODULE PHELP(INSPECT,DREGS=5,RSAVE,LOWSEG)=
00200 BEGIN
00300
00400
00500 ! HELPER
00600
00700
00800
00900 ! THIS MODULE CONTAINS SEVERAL ROUTINES WHICH MAY BE LOADED WITH
01000 ! A NORMAL BLISS MODULE TO PROVIDE DEBUGGING SUPPORT -- IT
01100 ! PRESUMES THAT 'DDT' IS ALSO LOADED;
01200 !
01300
01400 EXTERNAL DDTEND,DDT,JOBSYM;
01500
01600
01700 BIND BUFFLENGTH=15;
01800 OWN BUFF[BUFFLENGTH];
01900 OWN PBUFF; ! POINTER INTO THE OUTPUT BUFF
02000
02100 MACRO EBUFF= (BUFF+BUFFLENGTH)$,
02200 BBUFF= BUFF<36,7>$,
02300 SAVREGS= REGISTER I;I_15;DO PUSH(SREG,0,I) WHILE(I_.I-1) GTR 0;$,
02400 RESREGS= I_-15;DO POP(SREG,#20,I)WHILE(I_.I+1)LSS 0;$,
02500 SUBRET(L,V)= IF .(L)<0,18>LSS DDTEND<0,0> THEN
02600 (L)_.(L)+(V);$,
02700 ENTER= SAVREGS;$,
02800 LEAVE(LL,VV)= SUBRET(LL,VV); RESREGS; .VREG $;
02900
03000 MACHOP PUSH=#261, POP=#262;
03100
03200 BIND AREASZ=8, NUMAREAS=8;
03300
03400 STRUCTURE SAT[I,J] = [I*J](.SAT+.I*AREASZ+.J)<0,36>;
03500 GLOBAL XAREA0:XAREA1:XAREA2:XAREA3:
03600 XAREA4:XAREA5:XAREA6:XAREA7:
03700 XAREA8[AREASZ];
03800 BIND SAT XAREAS = XAREA0;
03900
04000
04100 GLOBAL XALTX0,XALTX1,XALTX2,XALTX3,
04200 XALTX4,XALTX5,XALTX6,XALTX7,
04300 XALTX8;
04400
04500
04600
04700
04800
04900 ROUTINE F50T6(X)=
05000 IF .X EQL 0 THEN 0 ELSE
05100 IF .X LEQ #12 THEN .X+#17 ELSE
05200 IF .X LEQ #44 THEN .X+#26 ELSE
05300 IF .X EQL #45 THEN #16 ELSE
05400 IF .X EQL #46 THEN #04 ELSE #05;
05500
05600 ROUTINE B50T6(X)=
05700 BEGIN REGISTER R;
05800 X_.X AND #37777777777; R_0;
05900 DECR I FROM 5 TO 0 DO
06000 (R_.R^(-6); R<30,6>_F50T6(.X MOD #50); X_.X DIV #50);
06100 .R
06200 END;
06300
06400 ROUTINE BPN=
06500 ! THIS ROUTINE MUST BE CHANGED FOR EACH VERSION OF DDT --
06600 ! OR, BETTER YET, DDT SHOULD BE CHANGED TO MAKE THE MOST
06700 ! RECENT BREAK POINT NUMBER AVAILABLE.
06800 BEGIN BIND BCOM3=#1416, B1ADR=#3206;
06900 IF ((.BCOM3<0,18>-(B1ADR-3)) MOD 3) EQL 0 THEN 0
07000 ELSE (.BCOM3<0,18>-(B1ADR-3))/3
07100 END;
07200
07300 ROUTINE SDDTST(X)=
07400 BEGIN REGISTER R,N; OWN ZN,ZZ; ZZ_ZN_0;
07500 R_.JOBSYM+1; N_ZZ;
07600 WHILE (R_.R+#2000002) LSS 0 DO
07700 IF (@@R-.X) LEQ 0 THEN
07800 IF (@@R-@@N) GEQ 0 THEN N_.R;
07900 .N-1
08000 END;
08100
08200 ROUTINE HDUMP=
08300 BEGIN MACHOP CALLI=#47; REGISTER R;
08400 R_BUFF; CALLI(R,#3); R_BUFFLENGTH;
08500 DO BUFF[.R]_0 WHILE (R_.R-1) GEQ 0;
08600 PBUFF_BBUFF
08700 END;
08800
08900 ROUTINE INITHELP= (BUFF_0; HDUMP());
09000
09100 ROUTINE HPUT(X)=
09200 IF .X NEQ 0 THEN
09300 BEGIN
09400 IF .PBUFF EQL 0 THEN INITHELP() ELSE
09500 IF .PBUFF GEQ EBUFF THEN HDUMP();
09600 REPLACEI(PBUFF,.X)
09700 END;
09800
09900 ROUTINE PUTS(X)=
10000 WHILE .X NEQ 0 DO (HPUT(.X<28,7>); X_.X^7);
10100
10200 ROUTINE CRLF= (HPUT(#15); HPUT(#12); HDUMP());
10300
10400 ROUTINE TAB= HPUT(#11);
10500
10600 ROUTINE PRINT6(X)=
10700 BEGIN LOCAL L;
10800 DECR I FROM 5 TO 0 DO
10900 (L_.X<30,6>; X_.X^6; IF .L NEQ 0 THEN HPUT(.L+#40));
11000 END;
11100
11200 ROUTINE PRINT50(X)= PRINT6(B50T6(.X));
11300
11400 ROUTINE PMOC(X)=
11500 BEGIN LOCAL T; T_0;
11600 DECR I FROM 11 TO 1 DO
11700 IF .X<3*.I,3> NEQ 0 THEN EXITLOOP (T_.I);
11800 DECR I FROM .T TO 0 DO HPUT("0"+.X<3*.I,3>);
11900 END;
12000
12100 ROUTINE PDISP(X,T)=
12200 IF .X<0,18> LSS DDTEND<0,0> THEN PMOC(.X<0,18>) ELSE
12300 BEGIN LOCAL M,L;
12400 L_SDDTST(.X<0,18>);
12500 IF NOT .T OR ((M _ .X<0,18>-@(@L+1)) EQL 0 ) THEN
12600 PRINT50(@@L)
12700 ELSE
12800 ( IF .M LEQ #10000 THEN (PRINT50(@@L);HPUT("+");PMOC(.M))
12900 ELSE PMOC(.X<0,18>)
13000 );
13100 END;
13200
13300 ROUTINE SPN(N)= INCR I FROM 1 TO .N DO HPUT(" ");
13400
13500 ROUTINE P2C= PUTS(",,");
13600
13700 ROUTINE SP3= SPN(3);
13800
13900 ROUTINE PWD(X)= (PMOC(.X<18,18>); P2C(); PDISP(.X<0,18>,1));
14000
14100 ROUTINE PWD2(X)=IF .X GEQ 0 THEN PWD(.X) ELSE (HPUT("-");PMOC(-.X));
14200
14300 ROUTINE PWO(X)= (PMOC(.X<18,18>); P2C(); PMOC(.X<0,18>));
14400
14500 ROUTINE PRG(BASE,F,T)=
14600 INCR I FROM .F TO .T DO
14700 BEGIN
14800 PMOC(.I); PUTS(": "); PWD2(@(.BASE+.I-1)); SPN(4);
14900 IF NOT .I THEN (CRLF(); TAB());
15000 END;
15100
15200 ROUTINE PRC(F,CALLED)=
15300 BEGIN LOCAL NP,LP,CALLER;
15400 CALLER_.(.F-1)<0,18>-1;
15500 NP_ IF .(@(.F-1))<23,13> NEQ #274^4 OR SREG THEN 0 ELSE
15600 .(@@(.F-1))<0,18>;
15700 LP_ .F-1-.NP;
15800 PDISP(.CALLED,0); TAB(); PUTS("(_"); PDISP(.CALLER,1); HPUT(")");
15900 TAB(); PRG(.LP,1,.NP);
16000 .CALLER<0,18>+.NP^18
16100 END;
16200
16300 ROUTINE PSTK=
16400 BEGIN LOCAL F,CALLED,VAL,LL,NL;
16500 VAL_.VREG; F_@@@FREG; NL_@.FREG-.F-3; LL_.F+1;
16600 CALLED_.(@(.F-1)-1)<0,18>; CRLF();
16700 UNTIL (.CALLED<0,18> EQL #777777) DO
16800 BEGIN LL_.F+1; CRLF();
16900 CALLED_PRC(.F,.CALLED<0,18>); CRLF(); TAB(); PRG(.LL,1,.NL);
17000 NL_@F-@@F-.CALLED<18,18>-2;
17100 IF NOT ((@@F LSS @F) AND (@@F GTR .BREG<0,18>)) THEN EXITLOOP;
17200 F_@@F;
17300 END;
17400 .VAL
17500 END;
17600
17700 ROUTINE PFRC=(LOCAL F; CRLF(); F_@@@FREG; PRC(.F,.(@(.F-1)-1)<0,18>));
17800
17900 ROUTINE PAREA=
18000 BEGIN LOCAL J,K,N,BN; BN_BPN();CRLF();
18100 INCR I FROM 0 TO AREASZ-1 DO
18200 BEGIN BIND AREA=.XAREAS[.BN,.I]<0,18>;
18300 CRLF(); J_.XAREAS[.BN,.I]<18,18>;N_0;
18400 IF AREA NEQ 0 THEN
18500 DO(CRLF();PDISP(AREA[.N],1);HPUT("/");TAB(); PWD2(@AREA[.N]))
18600 WHILE (N_.N+1; J_.J-1) GTR 0;
18700 END;
18800 END;
18900
19000 GLOBAL ROUTINE XSTAK(X)=(ENTER; PSTK(); LEAVE(X+1,1));
19100 GLOBAL ROUTINE XSTAKC(X)=(ENTER; PSTK(); LEAVE(X+1,0));
19200 GLOBAL ROUTINE XSTAKB(X)=(ENTER; PSTK(); LEAVE(X+1,1));
19300 GLOBAL ROUTINE XSTAKP(X)=(ENTER; PSTK(); LEAVE(X+1,2));
19400
19500
19600 GLOBAL ROUTINE XCALL(X)=(ENTER; PFRC(); LEAVE(X+1,1));
19700 GLOBAL ROUTINE XCALLC(X)=(ENTER; PFRC(); LEAVE(X+1,0));
19800 GLOBAL ROUTINE XCALLB(X)=(ENTER; PFRC(); LEAVE(X+1,1));
19900 GLOBAL ROUTINE XCALLP(X)=(ENTER; PFRC(); LEAVE(X+1,2));
20000
20100
20200 GLOBAL ROUTINE XAREA(X)=(ENTER; PAREA(); LEAVE(X+1,1));
20300 GLOBAL ROUTINE XAREAC(X)=(ENTER; PAREA(); LEAVE(X+1,0));
20400 GLOBAL ROUTINE XAREAB(X)=(ENTER; PAREA(); LEAVE(X+1,1));
20500 GLOBAL ROUTINE XAREAP(X)=(ENTER; PAREA(); LEAVE(X+1,2));
20600
20700
20800 GLOBAL ROUTINE XALTX(X)=(LOCAL L; ENTER; L_(@XALTX0[BPN()])(); LEAVE(X+1,.L));
20900
21000
21100
21200
21300 %- - - - - - - - P H E L P A D D I T I O N S - - - - - - - - -
21400
21500
21600
21700 THE DECLARATIONS BELOW ARE THE ADDITIONS TO THE STANDARD HELP.
21800 IN ADDITION, ALL OCCURENCES OF 'PUT' AND 'DUMP' IN HELP MUST BE
21900 CHANGED TO 'HPUT' AND 'HDUMP', AS IS DONE ABOVE.
22000 <%
22100
22200
22300 EXTERNAL ! I/O PACKAGE LINKAGE.
22400 OCTOUT,OUTMSG;
22500
22600 MACRO ! INTERFACING OLD I/O TO BLISS I/O.
22700 TYPECRLF = TYPELINE()$,
22800 TYPE(MSG,LF) = (OUTMSG(0,PLIT MSG);
22900 IF LF THEN TYPECRLF)$;
23000
23100 EXTERNAL TYPELINE; ! FUDGE, FIX LATER.
23200 EXTERNAL TYPOCT; ! DECLARED IN BLIPP.
23300
23400 GLOBAL ROUTINE OUTSYM(X) =
23500 ! PRINTS THAT SYMBOL FROM DDT'S TABLE WHICH HAS THE VALUE .X.
23600 ( PBUFF _ 0; PRINT50(@SDDTST(.X)); HDUMP(); );
23700
23800 OWN CH;
23900 MACHOP TTCALL = #51;
24000 MACRO NUMERIC7(S) = (.S LEQ #71 AND .S GEQ #60)$,
24100 ALPHA7(S) = (.S LEQ #132 AND .S GEQ #101)$,
24200 IDCHAR(S) = (.S EQL "." OR .S EQL #44 OR .S EQL #45)$;
24300 % DOLLAR AND PERCENT REPRESENTED AS OCTAL CONSTANTS.%
24400
24500 ROUTINE F7T50(X) =
24600 ! CONVERTS 7 BIT ASCII CHARACTERS TO RADIX #50 CODE.
24700 ! RESULT 0 FOR CHARACTER NOT IN RADIX #50 SET.
24800 ( X _ .X-#40;
24900 IF .X GEQ #20 AND .X LEQ #31 THEN .X-#17
25000 ELSE IF .X GEQ #41 AND .X LEQ #72 THEN .X-#26
25100 ELSE IF .X EQL #16 THEN #45
25200 ELSE IF .X EQL #4 THEN #46
25300 ELSE IF .X EQL #5 THEN #47
25400 ELSE 0
25500 ); ! END FROM 7 TO 50 CODER.
25600
25700 GLOBAL ROUTINE BLD8(S) =
25800 ! BUILDS AN OCTAL NUMBER STARTING WITH DIGIT IN S.
25900 BEGIN
26000 LOCAL N;
26100 N _ 0;
26200 UNTIL NOT NUMERIC7(S) DO
26300 ( N _ .N^3 OR (.S - #60); TTCALL(0,S) );
26400 CH _ .S;
26500 .N
26600 END; ! END OCTAL READER.
26700
26800 ROUTINE BLDN50 =
26900 ! BUILDS A NAME IN RADIX #50 CODE STARTING WITH LETTER IN CH.
27000 BEGIN
27100 LOCAL NCHAR,NAME;
27200 NAME _ NCHAR _ 0;
27300 UNTIL (NOT (NUMERIC7(CH) OR ALPHA7(CH) OR IDCHAR(CH)))
27400 OR ((NCHAR _ .NCHAR + 1) GTR 6) DO
27500 ( NAME _ .NAME*#50 + F7T50(.CH); TTCALL(0,CH));
27600 UNTIL NOT( NUMERIC7(CH) OR ALPHA7(CH) OR IDCHAR(CH))
27700 DO TTCALL(0,CH);
27800 .NAME
27900 END; ! END NAME READER.
28000
28100 ROUTINE SDDTNT(X) =
28200 ! SEARCHES NAME-TABLE OF DDT FOR ENTRY W. NAME .X.
28300 ! .X IN RADIX #50 W. FIRST 4 BITS ZERO.
28400 ! RETURNS -1 IF NOT FOUND.
28500 BEGIN
28600 REGISTER R;
28700 R _ .JOBSYM;
28800 WHILE (R _ .R + #2000002) LSS 0 DO
28900 ( IF .(@R)<0,32> EQL .X THEN RETURN .(@R+1)<0,18> );
29000 -1
29100 END; ! END DDT SYMBOL TABLE SEARCH FOR NAME.
29200
29300 ROUTINE NXTADR =
29400 ! DELIVERS VALUE OF EXPRESSION READ ( RESULTING FROM COMBINING
29500 ! SYMBOLS KNOWN TO DDT AND OCTAL CONSTANTS USING "+" AND "-").
29600 BEGIN
29700 LOCAL ADDR;
29800 WHILE .CH EQL " " DO TTCALL(0,CH);
29900 ADDR _ IF NUMERIC7(CH) THEN BLD8(.CH)
30000 ELSE IF ALPHA7(CH) THEN SDDTNT(BLDN50())
30100 ELSE ( TYPE('SYMB!',1); RETURN -1);
30200 WHILE .CH EQL " " DO TTCALL(0,CH);
30300 IF .CH EQL "+" THEN ADDR _ .ADDR + (TTCALL(0,CH); NXTADR())
30400 ELSE
30500 IF .CH EQL "-" THEN ADDR _ .ADDR - ( TTCALL(0,CH); NXTADR());
30600 .ADDR
30700 END; ! END NEXT ADDRESS GETTER.
30800
30900 GLOBAL ROUTINE INCALL =
31000 ! CALLED FROM QPEP EXECUTIVE TO READ AND PROCESS A CALL ON A
31100 ! USER DEFINED FUNCTION AS TYPED IN LIMP-MODE SEQUENCING.
31200 BEGIN
31300 MACHOP PUSH = #261;
31400 OWN PNAME,PARAS[8],NPARS;
31500 NPARS _ 0;
31600 TTCALL(0,CH);
31700 IF ( PNAME _ NXTADR()) LSS 0 THEN (TYPE('PROC!',1); RETURN);
31800 IF .CH NEQ "(" THEN (TYPE('LPAR!',1); RETURN);
31900 TTCALL(0,CH);
32000 UNTIL .CH EQL ")" OR .CH EQL #15 DO
32100 ( IF (PARAS[.NPARS] _ NXTADR() ) LSS 0 THEN
32200 ( TYPE('PAR!',1); RETURN);
32300 IF ( NPARS _ .NPARS + 1 ) GEQ 8 THEN
32400 ( TYPE('MANY!',1); RETURN);
32500 IF .CH EQL "," THEN TTCALL(0,CH)
32600 ELSE IF .CH NEQ ")" THEN (TYPE('RPAR!',1); RETURN);
32700 );
32800 INCR I FROM 0 TO .NPARS-1 DO PUSH(SREG,PARAS,I,1);
32900 PNAME _ (@PNAME)();
33000 SREG _ .SREG - (.NPARS^18+.NPARS);
33100 TYPE('#',0); TYPOCT(.PNAME,1);
33200 .PNAME
33300 END; ! END INCALL ROUTINE.
33400
33500 GLOBAL ROUTINE BPCALL =
33600 WHILE 1 DO
33700 ( TYPE(' :',0);
33800 TTCALL(4,CH);
33900 IF .CH EQL "C" THEN ( INCALL(); TTCALL(#11,0))
34000 ELSE ( OUTMSG(0,PLIT 'END BPCALL'); RETURN)
34100 ); ! END OG BPCALL ROUTINE.
34200
34300
34400
34500 END
34600
34700 ELUDOM