APPENDIX B

LISTING OF "DIOCALLS"
SHOWING THE BASIC CP/M DIRECT INTERFACE



PL/I-80 V1.0, COMPILATION OF: DIOCALLS

L: List Source Program

%include 'diomod.dcl';
   NO ERROR(S) IN PASS 1

   NO ERROR(S) IN PASS 2


PL/I-80 V1.0, COMPILATION OF: DIOCALLS

   1 a 0000 diotst:
   2 a 0006     proc options(main);
   3 a 0006     /* external CP/M I/O entry points */
   4 a 0006     /* (note: each source line begins with tab chars) */
   5+c 0006     dcl
   6+c 0006         memptr entry         returns (ptr),
   7+c 0006         memsiz entry         returns (fixed(15)),
   8+c 0006         memwds entry         returns (fixed(15)),
   9+c 0006         dfcb0  entry         returns (ptr),
  10+c 0006         dfcb1  entry         returns (ptr),
  11+c 0006         dbuff  entry         returns (ptr),
  12+c 0006         reboot entry,
  13+c 0006         rdcon  entry         returns (char(1)),
  14+c 0006         wrcon  entry         (char(1)),
  15+c 0006         rdrdr  entry         returns (char(1)),
  16+c 0006         wrpun  entry         (char(1)),
  17+c 0006         wrlst  entry         (char(1)),
  18+c 0006         coninp entry         returns (char(1)),
  19+c 0006         conout entry         (char(1)),
  20+c 0006         rdstat entry         returns (bit(1)),
  21+c 0006         getio  entry         returns (bit(8)),
  22+c 0006         setio  entry         (bit(8)),
  23+c 0006         wrstr  entry         (ptr),
  24+c 0006         rdbuf  entry         (ptr),
  25+c 0006         break  entry         returns (bit(1)),
  26+c 0006         vers   entry         returns (bit(16)),
  27+c 0006         reset  entry,
  28+c 0006         select entry         (fixed(7)),
  29+c 0006         open   entry   (ptr) returns (fixed(7)),
  30+c 0006         close  entry   (ptr) returns (fixed(7)),
  31+c 0006         sear   entry   (ptr) returns (fixed(7)),
  32+c 0006         searn  entry         returns (fixed(7)),
  33+c 0006         delete entry   (ptr),
  34+c 0006         rdseq  entry   (ptr) returns (fixed(7)),
  35+c 0006         wrseq  entry   (ptr) returns (fixed(7)),
  36+c 0006         make   entry   (ptr) returns (fixed(7)),
  37+c 0006         rename entry   (ptr),
  38+c 0006         logvec entry         returns (bit(16)),
  39+c 0006         curdsk entry         returns (fixed(7)),
  40+c 0006         setdma entry         (ptr),
  41+c 0006         allvec entry         returns (ptr),
  42+c 0006         wpdisk entry,
  43+c 0006         rovec  entry         returns (bit(16)),
  44+c 0006         filatt entry         (ptr),
  45+c 0006         getdpb entry         returns (ptr),
  46+c 0006         getusr entry         returns (fixed(7)),
  47+c 0006         setusr entry   (fixed(7)),
  48+c 0006         rdran  entry   (ptr) returns (fixed(7)),
  49+c 0006         wrran  entry   (ptr) returns (fixed(7)),
  50+c 0006         filsiz entry   (ptr),
  51+c 0006         setrec entry   (ptr),
  52+c 0006         resdrv entry         (bit(16)),
  53+c 0006         wrranz entry   (ptr) returns (fixed(7));
  54 c 0006     dcl
  55 c 0006         c char(1),
  56 c 0006         v char(254) var,
  57 c 0006         i fixed;
  58 c 0006 
  59 c 0006 
  60 c 0006     /**********************************
  61 c 0006     *                                 *
  62 c 0006     * Fixed Location Tests:           *
  63 c 0006     *     MEMPTR, MEMSIZ, MEMWDS,     *
  64 c 0006     *     DFCB0, DFCB1, DBUFF         *
  65 c 0006     *                                 *
  66 c 0006     **********************************/
  67 c 0006     dcl
  68 c 0006         memptrv ptr,
  69 c 0006         memsizv fixed,
  70 c 0006         (dfcb0v, dfcb1v, dbuffv) ptr,
  71 c 0006         command char(127) var based (dbuffv),
  72 c 0006         1 fcb0 based(dfcb0v),
  73 c 0006           2 drive fixed(7),
  74 c 0006           2 name  char(8),
  75 c 0006           2 type  char(3),
  76 c 0006           2 extnt fixed(7),
  77 c 0006           2 space (19) bit(8),
  78 c 0006           2 cr    fixed(7),
  79 c 0006         memory (0:0) based(memptrv) bit(8);
  80 c 0006     memptrv = memptr();
  81 c 000C     memsizv = memsiz();
  82 c 0012     dfcb0v  = dfcb0();
  83 c 0018     dfcb1v  = dfcb1();
  84 c 001E     dbuffv  = dbuff();
  85 c 0024     put edit ('Command Tail: ',command) (a);
  86 c 004A     put edit ('First Default File:',
  87 c 008D           fcb0.name,'.',fcb0.type) (skip,4a);
  88 c 008D     put edit ('dfcb0 ',unspec(dfcb0v),
  89 c 0137           'dfcb1 ',unspec(dfcb1v),
  90 c 0137           'dbuff ',unspec(dbuffv),
  91 c 0137           'memptr',unspec(memptrv),
  92 c 0137           'memsiz',unspec(memsizv),
  93 c 0137           'memwds',memwds())
  94 c 0137          (5(skip,a(7),b4),skip,a(7),f(6));
  95 c 0137     put skip list('Clearing Memory');
  96 c 0153         /* sample loop to clear mem */
  97 c 0153         do i = 0 repeat(i+1) while (i^=memsizv-1);
  98 c 016A         memory (i) = '00'b4;
  99 c 017F         end;
 100 c 017F 
 101 c 017F 
 102 c 017F     /**********************************
 103 c 017F     *                                 *
 104 c 017F     *        REBOOT Test              *
 105 c 017F     *                                 *
 106 c 017F     **********************************/
 107 c 017F     put skip list ('Reboot? (Y/N)');
 108 c 019B     get list (c);
 109 c 01B5     if translate(c,'Y','y') = 'Y' then
 110 c 01DD         call reboot();
 111 c 01E0 
 112 c 01E0 
 113 c 01E0     /**********************************
 114 c 01E0     *                                 *
 115 c 01E0     *       RDCON, WRCON Test         *
 116 c 01E0     *                                 *
 117 c 01E0     **********************************/
 118 c 01E0     put list('Type Input, End with "$" ');
 119 c 01F7     v = '^m^j';
 120 c 0204         do while (substr(v,length(v)) ^= '$');
 121 c 0220         v = v || rdcon();
 122 c 022E         end;
 123 c 022E     put skip list('You Typed:');
 124 c 024A         do i = 1 to length(v);
 125 c 0266         call wrcon(substr(v,i,1));
 126 c 028E         end;
 127 c 028E 
 128 c 028E 
 129 c 028E     /**********************************
 130 c 028E     *                                 *
 131 c 028E     *       RDRDR and WRPUN Test      *
 132 c 028E     *                                 *
 133 c 028E     **********************************/
 134 c 028E     put skip list('Reader to Punch Test?(Y/N)');
 135 c 02AA     get list (c);
 136 c 02C4     if translate(c,'Y','y') = 'Y' then
 137 c 02EC         do;
 138 c 02EC         put skip list('Copying RDR to PUN until ctl-z');
 139 c 0308         c = ' ';
 140 c 0314             do while (c ^= '^z');
 141 c 0323             c = rdrdr();
 142 c 032E             if c ^= '^z' then
 143 c 033D                 call wrpun(c);
 144 c 0346             end;
 145 c 0346         end;
 146 c 0346 
 147 c 0346 
 148 c 0346     /**********************************
 149 c 0346     *                                 *
 150 c 0346     *            WRLST Test           *
 151 c 0346     *                                 *
 152 c 0346     **********************************/
 153 c 0346     put list('List Output Test?(Y/N)');
 154 c 035D     get list(c);
 155 c 0377     if translate(c,'Y','y') = 'Y' then
 156 c 039F         do i = 1 to length(v);
 157 c 03BB         call wrlst(substr(v,i,1));
 158 c 03E3         end;
 159 c 03E3 
 160 c 03E3 
 161 c 03E3     /**********************************
 162 c 03E3     *                                 *
 163 c 03E3     *   Direct I/O, CONOUT, CONINP    *
 164 c 03E3     *                                 *
 165 c 03E3     **********************************/
 166 c 03E3     put list
 167 c 03FA         ('Direct I/O, Type Line, End with Line Feed');
 168 c 03FA         c = ' ';
 169 c 0406             do while (c ^= '^j');
 170 c 0415             call conout(c);
 171 c 041B             c = coninp();
 172 c 0429             end;
 173 c 0429 
 174 c 0429 
 175 c 0429     /**********************************
 176 c 0429     *                                 *
 177 c 0429     *  Direct I/O, Console Status     *
 178 c 0429     *             RDSTAT              *
 179 c 0429     *                                 *
 180 c 0429     **********************************/
 181 c 0429     put skip list('Status Test, Type Character');
 182 c 0445         do while (^rdstat());
 183 c 044F         end;
 184 c 044F     /* clear the character */
 185 c 044F     c = coninp();
 186 c 045A 
 187 c 045A 
 188 c 045A     /**********************************
 189 c 045A     *                                 *
 190 c 045A     *       GETIO, SETIO IObyte       *
 191 c 045A     *                                 *
 192 c 045A     **********************************/
 193 c 045A     dcl
 194 c 045A         iobyte bit(8);
 195 c 045A     iobyte = getio();
 196 c 0460     put edit ('IObyte is ',iobyte,
 197 c 0493           ', New Value: ') (skip,a,b4,a);
 198 c 0493     get edit (iobyte) (b4(2));
 199 c 04AF     call setio(iobyte);
 200 c 04B5 
 201 c 04B5 
 202 c 04B5     /**********************************
 203 c 04B5     *                                 *
 204 c 04B5     *   Buffered Write,  WRSTR Test   *
 205 c 04B5     *                                 *
 206 c 04B5     **********************************/
 207 c 04B5     put list('Buffered Output Test:');
 208 c 04CC     /* "v" was previously filled by RDCON */
 209 c 04CC     call wrstr(addr(v));
 210 c 04D8 
 211 c 04D8 
 212 c 04D8     /**********************************
 213 c 04D8     *                                 *
 214 c 04D8     *     Buffered Read RDBUF Test    *
 215 c 04D8     *                                 *
 216 c 04D8     **********************************/
 217 c 04D8     dcl
 218 c 04D8         1 inbuff static,
 219 c 04D8           2 maxsize bit(8) init('80'b4),
 220 c 04D8           2 inchars char(127) var;
 221 c 04D8     put skip list('Line Input, Type Line, End With Return');
 222 c 04F4     put skip;
 223 c 0505     call rdbuf(addr(inbuff));
 224 c 0511     put skip list('You Typed: ',inchars);
 225 c 0536 
 226 c 0536 
 227 c 0536     /**********************************
 228 c 0536     *                                 *
 229 c 0536     *      Console BREAK Test         *
 230 c 0536     *                                 *
 231 c 0536     **********************************/
 232 c 0536     put skip list('Console Break Test, Type Character');
 233 c 0552         do while(^break());
 234 c 055C         end;
 235 c 055C     c = rdcon();
 236 c 0567 
 237 c 0567 
 238 c 0567     /**********************************
 239 c 0567     *                                 *
 240 c 0567     *     Version Number VERS Test    *
 241 c 0567     *                                 *
 242 c 0567     **********************************/
 243 c 0567     dcl
 244 c 0567         version bit(16);
 245 c 0567     version = vers();
 246 c 056D     if substr(version,1,8) = '00'b4 then
 247 c 0576         put skip list('CP/M'); else
 248 c 0595         put skip list('MP/M');
 249 c 05B1     put edit(' Version ',substr(version,9,4),
 250 c 05F5         '.',substr(version,13,4)) (a,b4,a,b4);
 251 c 05F5 
 252 c 05F5 
 253 c 05F5     /**********************************
 254 c 05F5     *                                 *
 255 c 05F5     *     Disk System RESET Test      *
 256 c 05F5     *                                 *
 257 c 05F5     **********************************/
 258 c 05F5     put skip list('Resetting Disk System');
 259 c 0611     call reset();
 260 c 0614 
 261 c 0614 
 262 c 0614     /**********************************
 263 c 0614     *                                 *
 264 c 0614     *       Disk SELECT Test          *
 265 c 0614     *                                 *
 266 c 0614     **********************************/
 267 c 0614     put skip list('Select Disk # ');
 268 c 0630     get list(i);
 269 c 0648     call select(i);
 270 c 0654 
 271 c 0654     /**********************************
 272 c 0654     *                                 *
 273 c 0654     * Note:  The OPEN, CLOSE, SEAR,   *
 274 c 0654     *        SEARN, DELETE, RDSEQ,    *
 275 c 0654     *        WRSEQ, MAKE, and RENAME  *
 276 c 0654     * functions are tested in the     *
 277 c 0654     *        DIOCOPY program          *
 278 c 0654     *                                 *
 279 c 0654     **********************************/
 280 c 0654 
 281 c 0654     /**********************************
 282 c 0654     *                                 *
 283 c 0654     *         LOGVEC and CURDSK       *
 284 c 0654     *                                 *
 285 c 0654     **********************************/
 286 c 0654     put skip list ('Login Vector',
 287 c 0695         logvec(),'Current Disk',
 288 c 0695         curdsk());
 289 c 0695 
 290 c 0695     /**********************************
 291 c 0695     *                                 *
 292 c 0695     * See DIOCOPY for SETDMA Function *
 293 c 0695     *                                 *
 294 c 0695     **********************************/
 295 c 0695 
 296 c 0695     /**********************************
 297 c 0695     *                                 *
 298 c 0695     *  Allocate Vector ALLVEC Test    *
 299 c 0695     *                                 *
 300 c 0695     **********************************/
 301 c 0695     dcl
 302 c 0695         alloc (0:30) bit(8)
 303 c 0695             based (allvec()),
 304 c 0695         allvecp ptr;
 305 c 0695     allvecp = allvec();
 306 c 069B     put edit('Alloc Vector at ',
 307 c 0700         unspec(allvecp),':',
 308 c 0700         (alloc(i) do i=0 to 30))
 309 c 0700         (skip,a,b4,a,254(skip,4(b,x(1))));
 310 c 0700 
 311 c 0700     /**********************************
 312 c 0700     *                                 *
 313 c 0700     *  Note:  the following functions *
 314 c 0700     *  apply to version 2.0 or newer. *
 315 c 0700     *                                 *
 316 c 0700     **********************************/
 317 c 0700 
 318 c 0700     /**********************************
 319 c 0700     *                                 *
 320 c 0700     *           WPDISK Test           *
 321 c 0700     *                                 *
 322 c 0700     **********************************/
 323 c 0700     put skip list('Write Protect Disk?(Y/N)');
 324 c 071C     get list(c);
 325 c 0736     if translate(c,'Y','y') = 'Y' then
 326 c 075E         call wpdisk();
 327 c 0761 
 328 c 0761     /**********************************
 329 c 0761     *                                 *
 330 c 0761     *          ROVEC Test             *
 331 c 0761     *                                 *
 332 c 0761     **********************************/
 333 c 0761     put skip list('Read/Only Vector is',rovec());
 334 c 0788 
 335 c 0788     /**********************************
 336 c 0788     *                                 *
 337 c 0788     *  Disk Parameter Block Decoding  *
 338 c 0788     *          Using GETDPB           *
 339 c 0788     *                                 *
 340 c 0788     **********************************/
 341 c 0788     dcl
 342 c 0788         dpbp ptr,
 343 c 0788         1 dpb based (dpbp),
 344 c 0788           2 spt fixed(15),
 345 c 0788           2 bsh fixed(7),
 346 c 0788           2 blm bit(8),
 347 c 0788           2 exm bit(8),
 348 c 0788           2 dsm bit(16),
 349 c 0788           2 drm bit(16),
 350 c 0788           2 al0 bit(8),
 351 c 0788           2 al1 bit(8),
 352 c 0788           2 cks bit(16),
 353 c 0788           2 off fixed(7);
 354 c 0788     dpbp = getdpb();
 355 c 078E     put edit('Disk Parameter Block:',
 356 c 08C6         'spt',spt,'bsh',bsh,'blm',blm,
 357 c 08C6         'exm',exm,'dsm',dsm,'drm',drm,
 358 c 08C6         'al0',al0,'al1',al1,'cks',cks,
 359 c 08C6         'off',off)
 360 c 08C6         (skip,a,2(skip,a(4),f(6)),
 361 c 08C6             4(skip,a(4),b4),
 362 c 08C6             skip,2(a(4),b,x(1)),
 363 c 08C6             skip,a(4),b4,
 364 c 08C6             skip,a(4),f(6));
 365 c 08C6 
 366 c 08C6     /**********************************
 367 c 08C6     *                                 *
 368 c 08C6     *      Test Get/Set user Code     *
 369 c 08C6     *          GETUSR, SETUSR         *
 370 c 08C6     *                                 *
 371 c 08C6     **********************************/
 372 c 08C6     put skip list
 373 c 08FC         ('User is',getusr(),', New User:');
 374 c 08FC     get list(i);
 375 c 0914     call setusr(i);
 376 c 0920 
 377 c 0920     /**********************************
 378 c 0920     *                                 *
 379 c 0920     *         FILSIZ, SETREC,         *
 380 c 0920     *     RDRAN, WRRAN, WRRANZ are    *
 381 c 0920     *        tested in DIORAND        *
 382 c 0920     *                                 *
 383 c 0920     **********************************/
 384 c 0920 
 385 c 0920     /**********************************
 386 c 0920     *                                 *
 387 c 0920     *     Test Drive Reset RESDRV     *
 388 c 0920     *      (version 2.2 or newer)     *
 389 c 0920     *                                 *
 390 c 0920     **********************************/
 391 c 0920     dcl
 392 c 0920         drvect bit(16);
 393 c 0920     put list('Drive Reset Vector:');
 394 c 0937     get list(drvect);
 395 c 094F     call resdrv(drvect);
 396 c 0955 
 397 c 0955     /**********************************
 398 c 0955     *                                 *
 399 c 0955     *                                 *
 400 c 0955     **********************************/
 401 a 0955     end diotst;

CODE SIZE = 0958
DATA AREA = 04BA
END  COMPILATION


Next     Contents     Previous     Back to Home Page