Google
 

Trailing-Edge - PDP-10 Archives - AP-D471B-SB_1978 - report.bli
There are no other files named report.bli in the archive.
!***COPYRIGHT (C) 1974, 1975, 1976, 1977 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.***
%%
%
	THIS MODULE IMPLEMENTS THE REPORT COMMAND.

%
%%

MODULE REPORTX (MLIST,FSAVE,TIMER=EXTERNAL(SIX12)) =
BEGIN
	REQUIRE COMMON.BLI;
	REQUIRE ENTRY.BLI;
COMMENT(SETNAME);

! SUBROUTINE SETNAME
! ========== =======

! THIS ROUTINE PROCESSES THE REPORT NAME FOR 
! THE REPORT COMMAND.
! LAST MODIFIED ON 28 AUG 74 BY JG.

ROUTINE SETNAME (NAME) =
BEGIN
	LOCAL LASTCOUNT,THISCOUNT,THISREP,PAD,DIFF[5];
	LABEL LOOP;
	MAP	REPBLK THISREP:CURREP:FIRREP,
		VARYINGCHAR NAME;

	LASTCOUNT _ 0;
	IF .FIRREP NEQ NULL
	THEN BEGIN					! LOOK FOR THE PREVIOUS NAME LENGTH
		THISREP _ .FIRREP;
LOOP:		WHILE .THISREP NEQ NULL
		DO BEGIN
			LASTCOUNT _ .THISREP[NAMECOUNT];
			IF .LASTCOUNT NEQ 0 THEN LEAVE LOOP;! FIRST AND ONLY REPORT MAY BE 0
			THISREP _ .THISREP[NEXTREPORT]
		END
	END;

	IF .LASTCOUNT NEQ 0
	THEN BEGIN					! MAKE SURE LENGTHS MATCH
		THISCOUNT _ .NAME[LANGTH];
		IF .THISCOUNT NEQ .LASTCOUNT		! THIS MEANS WORK
		THEN BEGIN
			CNVCHR(.LASTCOUNT,DIFF,10);	! NEED THIS NUMBER LATER
			IF .THISCOUNT GTR .LASTCOUNT
			THEN ERTEXT(5)			! NAME TOO LONG
			ELSE BEGIN			! NAME MUST BE PADDED WITH *'S
				PAD _ .LASTCOUNT - .THISCOUNT;
				DUPL(BYTOFF(NAME[STRING],.THISCOUNT+1),"*",.PAD);
				ERTEXT(7)
			END;
			TTYOTS(.DIFF[LANGTH],DIFF[STRING]);ERTEXT(6);
			THISCOUNT _ .LASTCOUNT		! REGARDLESS, USE THE RIGHT LENGTH
		END
	END
	ELSE THISCOUNT _ IF .NAME[LANGTH] LEQ 12	! THIS IS FIRST REPORT OR FIRST HAD NO NAME
				THEN .NAME[LANGTH]
				ELSE BEGIN
					ERTEXT(5);TTYOTS(0,PLIT ASCIZ '12');ERTEXT(6);
					12
				END;

	IF .LASTCOUNT IS 0 AND .FIRREP ISNOT NULL	! THIS IS SECOND REPORT AND FIRST HAD NO NAME
	THEN BEGIN
		CNVCHR(.THISCOUNT,DIFF,10);
		ERTEXT(32);TTYOTS(.DIFF[LANGTH],DIFF[STRING]);ERTEXT(33);
		FIRREP[NAMECOUNT] _ .THISCOUNT;		! GIVE IT THE SAME LENGTH
		DUPL(FIRREP[REPORTNAME]<FIRSTINCR>,"*",.THISCOUNT) ! AND A NAME OF ALL *'S
	END;

	IF .FIRREP NEQ NULL
	THEN BEGIN					! SEE IF IT IS A PREVIOUSLY USED NAME
		THISREP _ .FIRREP;
		WHILE .THISREP NEQ NULL
		DO BEGIN				! MUST USE CMPASC HERE BECAUSE WE DIDN'T REALLY TRUNCATE
			IF CMPASC(NAME[STRING]<FIRSTINCR>,.THISCOUNT,THISREP[REPORTNAME]<FIRSTINCR>,.THISCOUNT)
			THEN BEGIN
				CURREP _ .THISREP;	! USE THAT REPORT BLOCK
				ERTEXT(10);
				RETURN
			END;
			THISREP _ .THISREP[NEXTREPORT]
		END
	END;

	IF GETREP(NEW) EQL FALSE THEN RETURN;		! IT SEEMS THAT WE NEED A FILE BLOCK AFTERALL
	COPYA(NAME[STRING]<FIRSTINCR>,CURREP[REPORTNAME]<FIRSTINCR>,.THISCOUNT);
	CURREP[NAMECOUNT] _ .THISCOUNT;
END;
COMMENT(REPORT);

! SUBROUTINE REPORT
! ========== ======

! THIS ROUTINE IS THE REPORT COMMAND.
! LAST MODIFIED ON 12 JUL 74 BY JG.

GLOBAL ROUTINE REPORT =
BEGIN
	LOCAL TOKEN;
	MAP   VARYINGCHAR TOKEN;

	TOKEN _ TTYINT();
	IF .TOKEN[LANGTH] GTR 0
	THEN BEGIN					! SIMPLE CHARACTER TOKEN
		SETNAME(.TOKEN);			! PROCESS REPORT NAME
		IF SEMI() THEN ERTEXT(4)		! SCAN FOR ;
	END
	ELSE BEGIN					! BREAK CHAR OR SUPER TOKEN
		IF .TOKEN[LANGTH] EQL -40		! SUPER TOKEN, USER TRYING TO BE FUNNY
		THEN BEGIN
			TOKEN[LANGTH] _ 40;		! FAKE OUT SETNAME
			SETNAME(.TOKEN);		! TOKEN WILL BE TRUNCATED OF COURSE
			TOKEN[LANGTH] _ -40;
			WHILE .TOKEN[LANGTH] EQL -40	! SCAN TO END OF SUPER TOKEN
			DO TOKEN _ TTYINT()
		END
		ELSE BEGIN				! BREAK CHAR, ARGUMENT PROBABLY IS NOT THERE
			ERTEXT(8);TTYOTS(0,PLIT ASCIZ 'REPORT');ERTEXT(9)
		END;
		IF .TOKEN[STRING] NEQ ';'		! WE REALLY WANTED A ;
		THEN IF SEMI() THEN ERTEXT(4)
	END
END;

END ELUDOM; ! END OF REPORT COMMAND MODULE ...