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

!***COPYRIGHT (C) 1974, 1975, 1976, 1977 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.***
%%
%
	THIS MODULE CONTAINS ALL THE NON-I/O UTILITY ROUTINES.

	ZERO   - ZEROS BLOCKS OF MEMORY
	CMPASC - COMPARES ASCII OR ASCIZ STRINGS
	CMPVAR - COMPARES VARYING STRINGS
	KEYCHK - CHECKS IF A STRING IS A KEYWORD
	ERTEXT - PRINTS ERROR TEXTS
	GET    - DOES THE CORE UUO FOR ALLOC
	ALLOC  - ALLOCATES WORK AREAS
	FREE   - FREES ALL THE ALLOCATION WORK AREAS
	SEMI   - SCANS FOR A ";" FROM THE TTY
	CNVCHR - CONVERTS A BINARY NUMBER TO A VARYING CHARACTER STRING
	GETREP - GETS A REPORT BLOCK
	BYTOFF - FORMS A BYTE POINTER WITH AN OFFSET
	DUPL   - DUPLICATES CHARACTER STRINGS
	COPYA  - COPIES ASCII STRINGS
	CNVSIX - CONVERTS ASCII TO SIXBIT
	PRTSPC - PRINTS "FOR FILE DEV:FILE.EXT[PPN]"
	CNVBDT - CONVERTS DATE UUO TO CHARACTER STRING
	CNVBTM - COMVERTS MSTIME UUO TO CHARACTER STRING
	MSTIME - DOES MSTIME UUO
	DATE   - DOES DATE UUO
	GETPPN - DOES GETPPN UUO
	PJOB   - DOES PJOB UUO
	INIT   - PERFORMS GENERAL INITIALIZATIONS
	CNVBIN - CONVERTS STRING TO BINARY, REVERSE OF CNVCHR
	ADDBYT - LIKE BYTOFF, BUT ADDS CHARS TO BYTE PTRS


%
%%

MODULE UTILTY (MLIST,FSAVE,TIMER=EXTERNAL(SIX12)) =
BEGIN

	REQUIRE COMMON.BLI;

	REQUIRE ENTRY.BLI;

COMMENT(ZERO);

! SUBROUTINE ZERO
! ========== ====

! THIS ROUTINE ZEROS A BLOCK OF MEMORY.
! LAST MODIFIED ON 26 JUN 74 BY JG.

GLOBAL ROUTINE ZERO (DATAPTR,COUNT) =
BEGIN
	REGISTER XWD;
	MACHOP   BLT = #251;

	XWD<LH> _ .DATAPTR;			! SET UP OVERLAPPING BLT
	XWD<RH> _ .DATAPTR+1;
	(.DATAPTR)<WORD> _ 0;			! ZERO FIRST WORD
	BLT(XWD,.DATAPTR+.COUNT-1)		! ZERO REST OF BLOCK
END;

COMMENT(CMPASC);

! SUBROUTINE CMPASC
! ========== ======

! THIS ROUTINE COMPARES TWO ASCII STRINGS AND RETURNS TRUE IF THEY ARE
! EQUAL, FALSE IF NOT. IF BOTH LENGTHS ARE ZERO, THEY ARE ASSUMED TO
! BE ASCIZ STRINGS. NOTE THAT IF THE STRINGS ARE ASCIZ, THEY ARE
! CONSIDERED EQUAL IF THEY MATCH UP TO BUT NOT INCLUDING THE FIRST NULL
! CHARACTER. THUS THEY NEED NOT BE THE SAME LENGTH AS LONG AS THE SHORTER
! STRING MATCHES THE LONGER FOR THE LENGTH OF THE SHORTER.

! LAST MODIFIED ON 26 AUG 74 BY JG.

GLOBAL ROUTINE CMPASC (PTR1,LEN1,PTR2,LEN2) =
BEGIN
	LOCAL TEMP,TEMP2;

	IF .LEN1 NEQ .LEN2 THEN RETURN FALSE;		! MUST BE SAME LENGTH, EVEN IF ZERO
	IF .LEN1 LSS 0 THEN RETURN FALSE;		! AND CERTAINLY NOT NEGATIVE
	IF .LEN1 EQL 0
	THEN REPEAT					! ASCIZ STRINGS
	BEGIN						! REPEAT UNTIL NULL CHAR
		TEMP _ SCANI(PTR1);
		TEMP2 _ SCANI(PTR2);
		IF .TEMP IS NULL OR .TEMP2 IS NULL	! LEAVE WITHOUT CHECKING THE OTHER CHAR
			THEN RETURN TRUE;
		IF .TEMP ISNOT .TEMP2 THEN RETURN FALSE
	END
	ELSE DECR TEMP FROM .LEN1-1 TO 0		! HERE WE WERE GIVEN LENGTHS
		DO IF SCANI(PTR1) NEQ SCANI(PTR2) THEN RETURN FALSE;
	TRUE
END;

COMMENT(CMPVAR);

! SUBROUTINE CMPVAR
! ========== ======

! THIS ROUTINE COMPARES TWO VARYING CHARACTER STRINGS.
! LAST MODIFIED ON 12 JUL 75 BY JG.

GLOBAL ROUTINE CMPVAR (VAR1,VAR2) =
BEGIN
	LOCAL A,B;
	MAP VARYINGCHAR VAR1:VAR2;

	IF .VAR1[LANGTH] NEQ .VAR2[LANGTH] THEN RETURN FALSE;! LENGTHS MUST BE EQUAL
	A _ .VAR1[LANGTH];
	IF .A LSS 0 THEN RETURN FALSE;			! AND NOT NEGATIVE
	B _ .A/5;					! CALCULATE LENGTH IN WORDS
	IF .B*5 NEQ .A THEN B _ .B+1;			! FUDGE IF NOT A FULL WORD
	INCR A FROM 0 TO .B-1				! WE CAN DO WORD COMPARISONS ON VARYING STRINGS
	DO IF @(VAR1[STRING]+.A) NEQ @(VAR2[STRING]+.A)
		THEN RETURN FALSE;
	TRUE
END;

COMMENT(KEYCHK);

