Google
 

Trailing-Edge - PDP-10 Archives - bb-kl11f-bm_tops20_v7_0_atpch1_19 - autopatch/cobold.c10
There are 2 other files named cobold.c10 in the archive. Click here to see a list.
 REP 11/1	;10C1
	COPYRIGHT (C) 1974, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION
 WIT
	COPYRIGHT (C) 1974, 1983, 1984, 1985 BY DIGITAL EQUIPMENT CORPORATION
 INS 5/2	;10C2
	;MJC	22-JAN-85	[1556] Remove code that allowed SEARCH ... WHEN to
	;;				ignore extraneous periods.
	;MJC	30-NOV-84	[1553] Rework PA823. to do END-XXX scope termination
	;;				by popping from the node stack
 INS 23/5	;10C3
		SETZM	SCPTRM##	;[1553] END-XXX SCOPE TERMINATOR
 REP 26/19	;10C4
	PA24.:	CAIN	TYPE,ELSE.	;[1005] ENCOUNTERED 'ELSE'?
 WIT
	PA24.:	CAIE	TYPE,ELSE.	;[1005][1553] ENCOUNTERED 'ELSE'?
		SKIPE	SCPTRM##	;[1553] OR END-XXX?
 INS 3/22	;10C5
		SETZM	EWFLG##		;[1553] Turn off when seen flag
 INS 18/30	;10C6

 INS 44/55	;10C7
		INTER.	PA148A		;[1556] IF IT IS A PERIOD
	PA148A:	SWOFF	FPERWD!FREGWD	;[1556] GET THE NEXT TOKEN
		POPJ	PP,		;[1556]

 INS 156/68	;10C8
		MOVEI	TC,IF.		;[1553] UNWIND TERM STACK TO AN IF
		PUSHJ	PP,PA824.	;[1553] CLEAN UP TERM STACK
		SETZM	EWFLG##		;[1553] Turn off when seen flag
 REP 30/87	;10C9
		PUSHJ	PP,PA821.	;SAVE CURRENT RESERVED WORD.
 WIT
		PUSHJ	PP,PA820.	;[1553]SAVE CURRENT RESERVED WORD.
 REP 6/88	;10C10
		CAIN	TA,PRIOD.	;IF AT END OF SEARCH STATEMENT
		SWON	FPERWD		; [413]   REGET THE PERIOD
		CAIN	TA,WHEN.	;DID WE COME HERE ON "WHEN"?
		 JRST	PA245A		;YES--MAKE SURE NO PERIOD FOLLOWED LAST SENTENCE
	PA245B:	HRRZI	TA,OPJUMP
 WIT
		SETZM	EWFLG##		;[1553] RESET WHEN SEEN FLAG
		CAIN	TA,PRIOD.	;IF AT END OF SEARCH STATEMENT
		SWON	FPERWD		; [413]   REGET THE PERIOD
	PA245B:	HRRZI	TA,OPJUMP	;[1556] REMOVE EXTRANEOUS PERIOD CODE
 REP 15/88	;10C11
		JRST	PA22.		;GO OUTPUT JUMP OPERATOR
	PA245A:	SKIPE	SWHEN##		;SKIP IF SOMETHING OTHER THAN 'WHEN' ENDED
					; LAST SENTENCE
		 JRST	PA245B		;NO, ALL OK
		HLRZ	LN,PERLNC	;GET LN & CP
		HRRZ	CP,PERLNC	; OF LAST PERIOD
		MOVEI	DW,E.621	;"PERIOD IGNORED"
		PUSHJ	PP,WARN
		JRST	PA245B		;RESUME PROCESSING
 WIT
		MOVEI	TC,SEARC.	;[1553] TERMINATOR TO LOOK FOR
		PUSHJ	PP,PA824.	;[1553] CLEAN UP TERMINATOR STACK
		JRST	PA22.		;GO OUTPUT JUMP OPERATOR
 REP 37/135	;10C12
	PA823.:	DMOVE	TB,NAMWRD	;remove END- from current token
 WIT
	PA823.:	SKIPE	SCPTRM##	;[1553] Did we get here from a popped node?
		JRST	PA823E		;[1553] Yes - Check next token
		DMOVE	TB,NAMWRD	;remove END- from current token
 REP 47/135	;10C13
		  HALT	.		;Cannot happen
		HLRZ	TYPE,(TA)	;Get first word of NAMTAB
		TRZN	TYPE,GWRESV	;Should be a reserved word
		HALT			;Should not happen
		SKIPA	TA,TEMNXT##	;Start at bottom of stack
	PA823B:	SUB	TA,[SZ.TEM,,SZ.TEM]	;Back up 1 item
		CAMN	TA,TEMLOC##	;Back up to top yet
		JRST	PA823C		;Yes, we did not find a match
		HRRZ	TB,(TA)		;Get token
		SETZ	TC,
		TRNE	TB,400000	;Is this an inline PERFORM xxx END-PERFORM ?
		SETO	TC,		;Yes
		ANDI	TB,377777
		CAME	TYPE,TB		;Is this the matching pair?
		JRST	PA823B		;No, try next
		SUB	TA,[SZ.TEM,,SZ.TEM]	;Back up 1 item
		MOVEM	TA,TEMNXT	;Reset bottom of stack
		CAIN	TYPE,SEARC.	;Is it END-SEARCH?
		POPJ	PP,		;Yes, haven't finished tags yet
		PUSHJ	PP,PA140.	;Terminate active SPIF
		PUSHJ	PP,PA37.	;[1541]CLEAN UP IFLVL STACK
		SWOFF	UNCONT		;Switch off unconditional GOTO flag
		CAIN	TYPE,PERFO.	;Is it END-PERFORM?
		JRST	PA823P		;Yes
		CAIE	TYPE,EVAL.	;Is it END-EVALUATE?
		POPJ	PP,		;
		SWON	FREGWD		;Turn on REGET word 
		JRST	PA0.		; and pop up one node

	PA823P:	SKIPE	TC		;Is it an inline PERFORM xxx END-PERFORM ?
		POPJ	PP,		;Yes, don't put out opcode
		SOS	ILPERF		;Count down active in-line PERFORMs
		MOVEI	TA,OPEPRF	;End in-line PERFORM opcode
		PUSHJ	PP,SETOP
		HRRZ	TA,TEMNXT
		HLRZ	TB,SZ.TEM(TA)	;It hasn't moved yet
		DPB	TB,OP.TRG	;Store tag number
		JRST	PA22.

	PA823C:	CAIN	TYPE,SEARC.	;
		EWARNJ	E.820		;
		PUSHJ	PP,PA140.	;Clean up SPIF
		PUSHJ	PP,PA37.	;[1541] Put out tag if required
		EWARNJ	E.820
 WIT
		  JRST	KILL		;[1553] Cannot happen
		HLRZ	TYPE,(TA)	;Get first word of NAMTAB
		TRZN	TYPE,GWRESV	;Should be a reserved word
		  JRST	KILL		;[1553] Should not happen
		MOVEM	TYPE,ENDTOK##	;[1553] Save the token that we found
		SETOM	SCPTRM##	;[1553] Flag to Pop nodes for one level
		MOVE	TA,TEMNXT##	;[1553] Start at bottom of stack
		JRST	PA823D		;[1553]

	PA823B:	MOVE	TA,TEMNXT##	;[1553] Restore last location
		SUB	TA,[SZ.TEM,,SZ.TEM]	;Back up 1 item
		MOVEM	TA,TEMNXT##	;[1553] Save new pointer
	PA823D:	CAMN	TA,TEMLOC##	;[1553] Back up to top yet ?
		JRST	PA823C		;Yes, we did not find a match
		HRRZ	TB,(TA)		;Get token
		SETZM	PEREPR##	;[1553]
		TRNE	TB,400000	;Is this an inline PERFORM xxx END-PERFORM ?
		SETOM	PEREPR##	;[1553] Yes
		ANDI	TB,177777	;[1553] Clear per-endper and if-else flags
		MOVE	TYPE,ENDTOK##	;[1553] Get the token back
		CAMN	TYPE,TB		;Is this the matching pair?
		JRST	PA823F		;[1553] Yes - end the loop
		SWON	FREGWD		;[1553] Turn on REGET word 
		CAIN	TB,PERFO.	;[1553] Is it END-PERFORM ?
		JRST	PA823P		;[1553] Yes
		JRST	PA0.		;[1553] No, Pop node and try next
	PA823F:	MOVM	TA,SCPTRM##	;[1553] Change flag
		MOVEM	TA,SCPTRM##	;[1553]   to match found
		CAIN	TYPE,PERFO.	;[1553] Is it END-PERFORM ?
		JRST	PA823P		;[1553] Yes
		SWOFF	UNCONT		;Switch off unconditional GOTO flag
		SWON	FREGWD		;[1553] Turn on REGET word 
		JRST	PA0.		;

	PA823E: SKIPG	SCPTRM##	;[1553] Found the match yet?
		JRST	PA823B		;[1553] No - check next token
		SWOFF	FREGWD		;[1553] Clear reget word
		SETZM	SCPTRM##	;[1553] Reset flag
		MOVE	TA,TEMNXT##	;[1553] Get current stack
		SUB	TA,[SZ.TEM,,SZ.TEM]	;[1553] Back up 1 item
		MOVEM	TA,TEMNXT	;[1553] Reset bottom of stack
		POPJ	PP,		;[1553]

	PA823P:	SKIPE	PEREPR##	;[1553]Is it inline PERFORM xxx END-PERFORM ?
		JRST	PA823E		;[1553]Yes, don't put out opcode
		SOS	ILPERF		;[1553] Count down active in-line PERFORMs
		JRST	PA0.		;[1553]No pop its node

		INTER.	PA823C
	PA823C:	SETZM	SCPTRM##	;[1553]Incorrect scope terminator
		SWOFF	FREGWD		;[1553]Reset flags, Get next word
		SETZM	EWFLG##		;[1553]Don't give E.855 error
		EWARNJ	E.820

	;[1553] PA824. removes the tokens from the terminator stack whose scope
	;[1553] is terminated by an ELSE or a WHEN.  It is called from the ELSE
	;[1553] and WHEN action routines with the token (IF, EVLAUATE or SEARCH)
	;[1553] in TC.

		INTER.	PA824.
	PA824.:	CAIN	TYPE,PRIOD.	;[1553] Did we scan a period?
		POPJ	PP,		;[1553] No more terminator stack
		SKIPA	TA,TEMNXT##	;[1553] Start at bottom of stack
	PA824A:	SUB	TA,[SZ.TEM,,SZ.TEM]	;[1553] Back up 1 item
		CAMN	TA,TEMLOC##	;[1553] Back up to top yet ?
		EWARNJ	E.855		;[1553] Yes, we did not find the matching one
		HRRZ	TB,(TA)		;[1553] Get token
		CAME	TB,TC		;[1553] Is this the matching token ?
		JRST	PA824A		;[1553]	No keep looking
		MOVEM	TA,TEMNXT	;[1553] Reset bottom of stack
		CAIE	TC,IF.		;[1553] IF-ELSE ?
		POPJ	PP,		;[1553] No - return 
		TRO	TB,200000	;[1553] Flag this IF as having an ELSE
		HRRZM	TB,(TA)		;[1553] Up date the terminator stack
		POPJ	PP,		;[1553] Done
 INS 88/136	;10C14
	;[1553] In-line perform wrap up actions
		INTER.	PA835.
	PA835.:	MOVEI	TC,PERFO.	;[1553] Find the last perform
		PUSHJ	PP,PA824.	;[1553]   in the terminator stack
		MOVEI	TA,OPEPRF	;[1553] End in-line PERFORM opcode
		PUSHJ	PP,SETOP	;[1553]
		HRRZ	TA,TEMNXT	;[1553]
		HLRZ	TB,(TA)		;[1553] It hasn't moved yet
		DPB	TB,OP.TRG	;[1553] Store tag number
		PUSHJ	PP,PA22.	;[1553]
		SWON	FREGWD		;[1553] Reget the word
		JRST	PA0.		;[1553] Pop the node

 INS 123/137	;10C15
		SETZM	EWFLG##		;[1553] Turn off when seen for E.855
 REP 126/137	;10C16
		POPJ	PP,
 WIT
		MOVEI	TC,EVAL.	;[1553] The token to look for
		JRST	PA824.		;[1553] Clean up terminator stack

 INS 222/137	;10C17
		SKIPE	SCPTRM##	;[1553] or a scope terminator?
		SWON	FREGWD		;[1553] Set flag to re-get the terminator.
 INS 286/137	;10C18
		SETZM	EWFLG		;[1553] This is not a scope term error
 REP 52/139	;10C19
	;IN SEARCH STATEMENT, SET FLAG THAT SAYS "." SEEN TO DELIMIT
	; STATEMENT. IF THE NEXT TOKEN IS A "WHEN", WE WILL ASSUME
	; THAT THE "." IS A MISTAKE
	; AND IGNORE IT.
 WIT
	;[1556] REMOVE CODE TO IGNORE A EXTRA PERIOD IN A SEARCH ... WHEN
 REP 59/139	;10C20
		HRLZM	LN,PERLNC##	;STORE LN AND CP
		HRRM	CP,PERLNC	;OF THE "." INCASE AFTER PARSING THE
					;NEXT TOKEN WE DECIDE THIS PERIOD IS EXTRANEOUS
		MOVE	TA,TEMLOC	;Reset scope terminator stack
		MOVEM	TA,TEMNXT
		SKIPE	ILPERF		;Do the in-line PERFORMs balance?
		EWARNW	E.821		;No
		SETZM	ILPERF
		JRST	PA0.		;POP UP A NODE
 WIT
		SETZM	SCPTRM##	;[1553] CLEAR END-XXX
		MOVE	TA,TEMLOC	;Reset scope terminator stack
		MOVEM	TA,TEMNXT
		SKIPLE	ILPERF		;[1553] Do the in-line PERFORMs balance?
		EWARNW	E.821		;No
		SETZM	ILPERF
		SWON	FPERWD		;[1556] REGET THE PERIOD
		JRST	PA0.		;POP UP A NODE

	;[1553] The next four entries make sure an ELSE or a WHEN after an Incorrect
	;[1553] Scope terminator gets a good error message

		INTER.	PCA7G.
	PCA7G.:	SKIPN	ERSKIP		;[1553] Skip if doing error recovery
		SETOM	EWFLG##		;[1553] Set flag that ELSE was seen
		JRST	PCA7.		;[1553] Pop the node

		INTER.	PCA7D.
	PCA7D.:	SKIPN	ERSKIP		;[1553] Skip if doing error recovery
		SETOM	EWFLG##		;[1553] Set flag that WHEN was seen
		JRST	PCA7A.		;[1553] Set flag and pop a node

		INTER.	PCA7E.
	PCA7E.:	SETZM	EWFLG##		;[1553] Reset the flag
		POPJ	PP,		;[1553]

		INTER.	PCA7F.
	PCA7F.:	SKIPE	EWFLG##		;[1553] Flag still set?
		JRST	PCA7FX		;[1553] Yes - Must have had a bad END-XXX 
		EWARNJ	E.148		;[1553] No - Use the old error
	PCA7FX:	EWARNJ	E.855		;[1553] Scope already terminated
 INS 26/142	;10C21
		SKIPN	SCPTRM##	;[1553] Scope Terminator?	
 REP 33/142	;10C22
		PUSH	PP,TD		;[670] GET AN AC
		MOVE	TD,PRVTOK##	;[1514] GET THE PREVIOUS TOKEN
		TRZ	TD,AMRGN.	;[1514] SHUT OFF FLAG IN CASE IT'S ON
		CAIE	TD,PRIOD.	;[1514] WAS IT A PERIOD?
		JRST	PCA61M		;[670] NO
		MOVE	TD,IFLVL	;[670] LOAD CURR NO OF LEVELS OF "IF"
		JUMPLE	TD,PCA61M	;[670] JUMP IF NO LEVELS OUTSTANDING
		HRRZ	TD,-2(NODPTR)	;[744] ABOUT TO END A SEARCH STMT?
		CAIN	TD,PD1055##	;[744]
		 JRST	PCA61M		;[744] YES
	PCA61J:	POP	NODPTR,NODE	;[670] UNWIND TWO LEVELS OF NODES FOR
		POP	NODPTR,NODE	;[670]   FOR EACH LEVEL OF "IF"
		HRRZ	TD,(NODPTR)	;[1050] SEE IF WE ARE UNWINDING A SPIF
		CAIN	TD,PD569.##	;[1050] AND WOULD RETURN HERE
		 JRST	[PUSHJ PP,PA139. ;[1050] YES, THIS IS THE I/O SPIF
			JRST .+2]	;[1050] GENERATE "END SPIF" AND SKIP
		PUSHJ	PP,PA37.	;[707] MAYBE OUTPUT FALSE-TAG
		SKIPLE	IFLVL		;[707] REACHED THE BOTTOM YET?
		JRST	PCA61J		;[670] NO
	PCA61M:	POP	PP,TD		;[670] YES, RESTORE AC
 WIT
		SWON	FREGWD		;[1553] Reget the period
 INS 72/145	;10C23
		INTER.	PCA97.
	PCA97.:	SWON	FREGWD		;[1553] Clean up for END-EVALUATE
		PUSHJ	PP,PA847.	;[1553] Wrap-up actions
		JRST	PA0.		;[1553] Pop a node

 SUM 154920