home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / cpm86 / trbtol86.lbr / CHAPTER3.PQS / CHAPTER3.PAS
Pascal/Delphi Source File  |  1985-10-23  |  12KB  |  586 lines
  1.  
  2. {
  3.         Copyright (c) 1981
  4.         By:     Bell Telephone Laboratories, Inc. and
  5.                 Whitesmith's Ltd.,
  6.  
  7.         This software is derived from the book
  8.                 "Software Tools in Pascal", by
  9.                 Brian W. Kernighan and P. J. Plauger
  10.                 Addison-Wesley, 1981
  11.                 ISBN 0-201-10342-7
  12.  
  13.         Right is hereby granted to freely distribute or duplicate this
  14.         software, providing distribution or duplication is not for profit
  15.         or other commercial gain and that this copyright notice remains
  16.         intact.
  17. }
  18.  
  19. PROCEDURE COMPARE;FORWARD;
  20. PROCEDURE INCLUDE;FORWARD;
  21. PROCEDURE CONCAT;FORWARD;
  22.  
  23. PROCEDURE MAKECOPY;
  24. VAR
  25.   INNAME,OUTNAME:XSTRING;
  26.   FIN,FOUT:FILEDESC;
  27. BEGIN
  28.   IF(NOT GETARG(2,INNAME,MAXSTR))
  29.     OR (NOT GETARG(3,OUTNAME,MAXSTR))THEN
  30.       ERROR('USAGE:MAKECOPY OLD NEW');
  31.   FIN:=MUSTOPEN(INNAME,IOREAD);
  32.   FOUT:=MUSTCREATE(OUTNAME,IOWRITE);
  33.   FCOPY(FIN,FOUT);
  34.   XCLOSE(FIN);
  35.   XCLOSE(FOUT)
  36. END;
  37.  
  38. PROCEDURE PRINT;
  39. VAR
  40.   NAME:XSTRING;
  41.   NULL:XSTRING;
  42.   I:INTEGER;
  43.   FIN:FILEDESC;
  44.   JUNK:BOOLEAN;
  45.  
  46. PROCEDURE FPRINT(VAR NAME:XSTRING;FIN:FILEDESC);
  47. CONST
  48.   MARGIN1=2;
  49.   MARGIN2=2;
  50.   BOTTOM=64;
  51.   PAGELEN=66;
  52. VAR
  53.   LINE:XSTRING;
  54.   LINENO,PAGENO:INTEGER;
  55.  
  56. PROCEDURE SKIP(N:INTEGER);
  57. VAR
  58.   I:INTEGER;
  59. BEGIN
  60.   FOR I:=1 TO N DO
  61.     PUTC(NEWLINE)
  62. END;
  63.  
  64. PROCEDURE HEAD(VAR NAME:XSTRING;PAGENO:INTEGER);
  65. VAR
  66.   PAGE:XSTRING;
  67. BEGIN
  68.   PAGE[1]:=ORD(' ');
  69.   PAGE[2]:=ORD('P');
  70.   PAGE[3]:=ORD('a');
  71.   PAGE[4]:=ORD('g');
  72.   PAGE[5]:=ORD('e');
  73.   PAGE[6]:=ORD(' ');
  74.   PAGE[7]:=ENDSTR;
  75.   PUTSTR(NAME,STDOUT);
  76.   PUTSTR(PAGE,STDOUT);
  77.   PUTDEC(PAGENO,1);
  78.   PUTC(NEWLINE)
  79. END;
  80.  
  81. BEGIN(*FPRINT*)
  82.   PAGENO:=1;
  83.   SKIP(MARGIN1);
  84.   HEAD(NAME,PAGENO);
  85.   SKIP(MARGIN2);
  86.   LINENO:=MARGIN1+MARGIN2+1;
  87.   WHILE(GETLINE(LINE,FIN,MAXSTR))DO BEGIN
  88.     IF(LINENO=0)THEN BEGIN
  89.       SKIP(MARGIN1);;
  90.       PAGENO:=PAGENO+1;
  91.       HEAD(NAME,PAGENO);
  92.       SKIP(MARGIN2);
  93.       LINENO:=MARGIN1+MARGIN2+1
  94.     END;
  95.     PUTSTR(LINE,STDOUT);
  96.     LINENO:=LINENO+1;
  97.     IF(LINENO>=BOTTOM)THEN BEGIN
  98.       SKIP(PAGELEN-LINENO);
  99.       LINENO:=0
  100.     END
  101.   END;
  102.   IF(LINENO>0)THEN
  103.     SKIP(PAGELEN-LINENO)
  104. END;
  105.   
  106. BEGIN(*PRINT*)
  107.   NULL[1]:=ENDSTR;
  108.   IF(NARGS=1)THEN
  109.     FPRINT(NULL,STDIN)
  110.   ELSE
  111.     FOR I:=2 TO NARGS DO BEGIN
  112.       JUNK:=GETARG(I,NAME,MAXSTR);
  113.       FIN:=MUSTOPEN(NAME,IOREAD);
  114.       FPRINT(NAME,FIN);
  115.       XCLOSE(FIN)
  116.     END
  117. END;
  118.  
  119. PROCEDURE COMPARE;
  120. VAR
  121.   LINE1,LINE2:XSTRING;
  122.   ARG1,ARG2:XSTRING;
  123.   LINENO:INTEGER;
  124.   INFILE1,INFILE2:FILEDESC;
  125.   F1,F2:BOOLEAN;
  126.   
  127. PROCEDURE DIFFMSG (N:INTEGER; VAR LINE1,LINE2:XSTRING);
  128. BEGIN
  129.   PUTDEC(N,1);
  130.   PUTC(COLON);
  131.   PUTC(NEWLINE);
  132.   PUTSTR(LINE1,STDOUT);
  133.   PUTSTR(LINE2,STDOUT)
  134. END;
  135.  
  136. BEGIN(*COMPARE*)
  137.   IF (NOT GETARG(2,ARG1,MAXSTR))
  138.    OR (NOT GETARG(3,ARG2,MAXSTR)) THEN
  139.      ERROR('USAGE:COMPARE FILE1 FILE2');
  140.   INFILE1:=MUSTOPEN(ARG1,IOREAD);
  141.   INFILE2:=MUSTOPEN(ARG2,IOREAD);
  142.   LINENO:=0;
  143.   REPEAT
  144.     LINENO:=LINENO+1;
  145.     F1:=GETLINE(LINE1,INFILE1,MAXSTR);
  146.     F2:=GETLINE(LINE2,INFILE2,MAXSTR);
  147.     IF (F1 AND F2) THEN
  148.       IF (NOT EQUAL(LINE1,LINE2)) THEN
  149.         DIFFMSG(LINENO,LINE1,LINE2)
  150.   UNTIL (F1=FALSE) OR (F2=FALSE);
  151.   IF(F2 AND NOT F1) THEN
  152.   WRITELN('COMPARE:END OF FILE ON FILE 1')
  153.   ELSE IF (F1 AND NOT F2) THEN
  154.     WRITELN('COMPARE:END OF FILE ON FILE2')
  155. END;
  156.  
  157.  
  158. PROCEDURE INCLUDE;
  159. VAR
  160.   INCL:XSTRING;
  161.  
  162. PROCEDURE FINCLUDE(F:FILEDESC);
  163. VAR
  164.   LINE,STR:XSTRING;
  165.   LOC,I:INTEGER;
  166.   F1:FILEDESC;
  167. FUNCTION GETWORD(VAR S:XSTRING;I:INTEGER;
  168.   VAR OUT:XSTRING):INTEGER;
  169.  
  170. VAR
  171.   J:INTEGER;
  172. BEGIN
  173.   WHILE(S[I] IN [BLANK,TAB,NEWLINE]) DO
  174.     I:=I+1;
  175.   J:=1;
  176.   WHILE(NOT (S[I] IN [ENDSTR,BLANK,TAB,NEWLINE])) DO BEGIN
  177.     OUT[J]:=S[I];
  178.     I:=I+1;
  179.     J:=J+1
  180.   END;
  181.   OUT[J]:=ENDSTR;
  182.   IF(S[I]=ENDSTR) THEN
  183.     GETWORD:=0
  184.   ELSE
  185.     GETWORD:=I
  186. END;
  187.  
  188. BEGIN
  189.   WHILE (GETLINE(LINE,F,MAXSTR))DO BEGIN
  190.     LOC:=GETWORD(LINE,1,STR);
  191.     IF (NOT EQUAL(STR,INCL)) THEN
  192.       PUTSTR(LINE,STDOUT)
  193.     ELSE BEGIN
  194.       LOC:=GETWORD(LINE,LOC,STR);
  195.       STR[XLENGTH(STR)]:=ENDSTR;
  196.       FOR I:= 1 TO XLENGTH(STR)DO
  197.         STR[I]:=STR[I+1];
  198.       F1:=MUSTOPEN(STR,IOREAD);
  199.       FINCLUDE(F1);
  200.       XCLOSE(F1)
  201.     END
  202.   END
  203. END;
  204.  
  205. BEGIN
  206.   INCL[1]:=ORD('#');
  207.   INCL[2]:=ORD('i');
  208.   INCL[3]:=ORD('n');
  209.   INCL[4]:=ORD('c');
  210.   INCL[5]:=ORD('l');
  211.   INCL[6]:=ORD('u');
  212.   INCL[7]:=ORD('d');
  213.   INCL[8]:=ORD('e');
  214.   INCL[9]:=ENDSTR;
  215.   FINCLUDE(STDIN)
  216. END;
  217.   
  218. PROCEDURE CONCAT;
  219. VAR
  220.   I:INTEGER;
  221.   JUNK:BOOLEAN;
  222.   FD:FILEDESC;
  223.   S:XSTRING;
  224. BEGIN
  225.   FOR I:=2 TO NARGS DO BEGIN
  226.     JUNK:=GETARG(I,S,MAXSTR);
  227.     FD:=MUSTOPEN(S,IOREAD);
  228.     FCOPY(FD,STDOUT);
  229.     XCLOSE(FD)
  230.   END
  231. END;
  232.  
  233. PROCEDURE ARCHIVE;
  234. CONST
  235.   MAXFILES=10;
  236. VAR
  237.   ANAME:XSTRING;
  238.   CMD:XSTRING;
  239.   FNAME:ARRAY[1..MAXFILES]OF XSTRING;
  240.   FSTAT:ARRAY[1..MAXFILES] OF BOOLEAN;
  241.   NFILES:INTEGER;
  242.   ERRCOUNT:INTEGER;
  243.   ARCHTEMP:XSTRING;
  244.   ARCHHDR:XSTRING;
  245. FUNCTION GETWORD(VAR S:XSTRING;I:INTEGER;VAR OUT:XSTRING):INTEGER;
  246. VAR
  247.   J:INTEGER;
  248. BEGIN
  249.   WHILE (S[I] IN [BLANK,TAB,NEWLINE]) DO
  250.     I:=I+1;
  251.   J:=1;
  252.   WHILE(NOT (S[I] IN [ENDSTR,BLANK,TAB,NEWLINE])) DO BEGIN
  253.     OUT[J]:=S[I];
  254.     I:=I+1;
  255.     J:=J+1
  256.   END;
  257.   OUT[J]:=ENDSTR;
  258.   IF(S[I]=ENDSTR) THEN
  259.     GETWORD:=0
  260.   ELSE
  261.     GETWORD:=I
  262. END;
  263.  
  264.  
  265. FUNCTION GETHDR(FD:FILEDESC;VAR BUF,NAME:XSTRING;
  266.   VAR SIZE:INTEGER):BOOLEAN;
  267. VAR
  268.   TEMP:XSTRING;
  269.   I:INTEGER;
  270. BEGIN
  271.   IF(GETLINE(BUF,FD,MAXSTR)=FALSE)THEN
  272.     GETHDR:=FALSE
  273.   ELSE BEGIN
  274.     I:=GETWORD(BUF,1,TEMP);
  275.     IF(NOT EQUAL(TEMP,ARCHHDR))THEN
  276.       ERROR('ARCHIVE NOT IN PROPER FORMAT');
  277.     I:=GETWORD(BUF,I,NAME);
  278.     SIZE:=CTOI(BUF,I);
  279.     GETHDR:=TRUE
  280.   END
  281. END;
  282.  
  283. FUNCTION FILEARG (VAR NAME:XSTRING):BOOLEAN;
  284. VAR
  285.   I:INTEGER;
  286.   FOUND:BOOLEAN;
  287. BEGIN
  288.   IF(NFILES<=0)THEN
  289.     FILEARG:=TRUE
  290.   ELSE BEGIN
  291.     FOUND:=FALSE;
  292.     I:=1;
  293.     WHILE(NOT FOUND) AND (I<=NFILES)DO BEGIN
  294.       IF(EQUAL(NAME,FNAME[I])) THEN BEGIN
  295.         FSTAT[I]:=TRUE;
  296.         FOUND:=TRUE
  297.       END;
  298.       I:=I+1
  299.     END;
  300.     FILEARG:=FOUND
  301.   END
  302. END;
  303.  
  304. PROCEDURE FSKIP(FD:FILEDESC;N:INTEGER);
  305. VAR
  306.   C:CHARACTER;
  307.   I:INTEGER;
  308. BEGIN
  309.   FOR I:=1 TO N DO
  310.     IF(GETCF(C,FD)=ENDFILE)THEN
  311.       ERROR('ARCHIVE:END OF FILE IN FSKIP')
  312. END;
  313.  
  314. PROCEDURE FMOVE(VAR NAME1,NAME2:XSTRING);
  315. VAR
  316.   FD1,FD2:FILEDESC;
  317. BEGIN
  318.   FD1:=MUSTOPEN(NAME1,IOREAD);
  319.   FD2:=MUSTCREATE(NAME2,IOWRITE);
  320.   FCOPY(FD1,FD2);
  321.   XCLOSE(FD1);
  322.   XCLOSE(FD2)
  323. END;
  324.  
  325.  
  326. PROCEDURE ACOPY(FDI,FDO:FILEDESC;N:INTEGER);
  327. VAR
  328.   C:CHARACTER;
  329.   I:INTEGER;
  330. BEGIN
  331.   FOR I:=1 TO N DO
  332.     IF (GETCF(C,FDI)=ENDFILE)THEN
  333.       ERROR('ARCHIVE: END OF FILE IN ACOPY')
  334.     ELSE
  335.       PUTCF(C,FDO)
  336. END;
  337.  
  338. PROCEDURE NOTFOUND;
  339. VAR
  340.   I:INTEGER;
  341. BEGIN
  342.   FOR I := 1 TO NFILES DO
  343.     IF(FSTAT[I]=FALSE)THEN BEGIN
  344.       PUTSTR(FNAME[I],STDERR);
  345.       WRITELN(':NOT IN ARCHIVE');
  346.       ERRCOUNT:=ERRCOUNT + 1
  347.     END
  348. END;
  349.  
  350. PROCEDURE ADDFILE(VAR NAME:XSTRING;FD:FILEDESC);
  351. VAR
  352.   HEAD:XSTRING;
  353.   NFD:FILEDESC;
  354. PROCEDURE MAKEHDR(VAR NAME,HEAD:XSTRING);
  355. VAR
  356.   I:INTEGER;
  357. FUNCTION FSIZE(VAR NAME:XSTRING):INTEGER;
  358. VAR
  359.   C:CHARACTER;
  360.   FD:FILEDESC;
  361.   N:INTEGER;
  362. BEGIN
  363.   N:=0;
  364.   FD:=MUSTOPEN(NAME,IOREAD);
  365.   WHILE(GETCF(C,FD)<>ENDFILE)DO
  366.     N:=N+1;
  367.   XCLOSE(FD);
  368.   FSIZE:=N
  369. END;
  370.  
  371. BEGIN
  372.   SCOPY(ARCHHDR,1,HEAD,1);
  373.   I:=XLENGTH(HEAD)+1;
  374.   HEAD[I]:=BLANK;
  375.   SCOPY(NAME,1,HEAD,I+1);
  376.   I:=XLENGTH(HEAD)+1;
  377.   HEAD[I]:=BLANK;
  378.   I:=ITOC(FSIZE(NAME),HEAD,I+1);
  379.   HEAD[I]:=NEWLINE;
  380.   HEAD[I+1]:=ENDSTR
  381. END;
  382.  
  383. BEGIN
  384.   NFD:=OPEN(NAME,IOREAD);
  385.   IF(NFD=IOERROR)THEN BEGIN
  386.     PUTSTR(NAME,STDERR);
  387.     WRITELN(':CAN''T ADD');
  388.     ERRCOUNT:=ERRCOUNT+1
  389.   END;
  390.   IF(ERRCOUNT=0)THEN BEGIN
  391.     MAKEHDR(NAME,HEAD);
  392.     PUTSTR(HEAD,FD);
  393.     FCOPY(NFD,FD);
  394.     XCLOSE(NFD)
  395.   END
  396. END;
  397.  
  398.  
  399. PROCEDURE REPLACE(AFD,TFD:FILEDESC;CMD:INTEGER);
  400. VAR
  401.   PINLINE,UNAME:XSTRING;
  402.   SIZE:INTEGER;
  403. BEGIN
  404.   WHILE(GETHDR(AFD,PINLINE,UNAME,SIZE))DO
  405.     IF(FILEARG(UNAME))THEN BEGIN
  406.       IF(CMD=ORD('U'))THEN
  407.         ADDFILE(UNAME,TFD);
  408.       FSKIP(AFD,SIZE)
  409.     END
  410.     ELSE BEGIN
  411.       PUTSTR(PINLINE,TFD);
  412.       ACOPY(AFD,TFD,SIZE)
  413.     END
  414. END;
  415.  
  416. PROCEDURE HELP;
  417. BEGIN
  418.   ERROR('USAGE:ARCHIVE -[CDPTUX] ARCHNAME [FILES...]')
  419. END;
  420.  
  421.  
  422. PROCEDURE GETFNS;
  423. VAR
  424.   I,J:INTEGER;
  425.   JUNK:BOOLEAN;
  426. BEGIN
  427.   ERRCOUNT:=0;
  428.   NFILES:=NARGS-3;
  429.   IF(NFILES>MAXFILES)THEN
  430.     ERROR('ARCHIVE:TO MANY FILE NAMES');
  431.   FOR I:=1 TO NFILES DO
  432.     JUNK:=GETARG(I+3,FNAME[I],MAXSTR);
  433.   FOR I:=1 TO NFILES DO
  434.    FSTAT[I]:=FALSE;
  435.   FOR I:=1 TO NFILES-1 DO
  436.     FOR J:=I+1 TO NFILES DO
  437.       IF(EQUAL(FNAME[I],FNAME[J]))THEN BEGIN
  438.         PUTSTR(FNAME[I],STDERR);
  439.         ERROR(':DUPLICATE FILENAME')
  440.       END
  441. END;
  442.  
  443.  
  444. PROCEDURE UPDATE(VAR ANAME:XSTRING;CMD:CHARACTER);
  445. VAR
  446.   I:INTEGER;
  447.   AFD,TFD:FILEDESC;
  448. BEGIN
  449.   TFD:=MUSTCREATE(ARCHTEMP,IOWRITE);
  450.   IF(CMD=ORD('u')) THEN BEGIN
  451.    AFD:=MUSTOPEN(ANAME,IOREAD);
  452.    REPLACE(AFD,TFD,ORD('u'));(*UPDATE EXISTING*)
  453.    XCLOSE(AFD)
  454.  END;
  455.  FOR I:=1 TO NFILES DO
  456.    IF(FSTAT[I]=FALSE)THEN BEGIN
  457.       ADDFILE(FNAME[I],TFD);
  458.       FSTAT[I]:=TRUE
  459.     END;
  460.     XCLOSE(TFD);
  461.     IF(ERRCOUNT=0)THEN
  462.       FMOVE(ARCHTEMP,ANAME)
  463.     ELSE
  464.       WRITELN('FATAL ERRORS - ARCHIVE NOT ALTERED');
  465.     REMOVE (ARCHTEMP)
  466.   END;
  467. PROCEDURE TABLE(VAR ANAME:XSTRING);
  468. VAR
  469.   HEAD,NAME:XSTRING;
  470.   SIZE:INTEGER;
  471.   AFD:FILEDESC;
  472. PROCEDURE TPRINT(VAR BUF:XSTRING);
  473. VAR
  474.   I:INTEGER;
  475.   TEMP:XSTRING;
  476. BEGIN
  477.   I:=GETWORD(BUF,1,TEMP);
  478.   I:=GETWORD(BUF,I,TEMP);
  479.   PUTSTR(TEMP,STDOUT);
  480.   PUTC(BLANK);
  481.   I:=GETWORD(BUF,I,TEMP);(*SIZE*)
  482.   PUTSTR(TEMP,STDOUT);
  483.   PUTC(NEWLINE)
  484. END;
  485.  
  486. BEGIN
  487.   AFD:=MUSTOPEN(ANAME,IOREAD);
  488.   WHILE(GETHDR(AFD,HEAD,NAME,SIZE))DO BEGIN
  489.     IF(FILEARG(NAME))THEN
  490.       TPRINT(HEAD);
  491.     FSKIP(AFD,SIZE)
  492.   END;
  493.   NOTFOUND
  494. END;
  495.  
  496. PROCEDURE EXTRACT (VAR ANAME:XSTRING;CMD:CHARACTER);
  497. VAR
  498.   ENAME,PINLINE:XSTRING;
  499.   AFD,EFD:FILEDESC;
  500.   SIZE : INTEGER;
  501. BEGIN
  502.   AFD:=MUSTOPEN(ANAME,IOREAD);
  503.   IF (CMD=ORD('p')) THEN
  504.     EFD:=STDOUT
  505.   ELSE
  506.     EFD:=IOERROR;
  507.   WHILE (GETHDR(AFD,PINLINE,ENAME,SIZE)) DO
  508.     IF (NOT FILEARG(ENAME))THEN
  509.       FSKIP(AFD,SIZE)
  510.     ELSE
  511.       BEGIN
  512.       IF (EFD<> STDOUT) THEN
  513.         EFD:=CREATE(ENAME,IOWRITE);
  514.       IF(EFD=IOERROR) THEN BEGIN
  515.         PUTSTR(ENAME,STDERR);
  516.         WRITELN(': CANT''T CREATE');
  517.         ERRCOUNT:=ERRCOUNT+1;
  518.         FSKIP(AFD,SIZE)
  519.       END
  520.       ELSE BEGIN
  521.         ACOPY(AFD,EFD,SIZE);
  522.         IF(EFD<>STDOUT)THEN
  523.         XCLOSE(EFD)
  524.       END
  525.     END;
  526.     NOTFOUND
  527.   END;
  528.  
  529. PROCEDURE DELETE(VAR ANAME:XSTRING);
  530. VAR
  531.   AFD,TFD:FILEDESC;
  532. BEGIN
  533.   IF(NFILES<=0)THEN(*PROTECT INNOCENT*)
  534.     ERROR('ARCHIVE:-D REQUIRES EXPLICIT FILE NAMES');
  535.   AFD:=MUSTOPEN(ANAME,IOREAD);
  536.   TFD:=MUSTCREATE(ARCHTEMP,IOWRITE);
  537.   REPLACE(AFD,TFD,ORD('d'));
  538.   NOTFOUND;
  539.   XCLOSE(AFD);
  540.   XCLOSE(TFD);
  541.   IF(ERRCOUNT=0)THEN
  542.     FMOVE(ARCHTEMP,ANAME)
  543.   ELSE
  544.     WRITELN('FATAL ERRORS - ARCHIVE NOT ALTERED');
  545.   REMOVE(ARCHTEMP)
  546. END;
  547.  
  548.  
  549. PROCEDURE INITARCH;
  550. BEGIN
  551.   ARCHTEMP[1]:=ORD('A');
  552.   ARCHTEMP[2]:=ORD('R');
  553.   ARCHTEMP[3]:=ORD('T');
  554.   ARCHTEMP[4]:=ORD('E');
  555.   ARCHTEMP[5]:=ORD('M');
  556.   ARCHTEMP[6]:=ORD('P');
  557.   ARCHTEMP[7]:=ENDSTR;
  558.   ARCHHDR[1]:=ORD('-');
  559.   ARCHHDR[2]:=ORD('H');
  560.   ARCHHDR[3]:=ORD('-');
  561.   ARCHHDR[4]:=ENDSTR;
  562. END;
  563.  
  564.  
  565. BEGIN
  566.   INITARCH;
  567.   IF (NOT GETARG(2,CMD,MAXSTR))
  568.     OR(NOT GETARG(3,ANAME,MAXSTR)) THEN
  569.       HELP;
  570.   GETFNS;
  571.   IF(XLENGTH(CMD)<>2) OR(CMD[1]<>ORD('-')) THEN
  572.     HELP
  573.   ELSE IF (CMD[2]=ORD('c'))OR(CMD[2]=ORD('u'))THEN
  574.     UPDATE(ANAME,CMD[2])
  575.   ELSE IF (CMD[2]=ORD('t'))THEN
  576.     TABLE(ANAME)
  577.   ELSE IF (CMD[2]=ORD('x'))OR(CMD[2]=ORD('p'))THEN
  578.     EXTRACT(ANAME,CMD[2])
  579.   ELSE IF (CMD[2]=ORD('d'))THEN
  580.     DELETE(ANAME)
  581.   ELSE
  582.     HELP
  583. END;
  584.  
  585.  
  586.