Trailing-Edge
-
PDP-10 Archives
-
BB-4172G-BM
-
language-sources/six12.bli
There are 19 other files named six12.bli in the archive. Click here to see a list.
MODULE SIX12(NOFSAVE,NODEBUG,RESERVE(7,9))=
! 5.200.22 - SIX12 MUST NOT CLOBBER REGISTER 9 WHICH HAS ERRDEV INITIALLY
BEGIN
! IF DEFAULT REGISTERS ARE CHANGED, MODIFY ROUTINE 'SIXDDT' !!
BIND BREG=?.BREG;
! DEBUGGING CONTROL MODULE
! --------------------------
!
! SEE SIX12.MAN FOR INFO CREDITS:
! ---------------------- C. B. WEINSTOCK WM. A. WULF
! T. LANE R. K. JOHNSSON
! REVISED: JULY 1, 1974 RJ14
BIND SAILSW = 0; ! SET TO 1 FOR USE WITH SAIL
! THESE BINDS CONTROL SIZE OF PROBLEM
! -----------------------------------
BIND STACKSIZE=50, NMACROS=40, LEVELS=10, EXTRAOPS=20,
BGOBASE=20, ROUTSCNT=50, MONITCNT=50, ROUTSIZE=4;
MACHOP TTCALL=#51, CALLI=#47, HLRE=#574, EXCH=#250, IN=#56, OUT=#57,
OPEN=#50, CLOSE=#70, LOOKUP=#76, ENTER=#77, INBUF=#64, OUTBUF=#65,
PUSH=#261, POP=#262, JRST=#254, RELEASE=#71;
EXTERNAL ?.JBSYM, ?.JBOPC, ?.JBDDT, DDTEND, DDT, ?.JBUUO, ?.JBFF,
?.JB41, ?.JBREL, ?.JBHRL;
! STORAGE DECLARATIONS
! --------------------
GLOBAL SIXRP,SIXLP,SIXVP,SIXRC,SIXLC,SIXVC,SIXVREG;
OWN STARTFLG,ENABFLG,NROUTS,NVALS,SIXTOG,RTNLVL,
DCNT,CHAR,NCHAR,NPCHAR,LPTFLG,ERRORFLG,SAILUUO,
GOFLG,TRACEFLG,MODEFLG,QUOTFLG,TRCCNT,OPQCNT,
TOPSTK,TOPOP,IOBASE,WDBASE,VTEMP,
LPTHDR[3],DSKHDR[3],ENTERPNT,PTEXT,NEWOPS,NNAMES,
BUFF[24],PCHAR[LEVELS],TEXTAREA[4*NMACROS],
! ALLOWING AVG. 20 CHARS/MACRO; CHANGE ROUTINE 'GETTEXT' IF CHANGED
DEFOPTAB[5*EXTRAOPS],DBGSTK[STACKSIZE],LPTBUF[#203];
STRUCTURE XVECTOR[I,J,K,L]=[I*J] (.XVECTOR+.J+(.I*J))<.K,.L>;
OWN XVECTOR
MONVALS[MONITCNT,2]:SIXNAMES[NMACROS,2]:ROUTS[ROUTSCNT,ROUTSIZE];
! SOME USEFUL MACROS
! ------------------
MACRO RNAME=?.JBUUO<0,18>$,
RH=0,18$,
LH=18,18$,
FW=0,36$,
ADR=0,0$,
OPCODE=27,9$,
BITFLD(N)=N,1$,
BITVAL(N)=1^(N)$,
DECRTOG=(SIXTOG_.SIXTOG-BGOBASE)$,
INCRTOG=(SIXTOG_.SIXTOG+BGOBASE)$,
SETON(U)=(U_ -1)$,
SETOFF(U)=(U_ 0)$,
ISON(U)=(.U NEQ 0)$,
ISOFF(U)=(.U EQL 0)$,
SETINTERNAL=(RTNLVL_-1)$,
SETISEXIT=(RTNLVL_ISEXIT)$,
OUTFLAG=(CASE .RTNLVL OF SET OUTS('B:'); OUTS('A:') TES)$,
STOPIT=
BEGIN
SETON(ENABFLG);
IF ISON(TRACEFLG) THEN INCRTOG;
LPTOFF(); GOFLG_2
END$;
! DECLARATIONS FOR UUO ENTRY TO SIX12
! -----------------------------------
BIND DEBUGUUO=#037,
TBLPOS=24,
EXITPOS=23,
SETUWP=#36;
MACRO TBLBIT=BITFLD(TBLPOS)$,
EXITBIT=BITFLD(EXITPOS)$,
ISINTBL=.?.JBUUO<TBLBIT>$,
ISEXIT=.?.JBUUO<EXITBIT>$,
CHKUWP(ACTION)=
BEGIN
REGISTER RUWP;
RUWP_0; CALLI(RUWP,SETUWP); RUWP_1;
(ACTION);
CALLI(RUWP,SETUWP); RUWP_0
END$;
FORWARD ERROR;
! TTY AND LPT I/O SUPPORT
! -----------------------
! ITEMS BEGINNING WITH 'TT' ALWAYS WRITE TO THE TTY. OTHERS
! WRITE EITHER TO TTY OR LPT-FILE, OR BOTH, DEPENDING ON STATE OF
! SWITCH 'LPTFLG' (SET BY LPTON, LPTDUP, AND LPTOFF). ROUTINES
! OPENLPT AND CLOSELPT MUST BE CALLED BEFORE AND AFTER ONE
! COMPLETE SET OF LPT OUTPUT. SEE SIX12.MAN.
BIND CRLFSTR=PLIT ASCIZ '?M?J', ! STRING FOR CRLF MACRO
VALSTR=PLIT ASCIZ '?IValue: '; ! FOR OUTVALUE
MACRO INC=(TTCALL(4,VREG); .VREG)$,
TTOUTC(Z)=(VREG_(Z); TTCALL(1,VREG))$,
OUTS(Z)=OUTSA(PLIT ASCIZ Z)$,
TTOUTS(Z)=TTCALL(3,PLIT ASCIZ Z)$,
OUTM(C,N)=(DECR QQ FROM (N)-1 TO 0 DO OUTC(C))$,
TTOUTM(C,N)=(DECR QQ FROM (N)-1 TO 0 DO TTOUTC(C))$,
CRLF=OUTSA(CRLFSTR)$,
TTCRLF=TTCALL(3,CRLFSTR)$,
TAB=OUTC(#11)$,
OUTDEFAULT(Z)=OUTN((Z),.IOBASE,1)$,
OUTRDEF(Z,R)=OUTN((Z),.IOBASE,(R))$,
OUTD(Z)=OUTN((Z),10,1)$,
OUTDR(Z,N)=OUTN((Z),10,(N))$,
OUTVALUE=(OUTSA(VALSTR); OUTDEFAULT(.SIXVREG); TAB;
PRDISP(.SIXVREG); CRLF)$;
! SUPPORT OF LPT AND SAVE/LOAD I/O
! --------------------------------
BIND SLCHN=#16,
LPTCHN=#17;
MACRO LPTCNT=LPTHDR[2]$,
LPTPTR=LPTHDR[1]$,
DSKCNT=DSKHDR[2]$,
DSKPTR=DSKHDR[1]$,
STATUS=BLOCK[0]$,
LDEV=BLOCK[1]$,
BUFW=BLOCK[2]$,
FNAME=BLOCK[0]$,
FEXT=BLOCK[1]$,
JUNK=BLOCK[2]$,
PPN=BLOCK[3]$;
ROUTINE OPENLPT=
BEGIN
LOCAL SAVFF,BLOCK[4];
STATUS_1;
LDEV_SIXBIT 'LPT';
BUFW_LPTHDR<ADR>^18;
IFSKIP OPEN(LPTCHN,BLOCK) THEN 0 ELSE RETURN ERROR(10);
FNAME_SIXBIT 'SIX12';
FEXT_SIXBIT 'LPT';
JUNK_0;
PPN_0;
IFSKIP ENTER(LPTCHN,BLOCK) THEN 0 ELSE RETURN ERROR(10);
SAVFF_.?.JBFF;
?.JBFF_LPTBUF<ADR>;
OUTBUF(LPTCHN,1);
?.JBFF_.SAVFF;
OUT(LPTCHN,0);
VREG_0
END;
ROUTINE OUTC(CHAR)=
BEGIN
IF .LPTFLG GEQ 0 THEN TTCALL(1,CHAR);
IF .LPTFLG NEQ 0 THEN
BEGIN
IF (LPTCNT_.LPTCNT-1) LEQ 0 THEN OUT(LPTCHN,0);
REPLACEI(LPTPTR,.CHAR)
END;
.VREG
END;
ROUTINE OUTSA(STR)=
BEGIN
IF .LPTFLG GEQ 0 THEN TTCALL(3,STR,0,1);
IF .LPTFLG NEQ 0 THEN
BEGIN
REGISTER PTR,C;
PTR_(.STR)<36,7>;
WHILE (C_SCANI(PTR)) NEQ 0 DO
(IF (LPTCNT_.LPTCNT-1) LEQ 0 THEN OUT(LPTCHN,0);
REPLACEI(LPTPTR,.C))
END;
.VREG
END;
ROUTINE INWORD=
BEGIN
IF ISON(ERRORFLG) THEN RETURN -1;
IF (DSKCNT_.DSKCNT-1) LEQ 0 THEN
IFSKIP IN(SLCHN,0) THEN (SETON(ERRORFLG); RETURN -1);
SCANI(DSKPTR)
END;
ROUTINE OUTWORD(WORD)=
BEGIN
IF ISON(ERRORFLG) THEN RETURN .VREG;
IF (DSKCNT_.DSKCNT-1) LEQ 0 THEN
IFSKIP OUT(SLCHN,0) THEN (SETON(ERRORFLG); RETURN .VREG);
REPLACEI(DSKPTR,.WORD);
.VREG
END;
ROUTINE CLOSELPT=
BEGIN
LPTFLG_0;
CLOSE(LPTCHN,0);
RELEASE(LPTCHN,0);
.VREG
END;
ROUTINE LPTON= (LPTFLG_-1; .VREG);
ROUTINE LPTDUP= (LPTFLG_1; .VREG);
ROUTINE LPTOFF= (LPTFLG_0; .VREG);
! GENERAL PURPOSE NUMBER OUTPUT ROUTINE
! -------------------------------------
ROUTINE OUTN(N,B,RD)=
BEGIN OWN NUM,NUMNP,BASE,REQD,COUNT;
ROUTINE XN=
BEGIN REGISTER R;
IF .NUM EQL 0 THEN RETURN
(OUTM(" ",.REQD-.COUNT); IF ISON(NUMNP) THEN OUTC("-"); .VREG);
R_.NUM MOD .BASE; NUM_.NUM/.BASE; COUNT_.COUNT+1; XN(); OUTC(R_.R+"0")
END;
NUMNP_ COUNT_ (.N LSS 0);
BASE_.B; REQD_.RD;
IF (NUM _ ABS(.N) AND NOT 1^35) NEQ 0 THEN RETURN XN();
OUTM(" ",.REQD-1-.NUMNP); IF .NUMNP NEQ 0 THEN OUTC("-"); OUTC("0");
.VREG
END;
MACRO PAGE=SWITCHES LIST;$;
PAGE! INTERACTIVE DEBUGGING INTERFACE AND SUPPORT
! -------------------------------------------
ROUTINE SDDTFA(X)=
! GIVEN A SYMBOL, SEARCH DDT SYMBOL-TABLE FOR ITS VALUE
BEGIN REGISTER R;
HLRE(R,?.JBSYM); R_ -.R; R_ .R^18 + .R + .?.JBSYM<RH>;
WHILE (R_.R-#2000002) GEQ 0 DO
IF .(.R)<0,32> EQL .X THEN RETURN @(.R+1);
ERROR(0)
END;
ROUTINE NSDDTFA(X,V)=
! GIVEN A SYMBOL SEARCH FOR THE ADDRESS OF ITS NEXT OCCURRENCE
BEGIN REGISTER R;
R_.V;
WHILE (R_.R-#2000002) GEQ 0 DO
IF .(.R)<0,32> EQL .X THEN RETURN .R;
0
END;
ROUTINE SDDTFS(X)=
! GIVEN AN ADDRESS, SEARCH TABLE FOR THE SYMBOL MOST NEARLY MATCHING IT
BEGIN REGISTER R,N;
N_ PLIT(0,0)[1]<ADR>; HLRE(R,?.JBSYM); R_ NOT .R; ! -.R -1
R_ .R^18 + .R + .?.JBSYM<RH>;
WHILE (R_.R-#2000002) GEQ 0 DO
(IF @@R LEQ .X THEN
IF @@R GTR @@N THEN
IF @(@R-1) GEQ 0 THEN N_.R<RH>);
.N-1
END;
ROUTINE MODDDT(X)=
! GIVEN A START ADDRESS X (IN TABLE) FIND MODULE NAME
BEGIN REGISTER R;
R_ .X + (.?.JBSYM<LH>^18);
WHILE (R_.R+#2000002) LSS 0 DO
IF .(.R)<32,2> EQL 0 THEN RETURN @@R;
@(.R-2)
END;
MACRO F50TO7(X)=
! CONVERT BASE 50 CHARACTER TO ASCII CHARACTER
(IF (X) EQL 0 THEN 0 ELSE
IF (X) LEQ #12 THEN (X)+#57 ELSE
IF (X) LEQ #44 THEN (X)+#66 ELSE
IF (X) EQL #45 THEN #56 ELSE (X)-2)$;
MACRO F7TO50(X)=
! CONVERT ASCII CHARACTER TO BASE 50 CHARACTER
(IF (X) EQL 0 THEN 0 ELSE
IF (X) EQL #56 THEN #45 ELSE
IF (X) LEQ #45 THEN (X)+2 ELSE
IF (X) LEQ #71 THEN (X)-#57 ELSE
IF (X) LEQ #132 THEN (X)-#66 ELSE (X)-#126)$;
ROUTINE PRSYM50(X)=
! PRINT NAME GIVEN IN BASE 50
BEGIN LOCAL R;
IF (X_.X AND #37777777777) NEQ 0 THEN
(R_.X MOD #50; PRSYM50(.X /#50); OUTC(F50TO7(.R)));
.VREG
END;
ROUTINE PRDISP(X)=
! PRINT BOTH HALVES OF .X IN "BASE+DISP" FORM
BEGIN LOCAL Z,M,L;
DECR I FROM 1 TO 0 DO
BEGIN BIND DUMMY=0;
Z_ IF .I THEN .X<LH> ELSE .X<RH>;
IF .Z LSS DDTEND<ADR> THEN
(IF .I THEN IF .Z EQL 0 THEN EXITBLOCK; OUTDEFAULT(.Z))
ELSE
BEGIN
L_SDDTFS(.Z); M_.Z-@(.L+1);
IF (.WDBASE GEQ 0) AND (.M GTR .WDBASE) THEN OUTDEFAULT(.Z)
ELSE
BEGIN
PRSYM50(@@L);
IF .M NEQ 0 THEN (OUTC("+"); OUTDEFAULT(.M))
END;
END;
IF .I THEN OUTS(',,');
END;
.VREG
END;
ROUTINE PRXDISP(X)=
! PRINT ONLY BASE OF .X<RH>
PRSYM50( @SDDTFS( .X<RH>));
ROUTINE PRG(B,T)=
! PRINT A CONT. SET OF WORDS FOR STACK DISPLAY
INCR I FROM 1 TO .T DO
BEGIN
OUTDEFAULT(.I); OUTS(': '); PRDISP(@(.B+.I-1));
IF .I LSS .T THEN IF .I OR (.I AND 2 AND .LPTFLG) NEQ 0
THEN OUTS(' ') ELSE OUTS('?M?J?I?I');
END;
ROUTINE PRCALL(F,CALLED)=
! PRINT A SINGLE ROUTINE CALL WITH ITS PARMS
BEGIN LOCAL NP,CALLER;
IF (CALLER _ .(.F-1)<RH>-1) LEQ 0 THEN RETURN 0;
NP_IF .(@(.F-1))<LH> NEQ (#274^9 OR SREG<ADR>^5) THEN 0
ELSE .(@@(.F-1))<RH>;
PRXDISP(.CALLED); TAB; OUTC(#50); OUTC("_");
PRDISP(.CALLER); OUTC(#51); TAB;
PRG( .F<RH>-1-.NP , .NP);
.NP^18 + .CALLER
END;
ROUTINE PSTK(FBACK,TOG,LEVEL)=
! DISPLAY CALL STACK TO LEVEL "LEVEL", "TOG" CONTROLS LOCALS DISPLAY
BEGIN LOCAL F,NAME,NL;
IF (F_.(@@FBACK-1)<RH> -1) LSS 0 THEN RETURN .VREG;
NAME_ .(.F)<RH>; F_@@FBACK;
NL _ IF .RTNLVL LSS 0 THEN .FBACK - .F -3 ELSE 0;
DO
BEGIN
IF (NAME _ PRCALL(.F,.NAME)) EQL 0 THEN RETURN .VREG;
IF .TOG THEN IF .NL GTR 0 THEN ! PRINT LOCALS
(OUTS('?M?J?I?I'); PRG( .F+1, .NL));
CRLF;
NL_ .F - @@F - .NAME<LH> -2;
IF NOT ( ( .(.F)<RH> LSS .F<RH>) AND
( .(.F)<RH> GTR .BREG) ) THEN RETURN .VREG;
F_@@F
END UNTIL (LEVEL_.LEVEL-1) LEQ 0;
.VREG
END;
PAGE! DEBUG INTEREST ROUTINES
! -----------------------
! THE TABLE ROUTS CONTAINS INFORMATION ABOUT EACH ROUTINE
! IN WHICH THE DEBUG SYSTEM IS 'INTERESTED'. THE VARIABLE
! NROUTS (INITIALIZED TO -1) CONTAINS THE INDEX OF THE LAST
! VALID ENTRY IN ROUTS. THE STRUCTURE OF EACH ENTRY IN ROUTS
! IS
! !------------------+------------------!
! ! INTEREST BITS ! ROUTINE ADDRESS !
! !------------------+------------------!
! ! POINTERS TO ! CONDITIONAL !
! !------------------+------------------!
! ! MACRO ! TEXTS !
! !------------------+------------------!
! ! ! !
! !------------------+------------------!
!
! (A ZERO MACRO POINTER DENOTES UNCONDITIONAL ACTION.)
! TWO VALUES ARE ASSOCIATED WITH EACH BIT IN THE INTEREST BITS
! FIELD. IF BIT (35-N) INDICATES AN ABC TYPE INTEREST, THEN
! ABCF IS A MACRO FOR THE BIT POSITION IN THE ENTRY, I.E. 0,N,1.
! ABCV IS A CONSTANT WITH A 1 IN THE CORRESPONDING BIT, I.E. 1^N.
!
! THE ROUTINE SETBIT(VAL) DOES THE FOLLOWING FOR EACH ROUTINE IN @SIXRP:
! 1) INSERT THE ROUTINE INTO ROUTS IF IT IS NOT ALREADY THERE.
! 2) TURN ON THE INTEREST BITS INDICATED BY VAL.
! 3) PUT IN CONDITIONAL MACRO POINTERS AS REQUIRED.
!
! THE ROUTINE UNSETBIT(VAL) DOES THE FOLLOWING FOR EACH ROUTINE IN @SIXRP:
! 1) TURN OFF THE INTEREST BITS INDICATED BY VAL.
! 2) FIX UP FLAGS IF ACTIVE TRACE OR OPAQUE IS BEING DELETED.
! 3) IF THE INTEREST BIT FIELD OF ANY ENTRY BECOMES
! ZERO, REMOVE THAT ENTRY FROM ROUTS.
MACRO BREAKF=0,BITFLD(18)$, ABREAKF=0,BITFLD(19)$,
OPQATF=0,BITFLD(20)$, OPQAFTF=0,BITFLD(21)$,
TRCATF=0,BITFLD(22)$, TRCAFTF=0,BITFLD(23)$,
PREVOFFF=0,BITFLD(33)$, IDIDONF=0,BITFLD(34)$,
IDIDOFFF=0,BITFLD(35)$;
BIND BREAKV=BITVAL(18), ABREAKV=BITVAL(19),
OPQATV=BITVAL(20), OPQAFTV=BITVAL(21),
TRCATV=BITVAL(22), TRCAFTV=BITVAL(23),
MAXACTRTN=23,
PREVOFFV=BITVAL(33), IDIDONV=BITVAL(34),
IDIDOFFV=BITVAL(35);
ROUTINE CFINDR(R)= ! CONDITIONAL FIND
! RETURN THE INDEX OF ROUTINE R IN ROUTS. -1 IF NOT FOUND
DECR I FROM .NROUTS TO 0 DO
IF .ROUTS[.I,0,RH] EQL .R<RH> THEN RETURN .I;
ROUTINE CINSERT(R)= ! CONDITIONAL INSERT
! RETURN THE INDEX OF R IN ROUTS. INSERT IF NECESSARY
BEGIN LOCAL L;
IF (L_CFINDR(.R)) GEQ 0 THEN RETURN .L;
ROUTS[(NROUTS_.NROUTS+1),0,FW]_.R<RH>;
.NROUTS
END;
ROUTINE CREMOVE(R,VAL)= ! CONDITIONAL REMOVE
! TURN OFF BITS SPECIFIED BY VAL IN THE ENTRY FOR R. DELETE R IF POSSIBLE.
BEGIN LOCAL L;
IF (L_CFINDR(.R)) LSS 0 THEN RETURN .VREG;
IF (VAL _ .ROUTS[.L,0,FW] AND .VAL) EQL 0 THEN RETURN .VREG;
IF (.VAL AND OPQAFTV) NEQ 0 THEN IF .ROUTS[.L,IDIDOFFF] THEN
(OPQCNT_0; TRACEFLG_-.ROUTS[.L,PREVOFFF]; ROUTS[.L,0,FW]_.ROUTS[.L,0,FW] AND NOT (IDIDOFFV+PREVOFFV));
IF (.VAL AND TRCAFTV) NEQ 0 THEN IF .ROUTS[.L,IDIDONF] THEN
(TRCCNT _ TRACEFLG _ ROUTS[.L,IDIDONF] _ 0);
ROUTS[.L,0,FW] _ .ROUTS[.L,0,FW] AND NOT .VAL;
WHILE .VAL NEQ 0 DO (INCRTOG; VAL_ .VAL AND NOT (1^35)^(-FIRSTONE(.VAL)));
IF .ROUTS[.L,0,LH] NEQ 0 THEN RETURN .VREG;
IF .L LSS .NROUTS THEN DECR J FROM ROUTSIZE-1 TO 0 DO
ROUTS[.L,.J,FW] _ .ROUTS[.NROUTS,.J,FW];
NROUTS_ .NROUTS -1; .VREG
END;
ROUTINE SETTBLBIT(ROUTN,ISITEXIT)=
BEGIN REGISTER PNTR;
BIND BITS = #777000777777 OR 1^EXITPOS,
MATCH = DEBUGUUO^27 OR .ISITEXIT^EXITPOS OR .ROUTN,
CORELIM = IF .ROUTN LSS #400000 THEN .?.JBREL<RH> ELSE .?.JBHRL<RH>;
PNTR _ INCR J FROM .ROUTN TO CORELIM DO
IF (@@J AND BITS) EQL MATCH THEN EXITLOOP .J;
IF .PNTR LSS 0 THEN (PRDISP(.ROUTN); ERROR(6))
ELSE CHKUWP( (.PNTR)<TBLBIT> _ 1 );
.VREG
END;
ROUTINE SETBIT(VAL,FBEGIN,FEND)=
BEGIN REGISTER L; LOCAL FIELD,BIT;
IF .SIXLC EQL 0 THEN SIXLP _ PLIT(0)<ADR>;
WHILE .VAL NEQ 0 DO
BEGIN
FIELD _ 17 - FIRSTONE(.VAL); BIT _ (1^18) ^ .FIELD; VAL _ .VAL AND NOT .BIT;
FIELD _ IF .FIELD THEN ROUTS[0,1+.FIELD^(-1),LH]
ELSE ROUTS[0,1+.FIELD^(-1),RH];
DECR I FROM .SIXRC-1 TO 0 DO
BEGIN
L_CINSERT(@(.SIXRP+.I));
IF (.ROUTS[.L,0,FW] AND .BIT) EQL 0 THEN DECRTOG;
ROUTS[.L,0,FW]_ .ROUTS[.L,0,FW] OR .BIT;
(.FIELD + .L*ROUTSIZE) _ @@SIXLP;
IF .FBEGIN NEQ 0 THEN SETTBLBIT(.(.SIXRP+.I)<RH>,0);
IF .FEND NEQ 0 THEN SETTBLBIT(.(.SIXRP+.I)<RH>,1);
END;
END;
.VREG
END;
ROUTINE UNSETBIT(VAL)=
DECR I FROM .SIXRC-1 TO 0 DO
CREMOVE(@(.SIXRP+.I),.VAL);
ROUTINE XBREAK=SETBIT(BREAKV,1,0);
ROUTINE DBREAK=UNSETBIT(BREAKV);
ROUTINE XABREAK=SETBIT(ABREAKV,0,1);
ROUTINE DABREAK=UNSETBIT(ABREAKV);
ROUTINE OPAQUE=
SETBIT(OPQAFTV+(IF .MODEFLG NEQ 1 THEN OPQATV),1,1);
ROUTINE DOPAQUE=
UNSETBIT(OPQAFTV+(IF .MODEFLG NEQ 1 THEN OPQATV));
ROUTINE XTRACE=
SETBIT((CASE .MODEFLG OF
SET TRCATV; TRCAFTV; TRCAFTV+TRCATV TES),1,1);
ROUTINE DTRACE=
UNSETBIT(CASE .MODEFLG OF
SET TRCATV; TRCAFTV; TRCAFTV+TRCATV TES);
PAGE! MONITORING OF VARIABLES
! -----------------------
! THE MONITORING ROUTINES USE ANOTHER TABLE WITH TWO-WORD ENTRIES,
! FORMATTED
!
! !---------------!---------------!
! ! LOCATION !
! !---------------!---------------!
! ! VALUE !
! !---------------!---------------!
!
! WHERE LOCATION IS A *POINTER* TO THE BYTE BEING MONITORED
! (I.E. IT HAS A POSITION, SIZE FIELD), AND VALUE IS THE
! BYTE'S LAST REPORTED CONTENTS.
MACRO ADDRESS=0,FW$,
OLDVAL=1,FW$;
ROUTINE CKVALS(RTN,TOG)=
BEGIN
LOCAL X,T;
DECR I FROM .NVALS TO 0 DO
BEGIN
X_.(.MONVALS[.I,ADDRESS]);
IF .X NEQ .MONVALS[.I,OLDVAL] THEN
BEGIN
IF .TOG GEQ 0 THEN
BEGIN
OUTS('*** ');
IF .TOG THEN OUTS('During ')
ELSE OUTS('Before ');
TOG_ -1;
PRXDISP(.RTN);
CRLF;
END;
PRDISP(.MONVALS[.I,0,RH]);
IF (T_.MONVALS[.I,0,LH]) NEQ #4400 THEN
BEGIN ! OUTPUT <P,S>
OUTC(#74); OUTD(.T<12,6>);
OUTC(","); OUTD(.T<6,6>);
OUTC(#76)
END;
TAB;
OUTS('Old: ');
OUTDEFAULT(.MONVALS[.I,OLDVAL]);
TAB;
OUTS('New: ');
OUTDEFAULT(.X);
CRLF;
MONVALS[.I,OLDVAL]_.X;
END;
END;
IF .TOG LSS 0 THEN STOPIT; .VREG
END;
ROUTINE XCHNG=
DECR I FROM .SIXRC-1 TO 0 DO
BEGIN BIND DUMMY=0;
IF .(.SIXRP+.I)<LH> EQL 0 THEN
(.SIXRP+.I)<LH> _ #004400; ! INSERT <FW>
DECR J FROM .NVALS TO 0 DO IF .MONVALS[.J,ADDRESS] EQL @(.SIXRP+.I) THEN EXITBLOCK;
DECRTOG;
NVALS_.NVALS+1;
MONVALS[.NVALS,ADDRESS]_@(.SIXRP+.I);
MONVALS[.NVALS,OLDVAL]_.@(.SIXRP+.I);
END;
ROUTINE DCHNG=
BEGIN
LOCAL L;
DECR I FROM .SIXRC-1 TO 0 DO
BEGIN BIND DUMMY=0;
IF .(.SIXRP+.I)<LH> EQL 0 THEN
(.SIXRP+.I)<LH> _ #004400; ! INSERT <FW>
L_DECR J FROM .NVALS TO 0 DO IF .MONVALS[.J,ADDRESS] EQL @(.SIXRP+.I) THEN EXITLOOP .J;
IF .L LSS 0 THEN EXITBLOCK;
INCRTOG;
IF .L LSS .NVALS THEN
BEGIN
MONVALS[.L,ADDRESS]_.MONVALS[.NVALS,ADDRESS];
MONVALS[.L,OLDVAL]_.MONVALS[.NVALS,OLDVAL];
END;
NVALS_.NVALS-1;
END;
.VREG
END;
PAGE! THE DEBUG PROCESSING ROUTINES
! -----------------------------
ROUTINE DOTVREG=.VREG;
ROUTINE EDDT=(?.JBOPC _ DOTVREG<ADR>; JRST(0,@?.JBDDT); .VREG);
ROUTINE SLASH(N)=
BEGIN REGISTER A;
A_.(@SIXLP)<RH>; N_IF .N EQL 3 THEN @@SIXRP -1 ELSE 0;
DECR I FROM .N TO 0 DO
BEGIN
PRDISP(.A); OUTS('/'); TAB; OUTRDEF(@@A,14);
TAB; PRDISP(@@A); CRLF; A_.A+1
END;
.VREG
END;
ROUTINE GOER=(IF ISON(TRACEFLG) THEN DECRTOG; GOFLG_1; .VREG);
ROUTINE DISAB=(SETOFF(ENABFLG); .VREG);
ROUTINE XSTRACE=
BEGIN
IF .OPQCNT GTR 0 THEN
(OPQCNT_0;
DECR J FROM .NROUTS TO 0 DO ROUTS[.J,0,FW] _ .ROUTS[.J,0,FW] AND NOT (IDIDOFFV+PREVOFFV));
SETON(TRACEFLG); .VREG
END;
ROUTINE XCLRTRACE=(SETOFF(TRACEFLG); .VREG);
ROUTINE XGOTRACE=(XSTRACE(); GOER());
ROUTINE NOSIX12=(?.JB41_ #255^27; GOER());
ROUTINE SETIT=
BEGIN
IF .(@SIXLP)<LH> EQL 0 THEN ! ADD P,S = <FW>
(@SIXLP)<LH> _ #004400;
@@SIXLP _ @@SIXRP; .VREG
END;
ROUTINE XBASE(K)=
BEGIN ! SET IOBASE
IF .K THEN
IF ((@@SIXRP LSS 2) OR (@@SIXRP GTR 10))
THEN RETURN ERROR(5)
ELSE (IOBASE _ @@SIXRP);
OUTD(.IOBASE); OUTS(' dec.?M?J'); .VREG
END;
ROUTINE XWBASE(K)=
BEGIN ! SET WDBASE
IF .K THEN WDBASE _ @@SIXRP;
OUTDEFAULT(.WDBASE); CRLF; .VREG
END;
ROUTINE CALL1=(OUTFLAG; PSTK( .ENTERPNT, 0, (-1)^(-1) ));
ROUTINE CALL2=(OUTFLAG; PSTK( .ENTERPNT, 1, (-1)^(-1) ));
ROUTINE XCALL(K)=(OUTFLAG; PSTK( .ENTERPNT, 0, (IF .K THEN @@SIXRP ELSE 1) ));
ROUTINE XLCALL(K)=(OUTFLAG; PSTK( .ENTERPNT, 1, (IF .K THEN @@SIXRP ELSE 1) ));
ROUTINE PPSYM(P)= ! COMMON CODE FOR PRS, SEARCH
BEGIN
IF @@P LSS 0 THEN OUTC("*"); TAB; OUTRDEF(@(.P+1),12); TAB;
IF ( CASE .(.P)<32,2> OF
SET
(OUTS('Module'); 0);
(OUTS('Global'); 1);
(OUTS('Own'); 1);
TES ) THEN (TAB; PRSYM50(MODDDT(.P)));
CRLF; .VREG
END;
ROUTINE PRS=
BEGIN LOCAL NAME,V; REGISTER P;
HLRE(P,?.JBSYM); P_ -.P; V_ .P^18 + .P + .?.JBSYM<RH>;
INCR I FROM 0 TO .SIXRC-1 DO
BEGIN
P_ .V; NAME_ .(SDDTFS( @(.SIXRP+.I)))<0,32>;
INCR J FROM 1 DO
BEGIN
IF (P_NSDDTFA(.NAME,.P)) EQL 0 THEN EXITLOOP;
PRSYM50(.NAME); OUTC("%"); OUTDEFAULT(.J); PPSYM(.P)
END;
END;
.VREG
END;
ROUTINE XSEARCH= ! ? SEARCH FEATURE
BEGIN LOCAL NAME[6],TNAME[6],R50NAME,CNT,TCNT; REGISTER P;
CNT_-1; TCNT_(.SIXRP)<36,7>; (.SIXRP+.SIXRC)<FW> _ 0; ! MAKE ASCIZ STRING
WHILE (P_SCANI(TCNT)) NEQ 0 DO
IF .CNT LSS 5 THEN NAME[(CNT_.CNT+1)]_ (IF .P EQL "??" THEN 0 ELSE F7TO50(.P));
HLRE(P,?.JBSYM); P_ -.P; P_ .P^18 + .P + .?.JBSYM<RH>;
WHILE (P_.P-#2000002) GEQ 0 DO
BEGIN BIND DUMMY=0;
R50NAME_ .(.P)<0,32>;
TCNT_ DECR X FROM 5 TO 0 DO
(TNAME[.X]_ .R50NAME MOD #50;
IF (R50NAME_.R50NAME / #50) EQL 0 THEN EXITLOOP .X);
IF 5-.TCNT GTR .CNT THEN EXITBLOCK;
INCR X FROM 0 TO .CNT DO
(IF .NAME[.X] NEQ 0 THEN
IF .NAME[.X] NEQ .TNAME[.TCNT] THEN EXITBLOCK;
TCNT_.TCNT+1);
PRSYM50(@@P); PPSYM(.P)
END;
.VREG
END;
ROUTINE XRETURN=
BEGIN
IF .RTNLVL EQL 0 THEN ! FIX UP ENTRY...
BEGIN REGISTER L;
MACRO POPADR=(.ENTERPNT-1)<RH>$;
BIND BITS = #777000777777 OR 1^EXITPOS,
CORELIM = IF .POPADR LSS #400000 THEN .?.JBREL<RH> ELSE .?.JBHRL<RH>;
L_ DEBUGUUO^27 OR 1^EXITPOS OR .?.JBUUO<RH>;
L_ INCR J FROM .POPADR TO CORELIM DO
IF (@@J AND BITS) EQL .L THEN EXITLOOP .J+1;
IF .L LEQ 0 THEN (PRXDISP(.POPADR); RETURN ERROR(6))
ELSE POPADR _ .L;
END;
SIXVREG_ @@SIXRP; GOER()
END;
ROUTINE XDEL2=
BEGIN
LOCAL PNT;
DECR J FROM .SIXRC-1 TO 0 DO
BEGIN
PNT _ DECR K FROM .NNAMES TO 0 DO
IF @(.SIXRP+.J) EQL .SIXNAMES[.K,0,FW] THEN EXITLOOP .K;
IF .PNT GEQ 0 THEN
(IF .PNT LSS .NNAMES THEN
(SIXNAMES[.PNT,0,FW] _ .SIXNAMES[.NNAMES,0,FW];
SIXNAMES[.PNT,1,FW] _ .SIXNAMES[.NNAMES,1,FW]);
NNAMES_.NNAMES-1)
END;
.VREG
END;
FORWARD PUSHOPER;
ROUTINE XDEL1=
BEGIN
QUOTFLG _ (-1)^(-1);
PUSHOPER( 4^18 + PLIT(0, 10^18+XDEL2<ADR>, 0, 0)<ADR>)
END;
MACRO APPLY(OP)=
BEGIN
SIXVC_.SIXVC+1; SIXVP_ VTEMP<ADR>;
VTEMP _ @@SIXLP OP @@SIXRP;
.VREG
END$,
ONEAPPLY(OP)=
BEGIN
SIXVC_.SIXVC+1; SIXVP_ VTEMP<ADR>;
VTEMP _ OP @@SIXRP;
.VREG
END$;
ROUTINE XADD=APPLY(+);
ROUTINE SUBTRACT(K)=IF .K LSS 2 THEN ONEAPPLY(-) ELSE APPLY(-);
ROUTINE TIMES=APPLY(*);
ROUTINE XDIV=APPLY(/);
ROUTINE XSHIFT=APPLY(^);
ROUTINE ATSIGN=ONEAPPLY(@);
ROUTINE XEQL=APPLY(EQL);
ROUTINE XNEQ=APPLY(NEQ);
ROUTINE XLSS=APPLY(LSS);
ROUTINE XLEQ=APPLY(LEQ);
ROUTINE XGTR=APPLY(GTR);
ROUTINE XGEQ=APPLY(GEQ);
ROUTINE XAND=APPLY(AND);
ROUTINE XEQOR=APPLY(OR);
ROUTINE XNOT=ONEAPPLY(NOT);
ROUTINE CONTENTS=(SIXVC_1; SIXVP_ VTEMP<ADR>;
VTEMP _ IF .(.SIXRP)<LH> EQL 0 THEN @@@SIXRP ELSE .(@@SIXRP); .VREG);
ROUTINE DOLSIGN=
BEGIN OWN DOLLAR[20];
SIXVC_1; SIXVP_ VTEMP<ADR>;
VTEMP_ DOLLAR[@@SIXRP]; .VREG
END;
ROUTINE JOIN= ! BINARY COMMA (CATENATION)
BEGIN
INCR J FROM 0 TO .SIXRC-1 DO (.SIXLP+.SIXLC +.J)<FW> _ @(.SIXRP+.J);
SIXVP_.SIXLP; SIXVC_ .SIXLC + .SIXRC; .VREG
END;
ROUTINE LPAREN= ! ROUTINE CALL
BEGIN LOCAL SCOUNT,SAVEGO; OWN COUNT;
SCOUNT_.COUNT; SAVEGO_.GOFLG; GOFLG_1; ! DON'T STOP IN ROUTINE
COUNT _ .SIXRC^18 + .SIXRC; ! SAVE # OF PARMS
INCR I FROM 0 TO .SIXRC-1 DO ! PUSH PARMS
PUSH(SREG,(.SIXRP+.I));
(@@SIXLP) (); ! THIS IS IT!
SREG _ .SREG - .COUNT; ! POP PARMS
VTEMP _ .VREG;
GOFLG_.SAVEGO; COUNT_.SCOUNT; SIXVC _ 1; SIXVP _ VTEMP<ADR>; .VREG
END;
ROUTINE FIELDSPEC= ! ADR <POS , SIZE>
BEGIN REGISTER R;
IF .SIXRC NEQ 2 THEN RETURN ERROR(3);
R _ #77 AND @@SIXRP; ! P FIELD
R _ ( (.R^6) OR (#77 AND @(.SIXRP +1)) ) ^6; ! S FIELD
SIXVP_ .SIXLP; SIXVC_1;
(.SIXVP)<LH> _ .R;
.VREG
END;
ROUTINE STRUCT=
BEGIN
IF .SIXRC NEQ 1 THEN RETURN ERROR(3);
SIXVP _ VTEMP<ADR>; SIXVC _ 1;
VTEMP _ (@@SIXLP + @@SIXRP)<0,36>;
.VREG
END;
ROUTINE INTEXT=
BEGIN
REGISTER W;
WHILE ISOFF(ERRORFLG) DO
BEGIN
IF (W_INWORD()) EQL 0 THEN RETURN .VREG;
(.PTEXT)<FW> _ .W; PTEXT _ .PTEXT+1
END;
.VREG
END;
ROUTINE OUTTEXT(POINT)=
BEGIN
INCR PTR FROM .POINT<RH> DO
BEGIN
OUTWORD(@@PTR);
IF .(.PTR)<29,7> EQL #177 THEN EXITLOOP;
IF .(.PTR)<22,7> EQL #177 THEN EXITLOOP;
IF .(.PTR)<15,7> EQL #177 THEN EXITLOOP;
IF .(.PTR)<8,7> EQL #177 THEN EXITLOOP;
IF .(.PTR)<1,7> EQL #177 THEN EXITLOOP;
END;
OUTWORD(0)
END;
ROUTINE FILEOPEN(ISINPUT)=
BEGIN
LOCAL BLOCK[4],TPPNBUF[2],BP,PTR;
REGISTER I,C;
MACRO ASCIITOSIX(C)=(((C)-#40) AND #77)$,
TPPN=I$;
ROUTINE CMUDEC(PTR)=
BEGIN
VREG _ .PTR<RH>;
CALLI(VREG,-2); VREG_0;
.VREG
END;
ROUTINE XTYP=
BEGIN
IF .C EQL 0 THEN RETURN 0;
IF .C EQL " " THEN RETURN 1;
IF .C EQL "." THEN RETURN 2;
IF .C EQL "[" THEN RETURN 3;
IF .C GEQ "A" THEN IF .C LEQ "Z" THEN RETURN 4;
IF .C GEQ "a" THEN IF .C LEQ "z" THEN (C_.C-#40; RETURN 4);
IF .C GEQ "0" THEN IF .C LEQ "9" THEN RETURN 4;
5
END;
STATUS _ #10;
LDEV _ SIXBIT 'DSK';
BUFW _ IF ISON(ISINPUT) THEN DSKHDR<ADR> ELSE DSKHDR<ADR>^18;
IFSKIP OPEN(SLCHN,BLOCK) THEN 0 ELSE RETURN ERROR(10);
BEGIN BIND DUMMY=0;
FNAME_FEXT_JUNK_PPN_0;
PTR _ (.SIXRP)<36,7>;
(.SIXRP+.SIXRC)<FW> _ 0; ! GUARANTEE ASCIZ STRING
BP _ FNAME<36,6>; I_6;
WHILE 1 DO
BEGIN ! GET FILENAME
C _ SCANI(PTR);
CASE XTYP() OF
SET
%0% EXITBLOCK;
%1% 0;
%2% EXITLOOP;
%3% EXITLOOP;
%4% IF (I_.I-1) GEQ 0 THEN REPLACEI(BP,ASCIITOSIX(.C));
%5% RETURN ERROR(9)
TES
END;
IF .C EQL "." THEN
BEGIN ! GET EXTENSION
BP _ FEXT<36,6>; I_3;
WHILE 1 DO
BEGIN
C _ SCANI(PTR);
CASE XTYP() OF
SET
%0% EXITBLOCK;
%1% 0;
%2% RETURN ERROR(9);
%3% EXITLOOP;
%4% IF (I_.I-1) GEQ 0 THEN REPLACEI(BP,ASCIITOSIX(.C));
%5% RETURN ERROR(9)
TES
END
END;
IF .C EQL "[" THEN
BEGIN ! GET PPN
IF (I_.PTR; SCANI(I)) GTR "7" THEN
BEGIN ! CMU PPN
BP _ TPPNBUF<36,7>;
DECR I FROM 7 TO 0 DO
IF COPYII(PTR,BP) EQL "]" THEN RETURN ERROR(9);
IF SCANI(PTR) NEQ "]" THEN RETURN ERROR(9);
IF (PPN_CMUDEC(TPPNBUF<ADR>)) EQL 0 THEN RETURN ERROR(9)
END
ELSE
BEGIN ! OCTAL PPN
TPPN _ 0;
WHILE (C_SCANI(PTR)) NEQ "]" DO
IF .C EQL "," THEN
(PPN<LH> _ .TPPN; TPPN_0)
ELSE
IF .C GEQ "0" AND .C LEQ "7"
THEN (TPPN_.TPPN^3 + .C - "0")
ELSE RETURN ERROR(9);
PPN<RH> _ .TPPN
END
END
END; ! OF DUMMY BLOCK
IF ISON(ISINPUT) THEN
(IFSKIP LOOKUP(SLCHN,BLOCK) THEN 0 ELSE RETURN ERROR(10))
ELSE
(IFSKIP ENTER(SLCHN,BLOCK) THEN 0 ELSE RETURN ERROR(10));
IF ISON(ISINPUT) THEN INBUF(SLCHN,2) ELSE OUTBUF(SLCHN,2);
1
END;
ROUTINE SIXSAVE=
BEGIN
LOCAL SAVFF;
SAVFF _ .?.JBFF;
IF NOT FILEOPEN(0) THEN RETURN .VREG;
SETOFF(ERRORFLG);
OUTWORD(.SIXTOG);
OUTWORD(.DCNT);
INCR J FROM 0 TO .NVALS DO
BEGIN ! OUTPUT A MONITOR ENTRY
OUTWORD(.MONVALS[.J,ADDRESS]);
OUTWORD(.MONVALS[.J,OLDVAL])
END;
OUTWORD(-1); ! END OF MONITORS
INCR J FROM 0 TO .NNAMES DO
BEGIN ! OUTPUT A MACRO
OUTWORD(.SIXNAMES[.J,0,FW]);
OUTTEXT(.SIXNAMES[.J,1,FW])
END;
OUTWORD(-1); ! END OF MACROS
INCR J FROM 0 TO .NROUTS DO
BEGIN ! OUTPUT A ROUTINE ENTRY
BIND ENTRY = .ROUTS[.J,0,0,MAXACTRTN];
OUTWORD(ENTRY);
DECR SUB FROM 17 TO 0 DO
BEGIN
BIND PTR = IF .SUB THEN ROUTS[.J,1+.SUB/2,LH]
ELSE ROUTS[.J,1+.SUB/2,RH];
IF (ENTRY AND (1^18)^.SUB) NEQ 0 THEN
(IF .PTR NEQ 0 THEN OUTTEXT(.PTR) ELSE OUTWORD(0))
END
END;
OUTWORD(-1);
IF ISON(ERRORFLG) THEN (ERROR(11); CLOSE(SLCHN,#40)) ELSE CLOSE(SLCHN,0);
RELEASE(SLCHN,0);
?.JBFF_.SAVFF;
.VREG
END;
ROUTINE SIXLOAD=
BEGIN REGISTER W,W2; LOCAL SAVFF;
SAVFF_.?.JBFF;
IF NOT FILEOPEN(1) THEN RETURN .VREG;
SETOFF(ERRORFLG); NVALS _ NNAMES _ NROUTS _ -1; PTEXT _ TEXTAREA<36,7>;
SIXTOG_INWORD(); DCNT_INWORD();
WHILE (W_INWORD()) NEQ -1 DO
BEGIN ! RETRIEVE MONITOR ENTRY
MONVALS[(NVALS_.NVALS+1),ADDRESS] _ .W;
MONVALS[.NVALS,OLDVAL] _ INWORD()
END;
WHILE (W_INWORD()) NEQ -1 DO
BEGIN ! RETRIEVE MACRO
SIXNAMES[(NNAMES_.NNAMES+1),0,FW]_.W;
SIXNAMES[.NNAMES,1,FW]_.PTEXT<RH>;
INTEXT()
END;
WHILE (W_INWORD()) NEQ -1 DO
BEGIN ! RETRIEVE ROUTINE ENTRY
ROUTS[(NROUTS_.NROUTS+1),0,FW]_.W;
SETTBLBIT(.W<RH>,0); SETTBLBIT(.W<RH>,1);
DECR SUB FROM 17 TO 0 DO
BEGIN BIND PTR = IF .SUB THEN ROUTS[.NROUTS,1+.SUB/2,LH]
ELSE ROUTS[.NROUTS,1+.SUB/2,RH];
IF (.W AND (1^18)^.SUB) NEQ 0 THEN
BEGIN
IF (W2_INWORD()) NEQ 0 THEN
(PTR _ .PTEXT<RH>; (.PTEXT)<FW> _ .W2; PTEXT_.PTEXT+1; INTEXT())
ELSE PTR _ 0
END
ELSE
PTR _ 0
END
END;
IF ISON(ERRORFLG) THEN (NVALS _ NNAMES _ NROUTS _ -1; ERROR(11));
CLOSE(SLCHN,0); RELEASE(SLCHN,0); ?.JBFF_.SAVFF;
.VREG
END;
ROUTINE BOOBOO=ERROR(4);
ROUTINE COPYR=(SIXVP_ .SIXRP; SIXVC_ .SIXRC; .VREG);
ROUTINE DEFINE=(QUOTFLG_2; MODEFLG_1; .VREG);
ROUTINE XSET1=(QUOTFLG_1; MODEFLG_1; .VREG);
ROUTINE XSET2=(QUOTFLG_1; MODEFLG_2; .VREG);
ROUTINE XSET3=(QUOTFLG_1; MODEFLG_3; .VREG);
ROUTINE SETAFTER=(MODEFLG_1; .VREG);
ROUTINE SETFROM=(MODEFLG_2; .VREG);
FORWARD EQUALS,GETTEXT,XPRINT;
PAGE! THE PLIT BELOW MAPS PRINT NAME TO ROUTINE
! -----------------------------------------
! REMEMBER WHILE INSERTING ENTRIES THAT THE PLIT IS SEARCHED *BACKWARDS*.
! THE PLIT CONTAINS A FIVE-WORD ENTRY FOR EACH PREDEFINED
! OPERATOR. OPERATORS DEFINED AT RUN-TIME ARE STORED IN THE
! SAME FORMAT IN 'DEFOPTAB', WHICH IS SEARCHED FIRST. THE FORMAT IS
!
! !------!----------!------------!-------------!------------!
! !PRINT ! WORD FOR ! WORD FOR ! WORD FOR ! WORD FOR !
! ! NAME !NULL PARSE!PREFIX PARSE!POSTFIX PARSE!BINARY PARSE!
! !------!----------!------------!-------------!------------!
!
! WHERE PRINT NAME CONTAINS THE RADIX50 REPRESENTATION OF A SYMBOL,
! OR AN ASCII CHAR. IN ITS LEFT HALF FOR A SPECIAL-CHARACTER PRINT NAME.
! EACH 'WORD FOR...' WORD HAS THE PRIORITY OF OPERATION FOR THAT PARSE
! IN ITS LEFT HALF, AND THE ADDRESS OF THE ROUTINE WHICH IS TO BE CALLED
! TO EXECUTE IT IN ITS RIGHT HALF. A ZERO WORD DENOTES "NO SUCH PARSE".
! A PRIORITY P > BRACEVAL INDICATES A LEFT BRACE; THE CORRESPONDING RIGHT
! BRACE MUST HAVE PRIORITY P-BRACEVAL. THE RIGHT BRACE ROUTINE IS A DUMMY, WHICH
! IS NEVER EXECUTED. THE CALL METHOD FOR OPERATORS IS EXPLAINED IN SIX12.MAN.
! THESE MACROS SIMPLIFY ENTERING OPERATORS...
MACRO ACHAR(OP,P0,R0,P1,R1,P2,R2,P3,R3)=
OP^18, (P0)^18+ R0<0,0>, (P1)^18+ R1<0,0>,
(P2)^18+ R2<0,0>, (P3)^18+ R3<0,0>$;
MACRO ANAME(OP,P0,R0,P1,R1,P2,R2,P3,R3)=
RADIX50 "OP", (P0)^18+ R0<0,0>, (P1)^18+ R1<0,0>,
(P2)^18+ R2<0,0>, (P3)^18+ R3<0,0>$;
BIND OPTAB= PLIT(
ANAME(NODEBU, 50,NOSIX12, 0,0, 0,0, 0,0),
ANAME(IF, 50,DOTVREG, 0,0, 0,0, 0,0),
ANAME(DISABL, 50,DISAB, 0,0, 0,0, 0,0),
ANAME(DDT, 50,EDDT, 0,0, 0,0, 0,0),
ANAME(SAVE, 0,0, 20,SIXSAVE, 0,0, 0,0),
ANAME(LOAD, 0,0, 20,SIXLOAD, 0,0, 0,0),
ANAME(LPTCLO, 50,CLOSELPT, 0,0, 0,0, 0,0),
ANAME(LPTOPE, 50,OPENLPT, 0,0, 0,0, 0,0),
ANAME(LPTOFF, 50,LPTOFF, 0,0, 0,0, 0,0),
ANAME(LPTDUP, 50,LPTDUP, 0,0, 0,0, 0,0),
ANAME(LPTON, 50,LPTON, 0,0, 0,0, 0,0),
ANAME(RETURN, 0,0, 20,XRETURN, 0,0, 0,0),
ANAME(FORGET, 50,XDEL1, 0,0, 0,0, 0,0),
ANAME(PRINT, 0,0, 10,XPRINT, 0,0, 0,0),
ANAME(ACTION, 50,XSET2, 0,0, 0,0, 0,0),
ANAME(OPER, 50,XSET1, 0,0, 0,0, 0,0),
ANAME(DEFINE, 50,DEFINE, 0,0, 0,0, 0,0),
ANAME(MACRO, 50,XSET3, 0,0, 0,0, 0,0),
ANAME(BIND, 50,XSET2, 0,0, 0,0, 0,0),
ANAME(WBASE, 20,XWBASE, 20,XWBASE, 0,0, 0,0),
ANAME(BASE, 20,XBASE, 20,XBASE, 0,0, 0,0),
ANAME(NOT, 0,0, 34,XNOT, 0,0, 0,0),
ANAME(OR, 0,0, 0,0, 0,0, 30,XEQOR),
ANAME(AND, 0,0, 0,0, 0,0, 32,XAND),
ANAME(EQL, 0,0, 0,0, 0,0, 36,XEQL),
ANAME(NEQ, 0,0, 0,0, 0,0, 36,XNEQ),
ANAME(LSS, 0,0, 0,0, 0,0, 36,XLSS),
ANAME(LEQ, 0,0, 0,0, 0,0, 36,XLEQ),
ANAME(GTR, 0,0, 0,0, 0,0, 36,XGTR),
ANAME(GEQ, 0,0, 0,0, 0,0, 36,XGEQ),
ANAME(GOTRAC, 50,XGOTRACE, 0,0, 0,0, 0,0),
ANAME(CLRTRA, 50,XCLRTRACE, 0,0, 0,0, 0,0),
ANAME(SETTRA, 50,XSTRACE, 0,0, 0,0, 0,0),
ANAME(GO, 50,GOER, 0,0, 0,0, 0,0),
ANAME(LCALL, 20,XLCALL, 20,XLCALL, 0,0, 0,0),
ANAME(CALL, 20,XCALL, 20,XCALL, 0,0, 0,0),
ANAME(LCALLS, 50,CALL2, 0,0, 0,0, 0,0),
ANAME(CALLS, 50,CALL1, 0,0, 0,0, 0,0),
ANAME(SEARCH, 0,0, 20,XSEARCH, 0,0, 0,0),
ANAME(PRS, 0,0, 10,PRS, 0,0, 0,0),
ANAME(FROM, 50,SETFROM, 0,0, 0,0, 0,0),
ANAME(AFTER, 50,SETAFTER, 0,0, 0,0, 0,0),
ANAME(DMONIT, 0,0, 10,DCHNG, 0,0, 0,0),
ANAME(MONITO, 0,0, 10,XCHNG, 0,0, 0,0),
ANAME(DTRACE, 0,0, 10,DTRACE, 0,0, 0,0),
ANAME(TRACE, 0,0, 10,XTRACE, 0,0, 10,XTRACE),
ANAME(DOPAQU, 0,0, 10,DOPAQUE, 0,0, 0,0),
ANAME(OPAQUE, 0,0, 10,OPAQUE, 0,0, 10,OPAQUE),
ANAME(DABREA, 0,0, 10,DABREAK, 0,0, 0,0),
ANAME(DBREAK, 0,0, 10,DBREAK, 0,0, 0,0),
ANAME(ABREAK, 0,0, 10,XABREAK, 0,0, 10,XABREAK),
ANAME(BREAK, 0,0, 10,XBREAK, 0,0, 10,XBREAK),
ACHAR(#175, 50,GETTEXT, 0,0, 0,0, 0,0),
ACHAR(#33, 50,GETTEXT, 0,0, 0,0, 0,0),
ACHAR("=", 0,0, 0,0, 0,0, 9,EQUALS),
ACHAR(";", 5,DOTVREG, 5,COPYR, 5,DOTVREG, 5,COPYR),
ACHAR("^", 0,0, 0,0, 0,0, 42,XSHIFT),
ACHAR("*", 0,0, 0,0, 0,0, 40,TIMES),
ACHAR("$", 0,0, 48,DOLSIGN, 0,0, 0,0),
ACHAR("@", 0,0, 44,ATSIGN, 0,0, 0,0),
ACHAR(".", 0,0, 44,CONTENTS, 0,0, 0,0),
ACHAR("-", 0,0, 38,SUBTRACT, 0,0, 38,SUBTRACT),
ACHAR("+", 0,0, 38,COPYR, 0,0, 38,XADD),
ACHAR(#76, 0,0, 0,0, 3,BOOBOO, 0,0),
ACHAR(#135, 0,0, 0,0, 2,BOOBOO, 0,0),
ACHAR(#51, 0,0, 0,0, 1,BOOBOO, 0,0),
ACHAR(#74, 0,0, 10003,COPYR, 0,0, 10003,FIELDSPEC),
ACHAR(#133, 0,0, 10002,COPYR, 0,0, 10002,STRUCT),
ACHAR(#50, 0,0, 10001,COPYR, 0,0, 10001,LPAREN),
ACHAR(",", 0,0, 0,0, 0,0, 15,JOIN),
ACHAR("_", 0,0, 0,0, 0,0, 25,SETIT),
ACHAR("!", 0,0, 0,0, 0,0, 20,SLASH),
ACHAR("/", 0,0, 0,0, 20,SLASH, 40,XDIV),
0 );
PAGE
BIND BRACEVAL = 10000;
ROUTINE EQUALS=
CASE .MODEFLG OF
SET
%0% ERROR(7);
%1% BEGIN LOCAL OLD,PARSE,ENTRY; ! DEFINE (OPERATOR)
IF .SIXRC NEQ 2 OR .SIXLC NEQ 2 THEN RETURN ERROR(3);
PARSE_ @(.SIXLP+1); IF .PARSE LSS 0 OR .PARSE GTR 3 THEN
PARSE _ SELECT .PARSE OF NSET
RADIX50 "NULL" : EXITSELECT 0; RADIX50 "PREFIX" : EXITSELECT 1;
RADIX50 "POSTFI" : EXITSELECT 2; RADIX50 "INFIX" : EXITSELECT 3;
ALWAYS : (TTOUTS('Which parse???M?J'); RETURN .VREG)
TESN;
ENTRY_ DECR J FROM .NEWOPS TO 0 BY 5 DO
IF @@SIXLP EQL .DEFOPTAB[.J] THEN EXITLOOP .J;
IF .ENTRY LSS 0 THEN ! INSERT NEW ENTRY
(ENTRY_NEWOPS_ .NEWOPS+5; DEFOPTAB[.NEWOPS]_ @@SIXLP;
OLD_ DECR J FROM .OPTAB[-1]-6 TO 0 BY 5 DO
IF @@SIXLP EQL .OPTAB[.J] THEN EXITLOOP .J;
DECR J FROM 3 TO 0 DO ! COPY OLD ENTRY
DEFOPTAB[.NEWOPS+1+ .J]_ (IF .OLD GEQ 0 THEN
.OPTAB[.OLD+1 +.J] ELSE 0) );
DEFOPTAB[.ENTRY+1+.PARSE]<LH> _ @@SIXRP;
DEFOPTAB[.ENTRY+1+.PARSE]<RH> _ @(.SIXRP+1);
.VREG
END;
%2% BEGIN REGISTER R; ! BIND (CREATE DDT-SYMBOL)
R_ .?.JBSYM - #2000002;
(.R)<FW> _ @@SIXLP OR 1^32; (.R+1)<FW> _ @@SIXRP;
?.JBSYM _ .R; .VREG
END;
%3% BEGIN ! MACRO
SIXNAMES[(NNAMES_.NNAMES+1),0,FW] _ @@SIXLP; SIXNAMES[.NNAMES,1,FW] _ @@SIXRP;
.VREG
END
TES;
ROUTINE XPRINT=
CASE .MODEFLG OF
SET
%0% 0;
%1% BEGIN REGISTER PNTR; ! OPERATOR
PNTR _ DECR J FROM .NEWOPS TO 0 BY 5 DO
IF @@SIXRP EQL .DEFOPTAB[.J] THEN EXITLOOP DEFOPTAB[.J]<ADR>;
IF .PNTR LSS 0 THEN
PNTR _ DECR J FROM .OPTAB[-1]-6 TO 0 BY 5 DO
IF @@SIXRP EQL .OPTAB[.J] THEN EXITLOOP OPTAB[.J]<ADR>;
IF .PNTR LSS 0 THEN (OUTS('No such operator?M?J'); RETURN .VREG);
IF .(.PNTR)<RH> EQL 0 THEN
OUTC(.(.PNTR)<LH>) ELSE PRSYM50(@@PNTR);
IF @(.PNTR+1) NEQ 0 THEN (OUTS('?M?JNull?I'); OUTDR(.(.PNTR+1)<LH>,5);
TAB; PRXDISP(@(.PNTR+1)));
IF @(.PNTR+2) NEQ 0 THEN (OUTS('?M?JPrefix?I'); OUTDR(.(.PNTR+2)<LH>,5);
TAB; PRXDISP(@(.PNTR+2)));
IF @(.PNTR+3) NEQ 0 THEN (OUTS('?M?JPostfix?I'); OUTDR(.(.PNTR+3)<LH>,5);
TAB; PRXDISP(@(.PNTR+3)));
IF @(.PNTR+4) NEQ 0 THEN (OUTS('?M?JInfix?I'); OUTDR(.(.PNTR+4)<LH>,5);
TAB; PRXDISP(@(.PNTR+4)));
CRLF; .VREG
END;
%2% BEGIN LOCAL PNTR,TEMP; ! ACTION
IF .SIXRC NEQ 2 THEN RETURN ERROR(3);
TEMP _ SELECT @@SIXRP OF NSET
RADIX50 "BREAK" : EXITSELECT BREAKV;
RADIX50 "ABREAK" : EXITSELECT ABREAKV;
RADIX50 "OPAQ" : EXITSELECT OPQATV;
RADIX50 "OPAQAF" : EXITSELECT OPQAFTV;
RADIX50 "TRACE" : EXITSELECT TRCATV;
RADIX50 "TRACEA" : EXITSELECT TRCAFTV;
ALWAYS : RETURN ERROR(8)
TESN;
IF (PNTR _ CFINDR(@(.SIXRP+1))) GEQ 0 THEN
IF (.ROUTS[.PNTR,0,FW] AND .TEMP) NEQ 0 THEN
BEGIN
TEMP _ 17 - FIRSTONE(.TEMP);
PNTR _ IF .TEMP THEN .ROUTS[.PNTR,1+.TEMP^(-1),LH]
ELSE .ROUTS[.PNTR,1+.TEMP^(-1),RH];
IF .PNTR EQL 0 THEN (OUTS('Unconditional?M?J'); RETURN .VREG);
PNTR _ (.PNTR)<36,7>;
WHILE (TEMP_SCANI(PNTR)) NEQ #177 DO OUTC(.TEMP);
CRLF; RETURN .VREG
END;
OUTS('Action not set?M?J'); .VREG
END;
%3% BEGIN REGISTER PNTR,C; ! MACRO
PNTR _ DECR J FROM .NNAMES TO 0 DO
IF @@SIXRP EQL .SIXNAMES[.J,0,FW] THEN EXITLOOP .J;
IF .PNTR LSS 0 THEN (OUTS('No such macro?M?J'); RETURN .VREG);
PNTR _ (.SIXNAMES[.PNTR,1,FW])<36,7>;
WHILE (C_SCANI(PNTR)) NEQ #177 DO OUTC(.C);
CRLF; .VREG
END
TES;
PAGE! ANALYSIS OF DEBUG INPUT LINES
! -----------------------------
! THE PARSING ALGORITHM USES A SIMPLE STACK METHOD BASED ON ONE FIRST
! DEVELOPED BY BAUER AND SAMELSON. IN ORDER TO RETAIN MAXIMUM INFORMATION
! ABOUT CONTEXT (NECESSARY SINCE OPERATOR PARSE IS NOT FIXED),BOTH
! OPERATORS AND OPERANDS ARE KEPT IN ONE STACK. THE OPERAND STACK
! ELEMENTS ARE FORMATTED
!
! !-------------------------!
! ! NO. OF WORDS IN OPERAND ! <- TOP WORD OF ENTRY
! !-------------------------!
! ! LAST DATA WORD ! ^ INCREASING
! ! ! ! ! ! ^ STACK
! ! FIRST DATA WORD ! ^ SUBSCRIPTS
! !-------------------------!
!
! WHERE THE COUNT IN THE TOP (LAST) WORD DOES NOT INCLUDE THE COUNT
! WORD ITSELF. OPERATOR ENTRIES ARE CHAINED TOGETHER:
!
! TOPOP --> !------------+------------!
! ! #400000 ! POINTER ! TO IMMEDIATELY PREVIOUS OPERATOR
! !------------+------------!
! ! PARSE INFO ! POINTER ! TO TABLE ENTRY FOR THIS OPERATOR
! !------------+------------!
!
! THUS, OPERATOR AND OPERAND ENTRIES ON THE STACK CAN BE DISTINGUISHED
! BY THE SIGN OF THEIR TOP WORD. THE 'PARSE INFO' IN THE ENTRY IS CONTAINED
! IN THE LAST 4 BITS OF THE HALFWORD, EACH OF WHICH IS 1 WHEN THE CORRESPONDING
! PARSE (NULL-BIT 14, PREFIX-15, POSTFIX-16, INFIX-17) MIGHT BE VALID.
! THE POINTER TO THE TABLE ENTRY POINTS TO ITS SECOND WORD, THE
! PRINT NAME NOT BEING REQUIRED AT THIS STAGE OF THE GAME.
MACRO ENDOFLINE=(.CHAR EQL #15)$;
ROUTINE ADVANCE= ! GET NEXT CHARACTER - HANDLES END OF MACRO
BEGIN
IF .NPCHAR EQL 0 THEN NCHAR_.NCHAR+1;
CHAR_ SCANI(PCHAR[.NPCHAR]);
WHILE .CHAR EQL #177 DO
CHAR_ SCANN(PCHAR[(NPCHAR_.NPCHAR-1)]);
.VREG
END;
ROUTINE TYPE=
BEGIN
IF .CHAR GEQ "0" THEN IF .CHAR LEQ "9" THEN RETURN 0;
IF .CHAR GEQ "A" THEN IF .CHAR LEQ "Z" THEN RETURN 1;
IF .CHAR GEQ "a" THEN IF .CHAR LEQ "z" THEN RETURN 1;
SELECT .CHAR OF
NSET
"#" : EXITSELECT 2;
#42 : EXITSELECT 3; #47 : EXITSELECT 3;
ALWAYS : 4
TESN
END;
ROUTINE ERROR(EN)=
BEGIN
SETON(ERRORFLG);
IF .EN LEQ 4 THEN (TTOUTM(".",.NCHAR); TTOUTC("^"); TTCRLF);
CASE .EN OF
SET
%0% TTOUTS('Unknown symbol');
%1% TTOUTS('Illegal character');
%2% TTOUTS('Syntax error');
%3% TTOUTS('Incorrect number of arguments');
%4% TTOUTS('Unmatched brace');
%5% TTOUTS('Base must be from 2 to 10 dec.');
%6% TTOUTS(': no debug linkage found for this routine');
%7% TTOUTS('Invalid equals');
%8% TTOUTS('Name action by BREAK,ABREAK,OPAQ,OPAQAFT,TRACE, or TRACEAFT');
%9% TTOUTS('Improper file-spec');
%10% TTOUTS('LOOKUP/ENTER failure');
%11% TTOUTS('Transmission error');
%12% TTOUTS('No space for macro text');
TES;
TTCRLF;
0
END;
ROUTINE PUSHOPER(OPERATOR)= ! PUSH OPERATOR ONTO STACK
BEGIN
TOPSTK_.TOPSTK+2;
DBGSTK[.TOPSTK-1]_.OPERATOR;
DBGSTK[.TOPSTK]_ 1^35 OR .TOPOP<RH>;
TOPOP_.TOPSTK;
.VREG
END;
ROUTINE PUSHITEM(AWORD)= ! PUT 1-WORD OPERAND ON STACK
BEGIN
IF .TOPSTK GEQ 0 THEN IF .DBGSTK[.TOPSTK] GEQ 0 THEN RETURN
BEGIN
TOPSTK_.TOPSTK+1;
DBGSTK[.TOPSTK] _ .DBGSTK[.TOPSTK-1] + 1;
DBGSTK[.TOPSTK-1] _ .AWORD;
.VREG
END;
TOPSTK_.TOPSTK+2;
DBGSTK[.TOPSTK] _ 1;
DBGSTK[.TOPSTK-1] _ .AWORD;
.VREG
END;
ROUTINE GETNUMBER= ! PICK UP NUMBER
BEGIN REGISTER VAL[2]; MACHOP TRNE=#602, MUL=#224;
VAL[0]_0;
WHILE TYPE() EQL 0 DO
( MUL(VAL[0],IOBASE); VAL[1]<35,1>_0;
TRNE(VAL[0],1); VAL[1]<35,1>_1;
VAL[0]_ .VAL[1] + .CHAR - "0"; ADVANCE());
.VAL[0]
END;
MACRO GETSYMBOL= ! GET BASE 50 REP. OF SYMBOL
BEGIN REGISTER Z,N; Z_0; N_6;
WHILE 1 DO
(IF (N_.N-1) GEQ 0 THEN (Z _ #50 * .Z + F7TO50(.CHAR)); ADVANCE();
IF .CHAR NEQ "." THEN IF TYPE() GTR 1 THEN EXITLOOP);
.Z
END$;
ROUTINE GETOP(OPNAME)= ! (SECOND) STACK WORD FOR OPERATOR
BEGIN REGISTER R;
R _ DECR I FROM .NEWOPS TO 0 BY 5 DO
IF .OPNAME EQL .DEFOPTAB[.I] THEN EXITLOOP DEFOPTAB[.I]<ADR>;
IF .R LSS 0 THEN
(R _ DECR I FROM .OPTAB[-1]-6 TO 0 BY 5 DO
IF .OPNAME EQL .OPTAB[.I] THEN EXITLOOP OPTAB[.I]<ADR> );
IF .R LSS 0 THEN -1 ELSE
( .R + 1
+ ((((@(.R+1) NEQ 0) ^1
+ (@(.R+2) NEQ 0))^1
+ (@(.R+3) NEQ 0))^1
+ (@(.R+4) NEQ 0)) ^ 18)
END;
ROUTINE GETTEXT=
BEGIN VTEMP_.PTEXT<RH>;
DO (REPLACEI(PTEXT, .CHAR);
IF .PTEXT<RH> GEQ TEXTAREA[4*NMACROS] THEN RETURN ERROR(12);
ADVANCE())
UNTIL ENDOFLINE OR .CHAR EQL #175 OR .CHAR EQL #33;
REPLACEI(PTEXT, #177); ADVANCE(); PTEXT _ (.PTEXT+1) <36,7>;
SIXVP_ VTEMP<ADR>; SIXVC_1; .VREG
END;
MACRO GETSTRING=
IF .CHAR EQL #47 THEN ! HOLD ALREADY DECLARED OUTSIDE MACRO
BEGIN
HOLD_ DBGSTK[.TOPSTK]<1,7>;
IF .TOPSTK GEQ 0 THEN IF .DBGSTK[.TOPSTK] GEQ 0 THEN
(TOPSTK _ .TOPSTK - .DBGSTK[.TOPSTK]; HOLD_.HOLD-1);
WHILE 1 DO (ADVANCE(); IF ENDOFLINE THEN EXITLOOP;
IF .CHAR EQL #47 THEN (ADVANCE(); IF .CHAR NEQ #47 THEN EXITLOOP);
REPLACEI(HOLD, .CHAR));
(.HOLD<RH>) <0,(.HOLD<30,6>)> _ 0;
HOLD_ .HOLD<RH> - DBGSTK<ADR>;
DBGSTK[.HOLD+1] _ .HOLD - .TOPSTK;
TOPSTK _ .HOLD+1;
END
ELSE
BEGIN HOLD_0;
WHILE 1 DO (ADVANCE(); IF ENDOFLINE THEN EXITLOOP;
IF .CHAR EQL #42 THEN (ADVANCE(); IF .CHAR NEQ #42 THEN EXITLOOP);
HOLD _ .HOLD^7 + .CHAR);
IF (QUOTFLG_.QUOTFLG-1) GEQ 0 THEN HOLD_ .HOLD^18; ! KLUDGE FOR DEFINING CHARACTER OPERATORS
PUSHITEM(.HOLD);
END$;
ROUTINE EXECUTE= ! EXECUTE TOP OPERATOR
BEGIN LOCAL PARSE,ROUTN;
PARSE _ FIRSTONE( .DBGSTK[.TOPOP-1]<18,4> ) -32;
SIXLC_ SIXRC_ SIXVC_ 0;
IF .PARSE AND .DBGSTK[.TOPSTK] GTR 0 THEN
BEGIN ! RIGHT OPERAND
SIXRC_ .DBGSTK[.TOPSTK];
SIXRP_ DBGSTK[.TOPSTK-.SIXRC]<FW>;
TOPSTK_ .TOPSTK -.SIXRC -1;
END;
ROUTN _ .(.DBGSTK[.TOPOP-1]<RH> + .PARSE)<RH> ; ! ROUTINE
TOPOP _ .DBGSTK[.TOPOP]<RH>; ! POP OPERATOR
TOPSTK _ .TOPSTK -2;
IF .PARSE GEQ 2 AND .DBGSTK[.TOPSTK] GTR 0 THEN
BEGIN ! LEFT OPERAND
SIXLC_ .DBGSTK[.TOPSTK];
SIXLP_ DBGSTK[.TOPSTK-.SIXLC]<FW>;
TOPSTK_ .TOPSTK - .SIXLC -1;
END;
( .ROUTN<RH> ) (.PARSE); ! ROUTINE CALL
IF ISON(ERRORFLG) THEN RETURN .VREG;
IF .SIXVC GTR 0 THEN
BEGIN ! GET RESULT
INCR J FROM 0 TO .SIXVC-1 DO
DBGSTK[.TOPSTK+1 +.J] _ @(.SIXVP +.J);
TOPSTK _.TOPSTK+ .SIXVC +1;
DBGSTK[.TOPSTK] _ .SIXVC;
END;
.VREG
END;
ROUTINE OPERATE(CURRNTOP)= ! SCHEDULES OPERATORS
BEGIN
MACRO LASTOP=DBGSTK[.TOPOP-1]$,
PRIO(OPWD,N)=(IF .OPWD<21-N,1> THEN
.(.OPWD<RH> +N)<LH> ELSE 0)$,
BRACE(OPWD)=(.(.OPWD<RH>+1)<LH> GTR BRACEVAL)$,
OPERAND=(.TOPSTK GEQ 0 AND .DBGSTK[.TOPSTK] GEQ 0)$,
CHKPARSES(OP)=(IF .OP<18,4> EQL 0 THEN
RETURN ERROR(2))$;
LOCAL P,PARSE,LBRACE;
SETOFF(LBRACE);
P_ PRIO(CURRNTOP,2); IF .P EQL 0 THEN P_ PRIO(CURRNTOP,3);
UNTIL .TOPOP<17,1> DO ! DO HIGHER-PRIORITY PREVIOUS OPERATORS
BEGIN
IF OPERAND THEN ! FOUND OPERAND BETWEEN THIS OP & PREVIOUS ONE
BEGIN
LASTOP_.LASTOP AND NOT #12000000; CHKPARSES(LASTOP);
PARSE_ FIRSTONE( .LASTOP<18,4> ) -32;
IF PRIO(LASTOP,.PARSE) LSS .P THEN EXITLOOP
END
ELSE
BEGIN
IF (.P EQL 0) OR BRACE(CURRNTOP)
OR ((.LASTOP AND #12000000) EQL 0) THEN
(IF BRACE(LASTOP) THEN EXITCOND [3];
IF .CURRNTOP GEQ 0 THEN EXITLOOP);
LASTOP_.LASTOP AND NOT #5000000; CHKPARSES(LASTOP)
END;
IF BRACE(LASTOP) AND (.CURRNTOP GEQ 0) THEN
(IF .(.LASTOP<RH>+1)<LH> EQL PRIO(CURRNTOP,2) + BRACEVAL
THEN SETON(LBRACE) ELSE EXITLOOP);
EXECUTE(); ! PREVIOUS OPERATOR
IF .ERRORFLG OR .LBRACE THEN RETURN .VREG;
END;
! NOW STACK CURRENT OPERATOR
IF .CURRNTOP LSS 0 THEN RETURN .VREG;
CURRNTOP_.CURRNTOP AND NOT (#3000000 ^ (OPERAND ^1));
CHKPARSES(CURRNTOP); ! ELIMINATE PARSES AND CHECK
PUSHOPER(.CURRNTOP);
IF (.CURRNTOP AND #5000000) EQL 0 THEN EXECUTE(); ! CAN DO AT ONCE
.VREG
END;
ROUTINE XDEBUG(PSWITCH)= ! PARSES INPUT LINE
BEGIN REGISTER HOLD; LOCAL T,NAME;
TOPOP_ TOPSTK_ -1;
QUOTFLG_ ERRORFLG_ MODEFLG_ 0;
WHILE ISOFF(ERRORFLG) DO
BEGIN
WHILE (.CHAR EQL " ") OR (.CHAR EQL "?I") DO ADVANCE();
IF ENDOFLINE THEN
BEGIN OPERATE(1^35); ! CLEAN UP & STOP
IF .ERRORFLG OR (.TOPSTK LEQ 0) THEN RETURN 0;
HOLD_.TOPSTK - .DBGSTK[.TOPSTK];
IF ISON(PSWITCH) THEN ! PRINT RESULT
INCR J FROM 0 TO .DBGSTK[.TOPSTK]-1 DO
(OUTRDEF(.DBGSTK[.HOLD+.J],14); TAB;
PRDISP(.DBGSTK[.HOLD+.J]); CRLF);
RETURN .DBGSTK[.HOLD];
END;
CASE TYPE() OF
SET
%0 NUMBER% PUSHITEM(GETNUMBER());
%1 SYMBOL% (NAME_GETSYMBOL;
IF (QUOTFLG_.QUOTFLG-1) GEQ 0 THEN
EXITCASE PUSHITEM(.NAME); % QUOTED %
IF .CHAR EQL "%" THEN EXITCASE
IF (ADVANCE(); T_GETNUMBER()) LEQ 0 THEN ERROR(0) ELSE
%SYMBOL % ( HLRE(HOLD,?.JBSYM); HOLD_ -.HOLD;
% WITH % HOLD_ .HOLD^18 + .HOLD + .?.JBSYM<RH>;
% COUNT % DECR J FROM .T-1 TO 0 DO
IF (HOLD_NSDDTFA(.NAME,.HOLD)) EQL 0
THEN EXITLOOP ERROR(0);
PUSHITEM(@(.HOLD+1)) );
DECR N FROM .NNAMES TO 0 DO ! LOOK FOR MACROS
IF .SIXNAMES[.N,0,FW] EQL .NAME THEN EXITCASE
( PCHAR[(NPCHAR_.NPCHAR+1)] _ (.SIXNAMES[.N,1,FW])<36,7>; ADVANCE());
HOLD_ GETOP(.NAME); IF .HOLD LSS 0
THEN PUSHITEM(SDDTFA(.NAME)) %SYMBOL %
ELSE OPERATE(.HOLD) ); %OPERATOR %
%2 # SIGN% (IOBASE _ IF (HOLD_.IOBASE) EQL 8 THEN 10 ELSE 8;
ADVANCE(); PUSHITEM(GETNUMBER()); IOBASE_.HOLD);
%3 STRING% GETSTRING;
%4 OTHER% (IF .CHAR EQL "=" THEN QUOTFLG_0;
HOLD_GETOP(.CHAR^18); ADVANCE(); IF .HOLD LSS 0 THEN
ERROR(1) ELSE OPERATE(.HOLD) )
TES;
END;
CHAR_#15;
0
END;
MACRO INPUT=
BEGIN
PCHAR[0]_ BUFF<36,7>;
DO (CHAR_INC; REPLACEI(PCHAR[0], .CHAR)) UNTIL .CHAR EQL #12;
REPLACEN(PCHAR[0], #15);
PCHAR[0]_ BUFF<36,7>; NPCHAR_0; ADVANCE(); NCHAR_0
END$;
ROUTINE ISUB= ! DRIVES SYNTAX ANALYZER
BEGIN
IF ((DCNT_.DCNT-1) LEQ 0) OR .TRACEFLG THEN
BEGIN
IF .DCNT LEQ 0 THEN (DCNT_BGOBASE; INCRTOG);
IF ISON(ENABFLG) THEN IFSKIP TTCALL(#13,0) THEN (STOPIT; GOFLG_0);
END;
UNTIL .GOFLG DO
BEGIN
IF .GOFLG GTR 0 THEN TTOUTC("&");
INPUT; GOFLG_2;
XDEBUG(1);
TOPOP_TOPSTK_ -1; ! FUDGE TO ENSURE PROPER (?) OPERATION
! IF SIX12 IS ENTERED RECURSIVELY
END;
.VREG
END;
PAGE! THE FOLLOWING ROUTINES HANDLE ENTRY TO SIX12
! --------------------------------------------
STRUCTURE XVECTPNT[J,K,L] = [1] (@.XVECTPNT+.J)<.K,.L>;
OWN XVECTPNT ROUTPNT, CONDPNT;
ROUTINE CHKCOND= ! CHECK CONDITION FOR ACTION
BEGIN
IF .CONDPNT EQL 0 THEN RETURN 1; ! UNCONDITIONAL
NPCHAR _ 1; PCHAR[1] _ (.CONDPNT)<36,7>; PCHAR[0] _ PLIT('?M?M?J')<29,7>;
ADVANCE(); NCHAR _ 0; VREG _ XDEBUG(0); TOPOP_TOPSTK_ -1; .VREG
END;
ROUTINE RTRCAFT=
(IF ISEXIT THEN
(IF .ROUTPNT[IDIDONF] THEN
IF (TRCCNT_.TRCCNT-1) LEQ 0 THEN
(TRACEFLG _ ROUTPNT[IDIDONF] _ 0) )
ELSE
IF .OPQCNT LEQ 0 AND .TRACEFLG GEQ 0 THEN
(IF CHKCOND() THEN
(ROUTPNT[IDIDONF]_1; TRCCNT_1; TRACEFLG<RH>_-1) )
ELSE IF .ROUTPNT[IDIDONF] THEN TRCCNT_.TRCCNT+1;
.VREG);
ROUTINE RTRCAT=
(IF .OPQCNT LEQ 0 AND .TRACEFLG GEQ 0 THEN
IF CHKCOND() THEN TRACEFLG _ .TRACEFLG OR NOT 1;
.VREG);
ROUTINE ROPQAFT=
(IF ISEXIT THEN
(IF .ROUTPNT[IDIDOFFF] THEN
IF (OPQCNT_.OPQCNT-1) LEQ 0 THEN
(TRACEFLG _ -.ROUTPNT[PREVOFFF] AND NOT 2; ROUTPNT[IDIDOFFF]_ROUTPNT[PREVOFFF]_0) )
ELSE
IF .OPQCNT LEQ 0 THEN
(IF CHKCOND() THEN
(ROUTPNT[IDIDOFFF]_1; ROUTPNT[PREVOFFF]_.TRACEFLG; OPQCNT_1; TRACEFLG<RH>_0) )
ELSE IF .ROUTPNT[IDIDOFFF] THEN OPQCNT_.OPQCNT+1;
.VREG);
ROUTINE ROPQAT=
(IF .TRACEFLG LSS 0 THEN IF CHKCOND() THEN TRACEFLG _ .TRACEFLG AND 1;
.VREG);
ROUTINE RABREAK=
(IF ISEXIT THEN
IF CHKCOND() THEN (STOPIT; OUTS('?M?J<=> After: '); PRXDISP(.RNAME); OUTVALUE);
.VREG);
ROUTINE RBREAK=
(IF NOT ISEXIT THEN
IF CHKCOND() THEN (STOPIT; OUTS('?M?J<=> At: '); PRCALL(@@ENTERPNT, .RNAME); CRLF);
.VREG);
BIND RTNSPLIT=PLIT(RBREAK,RABREAK,ROPQAT,ROPQAFT,RTRCAT,RTRCAFT, 12:DOTVREG);
ROUTINE CALLEM=
BEGIN REGISTER RSAVE; LOCAL SAVE[2],L;
RSAVE _ .SIXVREG; SIXVREG _ .VREG; SAVE[0] _ .RTNLVL; SETISEXIT;
SAVE[1] _ .ENTERPNT; ENTERPNT _ .FREG;
IF .NVALS GEQ 0 THEN CKVALS(.RNAME, .RTNLVL);
IF ISINTBL THEN
IF (L _ IF .NROUTS GEQ 0 THEN CFINDR(.RNAME) ELSE -1) GEQ 0 THEN
BEGIN
ROUTPNT _ ROUTS[.L, 0,0,0];
DECR J FROM (MAXACTRTN-18) TO 0 DO
IF (.ROUTPNT[0,LH] AND 1^.J) NEQ 0 THEN
(CONDPNT _ IF .J THEN .ROUTPNT[ 1+.J/2, LH]
ELSE .ROUTPNT[ 1+.J/2, RH];
(.RTNSPLIT[.J]) () )
END;
IF .TRACEFLG LSS 0 THEN
IF ISEXIT
THEN (IF .TRACEFLG<1,1> THEN (OUTS('<-- '); PRXDISP(.RNAME)); OUTVALUE)
ELSE (OUTS('--> '); PRCALL(@@FREG,.RNAME); IF .TRACEFLG<1,1> THEN CRLF);
IF .TRACEFLG THEN SETON(TRACEFLG) ELSE SETOFF(TRACEFLG);
ISUB();
RTNLVL_ .SAVE[0]; ENTERPNT_ .SAVE[1];
EXCH(RSAVE,SIXVREG)
END;
ROUTINE UUOH=
BEGIN
MACHOP POPJ=#263, XCT=#256, AOS=#350;
IF SAILSW THEN IF .?.JBUUO<OPCODE> NEQ DEBUGUUO THEN JRST(0,SAILUUO,0,1);
DCNT_.DCNT-1;
IF (SIXTOG_.SIXTOG-1) GTR 0 THEN POPJ(SREG,0);
DCNT_.DCNT+1;
IF NOT ISEXIT THEN
BEGIN
POP(SREG,VTEMP); ! GET PUSHED ADDRESS BACK
XCT(0,VTEMP,0,1); ! EXECUTE JSP AFTER DEBUG
AOS(0,VTEMP); ! PUSH RETURN PAST JSP
PUSH(SREG,VTEMP); ! AND SAVE
END;
JRST(0,CALLEM);
.VREG
END;
ROUTINE INITSIX12=
BEGIN
IF NOT SAILSW THEN CALLI(0,0);
TRACEFLG_ LPTFLG_ OPQCNT_ 0;
ENABFLG_ NROUTS_ NVALS_ NNAMES_ -1;
DCNT_ SIXTOG_ BGOBASE; GOFLG_ 1;
NEWOPS_ -5; PTEXT_ TEXTAREA<36,7>;
%THIS CHANGE WAS MADE BY SAGE GROUP.THIS CHANGE WAS
NECESSARY BECAUSE THERE WAS SMALL CHANGE IN MONITORS
THE OLD LINE
(.((.DDT<RH>)+1)<RH>)<FW>_ 0;
IS REPLACED BY THE FOLLOWING THREE LINES (CONDITIONAL).
%
IF .((.DDT<RH>)+1)<27,9> EQL #254 %JRST%
THEN (.((.DDT<RH>)+1)<RH>)<FW,0,1>_0
ELSE (.((.DDT<RH>)+1)<RH>)<FW>_0;
IOBASE_ 8; WDBASE_ #1000; ! CHANGE DEFAULT BASE,WBASE HERE
IF SAILSW THEN SAILUUO_.?.JB41<RH>;
?.JB41_ #260^27 OR SREG<ADR>^23 OR UUOH<ADR>; ! PUSHJ $S,UUOH
.VREG
END;
GLOBAL ROUTINE SIX12(XP)=
BEGIN REGISTER SAVE[3];
SAVE[0]_ .SIXVREG; SIXVREG_ .VREG; SAVE[1]_ .RTNLVL;
SAVE[2]_ .ENTERPNT; ENTERPNT_ .FREG;
SELECT .XP OF
NSET
#400000000000: ! MAIN PROGRAM ENTRY
BEGIN
INITSIX12();
IF .STARTFLG EQL 1 THEN (GOFLG_2; EXITSELECT SETINTERNAL)
ELSE RETURN .SIXVREG
END;
#377777000000: ! MAIN PROGRAM EXIT
RETURN .SIXVREG;
ALWAYS: ! USER CALL
BEGIN
STOPIT; CRLF;
OUTS('Pause '); OUTDEFAULT(.XP); OUTS(' at ');
PRDISP(.(.FREG-1)<RH>-1); CRLF;
SETINTERNAL; SIXVREG _ -1
END
TESN;
SIXTOG_.SIXTOG-1; ! TO KEEP COUNTERS IN STEP
ISUB(); RTNLVL_ .SAVE[1]; ENTERPNT_ .SAVE[2];
EXCH(SAVE[0],SIXVREG)
END;
ROUTINE SIXDD2=
BEGIN REGISTER SAVE[3];
SAVE[0]_ .SIXVREG; SIXVREG_ .VREG; SAVE[1]_ .RTNLVL; SETINTERNAL;
SAVE[2]_ .ENTERPNT; ENTERPNT_ .FREG;
STOPIT; SIXTOG_.SIXTOG-1;
ISUB();
SIXVREG _ .SAVE[0]; RTNLVL_ .SAVE[1]; ENTERPNT_ .SAVE[2];
.VREG
END;
GLOBAL ROUTINE SIXDDT=
! MUST BE CHANGED IF DEFAULT REGISTERS ARE CHANGED !
BEGIN
MACRO S(X)=PUSH(SREG,X)$, R(X)=POP(SREG,X)$;
IF SAILSW THEN (S(1);S(4);S(5);S(6);S(7);S(#10))
ELSE (S(1);S(3);S(4);S(5);S(6);S(7);S(#10);S(#11);S(#12));
SIXDD2();
IF SAILSW THEN (R(#10);R(7);R(6);R(5);R(4);R(1))
ELSE (R(#12);R(#11);R(#10);R(7);R(6);R(5);R(4);R(3);R(1));
.VREG
END;
END ELUDOM