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

MODULE CRASH=
BEGIN
!
! Conditional compilation
!
MACRO DEB[]=%IF %SWITCHES(DEBUG) %THEN %REMAINING %FI %;
COMPILETIME FTALLOC=((%VARIANT AND %O'4000') NEQ 0);
	!Compile stuff that uses core management package
!
! Forward declarations
!
FORWARD ROUTINE
%NAME('.CRASH');

DEB(	!The following routines are only used while debugging
FORWARD ROUTINE
!ASCIN,	!Get an ascii string (allocates core for it too)
SIXIN,	!Get a sixbit word off TTY
TYPCHR,	!Type a character (no logging)
TYPSTR;	!Type a string (no logging)
)
FORWARD ROUTINE
TBUF,	!Type a byte-mode i/o buffer
TIBUF,	!Type a byte-mode input buffer for NDB
TOBUF;	!Type a byte-mode output buffer for NDB
DEB(
FORWARD ROUTINE
TIBUFA,	!Type the whole buffer (ignore byte count)
TOBUFA,	!	"	"	"
SIXTIB,	!SIX12 operator version of above...
SIXTOB,	!...
SIXTIA,	!...
SIXTOA,	!...
ARGERR,	!'Improper arguments' error
CHPTR;	!initialize a byte pointer
)	!End debug-only
FORWARD ROUTINE
TYPE_TRANSFER; ! Describe the current transfer
!
! Include files & libraries
!

REQUIRE 'INTR.REQ';
LIBRARY 'DAPLIB';
!
! Version
!
MODULE_NAME_IS [CRAS]
VERSION [1] EDIT [6] DATE [3,JAN,78]

!
! Builtin
!
BUILTIN MACHOP,MACHSKIP;
!
! Literals
!
DEB(	!For DDT mostly
GLOBAL LITERAL P=%O'17';
GLOBAL LITERAL PT=XWD(%O'440700',0);
GLOBAL LITERAL CAL=XWD(%O'260740',0);
GLOBAL LITERAL ARG=XWD(%O'261740',0);
)

!
! Field definitions
!
FIELD	IOBUFFER_FIELDS=
	SET
	IOBUFF$STATUS=	[-1,0,18,0],	!File status
	IOBUFF$USE=	[0,34,1,0],	!the USE bit for this buffer
	IOBUFF$NOEOR=	[0,34,1,0],	!The not-end-of-record bit (TSK only)
	IOBUFF$LENGTH=	[0,18,14,0],	!The length of the buffer in words
	IOBUFF$COUNT=	[1,0,18,0],	!The word count of data in buffer
	IOBUFF$BKK=	[1,18,18,0],	!"Bookkeeping word"
	IOBUFF$DATA=	[2,0,0,0]	!Data portion of buffer
	TES;

MACRO	IOBUFFER=BLOCK FIELD(IOBUFFER_FIELDS) %;


!
! Global data
!

DEB(
GLOBAL LINE: VECTOR[64];
GLOBAL PTR: INITIAL(CH$PTR(LINE));
GLOBAL PPTR: INITIAL(PTR);
)	!end debug-only
!
! Macros
!
MACRO HALTJOB=CALLI(1,%O'12')%;

GLOBAL ROUTINE %NAME('.CRASH')=
BEGIN
%IF %SWITCHES(DEBUG)
	%THEN
	EXTERNAL ROUTINE SIX12;
	TYPE (CRLF,'[Entering SIX12]',CRLF);
	SIX12();
	%ELSE
	TYPE(CRLF,'[Please bring this output to your system manager]',CRLF);
	HALTJOB
	%FI
END;
DEB(
ROUTINE TFB(FB)=
!Type a filespec on terminal
BEGIN
MAP FB: REF NDB;
LOCAL STR: VECTOR[CH$ALLOCATION(200)];
EXTERNAL ROUTINE FUNPARSE;

FUNPARSE(.FB,CH$PTR(STR));
TSTR(STR);
END;
%IF FTALLOC %THEN
ROUTINE ASCIN=
!Get an ascii string & return address of it (always allocates 81 chars)
BEGIN
EXTERNAL ROUTINE TTYIN,ALLOC;
LOCAL PTR;
PTR=ALLOC(CH$ALLOCATION(81));
TTYIN(CH$PTR(.PTR),80);
.PTR
END;
%FI

ROUTINE SIXIN=
BEGIN
EXTERNAL ROUTINE TTYIN,RDSIXA;
LOCAL STR:VECTOR[CH$ALLOCATION(10)];
TTYIN(CH$PTR(STR),10);
RDSIXA(%REF(CH$PTR(STR)))
END;
)

MACRO TTCALL(FF,A)=MACHOP(%O'51',FF,A)%;
DEB(
ROUTINE TYPCHR(CHR)=TTCALL(1,CHR);
ROUTINE TYPSTR(STR)=MACHOP(%O'051',3,.STR);
)

