Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-10 - 43,50517/rpgiik.mac
There is 1 other file named rpgiik.mac in the archive. Click here to see a list.
	TITLE	RPGIIK FOR RPGII %1(46)		
	SUBTTL	DUMPS FOR RPGII CRASH		BOB CURRIER

;AUGUST 6, 1975 	22:27:28

;THIS PHASE OF THE COMPILER IS CALLED ONLY IN CASE OF DRYROT. WHEN
;THE COMPILER GETS AN IMPOSSIBLE ERROR (E.G. PDL OVERFLOW, ILL MEM REF,
;CPUn OPR1 ACTION REQUESTED, ETC.) THIS ROUTINE IS CALLED TO DUMP
;THE FILES, AND OPTIONALLY CORE SO THAT IT MAY BE POSSIBLE TO FIGURE
;WHAT THE HELL WENT WRONG.
;
;WE'RE A HISEG
TWOSEG
RELOC	400000



;DEFINE SOME ACCUMULATORS

LN=1		;MISC INDEX
CH=4		;OUTPUT CHARACTER
TE=12		;TEMP
TD=13		;TEMP
TC=14		;TEMP
TB=15		;TEMP
TA=16		;TEMP

;I/O CHANNELS

DSK==2
DMP==3

;MACRO DEFINITIONS

DEFINE	APRINT (X),	<
	MOVE	TC,[POINT 7,[ASCIZ @X@]]
	PUSHJ	PP,ASCOUT
>

	INTERNAL	RPGIIK

	EXTERNAL	IMPURE,RESTRT

IFN	%CPU-%20,<
IFN	DEBUG,<	EXTERNAL DDT
		.REQUEST DDT>
		>


;DEFINE SOME STUFF TO GET RID OF UNDEFINED GLOBALS

INTERNAL REGO
REGO==RPGIIK

RPGIIK:	PORTAL	K1
	Z
	PORTAL	K2

K1:	JSP	1,SETIO
	JRST	CORE

K2:	JSP	1,SETIO
	JRST	CORE
;SET UP I/O DEVICES

SETIO:	MOVE	PP,KILLPP
	OUTSTR	[ASCIZ /?Compiler Boo-Boo in phase /]
	OUTCHR	PHASEN
	OUTSTR	[ASCIZ /, dump being taken
/]
	INIT	DMP,0			; OPEN UP DISK
	SIXBIT	/DSK/
	XWD	KBHO,0
	JRST	4,.-3			; AGGGGGGGH! DRYROT WITHIN DRYROT

DMPGOT:	OUTBUF	DMP,2
	PJOB	TC,
	MOVEI	TD,3
	IDIVI	TC,12
	ADDI	TB,"0"-40
	LSHC	TB,-6
	SOJG	TD,.-3

	MOVE	TE,.JBREL
	MOVEM	TA,(TE)
	HRRM	1,(TE)

DMPENT:	MOVE	TD,SRCFIL##		; DMPFIL NAME = SRCFIL NAME
	MOVSI	TC,445560		; 'DMP' IN OTHER WORDS
	SETZB	TB,TA

	MOVEM	TD,SAVNAM		; SAVE FILE NAME FOR LATER TYPEOUT

	ENTER	DMP,TD
	JRST	4,.-1			; COULDN'T DO IT


	SETZM	PAGEN			; RESET PAGE NUMBER

	JRST	(1)			; OUT WE GO

KILLPP:	XWD	-20,KILLPL
;DUMP OUT CORE

CORE:	HRRZ	TA,FILLOC		; GET START OF FILTAB
	MOVEM	TA,FLNKHL		; STORE FOR LATER

FD.01:	PUSHJ	PP,HDROUT		; GIVE IT SOME HEAD
	APRINT	<**********	FILE: >
	LDB	TB,FI.NAM		; GET POINTER TO NAME
	PUSHJ	PP,NAMOUT		; OUT IT GOES
	APRINT	<	**********

DEVICE:	>
	LDB	TB,FI.DEV		; GET DEVICE
	MOVE	TC,[POINT 6,DEVTAB(TB)]
	PUSHJ	PP,SIXOUT
	APRINT	<
