/* XDIR - EXTENDED DIRECTORY LISTING */
/* B.RATOFF  -  10/13/77 */

[INT FCB]
[FCB := 5CH]
[MACRO BUFF '80H']
[MACRO MONLOC '5']
[MACRO CR '0DH']
[MACRO LF '0AH']
[MACRO PCFUN '2']
[MACRO CSFUN '0BH']
[MACRO FENCE '7CH']
[MACRO ZERO '30H']
[MACRO COLON '3AH']
[MACRO SPACE '20H']
[MACRO SFIRST '11H']
[MACRO SNEXT '12H']

[MACRO PSHALL 'STACK = HL; STACK = DE; STACK = BC; STACK = PSW;']
[MACRO POPALL 'PSW = STACK; BC = STACK; DE = STACK; HL = STACK;']

	DECLARE OSTACK(2) BYTE;

/* RESTORE CP/M'S STACK AND QUIT */
QUIT:	PROCEDURE;
	SP = (HL = OSTACK);
	RETURN;
	END QUIT;

/* PRINT CHARACTER IN REGISTER E */
PCHAR: PROCEDURE;
	[PSHALL]
	C = [PCFUN];
	CALL [MONLOC];
	C = [CSFUN];
	CALL [MONLOC];
	IF (A=A&1) !ZERO GOTO QUIT;
	[POPALL]
	END	PCHAR;

/* PRINT A CR-LF SEQUENCE */
CRLF:	PROCEDURE;
	E = [CR];
	CALL	PCHAR;
	E = [LF];
	CALL	PCHAR;
	END	CRLF;

/* PRINT A SPACE */
SPACE1:	PROCEDURE;
	E = [SPACE];
	CALL PCHAR;
	END SPACE1;

/* PRINT 2 SPACES */
SPACE2:	PROCEDURE;
	CALL SPACE1;
	CALL SPACE1;
	END SPACE2;

/* PRINT A 'FENCE' */
PFENCE:	PROCEDURE;
	E = [FENCE];
	CALL PCHAR;
	CALL SPACE2;
	END PFENCE;

/* PRINT B CHARS STARTING AT HL */
DOSTR:	PROCEDURE;
	REPEAT;
	   E=M(HL);
	   CALL PCHAR;
	   HL=HL+1;
	UNTIL (B=B-1) ZERO;
	END DOSTR;

BDIV:	PROCEDURE;
	/* BYTE DIVISION ROUTINE */
	B=0;
	L=8;
	REPEAT;
	   CY=0;
	   C=(A=<C);
	   B=(A=<B);
	   IF (A=B-D) PLUS THEN
	      DO;
		 B=A;
		 C=(A=C\1);
	      END;
	UNTIL (L=L-1) ZERO;
	END BDIV;

PDEC:	PROCEDURE;
	/* PRINT VALUE IN A IN UNSIGNED DECIMAL FORMAT */
	DECLARE (Q,$A,PRZ) BYTE;
	$A=A;	/* SAVE A */
	Q=(A=100);
	PRZ=(A=A\\A);	/* CLEAR LEADING ZERO FLAG */
	REPEAT;
	   /* DIVIDE A BY Q */
	   C=(A=$A);
	   D=(A=Q);
	   CALL BDIV;
	   $A=(A=B);	/* SAVE REMAINDER */
	   IF (A=C+0) !ZERO \ (A=PRZ+0) !ZERO THEN
	      DO;	/* PRINT QUOTIENT */
		 E=(A=C+[ZERO]);
		 CALL PCHAR;
		 PRZ=(A=1);	/* STOP SUPRESSING ZEROS */
	      END
	   ELSE  CALL SPACE1;
	   /* DIVIDE Q BY 10 */
	   C=(A=Q); D=10; CALL BDIV; Q=(A=C);
	UNTIL (A=Q; A::1) ZERO;
	E=(A=$A+[ZERO]);
	CALL PCHAR;
	END PDEC;

/* FIND A FILENAME AND PRINT IT */
DONAME:	PROCEDURE;
	DE=[HEX FCB];
	CALL [MONLOC];
	IF (A::255) ZERO GOTO QUIT; /* END OF DIRECTORY ? */
	B = 0;	/* CONVERT OFFSET RETURNED BY CP/M (0-3) */
	A = A & 3;	/* INTO ADDRESS (BUFF+1,33,65,OR 97) */
	A = >>A;
	A = >>A;
	A = >>A;
	A = A + 1;
	C = A;
	HL = [BUFF] + BC;
	B = 8;	/* PRINT FILENAME */
	CALL DOSTR;
	CALL SPACE1;
	B = 3;	/* PRINT FILETYPE */
	CALL DOSTR;
	A=M(HL)+[ZERO];	/* PRINT EXTENT # IF NON-ZERO */
	IF (A::[COLON]) !CY THEN A=A+7;
	IF (A::[ZERO]) ZERO THEN
	   CALL SPACE2
	ELSE DO; E='+';
		 CALL PCHAR;
		 E=A;
		 CALL PCHAR;
	     END;
	CALL SPACE1;
	HL=HL+1,+1,+1;	/* PRINT FILE SIZE */
	A=M(HL);
	CALL PDEC;
	CALL SPACE1;
	END DONAME;

/* MAINLINE STARTS HERE */
MAIN:	DECLARE NSTACK(20) BYTE;
	OSTACK = (HL = 0 + SP);	/* SAVE CP/M'S SP FOR RETURN */
	SP = .NSTACK(20);	/* SET UP OUR OWN STACK */
	/* WAS A FILE SPEC GIVEN? */
	IF (HL=[HEX FCB+1]; A=[SPACE]; A::M(HL)) ZERO THEN
	DO; B = 11;	/* NO, SO FORCE IT TO ????????.??? */
	    REPEAT;
		M(HL) = '?';
		HL = HL + 1;
	    UNTIL (B = B - 1) ZERO;
	END;
	M([HEX FCB+12])=(A='?');	/* MATCH ALL EXTENTS */
	C = [SFIRST];	/* GIVE INITIAL SEARCH CALL */
	CALL DONAME;
	CALL PFENCE;
	STACK = (BC = 200H);	/* 2 MORE NAMES ON THIS LINE */
DLOOP:	C = [SNEXT];	/* 'FIND NEXT' FDOS CALL */
	CALL DONAME;
	IF (BC = STACK; B=B-1; STACK = BC) !ZERO THEN
		    CALL PFENCE		/* MORE ON THIS LINE */
	ELSE	DO; BC = STACK;	/* GO TO NEXT LINE */
		    STACK = (BC = 300H);
		    CALL CRLF;
		END;
	GOTO DLOOP;	/* EITHER WAY, GO GET ANOTHER NAME */
EOF