Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/TURBO5.ZIP/IF.PAS

Pascal/Delphi Source File | 1986-12-26 | 10.8 KB | 270 lines

program IfTest;
{$C-} {$I-}
{ Process a command line "IF" statement in to a boolean variable and set the CP/M Plus error codes correspondingly.
  Syntax allows for full operator precedence and parenthesis.  Any file matching a file specification returns true.
  Valid operators are '&' for a logical AND, '|' for a logical OR, and '~' for a logical NOT.  For example, to allow
  the next conditional submit line to execute if there are no *.BAK files but there are either *.ASM or *.MAC files on
  the default drive, use the following line:
         IF ~ *.BAK & (*.ASM | *.MAC)
  Remember that any submit line which is preceeded by a ":" will only be used if the Error Code from the program on the
  previous line of the submit file returned a true value.  Thus if you wish to use PIP to copy the *.PAS files if there
  are no *.BAK files on A:, use the following lines in your submit file:
         IF ~ A:*.BAK
         :PIP C:=A:*.PAS
  This program requires a simple loader to be written in assembly language and tacked in front
  of the resulting command file in order to save the full command line before calling the Turbo Pascal
  program since Turbo destroys part of the command line during execution.  The assembly portion is:

         ; Assembly language portion of IF.PAS
         ;
         ; Required so that entire command line tail is saved before entering
         ; Turbo Pascal since Turbo destroys all but very beginning of command
         ; line.
         ;
         ; All that this module does is move the command line to 3E80h and then
         ; moves the Pascal program to 100h and executes it.  It will run only
         ; on a Z80 system.
         ;

         ; First, start by move the command line and this program itself up to higher memory.
                 org  100h
                 lxi  b,256
                 lxi  d,3E80h
                 lxi  h,0080h
                 db   0EDh,0B0h
                 jmp  3F20h

         ; Now move the Pascal program down to 100h -- Notice that this portion will actually
         ; be executed at 3F20h after being moved by above portion of code.
                 org  120h
                 lxi  b,3D00h
                 lxi  d,0100h
                 lxi  h,0180h
                 db   0EDh,0B0h
                 jmp  100h
                 end

  To assemble this fragment of assembly language, pull it into a file of its own called IF1.ASM
  and use MAC to assemble it as follows:
         A>MAC IF1 $PZ SZ
  Then convert the resulting IF1.HEX into IF1.COM by using the HEXCOM utility:
         A>HEXCOM IF1
  Now compile IF.PAS into IF.COM using Turbo Pascal.  Be sure to use the compiler options menu to
  force compilation into a .COM file and use the "E" command to set the end of memory to 3D00.  Setting
  the end of memory lower in this manner will prevent many problems with varying TPA sizes.  Next
  combine the two sections by using PIP as follows:
         A>PIP IF.COM=IF1.COM,IF.COM[O]
  The resulting file IF.COM is the final form of the program.

  If you have any questions, feel free to leave a note to me on Compuserve [74206,21] or to
         Scott Bussinger
         Professional Practice Systems
         112 South 131st Street
         Tacoma, WA  98444                                                                                              }

type Fyle = file;                      { Your generic untyped file }
     Stack = string[32];               { Stacks are implemented as strings so I can use all of the convenient functions }
     Symbol = (NotExists,Exists,NotOperator,AndOperator,OrOperator,LeftParenthesis,RightParenthesis);

const a: array[Symbol] of integer = (0,0,1,2,2,0,0);  { Number of arguments }
      f: array[Symbol] of integer = (7,7,5,3,1,9,0);  { Input precendence }
      g: array[Symbol] of integer = (8,8,6,4,2,0,0);  { Stack precendence }

var CPM: boolean;
    CPMPlus: boolean;
    MPM: boolean;
    Buffer: string[127];                      { A one sector buffer }
    CommandLine: string[127] absolute $3E80;  { Get the command line from CP/M -- was moved from $0080 }
    ResultStack: Stack;
    SubFile: File;

procedure InitStack(var S: Stack);
  { Initialize the stack to empty }
  { All of the stack routines use a string as the implementation medium }
  begin
  S := ''
  end;

procedure Push(Value: Symbol;var S: Stack);
  { Push a value onto the stack -- there is no overflow test }
  begin
  S := chr(ord(Value))+S
  end;

function Pop(var S: Stack): Symbol;
  { Pop a value from stack  -- there is no underflow test }
  begin
  Pop := Symbol(S[1]);
  delete(S,1,1)
  end;

function TopOfStack(var S: Stack): Symbol;
  { Return the value of the top element in the stack }
  begin
  TopOfStack := Symbol(S[1])
  end;

function SizeOfStack(var S: Stack): integer;
  { Return current number of elements in stack }
  begin
  SizeOfStack := length(S)
  end;