PHYSICAL NAME: >
	LDB	TB,FI.PHY##		; GET PHYSICAL NAME
	MOVE	TC,[POINT 6,TB]		; SET UP BYTE POINTER
	PUSHJ	PP,SIXOUT		; OUTPUT IT
	APRINT	<
>
	SETZB	TE,LN

FD.02:	MOVE	TC,[POINT 6,FTAB(LN)]	; GET A FILTAB ITEM
	PUSHJ	PP,SIXOUT		; PUT IT OUT IN ASCII
	APRINT	<: >
	LDB	TB,@BPTAB1(LN)		; GET THE REAL ITEM
	PUSHJ	PP,DECOUT		; OUTPUT IT IN DECIMAL
	AOJ	TE,
	AOJ	LN,
	CAIN	LN,BPTABM		; BOTTOM OF TABLE?
	JRST	FD.04			; YEP -

	CAIN	TE,6
	JRST	FD.03			; ALL DONE WITH THIS LINE

	APRINT	<	>
	JRST	FD.02			; LOOP-

FD.03:	APRINT	<
>
	SETZ	TE,
	JRST	FD.02

FD.04:	APRINT	<

>
	LDB	TB,FI.ADF
	JUMPE	TB,FD.05		; JUMP IF WE AREN'T LINKED

	APRINT	<THIS FILE LINKS TO >
	LDB	TA,FI.ADL		; GET LINK
	PUSHJ	PP,LNKSET		; CONVERT TO ABSOLUTE
	LDB	TB,FI.NAM		; GET THE NAMTAB LINK
	PUSHJ	PP,NAMOUT		; PRINT IT
	APRINT	<

>

FD.05:	MOVE	TA,FLNKHL
	LDB	TA,FI.DAT		; GET DATAB LINK
	JUMPN	TA,FD.06		; GO DUMP DATAB ITEMS

	APRINT	<***** NO DATAB ITEMS FOR THIS FILE *****
>

;GET NEXT FILTAB ITEM

FD.99:	MOVE	TA,FLNKHL
	ADDI	TA,SZ.FIL		; INCREMENT
	MOVEM	TA,FLNKHL
	HRRZ	TB,FILNXT
	CAME	TA,TB			; HIT THE END YET?
	JRST	FD.01			; NO -

	PUSHJ	PP,HDROUT		; YES -
	APRINT	<END OF DUMP
>
	JRST	DMPEND

;DUMP DATAB ITEMS

FD.06:	PUSHJ	PP,LNKSET
	APRINT	<

*****	MAJOR ITEM - >
	MOVE	3,TA			; SAVE DATAB POINTER

FD.06A:	LDB	TB,DA.NAM
	PUSHJ	PP,NAMOUT		; OUTPUT NAME OF ITEM
	LDB	TB,DA.ARE		; GET ARRAY ENTRY FLAG
	JUMPE	TB,FD.07

	APRINT	<
ARRAY ENTRY, INDEX = >
	LDB	TB,DA.IMD##		; IMMEDIATE?
	JUMPE	TB,FD.06B		; NO -
	LDB	TB,DA.INP##		; YES - GET INDEX
	PUSHJ	PP,DECOUT		; OUTPUT IT
	JRST	FD.08			; CONTINUE

FD.06B:	MOVEM	TA,DLNKHL		; STASH
	LDB	TA,DA.INP		; GET POINTER
	PUSHJ	PP,LNKSET		; SET UP LINK	
	LDB	TB,DA.NAM		; GET NAMTAB LINK
	PUSHJ	PP,NAMOUT		; OUTPUT IT
	MOVE	TA,DLNKHL		; RESTORE TA
	JRST	FD.08			; GO ON

FD.07:	LDB	TB,DA.OCC		; SEE IF A TABLE/ARRAY
	JUMPE	TB,FD.11

	APRINT	<
TABLE OR ARRAY, OCCURS = >
	PUSHJ	PP,DECOUT
	LDB	TB,DA.ALT		; SEE IF IT ALTERNATES
	JUMPE	TB,FD.08		; NOPE

	APRINT	<, ALTERNATES WITH >
	MOVEM	TA,DLNKHL
	LDB	TA,DA.ALL
	PUSHJ	PP,LNKSET
	LDB	TB,DA.NAM
	PUSHJ	PP,NAMOUT
	MOVE	TB,DLNKHL

