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