(*$M-,C-,D-*)
program cmpars,cmpars,cmdird;
TYPE
  SETOFCHAR = SET OF CHAR;
{a THING is a declaration used for objects that require conversion
 between SIXBIT, half words, and fullwords.}
  THING=RECORD
	CASE INTEGER OF
	1:(SIXBIT:PACKED ARRAY[1:6] OF 0..77B);
	2:(HALF:PACKED ARRAY[1:2] OF 0..777777B);
	3:(FULL:INTEGER)
	END;
{this is a string of characters, typically a file spec. Note that the
 actual string is variable length. The 150 upper bound is not actually
 enforced. See below.}
  STRING=PACKED ARRAY[1:150] OF CHAR;
{this is the long form gtjfn block}
  gtjfnblock=record
	d0,d1:integer;
	gjdev:^string;
	gjdir:^string;
	gjnam:^string;
	gjext:^string
	end;	
{a BLOCK is a file control block, the internal data structure representing
 the state of a file.  For the structure of this block, see PASUNV.MAC}
  BLOCK=ARRAY[0:32B] OF THING;
VAR
  DELIMS,OCTALS:SETOFCHAR;

INITPROCEDURE;
 BEGIN
 DELIMS:=[':','.','[',',',']'];
 OCTALS:=['0','1','2','3','4','5','6','7'];
 END;

function cmprsl(s:string):integer;
	var i:integer;
  begin
  i := 0;
  while (s[i+1] <> chr(0)) do
    i := i+1;
  cmprsl := i
  end;    