FD.08:	LDB	TB,DA.LDC		; SEE IF ARRAY IS LOADED FROM FILE
	JUMPN	TB,FD.09
	LDB	TB,DA.LDR
	JUMPN	TB,FD.09
	LDB	TB,DA.LDE
	JUMPE	TB,FD.10

FD.09:	APRINT	<
TBALE/ARRAY LOADS FROM FILE >
	MOVEM	TA,DLNKHL
	LDB	TA,DA.LDP		; GET LOAD POINTER
	PUSHJ	PP,LNKSET
	LDB	TB,FI.NAM
	PUSHJ	PP,NAMOUT		; DUMP NAME
	MOVE	TA,DLNKHL

FD.10:	LDB	TB,DA.DMP
	JUMPE	TB,FD.11
	APRINT	<
TABLE/ARRAY DUMPS TO FILE >
	MOVEM	TA,DLNKHL
	LDB	TA,DA.DPP
	PUSHJ	PP,LNKSET
	LDB	TB,FI.NAM
	PUSHJ	PP,NAMOUT
	MOVE	TA,DLNKHL

FD.11:	LDB	TB,DA.IND
	JUMPN	TB,FD.12
	APRINT	<
NO INDICATORS ASSOCIATED WITH THIS ITEM.>
	JRST	FD.14

FD.12:	APRINT	<
INDICATORS ASSOCIATED WITH THIS ITEM:
>
	MOVEM	TA,DLNKHL
	MOVEI	TE,6
	LDB	TA,DA.IND
	PUSHJ	PP,LNKSET

FD.12A:	LDB	TB,[POINT 1,(TA),1]	; GET "NOT" ENTRY
	MOVE	TC,[POINT 7,[ASCIZ /NOT /]]
	CAIN	TB,0
	MOVE	TC,[POINT 7,[ASCIZ /    /]]
	PUSHJ	PP,ASCOUT
	LDB	TB,[POINT 12,(TA),21]
	JUMPE	TB,FD.15		; OUTPUT INDICATORS

	LDB	CH,[POINT 8,(TA),9]
	PUSHJ	PP,CHOUT		; OUTPUT CHARACTER
	APRINT	< AT >
	PUSHJ	PP,DECOUT		; OUTPUT POSITION
	JRST	FD.16

FD.15:	LDB	TB,[POINT 8,(TA),9]	; GET INDICATOR
	PUSHJ	PP,DECOUT		; OUTPUT IT

FD.16:	LDB	TB,[POINT 1,(TA),22]
	JUMPN	TB,FD.16B
	AOJ	TA,
	LDB	TB,[POINT 1,(TA),0]
	MOVE	TC,[POINT 7,[ASCIZ / AND/]]
	CAIE	TC,0
	MOVE	TC,[POINT 7,[ASCIZ / OR/]]
	PUSHJ	PP,ASCOUT
	APRINT	<	>
	SOJN	TE,FD.12A
	APRINT	<
>
	MOVEI	TE,6
	JRST	FD.12A			; LOOP

FD.16B:	MOVE	TA,DLNKHL		; ALL DONE WITH INDICATORS
	APRINT	<

>

;OUTPUT VALUE IF ANY

FD.14:	LDB	TB,DA.VAL
	JUMPE	TB,FD.17
	APRINT	<
CONSTANT OR EDIT WORD:
>
	MOVEM	TA,DLNKHL
	MOVE	TA,TB
	PUSHJ	PP,LNKSET
	LDB	TD,[POINT 7,(TA),6]	; GET CHARACTER COUNT
	MOVE	TC,[POINT 7,(TA),6]	; SET UP POINTER
	PUSHJ	PP,VALOUT		; OUTPUT IT
	MOVE	TA,DLNKHL

;OUTPUT DATAB ITEMS

FD.17:	SETZ	LN,
	MOVEI	TE,6
	APRINT	<

>

