home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug004.ark / XDIR.M80 < prev    next >
Encoding:
Text File  |  1984-04-29  |  3.7 KB  |  180 lines
  1. /* XDIR - EXTENDED DIRECTORY LISTING */
  2. /* B.RATOFF  -  10/13/77 */
  3.  
  4. [INT FCB]
  5. [FCB := 5CH]
  6. [MACRO BUFF '80H']
  7. [MACRO MONLOC '5']
  8. [MACRO CR '0DH']
  9. [MACRO LF '0AH']
  10. [MACRO PCFUN '2']
  11. [MACRO CSFUN '0BH']
  12. [MACRO FENCE '7CH']
  13. [MACRO ZERO '30H']
  14. [MACRO COLON '3AH']
  15. [MACRO SPACE '20H']
  16. [MACRO SFIRST '11H']
  17. [MACRO SNEXT '12H']
  18.  
  19. [MACRO PSHALL 'STACK = HL; STACK = DE; STACK = BC; STACK = PSW;']
  20. [MACRO POPALL 'PSW = STACK; BC = STACK; DE = STACK; HL = STACK;']
  21.  
  22.     DECLARE OSTACK(2) BYTE;
  23.  
  24. /* RESTORE CP/M'S STACK AND QUIT */
  25. QUIT:    PROCEDURE;
  26.     SP = (HL = OSTACK);
  27.     RETURN;
  28.     END QUIT;
  29.  
  30. /* PRINT CHARACTER IN REGISTER E */
  31. PCHAR: PROCEDURE;
  32.     [PSHALL]
  33.     C = [PCFUN];
  34.     CALL [MONLOC];
  35.     C = [CSFUN];
  36.     CALL [MONLOC];
  37.     IF (A=A&1) !ZERO GOTO QUIT;
  38.     [POPALL]
  39.     END    PCHAR;
  40.  
  41. /* PRINT A CR-LF SEQUENCE */
  42. CRLF:    PROCEDURE;
  43.     E = [CR];
  44.     CALL    PCHAR;
  45.     E = [LF];
  46.     CALL    PCHAR;
  47.     END    CRLF;
  48.  
  49. /* PRINT A SPACE */
  50. SPACE1:    PROCEDURE;
  51.     E = [SPACE];
  52.     CALL PCHAR;
  53.     END SPACE1;
  54.  
  55. /* PRINT 2 SPACES */
  56. SPACE2:    PROCEDURE;
  57.     CALL SPACE1;
  58.     CALL SPACE1;
  59.     END SPACE2;
  60.  
  61. /* PRINT A 'FENCE' */
  62. PFENCE:    PROCEDURE;
  63.     E = [FENCE];
  64.     CALL PCHAR;
  65.     CALL SPACE2;
  66.     END PFENCE;
  67.  
  68. /* PRINT B CHARS STARTING AT HL */
  69. DOSTR:    PROCEDURE;
  70.     REPEAT;
  71.        E=M(HL);
  72.        CALL PCHAR;
  73.        HL=HL+1;
  74.     UNTIL (B=B-1) ZERO;
  75.     END DOSTR;
  76.  
  77. BDIV:    PROCEDURE;
  78.     /* BYTE DIVISION ROUTINE */
  79.     B=0;
  80.     L=8;
  81.     REPEAT;
  82.        CY=0;
  83.        C=(A=<C);
  84.        B=(A=<B);
  85.        IF (A=B-D) PLUS THEN
  86.           DO;
  87.          B=A;
  88.          C=(A=C\1);
  89.           END;
  90.     UNTIL (L=L-1) ZERO;
  91.     END BDIV;
  92.  
  93. PDEC:    PROCEDURE;
  94.     /* PRINT VALUE IN A IN UNSIGNED DECIMAL FORMAT */
  95.     DECLARE (Q,$A,PRZ) BYTE;
  96.     $A=A;    /* SAVE A */
  97.     Q=(A=100);
  98.     PRZ=(A=A\\A);    /* CLEAR LEADING ZERO FLAG */
  99.     REPEAT;
  100.        /* DIVIDE A BY Q */
  101.        C=(A=$A);
  102.        D=(A=Q);
  103.        CALL BDIV;
  104.        $A=(A=B);    /* SAVE REMAINDER */
  105.        IF (A=C+0) !ZERO \ (A=PRZ+0) !ZERO THEN
  106.           DO;    /* PRINT QUOTIENT */
  107.          E=(A=C+[ZERO]);
  108.          CALL PCHAR;
  109.          PRZ=(A=1);    /* STOP SUPRESSING ZEROS */
  110.           END
  111.        ELSE  CALL SPACE1;
  112.        /* DIVIDE Q BY 10 */
  113.        C=(A=Q); D=10; CALL BDIV; Q=(A=C);
  114.     UNTIL (A=Q; A::1) ZERO;
  115.     E=(A=$A+[ZERO]);
  116.     CALL PCHAR;
  117.     END PDEC;
  118.  
  119. /* FIND A FILENAME AND PRINT IT */
  120. DONAME:    PROCEDURE;
  121.     DE=[HEX FCB];
  122.     CALL [MONLOC];
  123.     IF (A::255) ZERO GOTO QUIT; /* END OF DIRECTORY ? */
  124.     B = 0;    /* CONVERT OFFSET RETURNED BY CP/M (0-3) */
  125.     A = A & 3;    /* INTO ADDRESS (BUFF+1,33,65,OR 97) */
  126.     A = >>A;
  127.     A = >>A;
  128.     A = >>A;
  129.     A = A + 1;
  130.     C = A;
  131.     HL = [BUFF] + BC;
  132.     B = 8;    /* PRINT FILENAME */
  133.     CALL DOSTR;
  134.     CALL SPACE1;
  135.     B = 3;    /* PRINT FILETYPE */
  136.     CALL DOSTR;
  137.     A=M(HL)+[ZERO];    /* PRINT EXTENT # IF NON-ZERO */
  138.     IF (A::[COLON]) !CY THEN A=A+7;
  139.     IF (A::[ZERO]) ZERO THEN
  140.        CALL SPACE2
  141.     ELSE DO; E='+';
  142.          CALL PCHAR;
  143.          E=A;
  144.          CALL PCHAR;
  145.          END;
  146.     CALL SPACE1;
  147.     HL=HL+1,+1,+1;    /* PRINT FILE SIZE */
  148.     A=M(HL);
  149.     CALL PDEC;
  150.     CALL SPACE1;
  151.     END DONAME;
  152.  
  153. /* MAINLINE STARTS HERE */
  154. MAIN:    DECLARE NSTACK(20) BYTE;
  155.     OSTACK = (HL = 0 + SP);    /* SAVE CP/M'S SP FOR RETURN */
  156.     SP = .NSTACK(20);    /* SET UP OUR OWN STACK */
  157.     /* WAS A FILE SPEC GIVEN? */
  158.     IF (HL=[HEX FCB+1]; A=[SPACE]; A::M(HL)) ZERO THEN
  159.     DO; B = 11;    /* NO, SO FORCE IT TO ????????.??? */
  160.         REPEAT;
  161.         M(HL) = '?';
  162.         HL = HL + 1;
  163.         UNTIL (B = B - 1) ZERO;
  164.     END;
  165.     M([HEX FCB+12])=(A='?');    /* MATCH ALL EXTENTS */
  166.     C = [SFIRST];    /* GIVE INITIAL SEARCH CALL */
  167.     CALL DONAME;
  168.     CALL PFENCE;
  169.     STACK = (BC = 200H);    /* 2 MORE NAMES ON THIS LINE */
  170. DLOOP:    C = [SNEXT];    /* 'FIND NEXT' FDOS CALL */
  171.     CALL DONAME;
  172.     IF (BC = STACK; B=B-1; STACK = BC) !ZERO THEN
  173.             CALL PFENCE        /* MORE ON THIS LINE */
  174.     ELSE    DO; BC = STACK;    /* GO TO NEXT LINE */
  175.             STACK = (BC = 300H);
  176.             CALL CRLF;
  177.         END;
  178.     GOTO DLOOP;    /* EITHER WAY, GO GET ANOTHER NAME */
  179. EOF
  180.