**********************************************************************
* Name:		DCOD
* Stack:	( ob --> $ )
* Desc:		Decompile object into hexadecimal data
**********************************************************************
ASSEMBLE
	CON(1)	8
RPL
xNAME DCOD
::
  CK1
  GARBAGE
  CODE
		GOSBVL	=SAVPTR
		A=DAT1	A
		R2=A	A		R2[A]=->ob
		D0=A			->ob

		A=DAT0	A		Verify object is prologed
		D1=A
		A=DAT1	A
		LC(5)	=PRLG
		?A=C	A
		GOYES	+
dcoderror	LC(5)	=SETTYPEERR
		GOVLNG	=GETPTREVALC
dcodmemerr	GOVLNG	=GPMEMERR
+		GOSBVL	=SKIPOB
		CD0EX
		R3=C	A		R2[A]=->obend
		GOSBVL	=ROOM
		LA(5)	100
		C=C-A	A
		GOC	dcodmemerr
		ASRB.F	A
		C=C+A	A
		CSRB.F	A
		R1=C	A		R1[A]=free
		GOSBVL	=MAKE$
		CD0EX
		D1=C			->output
		C=R2	A
		D0=C			->input
		C=0	A
		R2=C	A		indent=0

dcodloop	AD0EX
		D0=A
		C=R3	A		->obend
		?A<C	A
		GOYES	+
		CD1EX
		D0=C
		GOSBVL	=Shrink$
		GOVLNG	=GPOverWrR0Lp
+		GOSUB	dcodindent
		GOSUB	dcodcomp?
		GONC	+
		C=R2	A		* Output composite prolog *
		C=C+1	A		indent++
		R2=C	A
		GONC	dcodout5
+		LC(5)	=SEMI
		?A#C	A
		GOYES	dcodoutob
		C=R2	A		* Output SEMI *
		C=C-1	A		indent--
		R2=C	A
		D1=D1-	2		less indent on SEMI line
		C=R1	A
		C=C+1	A		free++
		R1=C	A
dcodout5	C=0	A
		LC(1)	5
		GOTO	dcodoutn	
dcodoutob	AD0EX			* Output object *
		B=A	A		->ob
		D0=A
		GOSBVL	=SKIPOB
		C=B	A
		CD0EX
		C=C-B	A		obsize
dcodoutn	A=R1	A		* Output N nibbles *
		A=A-C	A		free-obsize
		R1=A	A
		GOC	godcodmemerr
		B=C	A		nibbles
dcodoutnlp	B=B-1	A
		GOC	++
		A=DAT0	B
		LCASC	'9'
		ACEX	P
		?C<=A	P
		GOYES	+
		C=C+CON	B,7
+		DAT1=C	B
		D0=D0+	1
		D1=D1+	2
		GONC	dcodoutnlp
++		A=R1	A		* Output newline *
		A=A-1	A		free--
		R1=A	A
		GOC	godcodmemerr
		LCASC	'\n'
		DAT1=C	B
		D1=D1+	2
		GOTO	dcodloop
godcodmemerr	GOTO	dcodmemerr

* Indent current line
dcodindent	C=R1	A		free
		A=R2	A		indent	
		C=C-A	A
		R1=C	A		free'
		GOC	godcodmemerr
		LCASC	' '
-		A=A-1	A
		RTNC
		DAT1=C	B
		D1=D1+	2
		GONC	-

* Check if current object is a composite

dcodcomp?	A=DAT0	A
		LC(5)	=DOCOL		#02D9D
		?A=C	A
		RTNYES
		LC(3)	=DOLIST		#02A74
		?A=C	A
		RTNYES
		LC(2)	=DOSYMB		#02AB8
		?A=C	A
		RTNYES
		LC(2)	=DOEXT		#02ADA
		?A=C	A
		RTNYES
		RTNCC

  ENDCODE
;
**********************************************************************