FD.17A:	MOVE	TC,[POINT 6,DTAB(LN)]
	PUSHJ	PP,SIXOUT
	APRINT	<: >
	LDB	TB,@DPTAB(LN)
	PUSHJ	PP,DECOUT
	AOJ	LN,
	CAIN	LN,DPTABM		; END OF TABLE?
	JRST	FD.18			; YES -

	APRINT	<	>
	SOJN	TE,FD.17A
	APRINT	<
>
	MOVEI	TE,6
	JRST	FD.17A

;GET NEXT DATAB ENTRY

FD.18:	LDB	TB,DA.BRO		; A MINOR LEFT?
	JUMPE	TB,FD.19		; NO -


	APRINT	<

***	MINOR ITEM - >
	MOVE	TA,TB
	PUSHJ	PP,LNKSET
	JRST	FD.06A

FD.19:	MOVE	TA,3			; RESTORE MAJOR POINTER
	LDB	TB,DA.MAJ		; ANY MAJORS LEFT?
	JUMPE	TB,FD.99		; NO - GET ANOTHER FILTAB ITEM
	MOVE	TA,TB			; YES - LOOP
	JRST	FD.06

;FINISH IT UP

DMPEND:	OUTSTR	[ASCIZ	/Please print DSK:/]
	MOVE	TE,SAVNAM
	PUSHJ	PP,SIXTTY		; OUTPUT FILENAME
	OUTSTR	[ASCIZ /.DMP and submit with
an SPR, along with a copy of the source, to your system
programmer.
/]
	CLOSE DMP,

;BACK TO PHASE A

	MOVEI	TA,"K"
	MOVEM	TA,PHASEN
	MOVE	0,KILLAC
IFE	ONESEG,<			; [277]
	JRST	RESTRT			; [277]
	>				; [277]
IFN	ONESEG,<			; [277]
	JRST	RPGIIA##		; [277]
	>				; [277]
;PRINT OUT VERSION NUMBER ETC. AT TOP OF LISTING

HDROUT:	MOVEI	CH,14
	PUSHJ	PP,CHOUT		; GET TO TOP OF FORM
	MOVEI	CH,^D55
	MOVEM	CH,LINE
	APRINT	<Compiler Version >
	MOVE	TC,[POINT 6,VERZUN]
	PUSHJ	PP,SIXOUT
	APRINT	< -- dumped in phase >
	MOVE	CH,PHASEN
	PUSHJ	PP,CHOUT

	APRINT	< of program >
	MOVE	TC,[POINT 6,PRGID]
	PUSHJ	PP,SIXOUT
	APRINT	<		Page: >
	AOS	PAGEN
	PUSH	PP,TB			; SAVE THE AC
	MOVE	TB,PAGEN
	PUSHJ	PP,DECOUT
	APRINT	<


>

	POP	PP,TB			; RESTORE THE AC
	POPJ	PP,

;PUT AN ASCII CHARACTER INTO DMPFIL

CHOUT:	CAIN	CH,12			; IS CHAR A LINE FEED?
	JRST	CHOUT3			; YES - UPDATE LINE COUNTER

	SOSG	KBHO+2
	JRST	CHOUT2			; NO ROOM - MAKE IT

CHOUT1:	IDPB	CH,KBHO+1
	POPJ	PP,

CHOUT2:	OUT	DMP,
	JRST	CHOUT1

	OUTSTR	[ASCIZ /ERROR WHILE WRITING DUMP FILE
/]
	RELEASE	DMP,
	RELEASE	DSK,
	EXIT

CHOUT3:	SOSN	LINE			; PAGE OVERFLOW?
	PUSHJ	PP,HDROUT		; YES -
	JRST	CHOUT+2			; NO -

;OUTPUT ASCII STRING TO DMPFIL

ASCOUT:	ILDB	CH,TC
	CAIN	CH,0
	POPJ	PP,
	PUSHJ	PP,CHOUT
	JRST	ASCOUT

;OUTPUT NAMTAB ENTRY TO DMPFIL

NAMOUT:	ADD	TB,NAMLOC##		; ADD IN BASE OF NAMTAB
	MOVE	TC,[POINT 6,1(TB)]
	ILDB	CH,TC
	CAIN	CH,' '
	POPJ	PP,
	ADDI	CH,40
	PUSHJ	PP,CHOUT
	JRST	NAMOUT+2		; LOOP

