home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TURBO5.ZIP / JOB#52.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-12-26  |  6.8 KB  |  262 lines
  1. PROGRAM CPMDIO;
  2. (* DISK I/0 ROUTINES IN CPM *)
  3. (* BY K.M.CHUNG  3/27/80 *)
  4. (* LAST MOD 05/26/80 *)
  5. CONST
  6.     EFCB  =%010E; (*ADDR OF EXTENDED FCB *)
  7.     INBUF =%0080; (*COMMAND BUFFER ADDR*)
  8.     MCEFCB=%0110; (*ADDR OF CURRENT FCB*)
  9.     NFILE =%0113; (*ADDR OF NUMBER OF EXT FILES*)
  10.     MSTDF =%010C; (*STANDARD FILE NAME TABLE*)
  11.     BLKSZ=176; (*SIZE OF A EFCB (INCL BUFFER) *)
  12.     TRUE=1; FALSE=0;
  13.     (* OFFSETS OF EFCB ENTRIES*)
  14.     FNAME=1; FTYPE=9; RECCNT=15; RECNUM=32; PDEVNO=36;
  15.     DRIVENO=37; RECPTR=38; EOFF=39; STATE=40; OLDF=41;
  16.     WRITEF=42; IOBUFF=48;
  17.     (* MONITOR CMNDS*)
  18.     MLOGD =14; MOPEN=15; MCLOSE=16; MREAD=20;
  19.     MWRITE=21; MMAKE=22; MDRV  =25; MDMA =26;
  20. VAR N,CMD,DEVV,CH:INTEGER;
  21.  
  22.     PROC MON  EXT %0005; (*CP/M MONITOR*)
  23.     PROC BOOT EXT %0103;
  24.  
  25.     PROC ERROR(N,DEV);
  26.         VAR I,J,STDF:INTEGER;
  27.     BEGIN WRITE(13,10,'ERROR:');
  28.         STDF:=MEMW[MSTDF];
  29.         CASE N OF
  30. 2:        WRITE('INSUFFICIENT FILE SPEC');
  31. 3:        WRITE('ILLEGAL INPUT DEVICE');
  32. 4:        WRITE('FILE NOT FOUND');
  33. 5:        WRITE('EOF REACHED');
  34. 1:        WRITE('ILLEGAL OUTPUT DEVICE')
  35.         END;
  36.         IF N<>2 THEN BEGIN
  37.         WRITE('..');
  38.         IF DEV<16 THEN
  39.             J:=STDF+(DEV-1)*8
  40.         ELSE J:=MEMW[EFCB]+(DEV-16)*BLKSZ+FNAME;
  41.         FOR I:=J TO J+7 DO WRITE(MEM[I]);
  42.         IF DEV>=16 THEN
  43.         BEGIN WRITE('.');
  44.             FOR I:=J+8 TO J+10 DO WRITE(MEM[I]) END END;
  45.         WRITE(13,10,'REBOOT');READ(I);
  46.         BOOT
  47.     END;
  48.  
  49.     PROC CHKDRV(CEFCB);
  50.     BEGIN MON(0,MLOGD,MEM[CEFCB+DRIVENO]);
  51.         MON(0,MDMA,CEFCB+IOBUFF)
  52.     END;
  53.  
  54.     PROC READX(CEFCB); (*READ A RECORD*)
  55.     VAR RETVAL,T:INTEGER;
  56.     BEGIN CHKDRV(CEFCB);
  57.         T:=CEFCB+RECNUM; MEM[T]:=MEM[T]+1;
  58.         MON(0,MREAD,CEFCB) RET (RETVAL);
  59.         MEM[T]:=MEM[T]-1;
  60.         IF RETVAL SHR 8=1 (*EOF*)
  61.             THEN MEM[CEFCB+EOFF]:=TRUE
  62.     END;
  63.  
  64.     PROC WRITEX(CEFCB); (*WRITE A RECORD*)
  65.         VAR I,T:INTEGER;
  66.     BEGIN CHKDRV(CEFCB);
  67.         MON(0,MWRITE,CEFCB); MEM[CEFCB+WRITEF]:=TRUE;
  68.         T:=CEFCB+IOBUFF;
  69.         FOR I:=T TO T+127 DO MEM[I]:=%1A
  70.     END;
  71.  
  72. FUNC GETDEV(LDEV);
  73. BEGIN MEMW[MCEFCB]:=MEMW[EFCB]+(LDEV-16)*BLKSZ;
  74.         GETDEV:=MEM[MEMW[MCEFCB]+PDEVNO]
  75. END;
  76.  
  77. PROC INITF;
  78.     VAR CH,BPTR,LEN,FILENO,CEFCB,RCODE,I,STDEV,DFLTD:INTEGER;
  79.     PROC GETCH;
  80.     BEGIN CH:=MEM[BPTR]; BPTR:=BPTR+1 END;
  81.  
  82.     PROC GETF; (* GET DRIVE, FILENAME, & TYPE FROM CMND LINE*)
  83.         VAR I,K,TF:INTEGER;
  84.     BEGIN FOR I:=CEFCB TO CEFCB+IOBUFF-1 DO MEM[I]:=0;
  85.         WHILE CH=' ' DO GETCH;
  86.         K:=0; TF:=CEFCB+FNAME;
  87.         REPEAT IF K<8 THEN
  88.             BEGIN MEM[TF+K]:=CH; K:=K+1 END;
  89.             GETCH
  90.         UNTIL (CH=':') OR (CH='.') OR (CH=' ');
  91.         IF CH=':' THEN
  92.         BEGIN MEM[CEFCB+DRIVENO]:=MEM[TF]-'A';
  93.             K:=0; GETCH;
  94.             REPEAT IF K<8 THEN
  95.                 BEGIN MEM[TF+K]:=CH; K:=K+1 END;
  96.                 GETCH
  97.             UNTIL (CH='.') OR (CH=' ') END
  98.         ELSE MEM[CEFCB+DRIVENO]:=DFLTD; (*USE DEFAULT DRIVE*)
  99.         FOR I:=K TO 7 DO MEM[TF+I]:=' ';
  100.         K:=0; TF:=TF+8;
  101.         IF CH='.' THEN
  102.         BEGIN GETCH;
  103.             REPEAT IF K<3 THEN
  104.                 BEGIN MEM[TF+K]:=CH; K:=K+1 END;
  105.                 GETCH
  106.             UNTIL CH=' '
  107.         END;
  108.         FOR I:=K TO 2 DO MEM[TF+I]:=' '
  109.     END;
  110.  
  111.     FUNC POS; (*SEARCH STANDARD EXT FILE*)
  112.         VAR TF,I,J,STDF,TEND:INTEGER;
  113.     BEGIN TF:=CEFCB+FNAME;
  114.         TEND:=MEM[MEMW[MSTDF]]*8; STDF:=MEMW[MSTDF]+1;
  115.         FOR I:=0 TO 7 DO
  116.             MEM[STDF+TEND+I]:=MEM[TF+I];
  117.         I:=STDF;
  118.         REPEAT J:=0;
  119.             WHILE (J<8) AND (MEM[I+J]=MEM[TF+J]) DO J:=J+1;
  120.             I:=I+8
  121.         UNTIL J>=8;
  122.         IF I>STDF+TEND THEN POS:=0 ELSE POS:=(I-STDF)DIV 8
  123.     END;
  124.  
  125. BEGIN (*INITF*)
  126.     MON(0,MDRV)RET(RCODE); DFLTD:=RCODE SHR 8;
  127.     CEFCB:=MEMW[EFCB];
  128.     BPTR:=INBUF; GETCH; LEN:=CH; (*1ST CH=LINE LEN*)
  129.     MEM[INBUF+LEN+1]:=' ';
  130.     IF MEM[NFILE]>0 THEN
  131.     BEGIN GETCH;
  132.         FOR I:=0 TO MEM[NFILE]-1 DO
  133.         BEGIN GETF;
  134.             IF BPTR>INBUF+LEN+2 THEN ERROR(2,I+15);
  135.             STDEV:=POS;
  136.             IF STDEV<>0 THEN
  137.                 MEM[CEFCB+PDEVNO]:=STDEV
  138.             ELSE BEGIN
  139.                 MEM[CEFCB+PDEVNO]:=I+16;
  140.                 CHKDRV(CEFCB); MON(0,MOPEN,CEFCB) RET(RCODE);
  141.                 IF RCODE SHR 8=255 THEN MEM[CEFCB+EOFF]:=TRUE (*NEW FILE*)
  142.                 ELSE BEGIN MEM[CEFCB+OLDF]:=TRUE;
  143.                     MEM[CEFCB+RECNUM]:=-1;
  144.                     READX(CEFCB) END
  145.             END;
  146.             CEFCB:=CEFCB+BLKSZ
  147.         END
  148.     END
  149. END; (*INITF*)
  150.  
  151. PROC RESETZ(LDEV,FPTR);
  152.     VAR DEV,TREC,CEFCB:INTEGER;
  153. BEGIN DEV:=GETDEV(LDEV);
  154.     IF DEV>=16 THEN
  155.     BEGIN CEFCB:=MEMW[MCEFCB];
  156.         IF MEM[CEFCB+OLDF] THEN
  157.         BEGIN MEM[CEFCB+STATE]:=1; (*SET TO STATE 1*)
  158.             TREC:=FPTR DIV 128;
  159.             MEM[CEFCB+RECPTR]:=FPTR MOD 128;
  160.             IF TREC>MEM[CEFCB+RECCNT] THEN ERROR(5,DEV)
  161.             ELSE BEGIN MEM[CEFCB+EOFF]:=FALSE;
  162.                 IF TREC<>MEM[CEFCB+RECNUM] THEN
  163.                 BEGIN IF MEM[CEFCB+WRITEF] THEN WRITEX(CEFCB);
  164.                     MEM[CEFCB+RECNUM]:=TREC-1;
  165.                     READX(CEFCB)
  166.                 END
  167.             END
  168.         END
  169.     END
  170. END; (*RESETZ*)
  171.  
  172. FUNC READZ(LDEV);
  173.     VAR DEV,RPTR,CEFCB,T:INTEGER;
  174. BEGIN DEV:=GETDEV(LDEV);
  175.     CEFCB:=MEMW[MCEFCB];
  176.     IF DEV<16 THEN
  177.         IF (DEV=1) OR (DEV=3) THEN
  178.             BEGIN MON(0,DEV) RET(T);
  179.                 T:=T SHR 8; READZ:=T;
  180.                 IF T=%1A (*EOF*) THEN MEM[CEFCB+EOFF]:=TRUE END
  181.         ELSE ERROR(3,DEV)
  182.     ELSE IF MEM[CEFCB+OLDF] THEN
  183.         BEGIN IF MEM[CEFCB+EOFF] THEN ERROR(5,DEV);
  184.             RPTR:=MEM[CEFCB+RECPTR];
  185.             READZ:=MEM[CEFCB+IOBUFF+RPTR];
  186.             MEM[CEFCB+RECPTR]:=RPTR+1;
  187.             IF RPTR=127 THEN
  188.             BEGIN MEM[CEFCB+RECPTR]:=0;
  189.                 IF MEM[CEFCB+WRITEF] THEN
  190.                     BEGIN WRITEX(CEFCB);
  191.                         MEM[CEFCB+RECNUM]:=MEM[CEFCB+RECNUM]-1 END;
  192.                 READX(CEFCB) END
  193.         END
  194.         ELSE ERROR(4,DEV) (*FILE NOT FOUND*)
  195. END; (*READZ*)
  196.  
  197. PROC WRITEZ(LDEV,BYTE);
  198.     VAR DEV,CEFCB,TPTR:INTEGER;
  199. BEGIN DEV:=GETDEV(LDEV);
  200.     IF DEV<16 THEN
  201.         IF (DEV=2) OR (DEV=4) OR (DEV=5)
  202.             THEN MON(0,DEV,BYTE)
  203.             ELSE ERROR(1,DEV)
  204.     ELSE BEGIN CEFCB:=MEMW[MCEFCB];
  205.         IF MEM[CEFCB+OLDF] THEN
  206.         BEGIN CASE MEM[CEFCB+STATE] OF
  207.             1: MEM[CEFCB+STATE]:=2;(*IF LAST IO IS RESET THEN RANDOM WRITE*)
  208.             0,2:MEM[CEFCB+STATE]:=0
  209.             END;
  210.             MEM[CEFCB+WRITEF]:=TRUE;
  211.             TPTR:=MEM[CEFCB+RECPTR];
  212.             MEM[CEFCB+IOBUFF+TPTR]:=BYTE;
  213.             MEM[CEFCB+RECPTR]:=TPTR+1;
  214.             IF TPTR>=127 THEN
  215.                 BEGIN WRITEX(CEFCB); MEM[CEFCB+RECPTR]:=0;
  216.                     IF MEM[CEFCB+RECNUM]<MEM[CEFCB+RECCNT] THEN
  217.                         BEGIN MEM[CEFCB+RECNUM]:=MEM[CEFCB+RECNUM]-1;
  218.                             READX(CEFCB) END
  219.                 END
  220.         END
  221.         ELSE BEGIN MON(0,MMAKE,CEFCB);
  222.             MEM[CEFCB+IOBUFF]:=BYTE;
  223.             MEM[CEFCB+OLDF]:=TRUE;
  224.             MEM[CEFCB+RECPTR]:=1
  225.         END
  226.     END
  227. END; (*WRITEZ*)
  228.  
  229. PROC CLOSE;
  230.     VAR K,CEFCB,LDEV:INTEGER;
  231. BEGIN
  232.     FOR LDEV:=16 TO MEM[NFILE]+15 DO
  233.     IF (GETDEV(LDEV)>=16) THEN
  234.     BEGIN CEFCB:=MEMW[MCEFCB];
  235.         IF MEM[CEFCB+WRITEF] THEN
  236.         BEGIN
  237.             IF MEM[CEFCB+STATE]=2 (*LAST WRITE RANDOM*) THEN
  238.                 IF MEM[CEFCB+RECPTR]<>0 THEN WRITEX(CEFCB) ELSE
  239.             ELSE BEGIN IF MEM[CEFCB+RECPTR]<>0 THEN WRITEX(CEFCB);
  240.                 MEM[CEFCB+RECCNT]:=MEM[CEFCB+RECNUM]
  241.             END;
  242.             MON(0,MCLOSE,CEFCB)
  243.         END
  244.     END
  245. END; (*CLOSE*)
  246.  
  247. FUNC EOFZ(LDEV);
  248. BEGIN
  249.     EOFZ:=MEM[MEMW[MCEFCB]+EOFF]
  250. END;
  251. BEGIN (*MAIN*) END.
  252.   SYMNPAR[TBLINDX-K-(TTYPE=TFUNC)]:=K;
  253.      FOR I:=-K TO -1 DO SYMVAL[TBLINDX+I+1]:=I;
  254.      IF TTYPE=TFUNC THEN SYMVAL[TBLINDX-K]:=-K-1;
  255.      CHKSYM(')',4); CHKSYM(';',14) END
  256.   END;
  257.  
  258.   PROC FIXUP(ADDR,CADDR);
  259.   BEGIN MEMW[ADDR+1]:=CADDR-MADDR0 END;
  260.  
  261.   PROC STATEMENT;
  262.