function CheckDirectory(var Mask: Fyle): boolean;
  { Use an untyped file's name as a mask for a directory check using search first BDOS call }
  begin
  bdos(26,addr(Buffer));                         { Set DMA to point at a temporary sector buffer }
  CheckDirectory := bdos(17,addr(Mask)+12)<>255  { Do a Search-for-First using BDOS call and FCB in file interface block }
  end;                                           { addr(Mask)+12 is address of CP/M FCB in Pascal's FIB }

function ParseNext: Symbol;
  { Return the symbol type of next element on command line }
  { If underflow on command line, return a right parenthesis }
  var DirFile: Fyle;
      Filename: string[32];
  begin
  case CommandLine[1] of
    '&': begin
         ParseNext := AndOperator;
         delete(CommandLine,1,1)
         end;
    '|': begin
         ParseNext := OrOperator;
         delete(CommandLine,1,1)
         end;
    '~': begin
         ParseNext := NotOperator;
         delete(CommandLine,1,1)
         end;
    '(': begin
         ParseNext := LeftParenthesis;
         delete(CommandLine,1,1)
         end;
    ')': begin
         ParseNext := RightParenthesis;
         delete(CommandLine,1,1)
         end
    else begin                         { Should be a filename -- possibly with wildcards }
         Filename := '';
         repeat                        { Accumulate filename characters }
           if CommandLine[1]='*'       { Check for a fill-rest-of-field wildcard }
            then
             Filename := Filename+'????????'          { Add enough ?'s to fill either primary name or extension }
            else
             Filename := Filename+CommandLine[1];     { Add next character to file name }
           delete(CommandLine,1,1)
         until (CommandLine[1] in [#8,' ','~','&','|','(',')']) or (CommandLine=''); { Accumulate until delimiter }
         assign(DirFile,Filename);
         if CheckDirectory(DirFile)    { Look in directory for the file }
          then
           ParseNext := Exists
          else
           ParseNext := NotExists
         end
    end;
  while (CommandLine<>'') and (CommandLine[1] in [#8,' ']) do  { Strip off trailing spaces or tabs }
    delete(CommandLine,1,1)
  end;

function UseSymbol(Value: Symbol): boolean;
  { Combine the symbol with the result stack }
  { Type conversion uses the fact that ord(false)=0 and ord(true)=1 }
  begin
  if SizeOfStack(ResultStack) < a[Value]  { Make sure there is no stack underflow }
   then
    UseSymbol := true                  { Oops, we don't have enough arguments for that function -- a stack underflow }
   else
    begin
    UseSymbol := false;
    case Value of
      NotExists,Exists: Push(Value,ResultStack);
      AndOperator: Push(Symbol((Pop(ResultStack)=Exists) and (Pop(ResultStack)=Exists)),ResultStack);
      OrOperator: Push(Symbol((Pop(ResultStack)=Exists) or (Pop(ResultStack)=Exists)),ResultStack);
      NotOperator: Push(Symbol(Pop(ResultStack)<>Exists),ResultStack)
      end
    end
  end;

function InfixToReverseToBoolean: boolean;
  { Convert the input string into reverse polish notation and calculate the answer }
  label 1,Error;
  var NextSymbol: Symbol;
      ConversionStack: Stack;
      Temp: Symbol;
  begin
  InitStack(ConversionStack);
  Push(LeftParenthesis,ConversionStack);

  while CommandLine <> '' do           { Check that CommandLine is not empty }
    begin
    NextSymbol := ParseNext;
    while f[NextSymbol] <= g[TopOfStack(ConversionStack)] do
      begin
      Temp := Pop(ConversionStack);
      if f[NextSymbol] = g[Temp]
       then
        goto 1
       else
        if UseSymbol(Temp) then goto Error
      end;
    Push(NextSymbol,ConversionStack);
1:  end;
  if (SizeOfStack(ConversionStack)<>0) or (SizeOfStack(ResultStack)<>1)
   then
    begin
Error: writeln('Error in command syntax -- false assumed.');
    InfixToReverseToBoolean := false
    end
   else
    InfixToReverseToBoolean := Pop(ResultStack)=Exists
  end;

begin
CPMPlus := (hi(bdoshl(12))=0) and (lo(bdoshl(12))>=$30);  { Check for CP/M Plus version number }
CPM := (hi(bdoshl(12))=0) and not CPMPlus;  { Check for CP/M 2.2 or below }
MPM := hi(bdoshl(12))=1;               { Check for MP/M because this program will NOT run under that system }
if MPM
 then
  writeln('This program will not run under MP/M.')
 else
  begin
  while (CommandLine<>'') and (CommandLine[1] in [#8,' ']) do  { Strip off leading spaces or tabs in CommandLine }
    delete(CommandLine,1,1);
  CommandLine := CommandLine+')';      { Algorithm needs a final right parenthesis to work }
  InitStack(ResultStack);              { Prepare the result stack }
  if InfixToReverseToBoolean           { Convert command line into a boolean value }
   then
    begin
    writeln('true');
    if CPMPlus then                    { If CP/M 2.2 then do nothing if true }
      bdos(108,0)                      { If CP/M Plus then return a true value to CCP }
    end
   else
    begin
    writeln('false');
    if CPMPlus
     then
      bdos(108,$FF00)                  { If CP/M Plus then return a false value }
     else
      begin                            { If CP/M 2.2 then insert a ';' into last record of $$$.SUB to comment it out }
      assign(SubFile,'A:$$$.SUB');
      reset(SubFile);
      if ioresult=0 then
        begin
        seek(SubFile,pred(filesize(SubFile)));  { Move pointer to last record of file -- next line to be submitted }
        blockread(Subfile,Buffer,1);   { Read in record }
        Buffer := ';'+Buffer;          { Comment out the line so that it won't execute }
        blockwrite(Subfile,Buffer,1);  { Save sector again }
        close(SubFile)
        end
      end
    end
  end
end.
   blockwrite(Subfile,Buffer,1);  { Save sector again }
        close(SubFile)
        end
      end
    end
  end
end.