;OUTPUT DECIMAL NUMBER IN "TB" TO DMPFIL

DECOUT:	MOVE	TC,TB

DECL1:	IDIVI	TC,^D10			; TB = LOW ORDER DIGIT
	HRLM	TB,(PP)			; SAVE IT ON STACK
	SKIPE	TC			; LOOP UNTIL
	PUSHJ	PP,DECL1		;   ALL DIGITS OUT
	HLRZ	CH,(PP)
	ADDI	CH,"0"			; CONVERT TO ASCII
	JRST	CHOUT			; PUT IT OUT

;OUTPUT ONE SIXBIT WORD TO DMPFIL

SIXOUT:	ILDB	CH,TC
	ADDI	CH,40
	PUSHJ	PP,CHOUT
	TLNE	TC,770000
	JRST	SIXOUT
	POPJ	PP,

;OUTPUT A VALTAB ENTRY TO DMPFIL

VALOUT:	ILDB	CH,TC
	JUMPE	CH,CPOPJ
	PUSHJ	PP,CHOUT
	SOJN	TD,VALOUT
	POPJ	PP,

;OUTPUT A SIXBIT WORD TO TTY

SIXTTY:	MOVE	TD,[POINT 6,TE]

SIXTT1:	ILDB	CH,TD
	JUMPE	CH,CPOPJ
	ADDI	CH,40			; OUT OF THE REALM OF SIXBIT INOT ASCII!
	OUTCHR	CH
	TLNE	TD,770000
	JRST	SIXTT1

CPOPJ:	POPJ	PP,

;DEFINE TABLES

;TABLE OF VALID DEVICES

DEVTAB:	SIXBIT	/MFCU1/
	SIXBIT	/MFCU2/
	SIXBIT	/READ01/
	SIXBIT	/PRINTE/
	SIXBIT	/PRINTR/
	SIXBIT	/CONSOL/
	SIXBIT	/DISK/
	SIXBIT	/TAPE/

;TABLE OF FILTAB ENTRIES

FTAB:	SIXBIT	/FI.TYP/
	SIXBIT	/FI.DES/
	SIXBIT	/FI.PRO/
	SIXBIT	/FI.ORG/
	SIXBIT	/FI.RAF/
	SIXBIT	/FI.EOF/
	SIXBIT	/FI.KYP/
	SIXBIT	/FI.BKL/
	SIXBIT	/FI.RCL/
	SIXBIT	/FI.SEQ/
	SIXBIT	/FI.BUF/
	SIXBIT	/FI.AST/
	SIXBIT	/FI.REW/
	SIXBIT	/FI.EXT/
	SIXBIT	/FI.ADD/
	SIXBIT	/FI.OVI/
	SIXBIT	/FI.EXI/
	SIXBIT	/FI.OVL/
	SIXBIT	/FI.LPP/
	SIXBIT	/FI.KYL/
	SIXBIT	/FI.COR/
	SIXBIT	/FI.LIN/

BPTAB1:	EXP	FI.TYP##
	EXP	FI.DES##
	EXP	FI.PRO##
	EXP	FI.ORG##
	EXP	FI.RAF##
	EXP	FI.EOF##
	EXP	FI.KYP##
	EXP	FI.BKL##
	EXP	FI.RCL##
	EXP	FI.SEQ##
	EXP	FI.BUF##
	EXP	FI.AST##
	EXP	FI.REW##
	EXP	FI.ADD##
	EXP	FI.OVI##
	EXP	FI.EXI##
	EXP	FI.OVL##
	EXP	FI.LPP##
	EXP	FI.KYL##
	EXP	FI.COR##
	EXP	FI.LIN##

BPTABM=.-BPTAB1

;DEFINE SAME FOR DATAB

