Trailing-Edge
-
PDP-10 Archives
-
BB-J939B-BM
-
binary/six12.b10
There are no other files named six12.b10 in the archive.
! FILE: SIX12.BLI
!
BIND VERSION = UPLIT ASCIZ
'V6.24' ; ! GHL 22-MAY-79
! MAIN FILE FOR SIX12 DEBUG MODULE. REQUIRED BY EACH OF THE
! FOLLOWING CONFIGURATION FILES TO PRODUCE A DIFFERENT VERSION.
!
! FILE REGISTERS INPUT/OUTPUT
! ---- --------- ------------
!
! SIXA12.BLI BLISS-10 TOPS-10
! SIXB12.BLI BLISS-36C TOPS-10
! SIXC12.BLI BLISS-36 TOPS-10
!
! SIXD12.BLI BLISS-36C TOPS-20
! SIXE12.BLI BLISS-36 TOPS-20
!
! NOTE: BLISS-10 REGISTERS AND TOPS-20 INPUT/OUTPUT CAN NOT BE USED
! TOGETHER BECAUSE JSYS CALLS CLOBBER SREG (REGISTER 0).
!
! LINKAGE/REGISTER CONVENTIONS ARE ENCODED BY SYMBOL LINKAGETYPE AS FOLLOWS:
!
! LINKAGETYPE MUST GO WITH
! ----------- ------------
!
! 3 (BLISS36) SREG=#17, FREG=#16, AREG=#15, VREG=1,
! DREGS=7, RESERVE(0,#15)
!
! 2 (BLISS36C) SREG=#17, FREG=#15, AREG=(not used), VREG=1,
! DREGS=7, RESERVE(0,#16)
!
! 1 (BLISS10) SREG=0 (default), FREG=2 (default), AREG=(not used), VREG=3 (default),
! DREGS=5 (default), RESERVE none
!
! 0 (NON-STD) *** ANY OTHER COMBINATION ***
!
! NOTE: IF SREG IS NOT REGISTER 0, THEN REGISTER 0 SHOULD BE RESERVED
! TO AVOID POOR CODE QUALITY BY BLISS-10 COMPILER.
! 22-MAY-79, GLENN LUPTON
! FIX CODE WHICH BACKS UP A BYTE-POINTER IN XDEBUG.
! INCREASE NUMBER OF MACROS WHICH CAN BE DEFINED.
! DECREASE SPACE ALLOCATED PER MACRO.
! ALLOW STRUCTURE ACCESS TO HAVE MORE THAN ONE ACTUAL. IF
! THREE OR FOUR, USE BLOCK STRUCTURE. IF THE VARIABLE SIXREF
! IS TRUE THEN USE REF BLOCK/VECTOR.
! ADD SOME ERROR CHECKS RELATED TO LOAD.
! ADD VALUE OF SIXREF TO ITEMS IN LOAD/SAVE FILE.
!
! 13-JUL-78, RON BRENDER
! FIX ROUTINE FNDDBGUUO TO HANDLE ONE VS TWO SEGMENT IMAGES
! ADD GLOBAL "SIXRET" DEFINED AS "JRST @.JBOPC" DYNAMICALLY
! IN INITSIX12
! MAKE ACS SAVE/RESTORE IN EDDT & RET612 BE UNCONDITIONAL OF
! MONITOR, IE., ADD TO TOPS20 ALSO.
!
! 20-JUN-78, RON BRENDER
! ADD GLOBAL NAME "SIXOSA" FOR INTERNAL SERVICE ROUTINE "OUTSA"
!
! 2-MAY-78, RON BRENDER
! FIX SOME BUGS, NAMELY:
! SAVE/RESTORE .JBUUO IN ROUTINE LPAREN
! CHANGE DEFAULT LINKAGE MESSAGES FOR BLISS-36
! CHANGE SEARCH FOR DEBUG UUO ON TOPS-20 TO IGNORE .JBHRL
!
! 20-MAR-78, RON BRENDER
! SUPPORT number%L (ROUTINES: GETLCLCNT, GETLCLADR)
! DIAGNOSE MULTIPLE NAMES IN DDT SYMBOL TABLE IN NAME LOOKUP
! DELETE non-GLOBAL SYMBOLS FOR SIX12 ITSELF FROM DDT SYMBOL TABLE
! DURING INITIALIZATION
!
! 12-MAR-78, RON BRENDER
! ADD RESET COMMAND, DELETE RESET FROM NORMAL INITIALIZATION
! DELETE ARGUMENT FROM INITIALIZATION ENTRIES: SIX10, SIX36C, SIX36
!
! 4-MAR-78, RON BRENDER
! MAKE MACRO INTO ROUTINE: STOPIT
! ADD IDENT COMMAND
! ADD PRINT MONITOR COMMAND
! MAKE INITIAL SIGNON MESSAGE DEPEND ON STARTFLG
! ADD SIXPAT PATCH AREA IN PLACE OF %number OPERATOR
! DELETE ROUTINE: DOLSIGN, XPERCENT, SETIT
! ADD CHECKING OF POSITION/SIZE IN FIELD SELECTORS
! CHANGE ISUB SO THAT "!" AS FIRST CHAR IS A COMMENT LINE
! FINISH SUPPORT OF BLISS36 LINKAGE
! CLEAN UP INTERFACES TO DDT
!
! 12-FEB-78, RON BRENDER
! RESTRUCTURE TO USE CONFIGURATION FILES
!
! 10-FEB-78, RON BRENDER
! MERGE TOPS-20 INPUT/OUTPUT INTO THIS FILE
! (CREDIT TO MARTY JACK FOR A WORKED EXAMPLE)
! MODIFY ROUTINE XCHNG TO DISPLAY ALL MONITORED LOCATIONS
! MODIFY ROUTINE XEQUALS TO REPORT CHANGE OF MONITORED LOCATION
! ADD MORE ERROR CHECKING AND MESSAGES
! MODIFY ROUTINE XDEBUG TO IGNORE MODULE NAMES IN NAME SEARCH
! MODIFY FORMAT OF STACK DISPLAY (COMMANDS CALL,CALLS,LCALL,LCALLS)
! MAKE MACROS INTO ROUTINES: F50TO7,F7TO50,GETSYMBOL,GETSTRING,INPUT
! MODIFY ROUTINE UUOH TO LOOK AT INSTRUCTION AFTER DEBUG UUO
! MODIFY ROUTINE PRCALL TO ALSO USE ADJSP INSTRUCTION FOR ACTUALS COUNT
!
! 20-NOV-77, RON BRENDER
! ADD ENTRIES SIX10, SIX36 FOR INITIALIZATION
! ADAPT ROUTINE UUOH FOR B-36
! ADD CHECK IN ROUTINE EQUALS FOR NO SYMBOL TABLE SPACE FOR BIND
!
! 20-SEP-77, RON BRENDER
! ADD INITIAL IDENTIFICATION MESSAGE
! START CONVERSIONS FOR B-36
! MODIFY ROUTINE XDEBUG TO SUPPORT name%0 AND number%A NOTATION
! MODIFY ROUTINE XPRINT TO DISPLAY ALL MACROS AND ALL ACTIONS
!
! 12-SEP-77, RON BRENDER
! IMPROVE FORMATTING TO MAKE MORE READABLE,
! INCLUDING CHANGE ASSIGNMENT FROM "_" TO "=".
!
! 20-JUN-77, GERRY FISHER
! ADD ROUTINE SIX12C FOR BLISS-36C INTERFACE.
! ADD SIX36C FLAG.
! MAKE SEVERAL SMALL CHANGES TO OBTAIN ONE SOURCE
! FOR BLISS-10 AND BLISS-36C.
!
! 9-MAR-77, BOSE GHANTA
! MADE MODIFICATIONS TO SIX12.BLI TO HAVE A ROUTINE
! ORIENTED DEBUGGER FOR BLISS-36C.
!
GLOBAL BIND
SIXLSF = -1, ! DELETE LOCAL SYMBOLS FOR SIX12 FLAG
SIXSTF = -1,
SIXENF = -1;
BEGIN
BIND
BREG=?.BREG;
! Adapted from -- DEBUGGING CONTROL MODULE
! --------------------------
!
! 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
BIND
LINKTYPE = ! LIMIT RANGE TO 0 THRU 3
LINKAGETYPE*(LINKAGETYPE GEQ 0)*(LINKAGETYPE LEQ 3);
! THESE BINDS CONTROL SIZE OF PROBLEM
! -----------------------------------
BIND
SCRATCHSIZE=20,
BUFFSIZE=24,
STACKSIZE=50,
NMACROS=500,
LEVELS=10,
EXTRAOPS=20,
BGOBASE=20,
ROUTSCNT=50,
MONITCNT=50,
ROUTSIZE=4;
MACHOP
TTCALL=#51,
CALLI=#47,
HLRE=#574,
HRRE=#570,
JSYS=#104,
JFCL=#255,
EXCH=#250,
IN=#56,
OUT=#57,
OPEN=#50,
CLOSE=#70,
LOOKUP=#76,
ENTER=#77,
INBUF=#64,
OUTBUF=#65,
PUSH=#261,
POP=#262,
JRST=#254,
BLT=#251,
RELEASE=#71;
MACHOP
LSH=#242,
ASH=#240;
EXTERNAL
?.JBSYM,
?.JBUSY,
?.JBDDT,
?.JBOPC,
?.JBUUO,
?.JBDA,
?.JBFF,
?.JB41,
?.JBREL,
?.JBHRL;
! STORAGE DECLARATIONS
! --------------------
GLOBAL
SIXPAT[SCRATCHSIZE+1], ! PATCH AREA
SIXRP,
SIXLP,
SIXVP,
SIXRC,
SIXLC,
SIXVC,
SIXREF,
SIXVREG,
SIXSTK, ! INITIAL STACK POINTER VALUE
SIXACS[16]; ! SAVED ACS WHEN CALLING DDT
GLOBAL BIND
SIXSP = SREG<0,0>; ! STACK POINTER REGISTER NUMBER
EXTERNAL ! REFERS TO GLOBAL VALUES DEFINED IN OUTER BLOCK.
! IN THIS WAY, THEY MAY BE SPECIFIED AT LINK TIME.
SIXLSF, ! DELETE SIX12 LOCAL SYMBOLS FLAG VALUE
SIXSTF, ! INITIAL START FLAG VALUE
SIXENF; ! INITIAL ENABLE FLAG VALUE
OWN
STARTFLG=SIXSTF<0,0>,
ENABFLG=SIXENF<0,0>,
NROUTS,
NVALS,
SIXTOG,
RTNLVL, ! ROUTINE POSITION: 1 => AT ROUTINE EXIT, 0 => AT ROUTINE ENTRY,
! -1 => OTHERWISE.
DCNT,
CHAR,
NCHAR,
NPCHAR,
LPTFLG, ! LINE PRINTER OUTPUT FLAG
LPTOPNFLG, ! LINE PRINT FILE OPEN FLAG
ERRORFLG,
ERRORPARM,
SAILUUO,
GOFLG,
TRACEFLG,
MODEFLG,
QUOTFLG,
TRCCNT,
OPQCNT,
TOPSTK,
TOPOP,
IOBASE,
WDBASE,
VTEMP,
LPTHDR[3],
DSKHDR[3],
ENTERPNT,
PTEXT,
NEWOPS,
NNAMES,
BUFF[BUFFSIZE],
PCHAR[LEVELS],
TEXTAREA[2*NMACROS], ! ALLOWING AVG. 9 CHARS/MACRO; CHANGE ROUTINE 'GETTEXT' IF CHANGED
DEFOPTAB[5*EXTRAOPS],
DBGSTK[STACKSIZE],
LPTBUF[#203];
OWN
SIXBLS = 0; ! CODE TO INDICATE TYPE OF BLISS IN USE.
! ENCODED AS: 0 => BLISS-10 (DEFAULT),
! 1 => BLISS-36C, AND 2 => BLISS-36.
STRUCTURE
XVECTOR[I,J,K,L]=
[I*J]
(.XVECTOR+.J+(.I*J))<.K,.L>;
OWN
XVECTOR MONVALS[MONITCNT,2],
XVECTOR SIXNAMES[NMACROS,2],
XVECTOR ROUTS[ROUTSCNT,ROUTSIZE];
! SOME USEFUL MACROS
! ------------------
MACRO
RNAME=?.JBUUO<0,18>$,
RH=0,18$,
LH=18,18$,
FW=0,36$,
ADR=0,0$,
POS=30,6$,
SIZ=24,6$,
INDEX=18,4$,
INDIRECT=22,1$,
INDXDX=18,5$,
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)$,
ISFRED=(LINKTYPE EQL 3)$,
ISNOTFRED= NOT ISFRED$,
SETINTERNAL=(RTNLVL = -1)$,
SETISEXIT=(RTNLVL = ISEXIT)$,
OUTFLAG=OUTFLAGRTN()$,
DDTEND = (.?.JBDDT<18,18>)$,
DDT = (.?.JBDDT<0,18>)$;
FORWARD LPTOFF,OUTSA,ENDSIX12;
ROUTINE BEGINSIX12= .VREG; ! FIRST CODE ADDRESS IN SIX12
ROUTINE STOPIT=
BEGIN
SETON(ENABFLG);
IF ISON(TRACEFLG) THEN INCRTOG;
LPTOFF();
GOFLG = 2
END;
ROUTINE OUTFLAGRTN=
(CASE .RTNLVL OF
SET
OUTSA(UPLIT ASCIZ 'B:');
OUTSA(UPLIT ASCIZ 'A:')
TES)
;
! 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
IF TOPS10
THEN
BEGIN
REGISTER RUWP;
RUWP = 0;
CALLI(RUWP,SETUWP);
RUWP = 1;
(ACTION);
CALLI(RUWP,SETUWP);
RUWP = 0
END;
IF TOPS20
THEN
(ACTION);
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.
BIND
CRLFSTR=UPLIT ASCIZ '?M?J', ! STRING FOR CRLF MACRO
VALSTR=UPLIT ASCIZ '?IValue: '; ! FOR OUTVALUE
MACRO
INC=
(IF TOPS10 THEN (TTCALL(4,VREG); .VREG))$,
TTOUTC(Z)=
BEGIN
IF TOPS10
THEN
(VREG = (Z); TTCALL(1,VREG));
IF TOPS20
THEN
(VREG = (Z); JSYS(0,#074)); ! PBOUT
END$,
OUTS(Z)=
OUTSA(UPLIT ASCIZ Z)$,
TTOUTS(Z)=
BEGIN
IF TOPS10
THEN
TTCALL(3,UPLIT ASCIZ Z);
IF TOPS20
THEN
(VREG = (UPLIT ASCIZ Z)<36,7>; JSYS(0,#076)); ! PSOUT
END$,
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=
OUTCRLF()$,
TTCRLF=
BEGIN
IF TOPS10
THEN
TTCALL(3,CRLFSTR);
IF TOPS20
THEN
(VREG = CRLFSTR<36,7>; JSYS(0,#076)); ! PSOUT
END$,
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);
OUTS(' == ');
PRDISP(.SIXVREG);
CRLF)$;
ROUTINE OUTCRLF= OUTSA(CRLFSTR); ! OUTPUT NEWLINE
! 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
IF TOPS10
THEN
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);
END;
IF TOPS20
THEN
BEGIN
1<0,36> = #600001000000; ! OUTPUT FILE, NEW, SHORT
2<0,36> = (UPLIT ASCIZ 'LPT:SIX12.LPT')<36,7>; ! FILE SPEC
IFSKIP JSYS(0,#020) ! GTJFN
THEN .VREG ! .VREG SO DON'T CLOBBER 1
ELSE RETURN ERROR(10); ! REPORT FAILURE
LPTHDR = .1<0,18>; ! SAVE JFN
2<0,36> = #070000100000; ! 7-BYTES, WRITE ACCESS
IFSKIP JSYS(0,#021) ! OPENF
THEN 0
ELSE RETURN ERROR(10);
END;
LPTOPNFLG = -1; ! SET LINE PRINTER FILE OPEN
0
END;
ROUTINE OUTC(CHAR)=
BEGIN
IF .LPTFLG GEQ 0
THEN
BEGIN
IF TOPS10 THEN TTCALL(1,CHAR);
IF TOPS20 THEN (VREG = .CHAR; JSYS(0,#074)); ! PBOUT
END;
IF .LPTFLG NEQ 0
THEN
BEGIN
IF TOPS10
THEN
BEGIN
IF (LPTCNT = .LPTCNT-1) LEQ 0 THEN OUT(LPTCHN,0);
REPLACEI(LPTPTR,.CHAR)
END;
IF TOPS20
THEN
BEGIN
1<0,36> = .LPTHDR; ! GET JFN
2<0,36> = .CHAR; ! GET CHAR
JSYS(0,#051); ! BOUT
END;
END;
.VREG
END;
ROUTINE OUTSA(STR)=
BEGIN
IF .LPTFLG GEQ 0
THEN
BEGIN
IF TOPS10 THEN TTCALL(3,STR,0,1);
IF TOPS20 THEN (VREG = (.STR)<36,7>; JSYS(0,#076)); ! PSOUT
END;
IF .LPTFLG NEQ 0
THEN
BEGIN
IF TOPS10
THEN
BEGIN
REGISTER
PTR,
C;
PTR = (.STR)<36,7>;
WHILE (C = SCANI(PTR)) NEQ 0 DO
BEGIN
IF (LPTCNT = .LPTCNT-1) LEQ 0 THEN OUT(LPTCHN,0);
REPLACEI(LPTPTR,.C)
END
END;
IF TOPS20
THEN
BEGIN
1<0,36> = .LPTHDR; ! GET JFN
2<0,36> = (.STR)<36,7>; ! GET POINTER
3<0,36> = 0; ! ASCIZ TERMINATION
JSYS(0,#053); ! SOUT
END;
END;
.VREG
END;
GLOBAL BIND SIXOSA = OUTSA; ! GLOBAL NAME FOR EXTERNAL USE
ROUTINE INWORD=
BEGIN
IF ISON(ERRORFLG) THEN RETURN -1;
IF TOPS10
THEN
BEGIN
IF (DSKCNT = .DSKCNT-1) LEQ 0
THEN
IFSKIP IN(SLCHN,0) THEN (SETON(ERRORFLG); RETURN -1);
RETURN SCANI(DSKPTR)
END;
IF TOPS20
THEN
BEGIN
1<0,36> = .DSKHDR; ! GET JFN
JSYS(0,#050); ! BIN
RETURN .2<0,36>;
END;
END;
ROUTINE OUTWORD(WORD)=
BEGIN
IF ISON(ERRORFLG) THEN RETURN .VREG;
IF TOPS10
THEN
BEGIN
IF (DSKCNT = .DSKCNT-1) LEQ 0
THEN
IFSKIP OUT(SLCHN,0) THEN (SETON(ERRORFLG); RETURN .VREG);
REPLACEI(DSKPTR,.WORD);
END;
IF TOPS20
THEN
BEGIN
1<0,36> = .DSKHDR; ! GET JFN
2<0,36> = .WORD; ! GET BYTE
JSYS(0,#051); ! BOUT
END;
.VREG
END;
ROUTINE CLOSELPT=
BEGIN
LPTFLG = 0;
IF TOPS10
THEN
BEGIN
CLOSE(LPTCHN,0);
RELEASE(LPTCHN,0);
END;
IF TOPS20
THEN
BEGIN
VREG = .LPTHDR; ! GET JFN
JSYS(0,#022); ! CLOSF
VREG = 0; ! IGNORE FAILURE
END;
LPTOPNFLG = 0;
.VREG
END;
ROUTINE LPTON= (IF .LPTOPNFLG NEQ 0 THEN LPTFLG = -1 ELSE ERROR(19); .VREG);
ROUTINE LPTDUP= (IF .LPTOPNFLG NEQ 0 THEN LPTFLG = 1 ELSE ERROR(19); .VREG);
ROUTINE LPTOFF= (LPTFLG = 0; .VREG);
ROUTINE XRESET=
BEGIN
IF .LPTOPNFLG NEQ 0 THEN RETURN ERROR(20);
IF TOPS10 THEN CALLI(0,0);
IF TOPS20 THEN JSYS(0,#147);
.VREG
END;
! 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
BEGIN
OUTM(" ",.REQD-.COUNT);
IF ISON(NUMNP) THEN OUTC("-");
RETURN .VREG
END;
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 NSDDTFA(X,V)=
! GIVEN A SYMBOL SEARCH FOR THE ADDRESS OF ITS NEXT OCCURRENCE
BEGIN
REGISTER R;
IF .V EQL 0
THEN
BEGIN
HLRE(R,?.JBSYM);
R = -.R;
R = .R^18 + .R + .?.JBSYM<RH>
END
ELSE
R = .V;
WHILE (R = .R-#2000002) GEQ 0 DO
IF .(.R)<0,32> EQL .X
THEN
RETURN .R;
0
END;
%%% NOT USED ...
ROUTINE SDDTFA(X) =
! GIVEN A SYMBOL, SEARCH DDT SYMBOL-TABLE FOR ITS VALUE
BEGIN
REGISTER R;
IF (R = NSDDTFA(.X,0)) NEQ 0 THEN RETURN @(.R+1);
ERROR(0)
END;
%%%
ROUTINE SDDTFS(X)=
! GIVEN AN ADDRESS, SEARCH TABLE FOR THE SYMBOL MOST NEARLY MATCHING IT
BEGIN
REGISTER
R,
N;
N = UPLIT(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 NOSIXSYMS=
! DELETE SIX12'S LOCAL SYMBOLS FROM DDT SYMBOL TABLE
BEGIN
REGISTER R;
BIND SIXMODNAME =
CASE (LINKTYPE + 2*TOPS20)*((TOPS20 EQL 0) OR (TOPS20 EQL 1 AND LINKTYPE GEQ 2)) OF
SET
%0% -1;
%1% RADIX50 "SIXA..";
%2% RADIX50 "SIXB..";
%3% RADIX50 "SIXC..";
%4% RADIX50 "SIXD..";
%5% RADIX50 "SIXE..";
TES;
R = -HLRE(R,?.JBSYM);
R = .R^18 + .R + .?.JBSYM<RH>;
WHILE (R = .R - #2000002) GEQ 0 DO ! FIND SIX12 MODULE
BEGIN
IF .(.R)<32,2> EQL 0
THEN IF .(.R)<0,32> EQL SIXMODNAME
THEN EXITLOOP;
END;
WHILE (R = .R - #2000002) GEQ 0 DO ! DELETE LOCALS
BEGIN
IF .(.R)<32,2> EQL 0 THEN EXITLOOP; ! NEXT MODULE
IF .(.R)<32,2> EQL 2 ! LOCAL
THEN (.R)<FW> = #637777^18;
END;
.VREG
END;
ROUTINE FNDDBGUUO(STRT,ISITEXIT)=
!
! STARTING AT GIVEN ADDRESS (STRT), SCAN FORWARD LOOKING
! FOR DEBUG UUO. RETURN ITS ADDRESS IF FOUND,
! ELSE -1.
!
BEGIN
LOCAL
CORELIM,
MATCH;
BIND
BITS = #777000777777 OR 1^EXITPOS;
MATCH = DEBUGUUO^27 OR .ISITEXIT^EXITPOS OR .STRT<RH>;
IF .STRT<RH> GEQ ?.JBDA<ADR> AND .STRT<RH> LEQ .?.JBREL<RH>
THEN
CORELIM = .?.JBREL<RH>
ELSE
IF .STRT<RH> GEQ ((.?.JBHRL<RH>-.?.JBHRL<LH>) AND #777000) AND
.STRT<RH> LEQ .?.JBHRL<RH>
THEN
CORELIM = .?.JBHRL<RH>
ELSE
RETURN -1;
INCR J FROM .STRT<RH> TO .CORELIM DO
IF (@@J AND BITS) EQL .MATCH
THEN RETURN .J;
-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 IF .(.R)<FW> NEQ #637777^18 ! DON'T STOP ON DELETED SYMBOL
THEN RETURN @@R;
@(.R-2)
END;
ROUTINE F50TO7(X)=
! CONVERT BASE 50 CHARACTER TO ASCII CHARACTER
BEGIN
IF .X EQL 0 THEN 0 ! BLANK
ELSE IF .X LEQ #12 THEN .X+#57 ! "0" - "9"
ELSE IF .X LEQ #44 THEN .X+#66 ! "A" - "Z"
ELSE IF .X EQL #45 THEN #56 ! "."
ELSE IF .X EQL #47 THEN #45 + #72*(.SIXBLS NEQ 0)
! "%" IN B-10, "_" IN B-36(C)
ELSE .X-2 ! DOLLAR
END;
ROUTINE F7TO50(X)=
! CONVERT ASCII CHARACTER TO BASE 50 CHARACTER
BEGIN
IF .X EQL 0 THEN 0
ELSE IF .X EQL #56 THEN #45
ELSE IF .X EQL #46 THEN #45
ELSE IF .X EQL #137 THEN #47
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
END;
ROUTINE PRSYM50(X)=
! PRINT NAME GIVEN IN BASE 50
BEGIN
LOCAL R;
IF (X = .X AND #37777777777) NEQ 0
THEN
BEGIN
R = .X MOD #50;
PRSYM50(.X/#50);
OUTC(F50TO7(.R))
END;
.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 #140
THEN
BEGIN
IF .I THEN IF .Z EQL 0 THEN EXITBLOCK;
OUTDEFAULT(.Z)
END
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>) );
!
! ROUTINES TO PARSE AND DISPLAY THE STACK
!
MACRO
ACMASK = 0,16$,
COUNTACS(F) = COUNTONES(.((F)+1)<ACMASK>)$,
WITHINSIX12(PC) =
((PC) GTR BEGINSIX12<ADR> AND (PC) LSS ENDSIX12<ADR>)$;
ROUTINE COUNTONES(MASK)=
!
! COUNT THE ONE BITS IN A BIT MASK
!
BEGIN
REGISTER M,C,R;
M = .MASK;
C = 0;
R = 1;
WHILE .M NEQ 0 DO
BEGIN
IF (.M AND .R) NEQ 0 THEN C = .C+1;
M = .M AND NOT .R;
R = .R^1;
END;
.C
END;
ROUTINE GETARGBASE(F,N)=
! GET BASE OF ARGUMENT LIST GIVEN FRAME AND ARGUMENT COUNT
IF ISNOTFRED
THEN .F<RH> -1 -.N !B-10 & B-36C
ELSE .(.F-1)<RH> !B-36
;
ROUTINE GETCALLFROM(F)=
! GET ADDRESS OF CALL GIVEN CURRENT FRAME POINTER
IF ISNOTFRED
THEN .(.F-1)<RH> -1 !B-10 & B-36C
ELSE .(.F-COUNTACS(.F))<RH>-1 !B-36
;
ROUTINE GETARGCNT(F)=
! GET ARG COUNT OF CURRENT CALL GIVEN FRAME POINTER
BEGIN
REGISTER NP;
IF ISNOTFRED
THEN
!B-10 & B-36C
BEGIN
LOCAL INSTRPC;
INSTRPC = @(.F-1);
WHILE .(.INSTRPC)<LH> EQL #254^9 DO ! JRST 0,-
INSTRPC = .(.INSTRPC)<RH>; ! FOLLOW CROSS-JUMPING CHAIN
NP = 0;
IF .(.INSTRPC)<LH> EQL (#274^9 OR SREG<ADR>^5) ! SUB
THEN
NP = .(@@INSTRPC)<RH>
ELSE IF .(.INSTRPC)<LH> EQL (#105^9 OR SREG<ADR>^5) ! ADJSP
THEN
NP = -HRRE(NP,@INSTRPC);
END;
IF ISFRED
THEN
!B-36
NP = -HLRE(NP,@(.F-1)-1);
IF .NP LSS 0 THEN NP = 0;
.NP
END;
ROUTINE GETARGADR(N,FRAME)=
! GET ADDRESS OF THE N'TH ARGUMENT OF GIVEN FRAME.
! IF FRAME IS ZERO THEN USE CURRENT FRAME.
BEGIN
LOCAL F,NA;
IF .RTNLVL LSS 0 THEN RETURN -1;
F = (IF .FRAME EQL 0 THEN .(.ENTERPNT)<RH> ELSE .FRAME<RH>);
NA = GETARGCNT(.F);
IF .N LSS 1 OR .N GTR .NA THEN RETURN -1;
GETARGBASE(.F,.NA)+.N-1
END;
ROUTINE GETLCLCNT(PREVF)=
! GET NUMBER OF LOCALS FOR STACK FRAME BEFORE GIVEN FRAME
BEGIN
LOCAL F,NL;
PREVF = (IF .PREVF EQL 0 THEN .ENTERPNT<RH> ELSE .PREVF<RH>); ! CLEAN ADDRESS
F = .(.PREVF)<RH>; ! ADDRESS OF FRAME OF INTEREST
IF ISNOTFRED
THEN
BEGIN
NL = .PREVF -.F -2;
IF .PREVF NEQ .ENTERPNT<RH>
THEN NL = .NL - GETARGCNT(.PREVF);
END;
IF ISFRED
THEN
BEGIN
NL = .PREVF -.F -2;
IF .PREVF NEQ .ENTERPNT<RH>
THEN
BEGIN
NL = .NL -COUNTACS(.PREVF) +1;
IF (.(.PREVF-1)<RH> GTR .F) AND (.(.PREVF-1)<RH> LSS .PREVF)
THEN NL = .NL -GETARGCNT(.PREVF) -1;
END;
END;
IF .NL LEQ 0 THEN RETURN 0;
.NL
END;
ROUTINE GETLCLADR(N,PREVF)=
! GET ADDRESS OF N'TH LOCAL OF FRAME BEFORE PREVF
! IF FRAME IS ZERO THEN USE CURRENT FRAME.
BEGIN
IF .RTNLVL LSS 0 THEN RETURN -1;
PREVF = (IF .PREVF EQL 0 THEN .ENTERPNT<RH> ELSE .PREVF<RH>); ! CLEAN ADDRESS
IF .N LSS 1 THEN RETURN -1;
IF .N GTR GETLCLCNT(.PREVF) THEN RETURN -1;
.(.PREVF)<RH> + .N
END;
ROUTINE PRG(B,T)=
! PRINT A CONTIGUOUS 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
THEN OUTS(' ?I')
ELSE OUTS('?M?J?I?I');
END;
ROUTINE PRCALL(F,CALLED)=
! PRINT A SINGLE ROUTINE CALL WITH ITS PARMS
BEGIN
REGISTER NP; ! NUMBER OF PARAMETERS
LOCAL CALLFROM;
IF (CALLFROM = GETCALLFROM(.F)) LEQ 0 THEN RETURN 0;
NP = GETARGCNT(.F);
PRXDISP(.CALLED);
OUTS('?Ifrom?I');
IF WITHINSIX12(.CALLFROM<RH>)
THEN OUTS('"within SIX12"')
ELSE PRDISP(.CALLFROM);
IF .NP EQL 0
THEN
OUTS(' no actuals')
ELSE
BEGIN
OUTS('?M?J?IActuals?I');
PRG( GETARGBASE(.F,.NP), .NP);
END;
.CALLFROM<RH>
END;
ROUTINE PSTK(FBACK,TOG,LEVEL)=
! DISPLAY CALL STACK TO LEVEL "LEVEL", "TOG" CONTROLS LOCALS DISPLAY
BEGIN
LOCAL F,NAME,NL;
IF .RTNLVL GEQ 0
THEN
NAME = .(RNAME)<RH>
ELSE
BEGIN
IF (NAME = GETCALLFROM(@@FBACK)) LSS 0 THEN RETURN .VREG;
NAME = .(.NAME)<RH>;
END;
F = .(.FBACK)<RH>;
DO
BEGIN
IF (NAME = PRCALL(.F,.NAME)) EQL 0 THEN RETURN .VREG;
IF .TOG
THEN
BEGIN
NL = GETLCLCNT(.FBACK);
IF .NL GTR 0 ! PRINT LOCALS
THEN (OUTS('?M?J?ILocals?I'); PRG( .F+1, .NL));
END;
CRLF;
IF (.(.F)<RH> NEQ 0)
AND (.(.F)<RH> LSS .F<RH>)
AND (IF .SIXBLS LEQ 1
THEN .(.F)<RH> GTR .BREG
ELSE 1)
AND (NOT WITHINSIX12(.NAME<RH>))
THEN
BEGIN
FBACK = .F;
F = .(.F)<RH>;
END
ELSE
RETURN .VREG;
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
BEGIN
OPQCNT = 0;
TRACEFLG = -.ROUTS[.L,PREVOFFF];
ROUTS[.L,0,FW] = .ROUTS[.L,0,FW] AND NOT (IDIDOFFV+PREVOFFV)
END;
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
BEGIN
INCRTOG;
VAL = .VAL AND NOT (1^35)^(-FIRSTONE(.VAL))
END;
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;
PNTR = FNDDBGUUO(.ROUTN,.ISITEXIT);
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 PRMVALSNAM(ENTRY)=
! PRINT BYTE POINTER
BEGIN
LOCAL T;
PRDISP(.ENTRY<RH>); ! PRINT NAME
IF (T<LH> = .ENTRY<LH>) NEQ #4400
THEN
BEGIN ! PRINT <P,S>
OUTC("<");
OUTD(.T<POS>);
OUTC(",");
OUTD(.T<SIZ>);
IF .T<INDXDX> NEQ 0
THEN
BEGIN
OUTC(","); OUTD(.T<INDEX>);
OUTC(","); OUTD(.T<INDIRECT>);
END;
OUTC(">");
END;
.VREG
END;
ROUTINE CKVALS(RTN,TOG)=
! CHECK FOR CHANGED VALUES IN THE MONITOR TABLE
BEGIN
LOCAL
X;
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;
PRMVALSNAM(.MONVALS[.I,0,FW]);
TAB;
OUTS('Old: ');
OUTDEFAULT(.MONVALS[.I,OLDVAL]);
TAB;
OUTS('New: ');
OUTDEFAULT(.X);
CRLF;
MONVALS[.I,OLDVAL] = .X;
END;
END;
IF .TOG EQL -1 THEN STOPIT();
.VREG
END;
ROUTINE XPRINTMON=
! COMMAND: PRINT MONITOR
BEGIN
IF .NVALS LSS 0 THEN RETURN OUTS('No monitored locations?M?J');
DECR I FROM .NVALS TO 0 DO
BEGIN
PRMVALSNAM(.MONVALS[.I,0,FW]);
OUTS('?I= ');
OUTDEFAULT(.MONVALS[.I,OLDVAL]);
CRLF
END;
.VREG
END;
ROUTINE XCHNG=
!
! COMMAND: DMONITOR name ,...
! REPORT CURRENT ENTRIES OR
! INSERT ENTRIES IN MONITOR VALUES TABLE
!
BEGIN
LOCAL X;
IF .SIXRC EQL 0
THEN
!
! REPORT CURRENT ENTRIES
!
BEGIN
MODEFLG = 4; ! SO XPRINTMON WILL BE CALLED
RETURN .VREG
END;
! MAKE A NEW ENTRY
!
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>
IF .(.SIXRP+.I)<INDXDX> NEQ 0
THEN (PRMVALSNAM(@(.SIXRP+.I)); RETURN ERROR(18));
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;
.VREG
END;
ROUTINE DCHNG=
!
! DELETE ENTRY FROM MONITOR VALUES TABLE
!
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
BEGIN
OUTS('No entry for ');
PRMVALSNAM(@(.SIXRP+.I));
CRLF;
EXITBLOCK
END;
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 RET612=
BEGIN
REGISTER R;
R = SIXACS<ADR>^18;
BLT(R,#17);
.VREG
END;
ROUTINE EDDT=
BEGIN
REGISTER R;
R = SIXACS<ADR>;
BLT(R,SIXACS[15]);
?.JBOPC = RET612+1;
IF TOPS10
THEN
BEGIN
IF .?.JBDDT<RH> EQL 0 THEN RETURN ERROR(21);
JRST(0,@?.JBDDT);
END;
IF TOPS20
THEN
BEGIN
OWN SAVENTVEC;
1<0,36> = #400000000770; ! THIS PROCESS, PAGE 770
JSYS(0,#057); ! RPACS
IF (.2<0,36> AND #010000000000) EQL 0 ! IF THIS PAGE DOES NOT EXIST
THEN
BEGIN
1<0,36> = #400000; ! THIS PROCESS
JSYS(0,#205); ! GEVEC
SAVENTVEC = .2<0,36>; ! SAVE ENTRY VECTOR (GET DOES IT IN)
1<0,36> = #100011000000; ! OLD FILE, PHYSICAL, SHORT CALL
2<0,36> = (UPLIT ASCIZ 'SYS:UDDT.EXE')<36,7>; ! FILE SPEC
JSYS(0,#020); ! GTJFN
JRST(4,0); ! FAIL
1<18,18> = #400000; ! THIS PROCESS, JFN IN RIGHT HALF
JSYS(0,#200); ! GET
1<0,36> = #400000; ! THIS PROCESS
2<0,36> = .SAVENTVEC; ! ENTRY VECTOR
JSYS(0,#204); ! SEVEC
IF .?.JBSYM NEQ 0 ! ENSURE SYMBOLS LOADED
THEN #770001<0,36,0,1> = .?.JBSYM; ! COPY POINTER INTO DDT
#770002<0,36,0,1> = .?.JBUSY; ! ALSO UNDEFINED SYMBOL POINTER
END;
JRST(0,#770000); ! ALWAYS LOADES AT 770000
END;
.VREG
END;
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);
OUTS(' == ');
PRDISP(@@A);
CRLF;
A = .A+1
END;
.VREG
END;
ROUTINE GOER=
BEGIN
IF ISON(TRACEFLG) THEN DECRTOG;
GOFLG = 1;
.VREG
END;
ROUTINE DISAB=(SETOFF(ENABFLG); .VREG);
ROUTINE XSTRACE=
BEGIN
IF .OPQCNT GTR 0
THEN
BEGIN
OPQCNT = 0;
DECR J FROM .NROUTS TO 0 DO
ROUTS[.J,0,FW] = .ROUTS[.J,0,FW] AND NOT (IDIDOFFV+PREVOFFV)
END;
SETON(TRACEFLG);
.VREG
END;
ROUTINE XCLRTRACE=(SETOFF(TRACEFLG); .VREG);
ROUTINE XGOTRACE=(XSTRACE(); GOER());
ROUTINE NOSIX12=
IF .ERRORFLG EQL 0 THEN (?.JB41 = #255^27; GOER());
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(' decimal?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);
0
TES )
THEN (TAB; PRSYM50(MODDDT(.P)));
CRLF;
.VREG
END;
ROUTINE PRS=
BEGIN
LOCAL NAME,P;
INCR I FROM 0 TO .SIXRC-1 DO
BEGIN
P = 0;
NAME = @(.SIXRP+.I);
INCR J FROM 1 DO
BEGIN
IF (P = NSDDTFA(.NAME,.P)) EQL 0
THEN
BEGIN
IF .J EQL 1
THEN (TTOUTS('No entry for '); PRSYM50(.NAME); CRLF);
EXITLOOP
END;
PRSYM50(.NAME);
OUTC("%");
OUTDEFAULT(.J);
PPSYM(.P)
END;
END;
.VREG
END;
FORWARD PUSHOPER;
ROUTINE XPRS=
!
! COMMAND: PRS name ,...
!
BEGIN
QUOTFLG = (-1)^(-1);
PUSHOPER(4^18 + UPLIT(0, 10^18+PRS<ADR>, 0, 0)<ADR>);
.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
BEGIN
TNAME[.X] = .R50NAME MOD #50;
IF (R50NAME = .R50NAME / #50) EQL 0 THEN EXITLOOP .X
END;
IF 5-.TCNT GTR .CNT THEN EXITBLOCK;
INCR X FROM 0 TO .CNT DO
BEGIN
IF .NAME[.X] NEQ 0
THEN
IF .NAME[.X] NEQ .TNAME[.TCNT] THEN EXITBLOCK;
TCNT = .TCNT+1
END;
PRSYM50(@@P);
PPSYM(.P)
END;
.VREG
END;
ROUTINE XRETURN=
!
! COMMAND: RETURN exp
!
BEGIN
IF .RTNLVL EQL 0
THEN ! FIX UP ENTRY...
BEGIN
REGISTER L;
MACRO POPADR=(.ENTERPNT-1)<RH>$;
L = FNDDBGUUO(.?.JBUUO,1);
IF .L LEQ 0
THEN (PRXDISP(.POPADR); RETURN ERROR(6));
POPADR = .L+1;
END;
SIXVREG = @@SIXRP;
GOER()
END;
ROUTINE XDEL2=
! DELETE NAME FROM MACRO TABLE.
! SPACE FOR NAME IS RECOVERED, BUT SPACE FOR DEFINITION IS NOT.
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
BEGIN
IF .PNT LSS .NNAMES
THEN
BEGIN
SIXNAMES[.PNT,0,FW] = .SIXNAMES[.NNAMES,0,FW];
SIXNAMES[.PNT,1,FW] = .SIXNAMES[.NNAMES,1,FW]
END;
NNAMES = .NNAMES-1
END
END;
.VREG
END;
ROUTINE XDEL1=
!
! COMMAND: FORGET name ,...
!
! CREATE OPERATOR FOR EXECUTION AFTER LIST OF NAMES IS BUILT.
BEGIN
QUOTFLG = (-1)^(-1);
PUSHOPER(4^18 + UPLIT(0, 10^18+XDEL2<ADR>, 0, 0)<ADR>);
.VREG
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=
IF .SIXBLS NEQ 0
THEN
BEGIN
REGISTER R;
SIXVC = .SIXVC+1;
SIXVP = VTEMP<ADR>;
R = @@SIXLP;
VTEMP =
(IF @@SIXRP GTR 0
THEN LSH(R,@@SIXRP)
ELSE ASH(R,@@SIXRP));
.VREG
END
ELSE
APPLY(^);
FORWARD CONTENTS;
ROUTINE ATSIGN=
BEGIN
(.SIXRP)<LH> = 0;
CONTENTS()
END;
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=
BEGIN
IF (.(.SIXRP)<POS> + .(.SIXRP)<SIZ>) GTR 36 OR .(.SIXRP)<INDXDX> NEQ 0
THEN (PRMVALSNAM(@@SIXRP); RETURN ERROR(18));
SIXVC = 1;
SIXVP = VTEMP<ADR>;
VTEMP =
IF .(.SIXRP)<LH> EQL 0 THEN @@@SIXRP ELSE .(@@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,SAVJBUUO;
OWN ARGCOUNT; ! MUST BE OWN FOR STACK TRACE TO FIND
SCOUNT = .ARGCOUNT;
SAVEGO = .GOFLG;
SAVJBUUO = .?.JBUUO;
GOFLG = 1; ! DON'T STOP IN ROUTINE
IF ISNOTFRED OR WITHINSIX12(.(.SIXLP)<RH>)
THEN
!B-10 & B-36C
BEGIN
ARGCOUNT = .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 - .ARGCOUNT; ! POP PARMS
END
ELSE IF ISFRED THEN
!B-36
BEGIN
ARGCOUNT = (-.SIXRC)^18;
PUSH(SREG,ARGCOUNT);
AREG = .SREG+1;
ARGCOUNT = (.SIXRC+1)^18 + (.SIXRC+1);
INCR I FROM 0 TO .SIXRC-1 DO
PUSH(SREG,(.SIXRP+.I));
(@@SIXLP) ();
SREG = .SREG - .ARGCOUNT;
END;
VTEMP = .VREG; ! MUST BE AFTER STACK SUBTRACT
?.JBUUO = .SAVJBUUO;
GOFLG = .SAVEGO;
ARGCOUNT = .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; ! P & S FIELDS
SIXVP = .SIXLP;
SIXVC = 1;
(.SIXVP)<LH> = .R;
IF ((@@SIXRP LSS 0) OR (@@SIXRP GTR #77) OR
(@(@SIXRP+1) LSS 0) OR (@(@SIXRP+1) GTR #77))
THEN
BEGIN
PRDISP(.(.SIXLP)<RH>);
OUTC("<");
OUTD(@@SIXRP);
OUTC(",");
OUTD(@(@SIXRP+1));
OUTC(">");
ERROR(18);
END;
.VREG
END;
ROUTINE STRUCT=
BEGIN
REGISTER R;
IF .SIXRC EQL 2 OR .SIXRC GTR 4 THEN RETURN ERROR(3);
SIXVP = .SIXLP;
IF .SIXREF THEN @SIXVP = @@@SIXVP;
(.SIXVP)<RH> = .(.SIXVP)<RH> + @@SIXRP;
SIXVC = 1;
IF .SIXRC GTR 1
THEN
BEGIN
R = #77 AND @(@SIXRP+1);
R = ( (.R^6) OR (#77 AND @(@SIXRP +2)) ) ^6; ! P & S FIELDS
(.SIXVP)<LH> = .R;
END;
.VREG
END;
!
! FILE SERVICE ROUTINES FOR SAVE AND LOAD COMMANDS
!
ROUTINE INTEXT=
BEGIN
REGISTER W;
WHILE ISOFF(ERRORFLG) DO
BEGIN
IF (W = INWORD()) EQL 0 THEN RETURN .VREG;
(.PTEXT)<FW> = .W;
PTEXT = .PTEXT+1;
IF .PTEXT<RH> GEQ TEXTAREA[2*NMACROS] THEN RETURN ERROR(12);
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
!
! THESE DECLARATIONS USED ONLY BY TOPS-10 CODE BELOW
!
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;
IF TOPS10
THEN
BEGIN
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);
END;
IF TOPS20
THEN
BEGIN
(.SIXRP+.SIXRC)<FW> = 0; ! GUARANTEE ASCIZ STRING
IF ISON(ISINPUT)
THEN
BEGIN
1<0,36> = #100001000000; ! OLDFILE, SHORT CALL
2<0,36> = (.SIXRP)<36,7>; ! FILE SPEC
IFSKIP JSYS(0,#020) ! GTJFN
THEN .VREG ! DON'T CLOBBER AC1
ELSE RETURN ERROR(10); ! OPEN FAILURE
DSKHDR = .1<0,18>; ! SAVE JFN
2<0,36> = #440000200000; ! 36-BIT BYTES, READ ACCESS
IFSKIP JSYS(0,#021) ! OPENF
THEN 0 ! SUCCESS
ELSE RETURN ERROR(10); ! OPEN FAIULURE
END
ELSE
BEGIN
1<0,36> = #600001000000; ! NEW FILE, SHORT CALL
2<0,36> = (.SIXRP)<36,7>; ! FILE SPEC
IFSKIP JSYS(0,#020) ! GTJFN
THEN .VREG ! TO AVOID CLOBBERING AC1
ELSE RETURN ERROR(10); ! OPEN FAILURE
DSKHDR = .1<0,18>; ! SAVE JFN
2<0,36> = #440000100000; ! 36-BIT BYTES, WRITE ACCESS
IFSKIP JSYS(0,#021) ! OPENF
THEN 0 ! SUCCESS
ELSE RETURN ERROR(10); ! OPEN FAILURE
END;
END;
1
END;
ROUTINE SIXSAVE=
BEGIN
LOCAL SAVFF;
IF TOPS10 THEN SAVFF = .?.JBFF;
IF NOT FILEOPEN(0) THEN RETURN .VREG;
SETOFF(ERRORFLG);
OUTWORD(.SIXTOG);
OUTWORD(.DCNT);
OUTWORD(.SIXREF);
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 TOPS10
THEN
BEGIN
IF ISON(ERRORFLG)
THEN (ERROR(11); CLOSE(SLCHN,#40))
ELSE CLOSE(SLCHN,0);
RELEASE(SLCHN,0);
?.JBFF = .SAVFF;
END;
IF TOPS20
THEN
BEGIN
1<0,36> = .DSKHDR; ! GET JFN
JSYS(0,#022); ! CLOSF
VREG = 0; ! IGNORE FAILURE
END;
.VREG
END;
ROUTINE SIXLOAD=
!
! COMMAND: LOAD 'file-spec'
!
BEGIN
REGISTER W,W2;
LOCAL SAVFF;
IF TOPS10 THEN SAVFF = .?.JBFF;
IF NOT FILEOPEN(1) THEN RETURN .VREG;
SETOFF(ERRORFLG);
NVALS = NNAMES = NROUTS = -1;
PTEXT = TEXTAREA<36,7>;
SIXTOG = INWORD();
DCNT = INWORD();
SIXREF = 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
IF .NNAMES GEQ NMACROS
THEN
EXITLOOP ERROR(13);
SIXNAMES[(NNAMES = .NNAMES+1),0,FW] = .W;
SIXNAMES[.NNAMES,1,FW] = .PTEXT<RH>;
INTEXT();
IF .ERRORFLG THEN EXITLOOP;
END;
WHILE (W = INWORD()) NEQ -1 DO
BEGIN ! RETRIEVE ROUTINE ENTRY
LOCAL SAVERR;
SAVERR = .ERRORFLG;
ROUTS[(NROUTS = .NROUTS+1),0,FW] = .W;
IF (.W AND (BREAKV+OPQATV+OPQAFTV+TRCATV+TRCAFTV)) NEQ 0
THEN SETTBLBIT(.W<RH>,0);
IF (.W AND (ABREAKV+OPQATV+OPQAFTV+TRCATV+TRCAFTV)) NEQ 0
THEN SETTBLBIT(.W<RH>,1);
ERRORFLG = .SAVERR; ! IGNORE ERRORS FROM SETTBLBIT ROUTINE
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
BEGIN
PTR = .PTEXT<RH>;
(.PTEXT)<FW> = .W2;
PTEXT = .PTEXT+1;
INTEXT()
END
ELSE
PTR = 0
END
ELSE
PTR = 0
END
END;
IF ISON(ERRORFLG) THEN (NVALS = NNAMES = NROUTS = -1; ERROR(11));
IF TOPS10
THEN
BEGIN
CLOSE(SLCHN,0);
RELEASE(SLCHN,0);
?.JBFF = .SAVFF;
END;
IF TOPS20
THEN
BEGIN
1<0,36> = .DSKHDR; ! GET JFN
JSYS(0,#022); ! CLOSF
VREG = 0; ! IGNORE FAILURE
END;
.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,
SIXID,
XPRINT;
ROUTINE XIDENT=
BEGIN
EXTERNAL ?.DREGS; ! PRESERVE MASK FROM BLISS-10 COMPILER
BIND
NONSTD = UPLIT ASCIZ 'non-standard assignments',
DFLT = UPLIT ASCIZ 'default linkage',
ERRONS = UPLIT ASCIZ 'erroneous assignments';
SIXID();
OUTS('Using ');
CASE .SIXBLS OF
SET
%0: B-10%
OUTSA(
CASE LINKTYPE OF
SET
%0% NONSTD;
%1% DFLT;
%2% UPLIT ASCIZ '"/Z" option';
%3% ERRONS;
TES);
%1: B-36C%
OUTSA(
CASE LINKTYPE OF
SET
%0% NONSTD;
%1% UPLIT ASCIZ 'BLISS10_REGS option';
%2% DFLT;
%3% ERRONS;
TES);
%2: B-36%
OUTSA(
CASE LINKTYPE OF
SET
%0% NONSTD;
%1% UPLIT ASCIZ 'BLISS10 linkage';
%2% DFLT;
%3% UPLIT ASCIZ 'BLISS linkage';
TES);
TES;
OUTS(' with registers (decimal):?M?J');
OUTS(' Stack pointer: '); OUTD(SREG<ADR>); CRLF;
OUTS(' Frame pointer: '); OUTD(FREG<ADR>); CRLF;
IF ISFRED THEN
(OUTS(' Argument pointer: '); OUTD(AREG<ADR>); CRLF);
OUTS(' Value register: '); OUTD(VREG<ADR>); CRLF;
OUTS(' Preserve mask (octal): '); OUTN(-?.DREGS AND #177777, 8, 6); CRLF;
.VREG
END;
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(RESET, 50,XRESET, 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, 10,XPRINT, 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, 50,XPRS, 0,0, 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, 10,XCHNG, 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),
ANAME(IDENT, 50,XIDENT, 0,0, 0,0, 0,0),
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, 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, 20,SLASH),
ACHAR("/", 0,0, 0,0, 20,SLASH, 40,XDIV),
0 );
PAGE
BIND BRACEVAL = 10000;
ROUTINE EQUALS0=
ERROR(7);
ROUTINE XDEFINE=
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
BEGIN
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)
END;
DEFOPTAB[.ENTRY+1+.PARSE]<LH> = @@SIXRP;
DEFOPTAB[.ENTRY+1+.PARSE]<RH> = @(.SIXRP+1);
.VREG
END;
ROUTINE XBIND=
BEGIN
REGISTER R; ! BIND (CREATE DDT-SYMBOL)
LOCAL S;
R = .?.JBSYM - #2000002;
IF (S = NSDDTFA(RADIX50 "PAT..", 0)) EQL 0
THEN
RETURN ERROR(15)
ELSE
IF .R<RH> LSS @(.S+1)
THEN RETURN ERROR(15);
(.R)<FW> = @@SIXLP OR 1^32; ! DEFINE AS GLOBAL SYMBOL
(.R+1)<FW> = @@SIXRP;
?.JBSYM = .R;
.VREG
END;
ROUTINE XMACRO=
BEGIN ! MACRO DEFINITION
IF .NNAMES GEQ NMACROS THEN RETURN ERROR(13);
DECR J FROM .NNAMES TO 0 DO
IF @@SIXLP EQL .SIXNAMES[.J,0,FW] THEN RETURN ERROR(14);
SIXNAMES[(NNAMES = .NNAMES+1),0,FW] = @@SIXLP;
SIXNAMES[.NNAMES,1,FW] = @@SIXRP;
.VREG
END;
ROUTINE XASSIGN=
BEGIN ! ORDINARY ASSIGNMENT
IF .(@SIXLP)<LH> EQL 0
THEN !ADD P,S =<FW>
(@SIXLP)<LH> = #004400;
IF (.(.SIXLP)<POS> + .(.SIXLP)<SIZ>) GTR 36 OR .(.SIXLP)<INDXDX> NEQ 0
THEN (PRMVALSNAM(@@SIXLP); RETURN ERROR(18));
@@SIXLP = @@SIXRP;
IF .NVALS GEQ 0 THEN CKVALS(0,-2); ! CHECK MONITORED LOCATIONS
.VREG
END;
BIND EQUALSDISP =
UPLIT(EQUALS0,XDEFINE,XBIND,XMACRO,XASSIGN);
ROUTINE EQUALS= (.EQUALSDISP[.MODEFLG])(); ! DISPATCH TO SPECIFIC ROUTINE
!
! COMMAND: PRINT
!
FORWARD
XPRINT0,
XPRINTOPER,
XPRINTACT,
XPRINTMACRO;
BIND
XPRINTDISP = UPLIT(XPRINT0,XPRINTOPER,XPRINTACT,XPRINTMACRO,XPRINTMON);
ROUTINE XPRINT = (.XPRINTDISP[.MODEFLG])(); !DISPATCH TO SPECIFIC ROUTINES
ROUTINE XPRINT0 = ERROR(2);
ROUTINE XPRINTOPER =
!
! COMMAND: PRINT OPER
!
BEGIN
REGISTER PNTR; ! OPERATOR
IF .SIXRC GTR 1 THEN RETURN ERROR(3);
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
BEGIN
OUTS('?M?JNull?I');
OUTDR(.(.PNTR+1)<LH>,5);
TAB;
PRXDISP(@(.PNTR+1))
END;
IF @(.PNTR+2) NEQ 0
THEN
BEGIN
OUTS('?M?JPrefix?I');
OUTDR(.(.PNTR+2)<LH>,5);
TAB;
PRXDISP(@(.PNTR+2))
END;
IF @(.PNTR+3) NEQ 0
THEN
BEGIN
OUTS('?M?JPostfix?I');
OUTDR(.(.PNTR+3)<LH>,5);
TAB;
PRXDISP(@(.PNTR+3))
END;
IF @(.PNTR+4) NEQ 0
THEN
BEGIN
OUTS('?M?JInfix?I');
OUTDR(.(.PNTR+4)<LH>,5);
TAB;
PRXDISP(@(.PNTR+4))
END;
CRLF;
.VREG
END;
! THE FOLLOWING DEFINITIONS ARE USED BY
! THE "PRINT ACTION" DISPLAY ROUTINES
MACRO
ATM(A,B) = RADIX50 A,B $;
BIND
ALLACTV = ! ALL ACTION BITS
BREAKV+ABREAKV+OPQATV+OPQAFTV+TRCATV+TRCAFTV,
ACTTBL =
PLIT (
ATM("BREAK",BREAKV),
ATM("ABREAK",ABREAKV),
ATM("OPAQ",OPQATV),
ATM("OPAQAF",OPQAFTV),
ATM("TRACE",TRCATV),
ATM("TRACEA",TRCAFTV),
ATM("ALL",ALLACTV));
ROUTINE ACTBIT2NAM(BIT) =
! CONVERT BIT MASK TO PRINT NAME
(DECR J FROM .ACTTBL[-1]/2-2 TO 0 DO
IF .ACTTBL[.J*2+1] EQL .BIT
THEN EXITLOOP .ACTTBL[.J*2]);
ROUTINE ACTNAM2BIT(NAM) =
! CONVERT PRINT NAME TO BIT MASK
BEGIN
REGISTER R;
R =
DECR J FROM .ACTTBL[-1]/2-1 TO 0 DO
IF .ACTTBL[.J*2] EQL .NAM
THEN EXITLOOP .ACTTBL[.J*2+1];
IF .R EQL -1 THEN RETURN 0;
.R
END;
ROUTINE PR1ACTION(NAME,TYPE) =
! PRINT ONE ACTION
BEGIN
LOCAL P,T,T1,TV;
IF (P = CFINDR(.NAME)) LSS 0
THEN (OUTS('No actions set?M?J'); RETURN .VREG);
T = .ROUTS[.P,0,FW] AND .TYPE; !ACTIONS TO DISPLAY
IF .T NEQ 0 AND .SIXRC EQL 1
THEN
BEGIN
OUTS('Routine ');
PRXDISP(.ROUTS[.P,0,FW]);
CRLF
END;
WHILE .T NEQ 0 DO
BEGIN
T1 = 17 - FIRSTONE(.T); ! SELECT AN ACTION
TV = 1^(18+.T1); ! MAKE BACK TO BIT MASK
T = .T AND NOT .TV; ! CLEAR FOR NEXT LOOP
IF .TYPE EQL ALLACTV
THEN
BEGIN
PRSYM50(ACTBIT2NAM(.TV));
OUTS(':?I')
END;
TV =
IF .T1
THEN .ROUTS[.P,1+.T1^(-1),LH]
ELSE .ROUTS[.P,1+.T1^(-1),RH];
IF .TV EQL 0
THEN
OUTS('Unconditional?M?J')
ELSE
BEGIN
TV = (.TV)<36,7>;
WHILE (T1 = SCANI(TV)) NEQ #177 DO OUTC(.T1);
CRLF
END
END;
.VREG
END;
ROUTINE XPRINTACT =
!
! COMMAND: PRINT ACTION TYPE [NAME]
!
BEGIN
LOCAL TMP;
IF .SIXRC LSS 1 OR .SIXRC GTR 2 THEN RETURN ERROR(3);
IF (TMP = ACTNAM2BIT(@@SIXRP)) EQL 0 THEN RETURN ERROR(8);
IF .SIXRC EQL 2
THEN
! DISPLAY GIVEN NAME
PR1ACTION(@(.SIXRP+1),.TMP)
ELSE
! DISPLAY ALL NAMES FOR THIS ACTION
BEGIN
IF .NROUTS EQL -1
THEN (OUTS('No actions set?M?J'); RETURN .VREG);
DECR J FROM .NROUTS TO 0 DO
PR1ACTION(.ROUTS[.J,0,FW],.TMP);
END;
.VREG
END;
ROUTINE PR1MACRO(NAME) =
! PRINT ONE MACRO DEFINITION
BEGIN
LOCAL PNTR,C;
PNTR =
DECR J FROM .NNAMES TO 0 DO
IF .NAME 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;
ROUTINE XPRINTMACRO =
!
! COMMAND: PRINT MACRO [NAME]
!
BEGIN
IF .SIXRC GTR 1 THEN RETURN ERROR(3);
IF .SIXRC EQL 1
THEN
! PRINT GIVEN MACRO
PR1MACRO(@@SIXRP)
ELSE
! PRINT ALL MACROS
BEGIN
LOCAL P;
IF .NNAMES EQL -1
THEN (OUTS('No macros defined?M?J'); RETURN .VREG);
DECR J FROM .NNAMES TO 0 DO
BEGIN
P = .SIXNAMES[.J,0,FW];
PRSYM50(.P);
OUTS(' =?I');
PR1MACRO(.P);
END
END;
.VREG
END;
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
BEGIN
IF .NPCHAR EQL 0 THEN NCHAR = .NCHAR+1;
CHAR = SCANI(PCHAR[.NPCHAR]);
IF .CHAR EQL #177
THEN
BEGIN
NPCHAR = .NPCHAR-1;
CHAR = " "; ! FORCE BREAK AT END OF MACRO
END;
.VREG
END;
ROUTINE TYPE(TFLAG)=
!
! DETERMINE TYPE OF CHARACTER IN CHAR FOR INPUT SCANNING.
! TFLAG = 0 FOR NORMAL NAME, = 1 FOR NAME STARTING WITH "?".
!
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;
IF .CHAR EQL "&" THEN RETURN 1;
IF .SIXBLS NEQ 0
THEN
IF ((.CHAR EQL "_") OR (.CHAR EQL "$"))
THEN RETURN 1;
IF ((.CHAR EQL ".") OR (.CHAR EQL "%") OR (.CHAR EQL "$")) AND .TFLAG
THEN RETURN 1;
SELECT .CHAR OF
NSET
"#" : EXITSELECT 2;
#42 : EXITSELECT 3; ! ASCII "
#47 : EXITSELECT 3; ! ASCII '
ALWAYS : 4
TESN
END;
ROUTINE ERROR(EN)=
BEGIN
SETON(ERRORFLG);
IF .EN LEQ 4
OR .EN EQL 16
OR .EN EQL 17
OR .EN EQL 22
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 decimal');
%6% TTOUTS(': No debug linkage found for this routine');
%7% TTOUTS('Invalid equals');
%8% TTOUTS('Name action type by BREAK, ABREAK, OPAQ, OPAQAF, TRACE, TRACEA or ALL');
%9% TTOUTS('Improper file-spec');
%10% TTOUTS('Open failure ');
%11% TTOUTS('Transmission error');
%12% TTOUTS('No space for macro text');
%13% TTOUTS('No space for macro name definition');
%14% TTOUTS('Name already defined');
%15% TTOUTS('No space for symbol definition');
%16% (TTOUTS('Digit invalid for base '); OUTD(.IOBASE));
%17% TTOUTS('Actual/Local index out of range');
%18% TTOUTS(': Invalid field reference (byte pointer)');
%19% TTOUTS('Line printer file not open');
%20% TTOUTS('Line printer file still open');
%21% TTOUTS('DDT not loaded');
%22% (TTOUTS('Multiple definitions in DDT symbol table for '); PRSYM50(.ERRORPARM));
TES;
IF TOPS20
THEN
IF .EN EQL 10
THEN
BEGIN
1<0,36> = #101; ! WRITE ON .PRIOU
2<0,36> = #400000777777; ! THIS PROCESS, LAST ERROR
3<0,36> = 0; ! NO SIZE LIMIT
JSYS(0,#011); ! ERSTR
JFCL(0,0); ! FAIL
JFCL(0,0); ! FAIL
END;
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;
IF TYPE(0) NEQ 0 THEN RETURN ERROR(2);
WHILE TYPE(0) EQL 0 DO
BEGIN
IF (.CHAR - "0") GEQ .IOBASE
THEN (NCHAR = .NCHAR+1; ERROR(16));
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()
END;
.VAL[0]
END;
ROUTINE GETSYMBOL(TFLAG)= ! GET RADIX-50 REPRESENTATION OF SYMBOL
BEGIN
REGISTER Z,N;
Z = 0;
N = 6;
WHILE 1 DO
BEGIN
IF (N = .N-1) GEQ 0
THEN (Z = #50 * .Z + F7TO50(.CHAR));
ADVANCE();
IF TYPE(.TFLAG) GTR 1 THEN EXITLOOP
END;
.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
BEGIN
REPLACEI(PTEXT, .CHAR);
IF .PTEXT<RH> GEQ TEXTAREA[2*NMACROS] THEN RETURN ERROR(12);
ADVANCE()
END
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;
ROUTINE GETSTRING=
BEGIN
REGISTER HOLD;
IF .CHAR EQL #47
THEN
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
BEGIN
ADVANCE();
IF ENDOFLINE THEN EXITLOOP;
IF .CHAR EQL #47 THEN (ADVANCE(); IF .CHAR NEQ #47 THEN EXITLOOP);
REPLACEI(HOLD, .CHAR)
END;
(.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
BEGIN
ADVANCE();
IF ENDOFLINE THEN EXITLOOP;
IF .CHAR EQL #42 THEN (ADVANCE(); IF .CHAR NEQ #42 THEN EXITLOOP);
HOLD = .HOLD^7 + .CHAR
END;
IF (QUOTFLG = .QUOTFLG-1) GEQ 0 THEN HOLD = .HOLD^18; ! KLUDGE FOR DEFINING CHARACTER OPERATORS
PUSHITEM(.HOLD);
END;
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
BEGIN
IF BRACE(LASTOP) THEN EXITCOND [3];
IF .CURRNTOP GEQ 0 THEN EXITLOOP
END;
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,TFLAG,COUNT;
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 THEN (GOFLG = 2; RETURN 0); ! NEVER "GO" AFTER ERROR
IF .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
BEGIN
TAB;
OUTRDEF(.DBGSTK[.HOLD+.J],14);
OUTS(' == ');
PRDISP(.DBGSTK[.HOLD+.J]);
CRLF
END;
RETURN .DBGSTK[.HOLD];
END;
TFLAG = 0;
IF .CHAR EQL "??"
THEN
BEGIN
TFLAG = 1;
ADVANCE();
IF TYPE(.TFLAG) NEQ 1 THEN EXITLOOP ERROR(2)
END;
CASE TYPE(.TFLAG) OF
SET
%0 NUMBER% BEGIN
IF .QUOTFLG GTR 0
THEN (ADVANCE(); EXITCASE ERROR(2));
T = GETNUMBER();
WHILE .CHAR EQL " " OR .CHAR EQL "?I" DO ADVANCE();
IF .CHAR EQL "%"
THEN
BEGIN
ADVANCE();
NAME = GETSYMBOL(.TFLAG);
SELECT .NAME OF
NSET
RADIX50 "A" : T = GETARGADR(.T,0);
RADIX50 "L" : T = GETLCLADR(.T,0);
OTHERWISE : EXITCASE ERROR(2);
TESN;
IF .T EQL -1 THEN EXITCASE ERROR(17);
END;
PUSHITEM(.T);
END;
%1 SYMBOL% BEGIN
!
! GET A SYMBOL AND HANDLE MACROS OR QUALIFICATION
!
NAME = GETSYMBOL(.TFLAG);
IF (QUOTFLG = .QUOTFLG-1) GEQ 0
THEN EXITCASE PUSHITEM(.NAME);
WHILE .CHAR EQL " " OR .CHAR EQL "?I" DO ADVANCE();
IF .CHAR NEQ "%"
THEN
BEGIN
! LOOK FOR MACRO DEFINITION
DECR J FROM .NNAMES TO 0 DO
IF .SIXNAMES[.J,0,FW] EQL .NAME
THEN
BEGIN
! BACK UP CURRENT POINTER
BIND P = PCHAR[.NPCHAR]<ADR>;
IF .P<POS> GTR 29
THEN
BEGIN
P<POS> = 8;
P<RH> = .P<RH>-1;
END
ELSE
P<POS> = .P<POS>+7;
! START MACRO TEXT
NPCHAR = .NPCHAR+1;
PCHAR[.NPCHAR] = (.SIXNAMES[.J,1,FW])<36,7>;
ADVANCE();
EXITCASE
END;
END;
! HAVE "%" OR NON-MACRO
T = -1; !ALLOWS OPERATOR OR USER NAME
IF .CHAR EQL "%"
THEN
BEGIN
ADVANCE();
T = GETNUMBER();
IF .ERRORFLG NEQ 0 THEN EXITCASE;
END;
IF .T LEQ 0
THEN
! LOOK FOR OPERATOR
BEGIN
HOLD = GETOP(.NAME);
IF .HOLD NEQ -1
THEN EXITCASE OPERATE(.HOLD)
ELSE IF .T EQL 0 THEN EXITCASE ERROR(0);
END;
IF .T EQL -1
THEN
! UNQUALIFIED NAME
BEGIN
HOLD = 0;
COUNT = 0;
WHILE 1 DO
BEGIN
HOLD = NSDDTFA(.NAME,.HOLD);
IF .HOLD EQL 0 THEN EXITLOOP;
IF .(.HOLD)<32,2> NEQ 0
THEN
IF .COUNT EQL 0
THEN COUNT = .HOLD
ELSE EXITCASE (ERRORPARM = @@HOLD; ERROR(22));
END;
IF .COUNT EQL 0
THEN EXITCASE ERROR(0)
ELSE EXITCASE PUSHITEM(@(.COUNT+1));
END;
! MUST BE QUALLIFIED USER SYMBOL
HOLD = 0; ! TO START SYMBOL SEARCH
COUNT = .T;
WHILE .COUNT NEQ 0 DO
BEGIN
HOLD = NSDDTFA(.NAME,.HOLD);
IF .HOLD EQL 0 THEN EXITCASE ERROR(0);
IF .(.HOLD)<32,2> NEQ 0 THEN COUNT = .COUNT-1; ! SKIP MODULE NAMES
END;
PUSHITEM(@(.HOLD+1));
END;
%2 # SIGN% BEGIN
IF .QUOTFLG GTR 0
THEN (ADVANCE(); EXITCASE ERROR(2));
IOBASE =
IF (HOLD = .IOBASE) EQL 8 THEN 10 ELSE 8;
ADVANCE();
PUSHITEM(GETNUMBER());
IOBASE = .HOLD
END;
%3 STRING% BEGIN
IF .QUOTFLG GTR 0
THEN (ADVANCE(); EXITCASE ERROR(2));
GETSTRING();
END;
%4 OTHER%
BEGIN
IF .CHAR EQL "="
THEN
BEGIN
QUOTFLG = 0;
IF .MODEFLG EQL 0 THEN MODEFLG = 4
END;
HOLD = GETOP(.CHAR^18);
ADVANCE();
IF .HOLD LSS 0 THEN ERROR(1) ELSE OPERATE(.HOLD)
END
TES;
END;
CHAR = #15;
0
END;
ROUTINE INPUT=
BEGIN
OWN TXIBUF[9];
IF TOPS10
THEN
BEGIN
PCHAR[0] = BUFF<36,7>;
DO (CHAR = INC; REPLACEI(PCHAR[0], .CHAR)) UNTIL .CHAR EQL #12;
REPLACEN(PCHAR[0], #15);
END;
IF TOPS20
THEN
BEGIN
TXIBUF[0] = 8; ! NUMBER OF WORDS FOLLOWING
TXIBUF[1] = #045000000000; ! BREAK ON CRLF, JFN SUPPLIED
TXIBUF[2] = #000100000101; ! .PRIIN,.PRIOU
TXIBUF[3] = BUFF<36,7>; ! DESTINATION STRING
TXIBUF[4] = BUFFSIZE*5; ! LENGTH OF BUFF IN CHARS
TXIBUF[5] = BUFF<36,7>; ! DESTINATION STRING
TXIBUF[6] = (UPLIT ASCIZ '&')<36,7>; ! ^R BREAK
TXIBUF[7] = 0; ! BREAK CHARS NOT SUPPLIED
TXIBUF[8] = BUFF<36,7>; ! BACKUP LIMIT
VREG = TXIBUF<0,0>; ! POINT TO PARAMETER BLOCK
JSYS(0,#524); ! TEXTI
JRST(4,0); ! FAIL
REPLACEN(TXIBUF[3], #15); ! OVERWRITE LF WITH CR
END;
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
BEGIN
IF TOPS10
THEN IFSKIP TTCALL(#13,0) THEN (STOPIT(); GOFLG = 0);
IF TOPS20
THEN
IFSKIP (VREG = #100; JSYS(0,#102)) ! SIBE
THEN 0
ELSE (STOPIT(); GOFLG = 0);
END;
END;
UNTIL .GOFLG DO
BEGIN
DO
BEGIN
IF .GOFLG GTR 0 THEN TTOUTC("&");
INPUT();
END
UNTIL .CHAR NEQ "!";
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] = UPLIT('?M?M?J')<29,7>;
ADVANCE();
NCHAR = 0;
VREG = XDEBUG(0);
TOPOP = TOPSTK = -1;
.VREG
END;
ROUTINE RTRCAFT=
BEGIN
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
END;
ROUTINE RTRCAT=
BEGIN
IF .OPQCNT LEQ 0 AND .TRACEFLG GEQ 0
THEN
IF CHKCOND() THEN TRACEFLG = .TRACEFLG OR NOT 1;
.VREG
END;
ROUTINE ROPQAFT=
BEGIN
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
END;
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=
UPLIT(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 = CFINDR(.RNAME)) 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
BEGIN
CONDPNT =
IF .J
THEN .ROUTPNT[ 1+.J/2, LH]
ELSE .ROUTPNT[ 1+.J/2, RH];
(.RTNSPLIT[.J]) ()
END;
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=
!
! DEBUG UUO HANDLER
! *** MUST NOT HAVE ANY LOCAL, REGISTER, OR DYNAMIC BIND DECLARATIONS ***
!
BEGIN
MACHOP POPJ=#263, XCT=#256, AOS=#350;
IF SAILSW THEN IF .?.JBUUO<OPCODE> NEQ DEBUGUUO THEN JRST(0,SAILUUO,0,1);
IF (SIXTOG = .SIXTOG-1) GTR 0
THEN (DCNT = .DCNT-1; POPJ(SREG,0));
IF NOT ISEXIT
THEN
BEGIN
OWN ECNT;
POP(SREG,VTEMP); ! GET PUSHED ADDRESS BACK
IF .(.VTEMP)<LH> EQL #300^9 ! CAI 0,-
THEN
(ECNT = .(.VTEMP)<RH>; AOS(0,VTEMP))
ELSE
IF .(.VTEMP)<OPCODE> EQL #265 ! JSP -,-
THEN
BEGIN
ECNT = 1;
WHILE 1 DO
BEGIN
IF .(.VTEMP+.ECNT)<LH> EQL (#261^9 OR SREG<ADR>^5) ! PUSH $S,-
THEN
IF .(.VTEMP+.ECNT)<RH> LSS 16
THEN ECNT = .ECNT+1
ELSE EXITLOOP
ELSE
EXITLOOP;
END;
IF .(.VTEMP+.ECNT)<LH> EQL (#270^9 OR SREG<ADR>^5) ! ADD $S,-
THEN ECNT = .ECNT+1;
END
ELSE
ECNT = 0;
UNTIL (ECNT = .ECNT-1) LSS 0 DO
BEGIN
XCT(0,VTEMP,0,1); ! EXECUTE INSTRUCTION(S) AFTER DEBUG UUO
AOS(0,VTEMP); ! PUSH RETURN PAST THEM
END;
PUSH(SREG,VTEMP); ! AND SAVE
END;
JRST(0,CALLEM);
.VREG
END;
GLOBAL BIND SIXUUO = UUOH<ADR>;
! THIS DEFINITION JUST RESULTS IN A SYMBOL TABLE ENTRY
! FOR "SIXRET". THE VALUE IS DEFINE DYNAMICALLY IN INITSIX12.
!
GLOBAL BIND SIXRET = -1;
ROUTINE INITSIX12=
BEGIN
LOCAL T;
TRACEFLG = LPTFLG = OPQCNT = 0;
NROUTS = NVALS = NNAMES = -1;
DCNT = SIXTOG = BGOBASE;
GOFLG = 1;
SIXREF = 0;
NEWOPS = -5;
PTEXT = TEXTAREA<36,7>;
IF (T = NSDDTFA(RADIX50 "SIXSP", 0)) NEQ 0
THEN (.T)<35,1> = 1; ! SUPPRESS OUTPUT
IF (T = NSDDTFA(RADIX50 "SIXRET", 0)) NEQ 0
THEN (.T+1)<FW> = #254^27 OR 1^22 OR ?.JBOPC<ADR>; ! JRST @.JBOPC
IF SIXLSF<0,0> NEQ 0 THEN NOSIXSYMS(); ! KILL LOCAL SYMBOLS FOR SIX12 ITSELF
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;
ROUTINE SIXID=
BEGIN
OUTS('SIX12 ');
OUTSA(VERSION);
IF TOPS10 THEN OUTS(' (TOPS-10 I/O)');
IF TOPS20 THEN OUTS(' (TOPS-20 I/O)');
OUTS(' for BLISS-');
OUTSA( CASE .SIXBLS OF
SET
UPLIT ASCIZ '10';
UPLIT ASCIZ '36C';
UPLIT ASCIZ '36';
TES );
CRLF;
.VREG
END;
ROUTINE SIX12A(XP)=
!
! COMMON INITIALIZATON CODE
!
BEGIN
REGISTER SAVE[3];
SAVE[0] = .SIXVREG;
SIXVREG = .VREG;
SAVE[1] = .RTNLVL;
SAVE[2] = .ENTERPNT;
ENTERPNT = @.FREG;
IF .SIXSTK EQL 0 THEN SIXSTK = .SREG;
SELECT .XP OF
NSET
#400000000000: ! MAIN PROGRAM ENTRY
BEGIN
INITSIX12();
IF .STARTFLG NEQ 0
THEN (GOFLG = 2; SIXID(); EXITSELECT SETINTERNAL)
ELSE RETURN .SIXVREG
END;
#377777000000: ! MAIN PROGRAM EXIT (NOT USED?)
RETURN .SIXVREG;
ALWAYS: ! USER CALL
BEGIN
STOPIT();
CRLF;
OUTS('Pause ');
OUTDEFAULT(.XP);
SIXVREG = .(@@ENTERPNT-1)<RH>;
IF WITHINSIX12(.SIXVREG)
THEN OUTS(' from "within SIX12"')
ELSE (OUTS(' at '); PRDISP(.SIXVREG));
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];
IF .SIXSTK EQL 0
THEN
BEGIN
TTOUTS('You must initialize SIX12?M?J');
TTOUTS('Use "PUSHJ SIXSP,xxx" where xxx is SIX10, SIX36C or SIX36?M?J');
RETURN .VREG
END;
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];
TTOUTS('Return to DDT?M?J');
.VREG
END;
GLOBAL ROUTINE SIXDDT=
BEGIN
SIXDD2();
JRST(0,@?.JBDDT);
.VREG
END;
GLOBAL ROUTINE SIX10=
!
! DYNAMIC INITIALIZATION USED FOR BLISS-10 COMPILER
!
BEGIN
SIXBLS = 0;
SIX12A(1^35)
END;
GLOBAL ROUTINE SIX36C=
!
! INITIALIZATION ENTRY USED FOR BLISS-36C COMPILER
!
BEGIN
PUSH(SREG,9);
PUSH(SREG,7);
SIXBLS = 1;
SIX12A(1^35);
POP(SREG,7);
POP(SREG,9);
.VREG
END;
GLOBAL BIND SIX12C = SIX36C<ADR>;
GLOBAL ROUTINE SIX36=
!
! INITIALIZATION ENTRY USED FOR BLISS-36 COMPILER
!
BEGIN
PUSH(SREG,9);
PUSH(SREG,7);
SIXBLS = 2;
SIX12A(1^35);
POP(SREG,7);
POP(SREG,9);
.VREG
END;
ROUTINE ENDSIX12 = .VREG; ! LAST CODE ADDRESS IN SIX12 (EXCEPT ENTRY "SIX12")
GLOBAL ROUTINE SIX12(XP)=
!
! USER CALLABLE ENTRY TO SIX12
!
SIX12A(IF ISFRED THEN @@AREG ELSE .XP);
END
!
! END OF FILE: SIX12.BLI