/* WDIR - WIDE DIRECTORY LISTING */
/* B.RATOFF  -  9/11/77 */

[INT FCB]
[FCB := 5CH]
[MACRO BUFF '80H']
[MACRO MONLOC '5']
[MACRO CR '0DH']
[MACRO LF '0AH']
[MACRO PCFUN '2']
[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;

/* PRINT CHARACTER IN REGISTER E */
PCHAR: PROCEDURE;
	[PSHALL]
	C = [PCFUN];
	CALL [MONLOC];
	[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 B CHARS STARTING AT HL */
DOSTR:	PROCEDURE;
	REPEAT;
	   E=M(HL);
	   CALL PCHAR;
	   HL=HL+1;
	UNTIL (B=B-1) ZERO;
	END DOSTR;

/* FIND A FILENAME AND PRINT IT */
DONAME:	PROCEDURE;
	DE=[HEX FCB];
	CALL [MONLOC];
	IF (A::255) ZERO THEN	/* END OF DIRECTORY? */
	   DO; SP = (HL = OSTACK);
	       RETURN;		/* RESTORE CP/M'S SP & QUIT */
	   END;
	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;
	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 SPACE2;
	STACK = (BC = 300H);	/* 3 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 SPACE2	/* MORE ON THIS LINE */
	ELSE	DO; BC = STACK;	/* GO TO NEXT LINE */
		    STACK = (BC = 400H);
		    CALL CRLF;
		END;
	GOTO DLOOP;	/* EITHER WAY, GO GET ANOTHER NAME */
EOF