Metropoli BBS
VIEWER: todir.s MODE: TEXT (ASCII)
**********************************************************************
* Name:		->DIR
* Stack:	( Meta --> rrp )
* Desc:		Convert meta directory to directory
* Author:	Rick Grevelle
*		Mika Heiskanen (works from tempob, fixed stack bug)
**********************************************************************
ASSEMBLE
	CON(1)	8
RPL
xNAME \8DDIR
::
  CK1
  CKREAL COERCE
  DEPTH OVER #2* #>?SKIP SETSTACKERR	( * Too few objects * )

  CODE
		GOSBVL	=SAVPTR
		CD1EX
		D1=C
		A=DAT1	A
		D0=A
		D0=D0+	5
		A=DAT0	A		N
		C=0	A
		LC(1)	5+3+5
		D=C	A		memory taken so far
		C=A	A
		R0=C			R0[A] = N
		GONC	TDintoloop

TDtypeerr	LC(5)	=SETTYPEERR
		GOVLNG	=GETPTREVALC
TDmemerr	GOVLNG	=GPMEMERR

TDloop		R1=C	A
		D1=D1+	5
		A=DAT1	A		->name[i]
		D0=A
		A=DAT0	A		*DETLEF*
		LC(5)	=DOIDNT
		?A#C	A
		GOYES	TDtypeerr	* Must be IDNT *
		D0=D0+	5
		C=0	A
		C=DAT0	B
		?C=0	B
		GOYES	+
		C=C+1	A
		C=C+C	A
+		C=C+CON	A,7
		D=D+C	A
		GOC	TDmemerr

		D1=D1+	5
		A=DAT1	A		->ob[i]
		B=A	A
		D0=A
		GOSBVL	=SKIPOB
		CD0EX
		C=C-B	A
		D=D+C	A
		GOC	TDmemerr

		C=R1	A
TDintoloop	C=C-1	A
		GONC	TDloop

		C=D	A
		R1=C	A		memory required

		ST=0	10
TDretry		GOSBVL	=CREATETEMP
		GONC	TDgotmem
		?ST=1	10
		GOYES	TDmemerr
		GOSUB	+
		CON(5)	=DOCOL
		CON(5)	=GARBAGE
		CON(5)	=COLA
		CON(5)	=DOCODE
		REL(5)	->EndOfTD
		ST=1	10
		GOSBVL	=SAVPTR
		C=R1
		GOTO	TDretry
+		C=RSTK
		GOVLNG	=GETPTREVALC


TDgotmem	CD0EX
		R1=C			->rrp output
		D1=C
		LC(N)	13
		CON(5)	=DORRP
		CON(3)	#7FF
		CON(5)	0
		DAT1=C	13
		D1=D1+	13
		C=R0	A		N
		?C#0	A
		GOYES	+
		A=R1	A
		GOVLNG	=GPOverWrALp	( --> empty rrp )
+		D=C	A
		CD1EX
		D1=C
		R2=C	A		R2[A] = ->lastram-word
		GOSBVL	=D0=DSKTOP
		C=A	A		C[A] = ->stack
		GOC	TDlpEnt		*DETLEF*
*		D=D-1	A
*		GOC	TDfinish
TDloop2		D0=C
		RSTK=C
		AD1EX
		C=R2	A
		D1=A
		A=A-C	A
		DAT1=A	A
		D1=D1+	5
		AD1EX
		R2=A	A
		D1=A
		D0=D0+	5
		A=DAT0	A
		D0=A
		D0=D0+	5
		C=0	A
		C=DAT0	B
		?C=0	B
		GOYES	+
		RSTK=C
		C=C+1	A
		C=C+C	A
		GOSBVL	=MOVEDOWN
		C=RSTK
+		DAT1=C	B
		D1=D1+	2
		C=RSTK
		C=C+CON	A,10
		D0=C
		RSTK=C
		A=DAT0	A
		B=A	A
		D0=A
		GOSBVL	=SKIPOB
		C=B	A

		CD0EX
		C=C-B	A
		GOSBVL	=MOVEDOWN
		C=RSTK
TDlpEnt		D=D-1	A		*DETLEF*
		GONC	TDloop2

TDfinish	C=R1
		C=C+CON	A,8
		D1=C
		A=R2
		A=A-C	A
		DAT1=A	A
		GOSBVL	=GETPTR
		C=R0
		C=C+C	A
		D=D+C	A
		A=C	A
		C=C+C	A
		C=C+C	A
		C=C+A	A
		AD1EX
		A=A+C	A
		D1=A
		A=R1
		GOVLNG	=OverWrALoop
->EndOfTD
  ENDCODE
;
**********************************************************************
[ RETURN TO DIRECTORY ]