! SUBROUTINE KEYCHK
! ========== ======

! THIS ROUTINE CHECKS IF THE GIVEN VARYING CHARACTER STRING
! IS A KEYWORD. JUST IN CASE THE MATCH CONSTITUTED A PARTIAL
! UNIQUE MATCH, THE ENTIRE MATCHED KEYWORD IS COPIED INTO
! THE TOKEN, SO ROUTINES PRINTING THE TOKEN EXPECTING A
! RECOGNIZABLE KEYWORD THERE WILL NOT BE DISSAPPOINTED.
! THIS IS OK SINCE KEYCHK IS CALLED ONLY WHEN A REAL LIVE
! KEYWORD IS EXPECTED ANYWAY.

! LAST MODIFIED ON 26 AUG 74 BY JG.

GLOBAL ROUTINE KEYCHK (VARPTR,INDEXPTR) =
BEGIN
	LOCAL	MATCH,KPTR,MPTR;
	LABEL	THISONE;
	MAP	VARYINGCHAR VARPTR:KPTR:MPTR;

	MATCH _ 0;					! NO MATCHES YET
	INCR I FROM 0 TO NUMKEYWORDS-1			! LOOK AT ALL THE KEYWORDS
	DO THISONE: BEGIN
		KPTR _ .(.KEYWRD+.I )+1;		! GET PTR TO THIS KEYWORD
		IF .VARPTR[LANGTH] GTR .KPTR[LANGTH]	! TOKEN TOO BIG FOR MATCH?
			THEN LEAVE THISONE;		! YES
		IF CMPASC(VARPTR[STRING]<FIRSTINCR>,.VARPTR[LANGTH],KPTR[STRING]<FIRSTINCR>,.VARPTR[LANGTH])
		THEN IF .MATCH IS 0			! TOKEN MATCHES KEYWORD
			THEN BEGIN			! THIS IS THE FIRST MATCH
				MATCH _ .I;		! REMEMBER IT
				MPTR _ .KPTR		! AND THE POINTER
			END
			ELSE BEGIN			! THIS IS THE SECOND MATCH
				.INDEXPTR _ -1;		! INDICATE AMBIGUOUS KEYWORD
				RETURN FALSE		! NO COMMAND, OF COURSE
			END
	END;
	IF .MATCH ISNOT 0				! THEN WE FOUND A UNIQUE MATCH
	THEN BEGIN
		COPYA(MPTR[STRING]<FIRSTINCR>,VARPTR[STRING]<FIRSTINCR>,.MPTR[LANGTH]); 
		.INDEXPTR _ .MATCH+1;			! TELL CALLER WHICH ONE
		RETURN ..(.KEYWRD +.MATCH);		! HAPPILY RETURN (WITH TRUE IF COMMAND, FALSE IF NOT)
	END;

	.INDEXPTR _ 0;					! NO MATCH AT ALL
	FALSE						! RETURN SHAMEFULLY
END;

COMMENT(ERTEXT);

! SUBROUTINE ERTEXT
! ========== ======

! THIS ROUTINE PRINTS ERROR TEXTS ON THE TTY.
! LAST MODIFIED ON 28 AUG 74 BY JG.

GLOBAL ROUTINE ERTEXT (TEXTNUMBER) =
BEGIN
	EXTERNAL TTYOTS,TTYOTN;

	CASE .TEXTNUMBER-1 OF
	SET
		%1%  TTYOTS(0,PLIT ASCIZ 'UNRECOGNIZED COMMAND: ');
		%2%  TTYOTN(0,PLIT ASCIZ ' COMMAND NOT IMPLEMENTED.');
		%3%  TTYOTN(0,PLIT ASCIZ 'UNABLE TO OBTAIN CORE FOR WORK AREAS.');
		%4%  TTYOTN(0,PLIT ASCIZ 'GARBAGE AFTER COMMAND IGNORED.');
		%5%  TTYOTS(0,PLIT ASCIZ 'REPORT NAME TRUNCATED TO ');
		%6%  TTYOTN(0,PLIT ASCIZ ' CHARACTERS.');
		%7%  TTYOTS(0,PLIT ASCIZ 'REPORT NAME PADDED WITH *''S TO ');
		%8%  TTYOTS(0,PLIT ASCIZ 'EXPECTED ARGUMENT TO ');
		%9%  TTYOTN(0,PLIT ASCIZ ' MISSING.');
		%10% TTYOTN(0,PLIT ASCIZ 'REFERING TO PREVIOUS REPORT OF SAME NAME.');
		%11% TTYOTN(0,PLIT ASCIZ 'DEVICE NAME, FILE NAME, OR EXTENSION TOO LONG');
		%12% TTYOTN(0,PLIT ASCIZ 'MISSING OR INVALID DELIMITER IN FILE SPEC.');
		%13% TTYOTN(0,PLIT ASCIZ 'MUTIPLE FILE NAME OR EXTENSION.');
		%14% TTYOTN(0,PLIT ASCIZ 'UNRECOGNIZABLE FILE SPEC.');
		%15% TTYOTN(0,PLIT ASCIZ 'MISSING DEVICE NAME.');
		%16% TTYOTN(0,PLIT ASCIZ 'MISSING FILE NAME.');
		%17% TTYOTN(0,PLIT ASCIZ 'NO MORE I/O CHANNELS AVAILABLE.');
		%18% TTYOTS(0,PLIT ASCIZ 'LOOKUP ERROR CODE ');
		%19% TTYOTS(0,PLIT ASCIZ 'ENTER ERROR CODE ');
		%20% TTYOTS(0,PLIT ASCIZ ' CANNOT BE OPENED FOR ');
		%21% TTYOTN(0,PLIT ASCIZ 'MULTIPLE COLONS IN FILE SPEC.');
		%22% TTYOTN(0,PLIT ASCIZ 'MUTIPLE PERIODS IN FILE SPEC.');
		%23% TTYOTS(0,PLIT ASCIZ 'ERROR DURING CLOSE ');
		%24% TTYOTS(0,PLIT ASCIZ 'OPTION, ');
		%25% TTYOTN(0,PLIT ASCIZ ', NOT RECOGNIZED.');
		%26% TTYOTN(0,PLIT ASCIZ ', NOT IMPLEMENTED.');
		%27% TTYOTS(0,PLIT ASCIZ 'INVALID CHARACTER OR DELIMITER IN ');
		%28% TTYOTN(0,PLIT ASCIZ ' COMMAND.');
		%29% TTYOTN(0,PLIT ASCIZ ', MUST BE SPECIFIED FIRST.');
		%30% TTYOTN(0,PLIT ASCIZ ', IGNORED AFTER "ALL".');
		%31% TTYOTN(0,PLIT ASCIZ 'ASSUMING "BOTH".');
		%32% TTYOTS(0,PLIT ASCIZ 'PREVIOUS REPORT GIVEN NAME OF ');
		%33% TTYOTN(0,PLIT ASCIZ ' *''S.');
		%34% TTYOTN(0,PLIT ASCIZ ' FILE NOT SPECIFIED.');
		%35% TTYOTS(0,PLIT ASCIZ 'I/O ERROR ');
		%36% TTYOTN(0,PLIT ASCIZ 'NO REPORTS HAVE BEEN CREATED YET.');
		%37% TTYOTN(0,PLIT ASCIZ 'UNEXPECTED EOF IN INPUT FILE.');
		%38% TTYOTS(0,PLIT ASCIZ ' ERROR IN RECORD ');
		%39% TTYOTN(0,PLIT ASCIZ ' IS AMBIGUOUS.');
		%40% TTYOTN(0,PLIT ASCIZ 'ERROR ALLOCATING I/O BUFFERS.');
		%41% TTYOTN(0,PLIT ASCIZ 'INVALID PPN.');
		%42% TTYOTN(0,PLIT ASCIZ 'SFD''S NOT INPLEMENTED.');
		%43% TTYOTN(0,PLIT ASCIZ 'MULTIPLE PPN''S IN FILE SPEC.');
	TES