PROCEDURE CMGSYM(VAR N:STRING;VAR PT:INTEGER;last:integer;var item:alfa;
		 var done:Boolean);
	var ipt:integer;
	CH:CHAR;
	doingoctal:Boolean;
{GETOCT is a subprocedure used by GETSYM to handle the syntax
 #octal digits.  As in PIP, we allow this to specify otherwise
 untypable names, e.g. #2020000033.UFD.  Reads 2 digits and
 returns the character (presumably untypable) that they
 describe in sixbit.  If just one digit there, assume 0 first
 digit. The virtual # referred to below is if there are more than
 2 digits.  Then we assume a # after the first two.}
FUNCTION GETOCT:CHAR;
%CALLED WITH PT POINTING AT # (REAL OR VIRTUAL). GETS UP TO 2
FOLLOWING OCTAL DIGITS.  LEAVES PT POINTING AT LAST CHAR GOT\
   var oct:integer;
 BEGIN
 OCT:=0;
 IF(PT+1)<=LAST {PT+1 used because PT is the #}
  THEN IF N[PT+1] IN OCTALS
   THEN BEGIN
   OCT := 8 * (ORD(N[PT+1]) - 60B);
   PT := PT+1;
   IF ((PT+1) <= LAST)
    THEN IF (N[PT+1] IN OCTALS)
     THEN BEGIN
     OCT := OCT + (ORD(N[PT+1]) - 60B);
     PT := PT+1;
     END
   END;
 GETOCT := CHR (OCT + 40B);
 END;

{GETSYM gets the next atom and puts it in ITEM.  An atom is anything
 between delimiters, or a delimiter.  So each delimiter will be returned
 as a separate atom.  Updates PT to point to the character after the
 last one scanned.  This routine truncates at 6 characters, but scans
 more if they are there (usual DEC filename syntax).}
  BEGIN %GETSYM\
  ITEM:='          ';
  IPT:=1;	{IPT is pointing into ITEM.  Where the output is put.}
  CH:='A';
  DOINGOCTAL:=FALSE;
{skip blanks and nulls}
  WHILE(PT<=LAST) AND ((N[PT]=' ') OR (ORD(N[PT])=0))
    DO PT:=PT+1;
{scan until come to end of string or a delimiter}
  WHILE(PT<=LAST) AND NOT(CH IN DELIMS) DO
    BEGIN
     %DOINGOCTAL IS ON IF CHAR AT PT SHOULD BE INTERPRETED AS OCTAL\
    IF NOT (N[PT] IN OCTALS) THEN DOINGOCTAL := FALSE;
	{map lower case to upper, turn ctl characters into blanks}
    CH:=N[PT]; IF ORD(CH)>=140B THEN CH:=CHR(ORD(CH)-40B);
    IF ORD(CH)=11B THEN CH:= ' ';
	{if octal, make sure DOINGOCTAL is on and PT is pointing to
	 real or virtual #}
    IF CH='#'
     THEN DOINGOCTAL := TRUE
      %GETOCT WILL START LOOKING AT PT+1, LEAVE PT AT LAST IT SAW\
     ELSE IF DOINGOCTAL
      THEN PT := PT-1;
       %GETOCT EXPECT PT IS #, SO THIS MAKES IT START LOOKING AT
        PT.  WE HAVE VERIFIED PT IS OCTAL (FIRST LINE OF ROUTINE), SO
        GETOCT WILL AT LEAST GOBBLE A DIGIT AT PT\
	 {copy character to ITEM unless already 6}
    IF IPT<=6
     THEN IF DOINGOCTAL
      THEN ITEM[IPT]:=GETOCT
      ELSE ITEM[IPT]:=CH;
    PT:=PT+1;  IPT:=IPT+1;
    END;
  IF PT>LAST THEN DONE:=TRUE;
	{if we have a delimiter and IPT is 2, that means the delimiter
	 was the first thing we saw.  In that case, we want to return
	 just the delimiter.  If IPT > 2, then it is a delimiter that
	 marks the end of a normal atom, and we save the delimiter
	 for next time}
  IF (CH IN DELIMS) AND (IPT>2)
    THEN BEGIN IF IPT<=7 THEN ITEM[IPT-1]:=' '; IPT:=IPT-1; PT:=PT-1; DONE:= FALSE END;
  END;

{CVSIX take the item that is in ITEM and puts it in offset INDEX in the
 file control block we are building up.  SIXBIT conversion is done.}
PROCEDURE CMCVSIX(item:alfa;var dummy:block;INDEX:INTEGER);
    var ipt:integer;
  BEGIN
  FOR IPT:=1 TO 6 DO
  BEGIN
    DUMMY[INDEX].SIXBIT[IPT]:=ORD(ITEM[IPT])-40B;
END;
  END;

{CVINT takes the item that is in ITEM and puts it in the reference
 variable I.  It assumes ITEM is the character representation of an
 octal number.}
function cmcvint(item:alfa;var i:integer):Boolean;
	var ipt:integer;
  BEGIN
  i:=0; cmcvint:= true;
  ipt := 1;
  repeat
    if item[ipt] in octals
      then begin i:=i*8 + ord(item[ipt])-60b; ipt := ipt+1 end
    until (ipt > 6) or not (item[ipt] in octals);
  while ipt <= 6 do
    begin
    if item[ipt] <> ' '
      then cmcvint := false;
    ipt := ipt+1
    end    
  END;

function cmdirparse(var n:string;var pt:integer;last:integer;
		    var dummy:block;var done:Boolean;var olen:integer):Boolean;
  var i:integer;bo:boolean;item:alfa;
begin
cmdirparse := false;
CALLI(24B,0,0,I,BO);  {get our PPN}
DUMMY[20B].FULL:=I;   {supply our PPN as default, in case of [,]}
if done then goto 6;
CMGSYM(N,PT,LAST,ITEM,DONE);  {now get an atom.  Can be project number or comma if [,]}
IF(ITEM[1]=',') THEN  {if no proj number, we already have default}
ELSE IF(ITEM[1] IN DELIMS) THEN GOTO 6 {junk}
ELSE BEGIN
if cmcvint(item,i)
  then dummy[20b].half[1]:=i    {put proj number where it goes}
  else goto 6;
if done then goto 6;
CMGSYM(N,PT,LAST,ITEM,DONE);  	{comma after proj number - must be there}
IF NOT(ITEM[1] = ',') THEN GOTO 6;
END;
if done then begin olen := last; goto 5 end;
CMGSYM(N,PT,LAST,ITEM,DONE);  {we have now seen [proj,   This is prgr num
	  or ] in case of [,], or comma in case of [,,SFD]}
IF(ITEM[1]=',') THEN GOTO 4
ELSE IF(ITEM[1] IN DELIMS) THEN BEGIN OLEN := PT-2; GOTO 5 END
ELSE BEGIN
if cmcvint(item,i)  {here if we have a real prgrm nummber - put it away}
  then dummy[20b].half[2]:=i
  else goto 6;
if done then begin olen := last; goto 5 end;
CMGSYM(N,PT,LAST,ITEM,DONE);  {and get delimiter after prgm number - , or ]}
IF ITEM[1]=',' THEN GOTO 4
ELSE IF (ITEM[1] IN DELIMS) THEN BEGIN OLEN := PT-2; GOTO 5 END
ELSE GOTO 6;
END;

	{State 4 - we have seen the , after a PPN - scan for SFD's}
4:
FOR I:=1 TO 5 DO
  BEGIN
  if done then goto 6;
  CMGSYM(N,PT,LAST,ITEM,DONE);  {this is an SFD}
  IF (ITEM[1] IN DELIMS) THEN GOTO 6;
  CMCVSIX(item,dummy,20B+I);
  IF DONE THEN BEGIN OLEN := LAST; GOTO 5 END;
  CMGSYM(N,PT,LAST,ITEM,DONE);  {this is comma if more SFD's, or ] if no more}
  IF ITEM[1] = ',' THEN
  ELSE IF ITEM[1] IN DELIMS THEN BEGIN OLEN := PT-2; GOTO 5 END
  END;  {normal exit from this loop is finding ] and going to 5}
GOTO 6;  {didn't terminate with ]}

5: 
cmdirparse := true;

6:

END;


function cmdird(var n:string;SFDOK:Boolean):integer;
  type longppn=record
	dum1,dum2:integer;
	levels:array[20B:25B] of integer;
	end;
  var dummy:block;
      olen,i,last,pt:integer;
      done:Boolean;
      convert:record case Boolean of
	true:(int:integer);
	false:(pt:^longppn)
	end;
  begin
	{Initialization}
  delims := [chr(0)..chr(177B)] - ['a'..'z','A'..'Z','0'..'9'];
  last := cmprsl(n);
  done := false;
  pt := 2;
  for i := 20B to 25B do dummy[i].full := 0;
  if (n[1] <> '[') or (n[last] <> ']')
    then convert.int := 0
  else if not cmdirparse(n,pt,last,dummy,done,olen)
    then convert.int := 0
  else if olen <> last-1  {did we parse the whole thing?}
    then convert.int := 0
  else if (dummy[21B].full <> 0) and not SFDOK
    then convert.int := 0
  else begin
      if dummy[21B].full <> 0   {sfd's}
	then begin
	new(convert.pt);
	with convert.pt^ do
	  begin
	  dum1 := 0;
	  dum2 := 0;
	  for i := 20B to 25B do
	    levels[i] := dummy[i].full
	  end
	end
       else convert.int := dummy[20B].full  {simple PPN}
  end;
  cmdird := convert.int
  end;

{PARSE is the main file name parser. It is a finite state machine.
    B - file control block. See PASUNV.MAC.  In assembly language,
	you should pass the address of the control block in AC 2 (REG)
    N - file name.  This is a string of arbitrary length.  Note that
	error checking is turned off, so bounds are not checked on
	this array.  So the code below must be very careful to handle
	the bounds properly.  This is the only way to handle arbitrary
	length strings in Pascal.  In assembly language, put the
	address of the string in AC 3 (REG1).
    COUNT - length of the string N.  The compiler supplies this in
	AC 4 (REG2) for RESET, REWRITE, etc.  Also the pseudo-type
	STRING will cause a string to be tranmitted in one AC and
	the length in the next.  Be very careful not to refer to
	anything before N[COUNT], as bounds checking is turned off.
  This routine parses a standard DEC10 file spec and puts the resulting
  sixbit stuff in the appropriate places in the file control block.
  It returns the number of characters gobbled.
}
FUNCTION CMPARS(VAR B:BLOCK; VAR N:STRING; COUNT:INTEGER; 
		VAR GB:GTJFNBLOCK):INTEGER;
VAR
  ITEM:ALFA;  {Current atom, returned by GETSYM}
  BO,DONE:BOOLEAN;
  LASTSEEN,LAST,I,OCT:INTEGER;
  DUMMY:BLOCK;  {We build up the block in DUMMY.  If there is an error,
		 we do not want to have changed the real thing.}
  OLEN,OPT,PT:INTEGER;  {PT - next character to be scanned, index into N}
		    


{Beginning of main scanner logic}
BEGIN
	{Initialization}
delims := [chr(0)..chr(177B)] - ['a'..'z','A'..'Z','0'..'9'];
DONE:=FALSE;
LAST:=COUNT;
PT:=1;
OLEN := -1;
	{These are default values for the file control block}
b[1].full:=1;
DUMMY[14B].FULL:=0;
DUMMY[15B].FULL:=0;
DUMMY[12B].FULL:=0;
FOR I:=20B TO 20B+5 DO
 DUMMY[I].FULL:=0;
	{Here is the beginning of the finite state machine}
{Note that this code is as careful as possible about syntax errors,
 so whenever a name is expected, you have to check to be sure you
 didn't get a delimiter instead, or end of string.}
	{State 0: parse the first atom, file name or device}
CMGSYM(N,PT,LAST,ITEM,DONE);
if item[1] in delims then begin olen := 0; goto 5 end;
CMCVSIX(item,dummy,14B);  {use as file name.}
IF DONE THEN BEGIN OLEN := COUNT; GOTO 5 END;
OLEN := PT-1;
CMGSYM(N,PT,LAST,ITEM,DONE);	     {get the delimiter}
IF ITEM[1]=':'  THEN GOTO 1
ELSE IF ITEM[1]='.' THEN GOTO 2
ELSE IF ITEM[1]='[' THEN GOTO 3
ELSE GOTO 5;

	{State 1: a device name has just been parsed.  It was
		  interpreted as a file name, so copy to device
		  name field.  If there is another atom, it is
		  unambiguously a file name.}
1:
DUMMY[12B]:=DUMMY[14B];  DUMMY[14B].FULL := 0;
IF DONE THEN BEGIN OLEN := COUNT; GOTO 5 END;
OLEN := PT-1;
CMGSYM(N,PT,LAST,ITEM,DONE);	   {get next atom. If valid, it will be a file name}
IF(ITEM[1] IN DELIMS) THEN GOTO 5;
CMCVSIX(item,dummy,14B);
IF DONE THEN BEGIN OLEN := COUNT; GOTO 5 END;
OLEN := PT-1;
CMGSYM(N,PT,LAST,ITEM,DONE);	   {this is the delimiter after the file name}
IF ITEM[1]='.' THEN GOTO 2
ELSE IF ITEM[1]='[' THEN GOTO 3
ELSE GOTO 5;

	{State 2:  here after file name and dot.  Can be extension, PPN, or
		   end of string}
2:
DUMMY[15B].HALF[2] := 777777B;  {allow us to detect null ext}
IF DONE THEN BEGIN OLEN := COUNT; GOTO 5 END;
OLEN := PT-1;
CMGSYM(N,PT,LAST,ITEM,DONE);	{next atom: PPN, extension, or junk}
IF(ITEM[1]='[') THEN GOTO 3;  {PPN}
IF(ITEM[1] IN DELIMS) THEN GOTO 5; {junk}
CMCVSIX(item,dummy,15B);  {extension: put it in extension field}
IF DONE THEN BEGIN OLEN := COUNT; GOTO 5 END;
OLEN := PT-1;
CMGSYM(N,PT,LAST,ITEM,DONE);   {delimiter after extension}
IF(ITEM[1]='[') THEN GOTO 3
ELSE GOTO 5;

	{State 3: here after a [.  Had better be a PPN of some sort}
3:  if not cmdirparse(n,pt,last,dummy,done,olen)
      then goto 6
    else if n[olen+1] <> ']'
      then goto 6
    else begin
    olen := olen+1;  {gobble the ]}
    goto 5
    end;

	{State 5 - finished valid scan}
5:
{now we can copy the data into the real control block, since we know
 it is valid}

if item[1] = chr(33B)  {see if recognition is needed}
  then begin
  {yes - first figure out the last thing we saw, since completion shows
   only for fields after that}
  lastseen := 0;
  if dummy[12B].full <> 0
    then lastseen := 12B;
  if dummy[14B].full <> 0
    then lastseen := 14B;
  if dummy[15B].full <> 0
    then lastseen := 15B;  
  if dummy[20B].full <> 0
    then lastseen := 20B;
  end
 else lastseen := 100;  {high enough that no field shows}

opt := olen;  {place in atom buffer for recognized chars}

if (dummy[12B].full = 0) and (ord(gb.gjdev) <> 0)  {default dev?}
  then begin
  pt := 1;
  cmgsym(gb.gjdev^,pt,cmprsl(gb.gjdev^),item,done);
  cmcvsix(item,dummy,12B);
  if lastseen < 12B
    then begin
    for i := 1 to pt-1 do
      n[opt + i] := gb.gjdev^[i];
    n[opt + pt-1 + 1] := ':';
    opt := opt + pt-1 + 1
    end
  end;

if (dummy[14B].full = 0) and (ord(gb.gjnam) <> 0)  {default name?}
  then begin
  pt := 1;
  cmgsym(gb.gjnam^,pt,cmprsl(gb.gjnam^),item,done);
  cmcvsix(item,dummy,14B);
  if lastseen < 14B
    then begin
    for i := 1 to pt-1 do
      n[opt + i] := gb.gjnam^[i];
    opt := opt + pt-1
    end
  end;

if (dummy[15B].full = 0) and (ord(gb.gjext) <> 0)  {default ext?}
  then begin
  pt := 1;
  cmgsym(gb.gjext^,pt,cmprsl(gb.gjext^),item,done);
  cmcvsix(item,dummy,15B);
  if lastseen < 15B
    then begin
    n[opt + 1] := '.';
    for i := 1 to pt-1 do
      n[opt+1 + i] := gb.gjext^[i];
    opt := opt + pt-1 + 1
    end
  end;

n[opt+1] := chr(0);

if (dummy[12B].full = 0) and (dummy[14B].full = 0)
  then goto 6;  {no name given}

if dummy[14B].full = 0   {if no name, use device}
  then dummy[14B] := dummy[12B];

if dummy[12B].full = 0
  then begin
  DUMMY[12B].HALF[1]:=446353B;  {DSK}
  DUMMY[12B].HALF[2]:=0;
  end;

B[12B]:=DUMMY[12B];
B[14B]:=DUMMY[14B];
B[15B]:=DUMMY[15B];
B[15B].HALF[2] := 0;
FOR I:=20B TO 20B+5 DO
 B[I]:=DUMMY[I];
 b[1].full:=0;
goto 7;

6:
{error - note that going directly here results in an error.  The caller
 tests EOF to see if this worked.  EOF is initialized to true, and is
 only set false in 5 above.}
n[pt] := chr(0);
olen := pt-1;

7:
cmpars := olen

END {of cmpars}.