{$A-} PROGRAM CHAPTER6; {$I TOOLU.PAS} {$I FPRIMS.PAS} var cmdptr:file; PROCEDURE EDIT; CONST MAXLINES=1000; DITTO=255; CURLINE=PERIOD; LASTLINE=DOLLAR; SCAN=47; BACKSCAN=92; ACMD=97; CCMD=99; DCMD=100; ECMD=101; EQCMD=EQUALS; FCMD=102; GCMD=103; ICMD=105; MCMD=109; PCMD=112; QCMD=113; RCMD=114; SCMD=115; WCMD=119; XCMD=120; TYPE STCODE=(ENDDATA,ERR,OK); BUFTYPE=RECORD TXT:INTEGER; MARK:BOOLEAN; END; VAR EDITFID:FILE OF CHARACTER; BUF:ARRAY[0..MAXLINES]OF BUFTYPE; RECIN:INTEGER; RECOUT:INTEGER; LINE1,LINE2,NLINES,CURLN,LASTLN:INTEGER; PAT,LIN,SAVEFILE:XSTRING; CURSAVE,I:INTEGER; STATUS:STCODE; MORE:BOOLEAN; PROCEDURE GETTXT(N:INTEGER;VAR S:XSTRING); VAR ch:char;JUNK:BOOLEAN;I:INTEGER; BEGIN IF(N=0) THEN S[1]:=ENDSTR ELSE BEGIN i:=0; SEEK(EDITFID,BUF[N].TXT); repeat i:=succ(i); READ(EDITFID,s[i]); RECIN:=RECIN+1; u~tilööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööööBEGIN LINE2:=0; NLINES:=0; DONE:=(GETONE(LIN,I,NUM,STATUS)<>OK); WHILE(NOT DONE)DO BEGIN LINE1:=LINE2; LINE2:=NUM; NLINES:=NLINES+1; IF(LIN[I]=SEMICOL)THEN CURLN:=NUM; IF(LIN[I]=COMMA)OR(LIN[I]=SEMICOL)THEN BEGIN I:=I+1; DONE:=(GETONE(LIN,I,NUM,STATUS)<>OK) END ELSE DONE:=TRUE END; NLINES:=MIN(NLINES,2); IF(NLINES=0)THEN LINE2:=CURLN; IF(NLINES<=1)THEN LINE1:=LINE2; IF(STATUS<>ERR)THEN STATUS:=OK; GETLIST:=STATUS END; PROCEDURE REVERSE(N1,N2:INTEGER); VAR TEMP:BUFTYPE; BEGIN WHILE(N1N2)THEN BEGIN REVERSE(N1,N2); REVERSE(N2+1,N3); REVERSE(N1,N3) END END; FUNCTION MOVE(LINE3:INTEGER):STCODE; BEGIN IF(LINE1<=0)OR((LINE3>=LINE1)AND(LINE3LINE1)THEN CURLN:=LINE3 ELSE CURLN:=LINE3+(LINE2-LINE1+1); MOVE:=OK END END; FUNCTION LNDELETE(N1,N2:INTEGER;VAR STATUS:STCODE): STCODE; BEGIN IF(N1<=0)THEN STATUS:=ERR ELSE BEGIN BLKMOVE(N1,N2,LASTLN); LASTLN:=LASTLN-(N2-N1+1); CURLN:=PREVLN(N1); STATUS:=OK END; LNDELETE:=STATUS END; FUNCTION CKP(VAR LIN:XSTRING;I:INTEGER; VAR PFLAG:BOOLEAN;VAR STATUS:STCODE):STCODE; BEGIN SKIPBL(LIN,I); IF(LIN[I]=PCMD)THEN BEGIN I:=I+1; PFLAG:=TRUE END ELSE PFLAG:=FALSE; IF(LIN[I]=NEWLINE)THEN STATUS:=OK ELSE STATUS:=ERR; CKP:=STATUS END; FUNCTION PUTTXT(VAR LIN:XSTRING):STCODE; VAR I:INTEGER; BEGIN PUTTXT:=ERR; IF(LASTLN0) THEN REWRITE(EDITFID); (*$I+*) RECOUT:=0; RECIN:=0; CURLN:=0; LASTLN:=0 END; PROCEDURE CLRBUF; BEGIN CLOSE(EDITFID);ERASE(EDITFID) END; FUNCTION APPEND(LINE:INTEGER;GLOB:BOOLEAN):STCODE; VAR EINLINE:XSTRING; STAT:STCODE; DONE:BOOLEAN; BEGIN IF(GLOB)THEN STAT:=ERR ELSE BEGIN CURLN:=LINE; STAT:=OK; DONE:=FALSE; WHILE(NOT DONE)AND(STAT=OK)DO IF(NOT GETLINE(EINLINE,STDIN,MAXSTR))THEN STAT:=ENDDATA ELSE IF(EINLINE[1]=PERIOD) AND(EINLINE[2]=NEWLINE)THEN DONE:=TRUE ELSE IF(PUTTXT(EINLINE)=ERR)THEN STAT:=ERR END; APPEND:=STAT END; FUNCTION DOWRITE(N1,N2:INTEGER;VAR FIL:XSTRING):STCODE; VAR I:INTEGER; FD: FILEDESC; LINE: XSTRING; BEGIN FD:=CREATE(FIL,IOWRITE); IF(FD=IOERROR)THEN DOWRITE:=ERR ELSE BEGIN FOR I:=N1 TO N2 DO BEGIN GETTXT(I,LINE); PUTSTR(LINE,FD) END; XCLOSE(FD); PUTDEC(N2-N1+1,1); PUTC(NEWLINE); DOWRITE:=OK END END; FUNCTION DOREAD(N:INTEGER;VAR FIL:XSTRING):STCODE; VAR COUNT:INTEGER; T:BOOLEAN; STAT:STCODE; FD:FILEDESC; EINLINE:XSTRING; BEGIN FD:=OPEN(FIL,IOREAD); IF(FD=IOERROR)THEN STAT:=ERR ELSE BEGIN CURLN:=N; STAT:=OK; COUNT:=0; REPEAT T:=GETLINE(EINLINE,FD,MAXSTR); IF(T)THEN BEGIN STAT:=PUTTXT(EINLINE); IF(STAT<>ERR)THEN COUNT:=COUNT+1 END UNTIL(STAT<>OK)OR(T=FALSE); XCLOSE(FD); PUTDEC(COUNT,1); PUTC(NEWLINE) END; DOREAD:=STAT END; FUNCTION GETFN(VAR LIN:XSTRING;VAR I:INTEGER; VAR FIL:XSTRING):STCODE; VAR K:INTEGER; STAT:STCODE; FUNCTION GETWORD(VAR S:XSTRING;I:INTEGER;VAR OUT: XSTRING):INTEGER; VAR J:INTEGER; BEGIN WHILE(S[I]IN [BLANK,TAB,NEWLINE])DO I:=I+1; J:=1; WHILE(NOT(S[I]IN [ENDSTR,BLANK,TAB, NEWLINE]))DO BEGIN OUT[J]:=S[I]; I:=I+1; J:=J+1 END; OUT[J]:=ENDSTR; IF(S[I]=ENDSTR)THEN GETWORD:=0 ELSE GETWORD:=I END; BEGIN(*GETFN*) STAT:=ERR; IF(LIN[I+1]=BLANK)THEN BEGIN K:=GETWORD(LIN,I+2,FIL); IF(K>0)THEN IF(LIN[K]=NEWLINE)THEN STAT:=OK END ELSE IF(LIN[I+1]=NEWLINE) AND(SAVEFILE[1]<>ENDSTR)THEN BEGIN SCOPY(SAVEFILE,1,FIL,1); STAT:=OK; END; IF(STAT=OK)AND(SAVEFILE[1]=ENDSTR)THEN SCOPY(FIL,1,SAVEFILE,1); GETFN:=STAT END; PROCEDURE CATSUB(VAR LIN:XSTRING;S1,S2: INTEGER; VAR SUB: XSTRING;VAR NEW:XSTRING; VAR K:INTEGER;MAXNEW:INTEGER); VAR I,J:INTEGER; JUNK:BOOLEAN; BEGIN I:=1; WHILE(SUB[I]<>ENDSTR)DO BEGIN IF(SUB[I]=DITTO)THEN FOR J:=S1 TO S2-1 DO JUNK:=ADDSTR(LIN[J],NEW,K,MAXNEW) ELSE JUNK:=ADDSTR(SUB[I],NEW,K,MAXNEW); I:=I+1 END END; FUNCTION SUBST( VAR SUB:XSTRING;GFLAG,GLOB:BOOLEAN):STCODE; VAR NEW,OLD:XSTRING; J,K,LASTM,LINE,M:INTEGER; STAT:STCODE; DONE,SUBBED,JUNK:BOOLEAN; BEGIN IF(GLOB)THEN STAT:=OK ELSE STAT:=ERR; DONE:=(LINE1<=0); LINE:=LINE1; WHILE(NOT DONE)AND(LINE<=LINE2)DO BEGIN J:=1; SUBBED:=FALSE; GETTXT(LINE,OLD); LASTM:=0; K:=1; WHILE(OLD[K]<>ENDSTR)DO BEGIN IF(GFLAG)OR(NOT SUBBED)THEN M:=AMATCH(OLD,K,PAT,1) ELSE M:=0; IF(M>0)AND(LASTM<>M)THEN BEGIN SUBBED:=TRUE; CATSUB(OLD,K,M,SUB,NEW,J,MAXSTR); LASTM:=M END; IF(M=0)OR(M=K)THEN BEGIN JUNK:=ADDSTR(OLD[K],NEW,J,MAXSTR); K:=K+1 END ELSE K:=M END; IF(SUBBED)THEN BEGIN IF(NOT ADDSTR(ENDSTR,NEW,J,MAXSTR))THEN BEGIN STAT:=ERR; DONE:=TRUE END ELSE BEGIN STAT:=LNDELETE(LINE,LINE,STATUS); STAT:=PUTTXT(NEW); LINE2:=LINE2+CURLN-LINE; LINE:=CURLN; IF(STAT=ERR)THEN DONE:=TRUE ELSE STAT:=OK END END; LINE:=LINE+1 END; SUBST:=STAT END; FUNCTION MAKESUB(VAR ARG:XSTRING;FROM:INTEGER; DELIM:CHARACTER;VAR SUB:XSTRING):INTEGER; VAR I,J:INTEGER; JUNK:BOOLEAN; BEGIN J:=1; I:=FROM; WHILE(ARG[I]<>DELIM)AND(ARG[I]<>ENDSTR)DO BEGIN IF(ARG[I]=ORD('&'))THEN JUNK:=ADDSTR(DITTO,SUB,J,MAXPAT) ELSE JUNK:=ADDSTR(ESC(ARG,I),SUB,J,MAXPAT); I:=I+1 END; IF(ARG[I]<>DELIM) THEN MAKESUB:=0 ELSE IF (NOT ADDSTR(ENDSTR,SUB,J,MAXPAT))THEN MAKESUB:=0 ELSE MAKESUB:=I END; FUNCTION GETRHS(VAR LIN:XSTRING;VAR I:INTEGER; VAR SUB:XSTRING;VAR GFLAG:BOOLEAN):STCODE; BEGIN GETRHS:=OK; IF(LIN[I]=ENDSTR)THEN GETRHS:=ERR ELSE IF(LIN[I+1]=ENDSTR)THEN GETRHS:=ERR ELSE BEGIN I:=MAKESUB(LIN,I+1,LIN[I],SUB); IF(I=0)THEN GETRHS:=ERR ELSE IF(LIN[I+1]=ORD('G'))THEN BEGIN I:=I+1; GFLAG:=TRUE END ELSE GFLAG:=FALSE END END; FUNCTION DOCMD(VAR LIN:XSTRING;VAR I:INTEGER; GLOB:BOOLEAN;VAR STATUS:STCODE):STCODE; VAR FIL,SUB:XSTRING; LINE3:INTEGER; GFLAG,PFLAG:BOOLEAN; BEGIN PFLAG:=FALSE; STATUS:=ERR; IF(LIN[I]=PCMD)THEN BEGIN IF(LIN[I+1]=NEWLINE)THEN IF(DEFAULT(CURLN,CURLN,STATUS)=OK)THEN STATUS:=DOPRINT(LINE1,LINE2) END ELSE IF(LIN[I]=NEWLINE)THEN BEGIN IF(NLINES=0)THEN LINE2:=NEXTLN(CURLN); STATUS:=DOPRINT(LINE2,LINE2) END ELSE IF(LIN[I]=QCMD)THEN BEGIN IF( LIN[I+1]=NEWLINE)AND(NLINES=0)AND(NOT GLOB)THEN STATUS:=ENDDATA END ELSE IF(LIN[I]=ACMD)THEN BEGIN IF(LIN[I+1]=NEWLINE)THEN STATUS:=APPEND(LINE2,GLOB) END ELSE IF(LIN[I]=CCMD)THEN BEGIN IF(LIN[I+1]=NEWLINE)THEN IF(DEFAULT(CURLN,CURLN,STATUS)=OK)THEN IF(LNDELETE(LINE1,LINE2,STATUS)=OK)THEN STATUS:=APPEND(PREVLN(LINE1),GLOB) END ELSE IF(LIN[I]=DCMD)THEN BEGIN IF(CKP(LIN,I+1,PFLAG,STATUS)=OK)THEN IF(DEFAULT(CURLN,CURLN,STATUS)=OK)THEN IF(LNDELETE(LINE1,LINE2,STATUS)=OK)THEN IF(NEXTLN(CURLN)<>0)THEN CURLN:=NEXTLN(CURLN) END ELSE IF(LIN[I]=ICMD)THEN BEGIN IF(LIN[I+1]=NEWLINE)THEN BEGIN IF(LINE2=0)THEN STATUS:=APPEND(0,GLOB) ELSE STATUS:=APPEND(PREVLN(LINE2),GLOB) END END ELSE IF(LIN[I]=EQCMD)THEN BEGIN IF(CKP(LIN,I+1,PFLAG,STATUS)=OK)THEN BEGIN PUTDEC(LINE2,1); PUTC(NEWLINE) END END ELSE IF(LIN[I]=MCMD)THEN BEGIN I:=I+1; IF(GETONE(LIN,I,LINE3,STATUS)=ENDDATA)THEN STATUS:=ERR; IF(STATUS =OK)THEN IF(CKP(LIN,I,PFLAG,STATUS)=OK)THEN IF(DEFAULT(CURLN,CURLN,STATUS)=OK)THEN STATUS:=MOVE(LINE3) END ELSE IF(LIN[I]=SCMD)THEN BEGIN I:=I+1; IF(OPTPAT(LIN,I)=OK)THEN IF(GETRHS(LIN,I,SUB,GFLAG)=OK)THEN IF(CKP(LIN,I+1,PFLAG,STATUS)=OK)THEN IF(DEFAULT(CURLN,CURLN,STATUS)=OK)THEN STATUS:=SUBST(SUB,GFLAG,GLOB) END ELSE IF(LIN[I]=ECMD)THEN BEGIN IF(NLINES =0)THEN IF(GETFN(LIN,I,FIL)=OK)THEN BEGIN SCOPY(FIL,1,SAVEFILE,1); CLRBUF; SETBUF; STATUS:=DOREAD(0,FIL) END END ELSE IF(LIN[I]=FCMD)THEN BEGIN IF(NLINES =0)THEN IF(GETFN(LIN,I,FIL)=OK)THEN BEGIN SCOPY(FIL,1,SAVEFILE,1); PUTSTR(SAVEFILE,STDOUT); PUTC(NEWLINE); STATUS:=OK END END ELSE IF(LIN[I]=RCMD)THEN BEGIN IF(GETFN(LIN,I,FIL)=OK)THEN STATUS:=DOREAD(LINE2,FIL) END ELSE IF(LIN[I]=WCMD)THEN BEGIN IF(GETFN(LIN,I,FIL)=OK)THEN IF(DEFAULT(1,LASTLN,STATUS)=OK)THEN STATUS:=DOWRITE(LINE1,LINE2,FIL) END; IF(STATUS =OK)AND(PFLAG)THEN STATUS:=DOPRINT(CURLN,CURLN); DOCMD:=STATUS END;(*DOCMD*) FUNCTION CKGLOB(VAR LIN: XSTRING;VAR I:INTEGER; VAR STATUS:STCODE): STCODE; VAR N:INTEGER; GFLAG:BOOLEAN; TEMP: XSTRING; BEGIN IF(LIN[I]<>GCMD)AND(LIN[I]<>XCMD)THEN STATUS:=ENDDATA ELSE BEGIN GFLAG:=(LIN[I]=GCMD); I:=I+1; IF(OPTPAT(LIN,I)=ERR)THEN STATUS:=ERR ELSE IF( DEFAULT(1,LASTLN,STATUS)<>ERR)THEN BEGIN I:=I+1; FOR N:=LINE1 TO LINE2 DO BEGIN GETTXT(N,TEMP); PUTMARK(N,(MATCH(TEMP,PAT)=GFLAG)) END; FOR N:=1 TO LINE1-1 DO PUTMARK(N,FALSE); FOR N:=LINE2+1 TO LASTLN DO PUTMARK(N,FALSE); STATUS:=OK END END; CKGLOB:=STATUS END; FUNCTION DOGLOB(VAR LIN:XSTRING;VAR I,CURSAVE:INTEGER; VAR STATUS: STCODE):STCODE; VAR COUNT,ISTART,N: INTEGER; BEGIN STATUS:=OK; COUNT:=0; N:=LINE1; ISTART:=I; REPEAT IF(GETMARK(N))THEN BEGIN PUTMARK(N,FALSE); CURLN:=N; CURSAVE:=CURLN; I:=ISTART; IF(DOCMD(LIN,I,TRUE,STATUS)=OK)THEN COUNT:=0 END ELSE BEGIN N:=NEXTLN(N); COUNT:=COUNT + 1 END UNTIL(COUNT > LASTLN)OR(STATUS <> OK); DOGLOB:=STATUS END; BEGIN SETBUF; PAT[1]:=ENDSTR; SAVEFILE[1]:=ENDSTR; IF(GETARG(2,SAVEFILE,MAXSTR))THEN IF(DOREAD(0,SAVEFILE)=ERR)THEN WRITELN('?'); MORE:=GETLINE(LIN,STDIN,MAXSTR); WHILE(MORE)DO BEGIN I:=1; CURSAVE:=CURLN; IF(GETLIST(LIN,I,STATUS)=OK)THEN BEGIN IF(CKGLOB(LIN,I,STATUS)=OK)THEN STATUS:=DOGLOB(LIN,I,CURSAVE,STATUS) ELSE IF(STATUS<>ERR)THEN STATUS:=DOCMD(LIN,I,FALSE,STATUS) END; IF(STATUS=ERR)THEN BEGIN WRITELN('?'); CURLN:=MIN(CURSAVE,LASTLN) END ELSE IF(STATUS=ENDDATA)THEN MORE:=FALSE; IF(MORE)THEN MORE:=GETLINE(LIN,STDIN,MAXSTR) END; CLRBUF END; BEGIN EDIT; ENDCMD;assign(cmdptr,'SHELL.COM');execute(cmdptr) END.