DTAB:	SIXBIT	/DA.NPS/
	SIXBIT	/DA.RTR/
	SIXBIT	/DA.TRA/
	SIXBIT	/DA.LHI/
	SIXBIT	/DA.STS/
	SIXBIT	/DA.FLD/
	SIXBIT	/DA.SIZ/
	SIXBIT	/DA.DEC/
	SIXBIT	/DA.PRI/
	SIXBIT	/DA.PRO/
	SIXBIT	/DA.STR/
	SIXBIT	/DA.FRR/
	SIXBIT	/DA.RII/
	SIXBIT	/DA.CLI/
	SIXBIT	/DA.FPL/
	SIXBIT	/DA.STP/
	SIXBIT	/DA.ORT/
	SIXBIT	/DA.ARC/
	SIXBIT	/DA.FOV/
	SIXBIT	/DA.SPA/
	SIXBIT	/DA.SKA/
	SIXBIT	/DA.EDT/
	SIXBIT	/DA.BLA/
	SIXBIT	/DA.SPB/
	SIXBIT	/DA.END/
	SIXBIT	/DA.EPR/
	SIXBIT	/DA.SEQ/
	SIXBIT	/DA.ARE/
	SIXBIT	/DA.SNM/
	SIXBIT	/DA.FRP/
	SIXBIT	/DA.TOP/
	SIXBIT	/DA.MAT/
	SIXBIT	/DA.FMN/
	SIXBIT	/DA.FBZ/
	SIXBIT	/DA.SKB/
	SIXBIT	/DA.RES/
	SIXBIT	/DA.DUN/
	SIXBIT	/DA.ICH/
	SIXBIT	/DA.ARP/
	SIXBIT	/DA.IMD/
	SIXBIT	/DA.INP/
	SIXBIT	/DA.INF/

DPTAB:	EXP	DA.NPS##
	EXP	DA.RTR##
	EXP	DA.TRA##
	EXP	DA.LHI##
	EXP	DA.STS##
	EXP	DA.FLD##
	EXP	DA.SIZ##
	EXP	DA.DEC##
	EXP	DA.PRI##
	EXP	DA.PRO##
	EXP	DA.STR##
	EXP	DA.FRR##
	EXP	DA.RII##
	EXP	DA.CLI##
	EXP	DA.FPL##
	EXP	DA.STP##
	EXP	DA.ORT##
	EXP	DA.ARC##
	EXP	DA.FOV##
	EXP	DA.SPA##
	EXP	DA.SKA##
	EXP	DA.EDT##
	EXP	DA.BLA##
	EXP	DA.SPB##
	EXP	DA.END##
	EXP	DA.EPR##
	EXP	DA.SEQ##
	EXP	DA.ARE##
	EXP	DA.SNM##
	EXP	DA.FRP##
	EXP	DA.TOP##
	EXP	DA.MAT##
	EXP	DA.FMN##
	EXP	DA.FBZ##
	EXP	DA.SKB##
	EXP	DA.RES##
	EXP	DA.DUN##
	EXP	DA.ICH##
	EXP	DA.ARP##
	EXP	DA.IMD##
	EXP	DA.INP##
	EXP	DA.INF##

DPTABM=.-DPTAB

;DEFINE SOME EXTERNALS

IFE	ONESEG,<
EXTERNAL PUREC
	>
EXTERNAL .JBREL,.JBSA,VERZUN
EXTERNAL TTYBHO,TTYBHI,KBUFI,KBHO,KBHI,KILLPL,KILLAC
EXTERNAL PHASEN,TOPLOC,IMPURE,KDATA,.JBFF,SRCBUF,PRGID
EXTERNAL LSTDEV,FSTCLR,TTYBUF,PPSIZE,PPLIST
EXTERNAL KILLPL,SAVNAM,FILLOC,FILNXT,LNKSET
EXTERNAL LINE,PAGEN,FLNKHL,DLNKHL

;DEFINE TABLE STUFF

EXTERNAL FI.NAM,FI.DEV,FI.ADF,FI.ADL,FI.DAT
EXTERNAL DA.NAM,DA.MAJ,DA.BRO,DA.IND,DA.VAL,DA.COR,DA.LDC
EXTERNAL DA.LDR,DA.LDE,DA.DMP,DA.OCC,DA.ALT,DA.ALL,DA.LDP
EXTERNAL DA.DPP


	END	RPGIIK