Upload

Digital Research

MPM OPERATING SYSTEMS/MPM II/MPM II SOURCE/UTIL7/DP.PLM

@@ -0,0 +1,133 @@
+$title ('SDIR - Print')
+
+/*
+  Copyright (C) 1981
+  Digital Research
+  P.O. Box 579
+  Pacific Grove, CA 93950
+
+  Revised:
+    14 Sept 81 by Danny Horovitz
+*/
+
+dprint:
+do;
+              /* print routines for extended directory */
+
+declare dcl literally 'declare',
+        lit literally 'literally',
+        word lit 'address',
+        true literally '1',
+        false literally '0',
+        boolean literally 'byte',
+        cr literally '13',
+        lf literally '10';
+
+mon1: procedure(f,a) external;
+    declare f byte, a address;
+end mon1;
+
+dcl debug byte external;
+
+break: procedure external;
+end break;
+
+             /* fcb and dma buffer constants */
+declare
+    f$name           lit '1',        /* file name                           */
+    fnamelen         lit '8',        /* file name length                    */
+    f$type           lit '9',        /* file type field                     */
+    f$typelen        lit '3';        /* type length                         */
+
+        /* BDOS calls */
+
+print$char: procedure(char) public;
+    declare char byte;
+    call mon1(2,char);
+end print$char;
+
+print: procedure(string$adr) public;
+    dcl string$adr address;
+    call mon1(9,string$adr);
+    if debug then
+       call break; 
+end print;
+
+printb: procedure public;
+    call print$char(' ');
+end printb;
+ 
+crlf: procedure public;
+    call print$char(cr);
+    call print$char(lf);
+end crlf;
+
+printfn: procedure(fname$adr) public;
+    dcl fname$adr address,
+        file$name based fname$adr (1) byte,
+        i byte;                                /* <filename> ' ' <filetype> */
+
+    do i = 0 to f$namelen - 1;
+        call printchar(file$name(i) and 7fh);
+    end;
+    call printchar(' ');
+    do i = f$namelen to f$namelen + f$typelen - 1;
+        call printchar(file$name(i) and 7fh);
+    end;
+end printfn;
+
+pdecimal: procedure(v,prec,zerosup) public;
+                         /* print value v, field size = (log10 prec) + 1  */
+                         /* with leading zero suppression if zerosup = true */
+    declare v address,                          /* value to print           */
+            prec address,                       /* precision                */
+            zerosup boolean,                    /* zero suppression flag    */
+            d byte;                             /* current decimal digit    */
+
+    do while prec <> 0;
+        d = v / prec;                           /* get next digit           */
+        v = v mod prec;                         /* get remainder back to v  */
+        prec = prec / 10;                       /* ready for next digit     */
+        if prec <> 0 and zerosup and d = 0 then
+            call printb;
+        else
+        do;
+            zerosup = false;
+            call printchar('0'+d);
+            end;
+        end;
+end pdecimal;
+
+p3byte: procedure(byte3adr,prec) public;
+                                   /* print 3 byte value with 0 suppression */
+      dcl byte3adr address,        /* assume high order bit is < 10         */
+          prec address,
+          b3 based byte3adr structure (
+          lword address,
+          hbyte byte),
+          i byte;
+
+                                       /* prec = 1 for 6 chars, 2 for 7 */
+      if b3.hbyte <> 0 then
+      do;
+          call pdecimal(b3.hbyte,prec,true);  /* 3 for 8 chars printed      */
+          call pdecimal(b3.lword,10000,false);
+      end;
+      else
+      do;
+          i = 1;
+          do while i <= prec;
+              call printb;
+              i = i * 10;
+          end;
+          call pdecimal(b3.lword,10000,true);
+      end;
+end p3byte;
+
+end dprint;
+
+                        
+
+                                                                      
+                                              
+