ROUTINE TBUF(ADDR,LEN,BSZ)=
BEGIN
MAP	ADDR: REF BLOCK FIELD(IOBUFFER_FIELDS);
GLOBAL	TYPE_ASCII: INITIAL(1),
	TBFPRE: INITIAL('{'),
	TBFPOS: INITIAL('}');

LOCAL PTR,W;

W=777;
PTR=CH$PTR(ADDR[IOBUFF$DATA],0,.BSZ);

DECR C FROM .LEN TO 1
DO	BEGIN
	LABEL TYPE_BYTE;
	W=.W+1;
	IF .W GTR 70 THEN (TYPE(CRLF);W=0);

	TYPE_BYTE: !Type out the byte pointed to by the pointer & inc pointer
		BEGIN
		LOCAL CH;
		CH=CH$RCHAR_A(PTR);
		SELECT .CH OF SET
		[32 TO 126]:	IF .TYPE_ASCII
				THEN (TCHR(.CH);LEAVE TYPE_BYTE);
		TES;
		W=.W+4;
		!Type it in octal
		TSTR(TBFPRE);
		TNUM(.CH);
		TSTR(TBFPOS);
		END;
	END;

TYPE(CRLF);
IF .ADDR[IOBUFF$NOEOR]			!Check the no-end-of-record bit
THEN TYPE('(no end of record)',CRLF);
END;

GLOBAL ROUTINE TIBUF(NB)=
BEGIN
MAP NB: REF NDB;
LOCAL ADDR: REF IOBUFFER;

TYPE('Recv '); TYPE_TRANSFER(.NB);
ADDR=.NB[FILE$I_CBUFF];
TBUF(.ADDR,
 .NB[FILE$I_COUNT],
 .NB[FILE$I_BYTESIZE]);
END;

GLOBAL ROUTINE TOBUF(NB)=
BEGIN
MAP NB: REF NDB;
LOCAL ADDR: REF IOBUFFER;

TYPE('Send '); TYPE_TRANSFER(.NB);
ADDR=.NB[FILE$O_CBUFF];
IF .NB[FILE$O_USE] THEN TYPE('(Dummy out)',CRLF)
ELSE TBUF(.ADDR,
 CH$DIFF(.NB[FILE$O_PTR],CH$PTR(.ADDR+2)),
 .NB[FILE$O_BYTESIZE]);
END;

DEB(
ROUTINE TIBUFA(NB)=
BEGIN
MAP NB: REF NDB;
LOCAL ADDR: REF IOBUFFER;

ADDR=.NB[FILE$I_CBUFF];
TBUF(.ADDR,
 (.ADDR[IOBUFF$LENGTH]*(%BPVAL/.NB[FILE$I_BYTESIZE])),
 .NB[FILE$I_BYTESIZE]);
END;

ROUTINE TOBUFA(NB)=
BEGIN
MAP NB: REF NDB;
LOCAL ADDR: REF IOBUFFER;

ADDR=.NB[FILE$O_CBUFF];
TBUF(.ADDR,
 (.ADDR[IOBUFF$LENGTH]*(%BPVAL/.NB[FILE$O_BYTESIZE])),
 .NB[FILE$O_BYTESIZE]);
END;

!SIX12 operator routines
EXTERNAL
	SIXVC,		!Return arg count
	SIXVP: VECTOR,	!Returned args
	SIXLC,		!Left arg count
	SIXLP: VECTOR,	!Left args
	SIXRC,		!Right arg count
	SIXRP: VECTOR;	!Right args

GLOBAL ROUTINE SIXTIB=
BEGIN
IF .SIXRC EQL 1
THEN TIBUF(.SIXRP[0])
ELSE ARGERR();
SIXVC=0;	!Return nothing
END;

GLOBAL ROUTINE SIXTOB=
BEGIN
IF .SIXRC EQL 1
THEN TOBUF(.SIXRP[0])
ELSE ARGERR();
SIXVC=0;	!Return nothing
END;

GLOBAL ROUTINE SIXTIA=
BEGIN
IF .SIXRC EQL 1
THEN TIBUFA(.SIXRP[0])
ELSE ARGERR();
SIXVC=0;	!Return nothing
END;

GLOBAL ROUTINE SIXTOA=
BEGIN
IF .SIXRC EQL 1
THEN TOBUFA(.SIXRP[0])
ELSE ARGERR();
SIXVC=0;	!Return nothing
END;

ROUTINE ARGERR=(TYPE('?Improper arguments',CRLF));

ROUTINE CHPTR(ADDR)=CH$PTR(.ADDR);
)	!end debug-only

ROUTINE TYPE_TRANSFER(NB)=(EXTERNAL ROUTINE TXFER;TXFER(.NB));


END ELUDOM