Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

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>;