END;

COMMENT(GET);

! SUBROUTINE GET
! ========== ===

! THIS ROUTINE IS USED BY ALLOC TO DO THE CORE UUO.
! IT RETURNS A POINTER TO A BLOCK OF HOWMUCH WORDS.
! IF THE CORE UUO FAILS, AN ERROR MESSAGE IS
! PRINTED AND GET RETURNS FALSE.
! LAST MODIFIED ON 9 JUL 74 BY JG.

ROUTINE GET (HOWMUCH) =
BEGIN
	REGISTER AC;
	MACHOP	 CALLI = #47;
	MACRO	 COREUUO = CALLI(AC,#11)$;

	AC _ .?.JBFF+.HOWMUCH-1;			! CORE UUO NEEDS TOTAL CORE REQUIREMENT
	IFSKIP COREUUO					! DID WE GET IT?
	THEN BEGIN					! YES
		AC _ .?.JBFF;				! KLUDGY, SAVES A LOCAL VAR
		?.JBFF _ .?.JBFF+.HOWMUCH;		! MUST UPDATE .JBFF
		RETURN (.AC)<WORD>			! FORCE OLD .JBFF TO WORD PTR AND RETURN
	END
	ELSE BEGIN					! NO SUCH LUCK
		ERTEXT(3);				! TELL THE WORLD ABOUT OUR PROBLEMS
		RETURN FALSE				! SUPER DISSAPPOINTMENT
	END
END;

COMMENT(ALLOC);

! SUBROUTINE ALLOC
! ========== =====

! THIS ROUTINE IS THE STORAGE ALLOCATOR FOR THE MCS
! REPORT GENERATOR. IT RETURNS A POINTER TO A
! ZEROED BLOCK OF CORE. IF WORDS AMOUNT OF CORE IS
! NOT OBTAINABLE, ALLOC RETURNS FALSE. THE STORAGE
! MANAGEMENT METHOD (IF IT DESERVES THAT NAME) IS QUITE
! SIMPLE - EACH ALLOCATION AREA HAS THREE WORDS OVERHEAD
! AT THE BEGINNING. THE FIRST IS THE POINTER TO THE
! NEXT ALOCATION AREA, THE SECOND IS THE HIGHEST ADDRESS
! USABLE IN THIS AREA, THE THIRD IS THE ADDRESS OF THE
! LAST USED WORD IN THE AREA. STORAGE IS ALLOCATED BY
! UPDATING THE LASTUSED WORD. THE REASON WE CAN GET AWAY
! WITH SOMETHING THIS SIMPLE IS THAT THE STORAGE IS NEVER
! FREED BY THE ROUTINE REQUESTING IT, LARGELY BECAUSE
! ONCE THE STORAGE IS ALLOCATED, IT IS NEEDED UNTIL THE
! GENERATION OF ALL THE REPORTS IS FINISHED, I.E., WHEN
! THE GO COMMAND ENDS. TO ADD TO THE SIMPLICITY, WHEN
! THE GO COMMAND ENDS, ALL THE STORAGE CAN BE FREED. THIS
! SAVES A LOT OF BOOKKEEPPING. NOW, IN ORDER FOR OUR FAITHFUL
! READER TO UNDERSTAND HOW WE HAVE MANAGED TO COMPLICATE
! SUCH A SIMPLE SCHEME, HE MUST REALIZE THAT TWO PROCESSES
! TAKE PLACE ASYNCHRONOUSLY IN THIS ROUTINE - THE FIRST IS
! THE PARCELLING OUT OF THE STORAGE IN THE AREAS (AND GETTING
! NEW AREAS WHEN NECESSARY) AND THE SECOND IS THE UPDATTING
! OF CURFRE WHICH ALWAYS POINTS TO WHERE WE START LOOKING
! FOR ROOM. THE STORAGE IS PARCELLED OUT BY STARTING AT CURFRE
! AND LOOKING FOR AN AREA THAT HAS THE ROOM FOR THE REQUEST.
! IF ONE IS FOUND, LASTUSED IS UPDATED AND THE POINTER RETURNED.
! IF ONE IS NOT FOUND, A NEW ALLOCATION AREA IS OBTAINED FROM
! GET, IT'S SIZE BEING DETERMINED BY THE SIZE OF THE REQUEST. IF
! IT WILL FIT IN THE "STANDARD" AREA THEN COREINCR IS THE SIZE
! OF THE AREA, IF IT WON'T, THEN THE REQUESTED AMOUNT PLUS THE
! 3 OVERHEAD WORDS IS USED FOR THE AREA SIZE. ALL NEW AREAS
! ARE PLACED IN THE CHAIN IMMEDIATELY AFTER CURFRE. ITS PLACED
! THERE BECAUSE WE HAVE ONLY 2 POINTERS TO AREAS - FIRFRE AND
! CURFRE, AND WE DON'T WANT TO PLACE IT AT THE BEGINNING.
! QUITE INDEPENDENT OF ALL THIS IS THE UPDATTING OF CURFRE.
! THIS OCCURS ONLY WHEN THE CURRENT ALLOCATION AREA HAS LESS
! THAN 10 WORDS LEFT. JUST TO BE TIDY, THE SIZE OF THE FIRST
! ALOCATION AREA IS SUCH THAT THE LOW SEG IS ROUNDED TO A
! PAGE BOUNDARY.

! LAST MODIFED ON 23 AUG 74 BY JG.

GLOBAL ROUTINE ALLOC(WORDS) =
BEGIN
	LABEL SEARCH;
	LOCAL THISAREA,AMOUNT,NEXT;
	MACRO INIT(BLOCK,SIZE) =
		BLOCK[NEXTAREA] _ NULL;
		BLOCK[HIGHADDR] _ (.BLOCK+SIZE-1)<ADDR>;
		BLOCK[LASTUSED] _ (.BLOCK+2)<ADDR>$;
	MAP   AREA FIRFRE:CURFRE:THISAREA:NEXT;

	IF .WORDS EQL 0 OR .FIRFRE IS NULL		! FIRST CALL EVER OR FIRST AFTER RESET UUO
	THEN BEGIN
		AMOUNT _ .?.JBFF MOD 512;		! ROUND UPWARD TO PAGE BOUNDARY
		IF .AMOUNT ISNOT 0
			THEN AMOUNT _ 512 - .AMOUNT;
		CURFRE _ FIRFRE _ GET(COREINCR+.AMOUNT);! NOW GET THE CORE
		IF .CURFRE EQL NULL THEN RETURN FALSE;	! TOO BAD
		INIT(CURFRE,COREINCR+.AMOUNT);		! INITIALIZE THE AREA
		RETURN .CURFRE
	END;

	THISAREA _ .CURFRE;				! THIS HOPEFULLY WILL BE WHERE WE PUT IT

	IF .CURFRE[LASTUSED]+.WORDS GTR .CURFRE[HIGHADDR]
	THEN BEGIN					! NOPE, THERE'S NO ROOM
		AMOUNT _ IF .WORDS LEQ COREINCR-3	! IN CASE WE NEED TO GETA NEW AREA
			THEN COREINCR			! STANDARD WILL BE ENOUGH
			ELSE .WORDS+3;			! NOT BIG ENOUGH, REMEMBER THE HEADER!
		IF .CURFRE[NEXTAREA] EQL NULL		! NO AREAS LEFT ON CHAIN
		THEN BEGIN
			THISAREA _ GET(.AMOUNT);	! GET A NEW ONE
			IF .THISAREA EQL NULL THEN RETURN FALSE;
			CURFRE[NEXTAREA] _ .THISAREA;	! PLACE IT ON THE CHAIN
			INIT(THISAREA,.AMOUNT);		! INITIALIZE IT
			IF .CURFRE[HIGHADDR] - .CURFRE[LASTUSED] LSS 10
				THEN CURFRE _ .THISAREA;! OLD ONE HAD LESS THE 10 FREE WORDS, DISCARD IT
		END
		ELSE SEARCH: BEGIN			! THERE MIGHT BE ROOM SOMEWHERE
			NEXT _ .CURFRE[NEXTAREA];	! LOOK AT NEXT AREA
			WHILE .NEXT NEQ NULL		! AND KEEP LOOKING AT THE NEXT ONE
			DO BEGIN
				IF .NEXT[LASTUSED]+.WORDS LEQ .NEXT[HIGHADDR]
				THEN BEGIN		! WE FOUND SOME ROOM
					THISAREA _ .NEXT;
					IF .CURFRE[HIGHADDR] - .CURFRE[LASTUSED] LSS 10
						THEN CURFRE _ .CURFRE[NEXTAREA];! DISCARD CURRENT AREA
					LEAVE SEARCH
				END;
				NEXT _ .NEXT[NEXTAREA]	! NEXT AREA
			END;
			THISAREA _ GET(.AMOUNT);	! NEED A NEW AREA
			IF .THISAREA EQL NULL THEN RETURN FALSE;
			THISAREA[NEXTAREA] _ .CURFRE[NEXTAREA];! INSERT AFTER CURFRE IN CHAIN
			CURFRE[NEXTAREA] _ .THISAREA;
			THISAREA[HIGHADDR] _ (.THISAREA+.AMOUNT-1)<ADDR>;! INITIALIZE AREA
			THISAREA[LASTUSED] _ (.THISAREA+2)<ADDR>;
			IF .CURFRE[HIGHADDR] - .CURFRE[LASTUSED] LSS 10
				THEN CURFRE _ .THISAREA;! DISCARD OLD AREA
		END
	END;

	NEXT _ .THISAREA[LASTUSED]+1;			! FIRST FREE WORD
	THISAREA[LASTUSED] _ .THISAREA[LASTUSED]+.WORDS;! UPDATE LASTUSED
	ZERO(.NEXT,.WORDS);				! MAKE REAL SURE IT CONTAINS ZEROS
	(.NEXT)<WORD>					! RETURN WORD POINTER
END;

COMMENT(FREE);

! SUBROUTINE FREE
! ========== ====

! THIS ROUTINE EMPTIES ALL THE ALLOCATIONS AREAS
! BY SETING THE LASTUSED FIELD OF EACH AREA
! HEADER TO THE THIRD WORD OF THAT AREA.
! LAST MODIFIED ON 12 JUL 74 BY JG.

GLOBAL ROUTINE FREE =
BEGIN
	LOCAL NEXT;
	MAP   AREA NEXT;

	IF .FIRFRE IS NULL THEN RETURN;			! FREE MAY BE CALLED BEFORE ANY ALLOCATIONS
	NEXT _ .FIRFRE;
	WHILE .NEXT ISNOT NULL				! FOR ALL THE AREAS
	DO BEGIN
		NEXT[LASTUSED] _ (.NEXT+2)<ADDR>;	! RESET LASTUSED
		NEXT _ .NEXT[NEXTAREA]			! NEXT AREA
	END;
	CURFRE _ .FIRFRE				! RESET CURFRE
END;

COMMENT(SEMI);

! SUBROUTINE SEMI
! ========== ====

! THIS ROUTINE READS AND THROWS AWAY TOKENS FROM
! THE TTY UNTIL IT FINDS A ";". IT RETURNS TRUE IF IT
! ENCOUNTERS ANYTHING BEFORE IT SAW THE ";", FALSE OTHERWISE.
! LAST MODIFIED ON 12 JUL 74 BY JG.

GLOBAL ROUTINE SEMI =
BEGIN
	LOCAL GARBAGE,TOKEN;
	MAP   VARYINGCHAR TOKEN;
	EXTERNAL TTYINT;

	GARBAGE _ FALSE;				! NO GARBAGE YET
	REPEAT BEGIN
		TOKEN _ TTYINT();			! GET A TOKEN
		IF .TOKEN[STRING] IS ';' THEN RETURN .GARBAGE;! FOUND A ";"
		GARBAGE _ TRUE				! NOT A ";", WE SAW GARBAGE
	END
END;

COMMENT(CNVCHR);

! SUBROUTINE CNVCHR
! ========== ======

! THIS ROUTINE CONVERTS A BINARY NUMBER INTO A
! VARYING CHARACTER STRING USING THE SPECIFIED
! BASE. THE OUTPUT AREA IS ASSUMED TO BE AT
! LEAST 5 WORDS LONG (THIS INCLUDES THE WORD FOR
! THE HEADER). NO CHECKING OF THE BASE IS
! DONE AND VERY LARGE NUMBERS IN BASE 2 MAY NOT
! FIT IN 20 CHARACTERS (THEY SHOULD BE PRINTED AS
! AN OCTAL WORD ANYWAY). A DEFINITE IMPROVEMENT
! IN THE OVERALL PERFORMANCE OF MCSREP CAN BE
! ACHIEVED BY RECODING THIS ROUTINE IN MACRO-10.
! LAST MODIFIED ON 11 JUL 74 BY JG.

GLOBAL ROUTINE CNVCHR (NUMBER,CHAROUTPTR,BASE) =
BEGIN
	OWN NEGATIVE,OUTPUT,OUTPTR,N,B;			! THESE MUST BE OWN OR DIVIDE MUST BE A FUNCTION

	% THIS IS THE ROUTINE THAT DOES ALL THE WORK. %

	ROUTINE DIVIDE =
	BEGIN
		LOCAL REMAINDER;
		IF .N IS 0				! HAVE WE REACHED THE "BOTTOM"
		THEN BEGIN				! YES
			IF .NEGATIVE			! CHECK IF NUMBER WAS NEGATIVE
			THEN BEGIN			! YES, IT WAS
				REPLACEI(OUTPUT,"-");	! OUTPUT A "-"
				.OUTPTR _ 1;		! ONE CHAR IN OUTPUT
			END;
			RETURN				! NOW START CLIMBING UP THE STACK, OUTPUTTING CHARS AS WE GO
		END;
		REMAINDER _ .N MOD .B;			! GET NUMBER FOR THIS PRINT POSITION
		N _ .N/.B;				! GO TO NEXT NUMBER POSITION
		DIVIDE();				! DO THE REST OF THE NUMBER
		REPLACEI(OUTPUT,.REMAINDER+"0");	! NOW OUTPUT THIS CHAR
		.OUTPTR _ ..OUTPTR+1			! INCREMENT THE CHAR COUNT
	END;						! CONTINUE UP THE STACK

	% ALL THIS IS JUST SETUP FOR DIVIDE %

	ZERO(.CHAROUTPTR,5);				! MAKE SURE WE HAVE VIRGIN WORK AREA
	OUTPUT _ (.CHAROUTPTR+1)<FIRSTINCR>;		! PTR TO OUTPUT AREA
	OUTPTR _ .CHAROUTPTR;				! POINTER TO LENGTH OF OUTPUT AREA
	IF .NUMBER IS 0					! SPECIAL CASE THIS
	THEN BEGIN
		REPLACEI(OUTPUT,"0");
		.CHAROUTPTR _ 1;
		RETURN
	END;
	IF .NUMBER LSS 0
		THEN NEGATIVE _ TRUE			! REMEMBER THAT IT WAS NEGATIVE
		ELSE NEGATIVE _ FALSE;
	N _ ABS(.NUMBER);				! MAKE SURE NUMBER IS NON-NEGATIVE
	B _ .BASE;					! COPY BASE INTO OWN VAR
	DIVIDE();					! OFF WE GO!
END;

COMMENT(GETREP);

! SUBROUTINE GETREP
! ========== ======

! THIS ROUTINE EITHER CAUSES CURREP TO POINT TO A
! NEW REPORT BLOCK OR INSURES THAT CURREP POINTS TO AN
! OLD ONE BY ALLOCATING ONE IF FIRREP IS NULL. IT
! RETURNS TRUE IF NO PROBLEMS, FALSE IF THE ALLOCATION
! FAILS.
! LAST MODIFIED ON 1 AUG 74 BY JG.

GLOBAL ROUTINE GETREP (PARM) =
BEGIN
	LOCAL TEMP;
	MAP   REPBLK FIRREP:CURREP:TEMP;

	IF .PARM IS OLD					! THEN JUST CHECK FOR EXISTING REPORT BLOCK
	THEN IF .FIRREP ISNOT NULL THEN RETURN TRUE;	! IF NONE, THEN PROCEED LIKE NEW
	TEMP _ ALLOC(REPORTBLKSIZ);			! GET A REPORT BLOCK
	IF .TEMP IS NULL THEN RETURN FALSE;
	IF .FIRREP IS NULL				! MUST CREAT START OF CHAIN
	THEN CURREP _ FIRREP _ .TEMP
	ELSE BEGIN
		IF .CURREP[NEXTREPORT] ISNOT NULL	! MUST LINK TO NEXT REPORT
			THEN TEMP[NEXTREPORT] _ .CURREP[NEXTREPORT];
		CURREP[NEXTREPORT] _ .TEMP;		! LINK FROM PREVIOUS REPORT
		CURREP _ .TEMP				! SET CURREP
	END;
	TRUE
END;

COMMENT(BYTOFF);

! SUBROUTINE BYTOFF
! ========== ======

! THIS ROUTINE RETURNS A BYTE POINTER, OFFSET
! A SPECIFIED AMOUNT OF CHARACTERS FROM THE
! GIVEN ADDRESS. IT IS ASSUMED THAT THE
! RETURNED POINTER WILL BE USED IN INCREMENT OPERATIONS.
! LAST MODIFIED ON 1 AUG 74 BY JG.

GLOBAL ROUTINE BYTOFF (ADDRESS,OSET) =
BEGIN
	LOCAL T1,T2,T3;
	T1 _ T2 _ 0;
	T1<S> _ 7;					! BYTE SIZE IS ASCII
	T3 _ .OSET MOD 5;				! HOW MANY EXTRA CHARS NEEDED?
	IF .T3 IS 0					! FUDGE THINGS FOR FIRST CHAR IN WORD
	THEN BEGIN
		ADDRESS _ .ADDRESS-1;
		T3 _ 5
	END;
	T2<P> _ (6-.T3)*7+1;				! ADJUST P FIELD TO RIGHT AMOUNT OF BITS
	.T1 + .T2 + (.ADDRESS)<ADDR>+.OSET/5		! PUT IT ALL TOGETHER
END;

COMMENT(DUPL);

! SUBROUTINE DUPL
! ========== ====

! THIS ROUTINE DUPLICATES A CHARACTER (RIGHT JUSTIFIED
! IN THE INPUT ARGUMENT) USING THE GIVEN BYTE
! POINTER AND RETURNS THE INCREMENT TYPE BYTE
! POINTER TO THE NEXT CHARACTER.
! LAST MODIFIED ON 12 JUL 74 BY JG.

GLOBAL ROUTINE DUPL (BYTEPTR,CHAR,COUNT) =
BEGIN
	DECR I FROM .COUNT-1 TO 0
		DO REPLACEI(BYTEPTR,.CHAR);
	.BYTEPTR
END;

COMMENT(COPYA);

! SUBROUTINE COPYA
! ========== =====

! THIS ROUTINE COPIES ASCII STRINGS. IF THE COUNT
! IS ZERO, THE SOURCE IS ASSUMED TO BE AN ASCIZ STRING.
! LAST MODIFIED ON 29 JUL 74 GY JG.

GLOBAL ROUTINE COPYA (SRCE,DST,CNT) =
BEGIN
	LOCAL T;
	IF .CNT EQL 0
	THEN REPEAT BEGIN				! ASCIZ STRING
		T _ SCANI(SRCE);
		IF .T EQL NULL THEN RETURN .CNT;	! RETURN THE COUNT
		REPLACEI(DST,.T);			! COPY TO DESTINATION
		CNT _ .CNT+1				! NOT NICE TO USE PARAMETER FOR TEMPORARY, BUT ...
	END
	ELSE DECR I FROM .CNT-1 TO 0			! STRING WITH COUNT
		DO COPYII(SRCE,DST);
	.CNT						! RETURN THE COUNT
END;

COMMENT(CNVSIX);

! SUBROUTINE CNVSIX
! ========== ======

! THIS ROUTINE CONVERTS UP TO SIX ASCII CHARACTERS
! TO SIXBIT AND STUFFS THEM INTO ONE WORD,
! WHICH IS RETURNED. ILLEGAL SIXBIT CHARACTERS ARE
! CONVERTED TO \ (BACKSLASH).
! LAST MODIFIED ON 17 JUL 74 BJ JG.

GLOBAL ROUTINE CNVSIX(ASCBP,COUNT) =
BEGIN
	LOCAL SIXTEMP,SIXBP,CHAR;

	COUNT _ IF .COUNT LEQ 6 THEN .COUNT-1 ELSE 5;
	SIXBP _ SIXTEMP<36,6>;				! SIXBIT PTR TO TEMP
	SIXTEMP _ 0;					! START WITH ALL BLANKS
	DECR I FROM .COUNT TO 0
	DO BEGIN
		CHAR _ SCANI(ASCBP);			! GET A CHAR
		IF .CHAR GTR #140 AND .CHAR LSS #173	! IS CHAR LOWER CASE LETTER?
		THEN CHAR _ .CHAR - #40;		! YES, CONVERT TO UPPER CASE
		IF .CHAR LSS #40 OR .CHAR EQL #140 OR .CHAR GTR #172
		THEN CHAR _ "\";			! CHAR IS NOT GOOD
		REPLACEI(SIXBP,.CHAR- #40);		! CONVERT TO SIXBIT AND INSERT
	END;
	.SIXTEMP
END;

COMMENT(PRTSPC);

! SUBROUTINE PRTSPC
! ========== ======

! THIS ROUTINE PRINTS "FOR FILE DEV:FILE.EXT[PPN]"
! ON THE TTY. USED FOR ERROR MESSAGES.
! LAST MODIFIED ON 16 AUG 74 BY JG.

GLOBAL ROUTINE PRTSPC (CHANNEL) =
BEGIN
	LOCAL EXT,FILEPTR,NUM[5];
	MAP   FILBLK FILEPTR;
	EXTERNAL TTYOTC,TTYOSX,TTYOTS,TTYOTN;

	TTYOTS(0,PLIT ASCIZ ' FOR FILE ');		! PRINT EASY PART
	FILEPTR _ .CHANLS[.CHANNEL];			! GET POINTER TO FILE BLOCK
	TTYOSX(.FILEPTR[DEVICE]); TTYOTC(":");		! PRINT THE DEVICE
	TTYOSX(.FILEPTR[FILENAME]);			! AND THE FILENAME (WHICH COULD BE NULL, WE DON'T CARE)
	IF (EXT _ 0; EXT<LH> _ .FILEPTR[EXTENSION]) NEQ NULL
	THEN BEGIN					! PRINT THE EXTENSION ONLY IF NON-NULL
		TTYOTC(".");
		TTYOSX(.EXT);
	END;
	IF .FILEPTR[PPNUM] ISNOT .USRPPN		! PRINT PPN ONLY IF NOT LOGIN PPN
	THEN BEGIN
		TTYOTC("[");
		CNVCHR(.FILEPTR[PPNUM]<LH>,NUM,8);
		TTYOVR(NUM);
		TTYOTC(",");
		CNVCHR(.FILEPTR[PPNUM]<RH>,NUM,8);
		TTYOVR(NUM);
		TTYOTC("]")
	END;
	TTYOTN(0,PLIT ASCII '.')
END;

COMMENT(CNVBDT);

! SUBROUTINE CNVBDT
! ========== ======

! THIS ROUTINE CONVERTS THE RESULT OF THE DATE
! UUO TO "MON XX, 197X".
! LAST MODIFIED ON 30 JUL 74 BY JG.

GLOBAL ROUTINE CNVBDT(BINDAT,OUTPTR) =
BEGIN
	BIND	MONTHS = PLIT('JAN','FEB','MAR','APR','MAY','JUN',
			      'JUL','AUG','SEP','OCT','NOV','DEC');
	LOCAL	YEAR,MONTH,DAY,PTR,NUM[5];

	YEAR _ .BINDAT/372+1964;			! BASE YEAR IS 1964
	BINDAT _ .BINDAT MOD 372;
	MONTH _ .BINDAT/31;				! GET MONTH
	DAY _ (.BINDAT MOD 31)+1;			! AND DAY

	PTR _ MONTHS[.MONTH]<FIRSTINCR>;
	DECR I FROM 2 TO 0
		DO COPYII(PTR,OUTPTR);			! COPY MONTH TO OUTPUT
	REPLACEI(OUTPTR," ");
	CNVCHR(.DAY,NUM,10);				! CONVERT DAY TO CHAR
	PTR _ NUM[STRING]<FIRSTINCR>;
	COPYII(PTR,OUTPTR);				! COPY IT TO OUTPUT
	IF .DAY GEQ 10
		THEN COPYII(PTR,OUTPTR);		! THERE IS A SECOND CHAR
	REPLACEI(OUTPTR,","); REPLACEI(OUTPTR," ");
	CNVCHR(.YEAR,NUM,10);				! CONVERT YEAR TO CHAR
	PTR _ NUM[STRING]<FIRSTINCR>;
	DECR I FROM 3 TO 0
		DO COPYII(PTR,OUTPTR);			! COPY YEAR TO OUTPUT
	IF .DAY LSS 10 THEN REPLACEI(OUTPTR," ");	! OTHER PEOPLE COUNT ON FIELD BEGIN 12 CHARS
	.OUTPTR
END;

COMMENT(CNVBTM);

! SUBROUTINE CNVBTM
! ========== ======

! THIS ROUTINE CONVERTS THE RESULT OF THE MSTIME
! UUO TO "XX:XX:XX".
! LAST MODIFIED ON 30 JUL 74 BY JG.

GLOBAL ROUTINE CNVBTM(BINTIM,OUTPTR) =
BEGIN
	LOCAL HOUR,MINUTE,SECOND,PTR,NUM[5];

	HOUR _ .BINTIM/3600000;				! GET HOURS
	BINTIM _ .BINTIM MOD 3600000;
	MINUTE _ .BINTIM/60000;				! AND MINUTES
	SECOND _ (.BINTIM MOD 60000)/1000;		! AND SECONDS

	IF .HOUR IS 0
	THEN OUTPTR _ DUPL(.OUTPTR," ",3)		! PAD HOUR WITH BLANKS
	ELSE BEGIN
		IF .HOUR LSS 10 THEN REPLACEI(OUTPTR," ");! LEFT JIUSTIFY HOUR
		CNVCHR(.HOUR,NUM,10);			! CONVERT TO CHAR
		PTR _ NUM[STRING]<FIRSTINCR>;
		COPYII(PTR,OUTPTR);			! COPY TO OUTPUT
		IF .HOUR GEQ 10
			THEN COPYII(PTR,OUTPTR);	! ANOTHER CHAR TO OUTPUT
		REPLACEI(OUTPTR,":");
	END;

	IF .MINUTE IS 0
	THEN BEGIN
		IF .HOUR IS 0				! ONLY ZAP FIELD IF HOUR IS ZERO
			THEN REPLACEI(OUTPTR," ")
			ELSE REPLACEI(OUTPTR,"0");
		REPLACEI(OUTPTR,"0");			! BUT ALWAYS PLACE AT LEAST ONE "0" FOR MINUTES
		REPLACEI(OUTPTR,":")
	END
	ELSE BEGIN
		IF .MINUTE LSS 10
		THEN IF .HOUR IS 0			! SAME TYPE KLUDGE 0 HOUR
			THEN REPLACEI(OUTPTR," ")
			ELSE REPLACEI(OUTPTR,"0");
		CNVCHR(.MINUTE,NUM,10);			! CONVERT TO CHAR
		PTR _ NUM[STRING]<FIRSTINCR>;
		COPYII(PTR,OUTPTR);			! COPY TO OUTPUT
		IF .MINUTE GEQ 10
			THEN COPYII(PTR,OUTPTR);	! AND THE OTHER TOO
		REPLACEI(OUTPTR,":")
	END;

	IF .SECOND IS 0
	THEN OUTPTR _ DUPL(.OUTPTR,"0",2)		! THIS ONE IS EASY
	ELSE BEGIN
		IF .SECOND LSS 10
			THEN REPLACEI(OUTPTR,"0");	! AND SO IS THIS
		CNVCHR(.SECOND,NUM,10);			! CONVERT TO CHAR
		PTR _ NUM[STRING]<FIRSTINCR>;
		COPYII(PTR,OUTPTR);			! COPY TO OUTPUT
		IF .SECOND GEQ 10
			THEN COPYII(PTR,OUTPTR)		! PICK LAST CHAR IN SECOND
	END;

	.OUTPTR
END;

COMMENT(MSTIME);

! SUBROUTINE MSTIME
! ========== ======

! THIS ROUTINE DOES THE MSTIME UUO.
! LAST MODIFIED ON 29 JUL 74 BY JG.

GLOBAL ROUTINE MSTIME =
BEGIN
	MACHOP	CALLI = #47;
	REGISTER AC;
	CALLI(AC,#23);
	.AC
END;

COMMENT(DATE);

! SUBROUTINE DATE
! ========== ====

! THIS ROUTINE DOES THE DATE UUO.
! LAST MODIFIED ON 29 JUL 74 BY JG.

GLOBAL ROUTINE DATE =
BEGIN
	MACHOP	CALLI = #47;
	REGISTER AC;
	CALLI(AC,#14);
	.AC
END;

COMMENT(GETPPN);

! SUBROUTINE GETPPN
! ========== ======

! THIS ROUTINE DOES THE GETPPN UUO.
! LAST MODIFIED ON 29 JUL 74 BY JG.

GLOBAL ROUTINE GETPPN =
BEGIN
	MACHOP	CALLI = #47;
	REGISTER AC;
	IFSKIP CALLI(AC,#24) THEN ELSE;
	.AC
END;

COMMENT(PJOB);

! SUBROUTINE PJOB
! ========== ====

! THE ROUTINE DOES THE PJOB UUO.
! LAST MODIFIED ON 29 JUL 74 BY JG.

GLOBAL ROUTINE PJOB =
BEGIN
	MACHOP	CALLI = #47;
	REGISTER AC;
	CALLI(AC,#30);
	.AC
END;

COMMENT(INIT);

! SUBROUTINE INIT
! ========== ====

! THIS ROUTINE INITIALIZES EVERYTHING THAT HAS TO
! BE INITIALIZED EXCEPT CHANLS, WHICH IS DONE BY
! RESET.
! LAST MODIFIED ON 27 AUG 74 BY JG.

GLOBAL ROUTINE INIT(DORESET) =
BEGIN
	IF .USRPPN IS 0					! THIS MUST BE FIRST CALL
	THEN BEGIN
		USRPPN _ GETPPN();			! GET THE PPN
		USRJBN _ PJOB();			! AND THE JOB NUMBER
		CNVBDT(DATE(),CHRDAT<FIRSTINCR>);	! SET TODAY'S DATE
		CNVBTM(MSTIME(),CHRTIM<FIRSTINCR>)	! AND NOW'S TIME
	END;
	INCHNL _ OTCHNL _ -1;				! RESET INPUT AND OUTPUT CHANNELS
	CURREP _ FIRREP _ NULL;
	FREE();
	IF .DORESET					! RESET UUO?
	THEN BEGIN
		RESET();
		CURFRE _ FIRFRE _ NULL			! ONLY CLEAR AREA POINTERS AFTER RESET UUO
	END
END;

COMMENT(CNVBIN);

! SUBROUTINE CNVBIN
! ========== ======

! THIS ROUTINE CONVERTS A VARYING STRING TO A
! BINARY NUMBER USING THE SPECIFIED BASE.
! IF THE STRING IS INVALID, THE NUMBER
! IS SET TO ZERO AND FALSE IS RETURNED.
! LAST MODIFIED ON 15 AUG 74 BY JG.

GLOBAL ROUTINE CNVBIN(VARPTR,BASE,BINPTR) =
BEGIN
	LOCAL	CHAR,PTR;
	MAP	VARYINGCHAR VARPTR;

	.BINPTR _ 0;					! CLEAR OUTPUT NUMBER
	PTR _ VARPTR[STRING]<FIRSTINCR>;		! PTR TO INPUT STRING
	DECR I FROM .VARPTR[LANGTH]-1 TO 0
	DO BEGIN
		CHAR _ SCANI(PTR);			! GRAB SOMETHING AND STARE AT IT
		IF .CHAR LSS "0" OR .CHAR GTR "9"	! IS IT A NUMBER
		THEN BEGIN				! NO
			.BINPTR _ 0;			! CLEAR NUMBER
			RETURN FALSE			! RETURN BAD NEWS
		END;
		IF (CHAR _ .CHAR-"0") GEQ .BASE		! CONVERT TO BINARY AND CHECK BASE CONTRAINT
		THEN BEGIN				! CHAR TOO BIG FOR BASE (I.E., "9" IN OCTAL)
			.BINPTR _ 0;			! CLEAR NUMBER
			RETURN FALSE			! AGAIN RETURN WITH BAD NEWS
		END;
		.BINPTR _ ..BINPTR*.BASE+.CHAR		! PLACE CHAR AS BINARY PART OF OUTPUT WORD
	END;
	TRUE
END;

COMMENT(ADDBYT);

! SUBROUTINE ADDBYT
! ========== ======

! THIS ROUTINE TAKES A BYTE POINTER AND ADDS TO
! IT THE SPECIFIED NUMBER OF CHARS. NOTE THAT
! THIS ROUTINE DIFFERS FROM BYTOFF IN THAT BYTOFF
! ASSUMES ITS ARGUMENT IS A WORD ADDRESS.
! LAST MODIFIED ON 23 AUG 74 BY JG.

GLOBAL ROUTINE ADDBYT (BYTPTR,COUNT) =
BEGIN
	LOCAL	TEMP,EXTRA;

	TEMP _ BYTOFF(.BYTPTR,.COUNT);			! DO THE EASY PART FIRST
	EXTRA _ 5-.BYTPTR<P>/5;				! SEE HOW MANY EXTRA CHARS IN ORIGINAL BYTE PTR
	DECR I FROM .EXTRA-1 TO 0
		DO INCP(TEMP);				! INCREMENT THE BYTE PTR THAT MANY
	.TEMP
END;

END ELUDOM; ! END OF UTILITY MODULE ...