Trailing-Edge
-
PDP-10 Archives
-
bb-kl11i-bm_tops20_v7_0_atpch_1-22
-
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