XLATE2$MOD:
DO;

/************************************************************************/
/*																		*/
/*      '(C) Intel Corporation 1981'.  All rights reserved.  No			*/
/*      part of this program or publication may be reproduced,			*/
/*      transmitted, transcribed, stored in a retrievel system, or		*/
/*      translated into any language or computer language, in any		*/
/*      form or by any means, electronic, mechanical, magnetic,			*/
/*      optical, chemical, manual or otherwise, without the prior		*/
/*      written permission of Intel Corporation, 3065 Bowers			*/
/*      Avenue, Santa Clara, California, 95051, Attn: Software			*/
/*      License Administration.											*/
/*																		*/
/************************************************************************/

DECLARE COPYRIGHT (*) BYTE DATA ('(C) INTEL CORP 1981');

DECLARE PROGRAM$VERSION$NUMBER$STRING (*) BYTE DATA
    ('program_version_number=V1.0',0);

DECLARE LIT     LITERALLY 'LITERALLY',
        DCL     LIT       'DECLARE',
        TRUE    LIT       '0FFH',
        FALSE   LIT       '000H',
        PROC    LIT       'PROCEDURE',
        ENDPROC LIT       'END;',
        THENN   LIT       'THEN DO;',
        ELLSE   LIT       'END; ELSE DO;',
        ELSIF   LIT       'END; ELSE IF',
        ENDIF   LIT       'END;',
        ENDDO   LIT       'END;',
        CR      LIT       '0DH',
        LF      LIT       '0AH',
        NULL    LIT       '0',
        CHK     LIT       'CALL CHECK$ISIS$STATUS(STATUS)',
        TOEND   LIT       '7FFFH',
        TOBEG   LIT       '08000H'
        ;

DCL     comtrace            LIT '/*';   /* for debugging procedure trace */

DCL     PCNT$0$TYPE         LIT '0',
        PCNT$0$DOT$TYPE     LIT '1',
        PCNT$0$DOT$EXT$TYPE LIT '2',
        NUMB$0$TYPE         LIT '3';

DCL     NAME$DOT$TYPE       LIT  '0',
        NAME$DOT$EXT$TYPE   LIT  '1',
        NAME$ONLY$TYPE      LIT  '2';

DCL     UNKNOWN$TYPE        LIT  '10';

DCL     NAME$ADDED          LIT  '1',
        NEW$LINE            LIT  '3',
        DONE                LIT  '0';

DCL NO$NUM$EXTENSION        LIT '0FFFFH';

$EJECT
EXIT:   PROC             EXTERNAL;                                        END;
RESCAN: PROC (AFT,ST)    EXTERNAL; DCL  (AFT, ST)   ADDRESS;              END;
CO:     PROC (CHR)       EXTERNAL; DCL  CHR         BYTE;                 END;
READC:  PROC (PTR,LEN)   EXTERNAL; DCL (PTR,LEN)    ADDRESS;              END;
READI:  PROC (PTR,LEN)   EXTERNAL; DCL (PTR,LEN)    ADDRESS;              END;
READ1:  PROC (PTR,LEN)   EXTERNAL; DCL (PTR,LEN)    ADDRESS;              END;
OPENO:  PROC (PTR)       EXTERNAL; DCL  PTR         ADDRESS;              END;
OPENI:  PROC (PTR)       EXTERNAL; DCL  PTR         ADDRESS;              END;
OPEN1:  PROC (PTR,MO)    EXTERNAL; DCL  PTR ADDRESS,MO BYTE;              END;
CLOSEO: PROC             EXTERNAL;                                        END;
CLOSEI: PROC             EXTERNAL;                                        END;
CLOSE1: PROC             EXTERNAL;                                        END;
CONS:   PROC (P1,P2)     EXTERNAL; DCL  (P1,P2)     ADDRESS;              END;
SEEK:   PROC (A,M,B,C,S) EXTERNAL; DCL  (A,M,B,C,S) ADDRESS;              END;
SCANMATCH: PROC(P)BYTE   EXTERNAL; DCL  P           ADDRESS;              END;
SCAN$WHILE:PROC(P)       EXTERNAL; DCL  P           ADDRESS;              END;
SCAN$UNTIL:PROC(P)       EXTERNAL; DCL  P           ADDRESS;              END;
TERM$CH:   PROC   BYTE   EXTERNAL;                                        END;
OUT$CHAR:  PROC   (CHAR) EXTERNAL; DCL  CHAR        BYTE;                 END;
OUT$PRINT: PROC (PTR)    EXTERNAL; DCL  PTR         ADDRESS;              END;
OUT$DEC$R: PROC (VAL,W)  EXTERNAL; DCL  VAL ADDRESS, W BYTE;              END;
DEC$IN:    PROC ADDRESS  EXTERNAL;                                        END;
DEL:       PROC(PTR)     EXTERNAL; DCL   PTR        ADDRESS;              END;
FMOVE: PROC (C,S,D)      EXTERNAL; DCL  (C,S,D)     ADDRESS;              END;
WHOCI:  PROC (PTR)       EXTERNAL; DCL  PTR         ADDRESS;              END;
WHOCO:  PROC (PTR)       EXTERNAL; DCL  PTR         ADDRESS;              END;
WRITEO: PROC(P,L)        EXTERNAL; DCL  (P,L)       ADDRESS;              END;
WRITEC: PROC(P,L)        EXTERNAL; DCL  (P,L)       ADDRESS;              END;
ERROR: PROC(ERROR$NO)    EXTERNAL; DCL  ERROR$NO    ADDRESS;              END;
MEM$CK: PROC ADDRESS     EXTERNAL;                                        END;
SPATH: PROC(FILE,BUFFER,STATUS)  EXTERNAL;
       DCL (FILE,BUFFER,STATUS)  ADDRESS;                                 END;
LOAD: PROC(FILE,BIAS,SWITCH,ENTRY,STATUS) EXTERNAL;
      DCL (FILE,BIAS,SWITCH,ENTRY,STATUS) ADDRESS;                        END;
GETD: PROC(DRIVE,CON,COUNT,ACTUAL$COUNT,BUFFER,STATUS) EXTERNAL;
      DCL (DRIVE,CON,COUNT,ACTUAL$COUNT,BUFFER,STATUS) ADDRESS;           END;
WRITE:PROC(AFTN,BUFFER,COUNT,STATUS) EXTERNAL;
      DCL (AFTN,BUFFER,COUNT,STATUS) ADDRESS;                             END;

DCL    (STATUS,REPORT,ERRED,FATAL,ACTUAL) ADDRESS EXTERNAL;
DCL    (SCANP,OBUFP,GIVEUP)      ADDRESS EXTERNAL,
       (SCANENDED,TARLEN,JOKER)  BYTE    EXTERNAL;
DCL    LEADCHAR                  BYTE    EXTERNAL;

$EJECT
DCL    SCANBYTE BASED SCANP BYTE,
       SCANP$TMP ADDRESS;
DCL    BLOKNO ADDRESS, BYTENO ADDRESS;

/*********************************************
    G L O B A L   S T R U C T U R E S
*********************************************/
DCL   NAMEINDEX ADDRESS;
DCL   MAXINDEX  LIT '200';
DCL   NAME$LIST (MAXINDEX)     STRUCTURE ( DRIVE (4) BYTE,
                                           NAME  (6) BYTE,
                                           EXT   (3) BYTE,
                                           TYPE BYTE);
DCL   FILL$INDEX BYTE;
DCL   MAX$FILLS LIT '30';
DCL   FILL$ARRAY (MAX$FILLS)   STRUCTURE ( FILL$PTR ADDRESS,
                                           TYPE BYTE,
                                           EXT (4) BYTE,
                                           DRIVE (4) BYTE);

/*********************************************
       G L O B A L   V A R I A B L E S
*********************************************/

DCL FRONT$EXT          LIT '512',
    READ$LEN           LIT '1024';
DCL TEMPLATE (1536)    BYTE;
DCL PAD                BYTE;  /* this is a pad for template, do not disturb */
DCL INVOK$NAME (16)    BYTE;

DCL (FROM$PTR, FILL$PTR) ADDRESS;
DCL ENDOFLIST          BYTE;

DCL DEBUG$FLAG         BYTE INITIAL (FALSE);
DCL HALT$FLAG          BYTE INITIAL (FALSE);
DCL SCRUNCH$FLAG       BYTE INITIAL (FALSE);

DCL TARGET (10)        BYTE PUBLIC ;
DCL READBUF (129)      BYTE;
DCL MSG$BUF (128)      BYTE;
DCL BLANK$STR (16)     BYTE DATA('                ');
DCL NULLSTRING(16)     BYTE DATA(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
DCL DR$STR(4)          BYTE DATA(':F#:');
DCL LENGTH$TO$WRITE$FROM$TEMPLATE ADDRESS;
DCL MONITOR ADDRESS DATA(0);
DCL CONNECTION ADDRESS INITIAL(0);
DCL MEM$TOP ADDRESS;
DCL END$OF$DIRECTORY ADDRESS;
DCL READING$REMOTE BYTE;

/*********************************************
    D I R E C T O R Y    G L O B A L S
*********************************************/
DCL DIR$TO$SEARCH BYTE;
DCL DIRECTORY$NAME (*) BYTE DATA(':F :ISIS.DIR ');
DCL DIR$BUF  (16384) BYTE;
DCL DIR$ENTRY$PTR ADDRESS,
    DIR$ENTRY BASED DIR$ENTRY$PTR STRUCTURE
                (PRESENCE BYTE,
                FILENAME (6) BYTE,
                EXTENSION (3) BYTE,
                ATTRIBUTES BYTE,
                EOF$COUNT BYTE,
                NUM$DATA$BLKS ADDRESS,
                HEADER$BLK$PTR ADDRESS);
DCL DIR$NAME (50) BYTE AT (.DIRECTORY$NAME);

$EJECT
/*********************************************
    C O M M O N      P R O C E D U R E S
*********************************************/
PRINT: PROC (PTR);
  DCL (TMP$PTR,PTR) ADDRESS,CHR BASED PTR BYTE;
  TMP$PTR = PTR;
  DO WHILE CHR <> NULL;
     PTR = PTR + 1;
  ENDDO
  CALL WRITEC(TMP$PTR,PTR-TMP$PTR);
END PRINT;

PRINT$CR: PROC (PTR);
  DCL PTR ADDRESS;
  CALL PRINT(PTR);
  CALL PRINT(.(CR,LF,0));
END PRINT$CR;

PRINT$CR$EXIT: PROC (PTR);
  DCL PTR ADDRESS;
  CALL PRINT$CR(PTR);
  CALL EXIT;
END;

CHK$STATUS: PROC (PTR);
  DCL PTR ADDRESS;
  DCL STATUS$OUT ADDRESS;
  IF STATUS <> 0 THENN
     STATUS$OUT = STATUS;
     CALL PRINT(.('bad status (= ',0));
     OBUFP = .MSG$BUF;
     CALL OUT$DEC$R(STATUS$OUT,5);
     CALL OUTPRINT(.(') ',0));
     CALL OUTCHAR(NULL);
     CALL PRINT(.MSG$BUF);
     CALL PRINT$CR$EXIT(PTR);
  ENDIF
END CHK$STATUS;

CHECK$ISIS$STATUS:  PROC(ISIS$STATUS);
   DCL ISIS$STATUS  ADDRESS;
   IF ISIS$STATUS <> 0  THEN
     DO;
       CALL ERROR(ISIS$STATUS);
       CALL MONITOR;
     END;
END CHECK$ISIS$STATUS;

comtrace BEG$PR$DEBUG: PROC ( PTR,VAL,PROC$PTR);
           DCL (PTR,PROC$PTR) ADDRESS, VAL BYTE;
           IF DEBUG$FLAG THENN
              DO WHILE VAL > 0;
                 CALL PRINT(.('.',0));
                 VAL = VAL - 1;
              ENDDO
              CALL PRINT(.('entering ',0));
              CALL PRINT$CR(PTR);
              CALL PROC$PTR;
           ENDIF
         END BEG$PR$DEBUG;

comtrace END$PR$DEBUG: PROC( PTR,VAL,PROC$PTR);
            DCL (PTR,PROC$PTR) ADDRESS, VAL BYTE;
           IF DEBUG$FLAG THENN
              DO WHILE VAL > 0;
                 CALL PRINT(.('.',0));
                 VAL = VAL - 1;
              ENDDO
              CALL PRINT(.('leaving  ',0));
              CALL PRINT$CR(PTR);
              CALL PROC$PTR;
           ENDIF
         END END$PR$DEBUG;                            /* opt */

DEBLANK: PROC (PTR) ADDRESS;
 DCL PTR ADDRESS,CHR BASED PTR BYTE;
 DO WHILE CHR = ' ';
  PTR = PTR + 1;
 ENDDO
 RETURN PTR;
END DEBLANK;

LESSER$OF: PROC (VAL1,VAL2) ADDRESS;
  DCL (VAL1,VAL2) ADDRESS;
  IF VAL1 > VAL2 THENN
     RETURN VAL2;
  ELLSE
     RETURN VAL1;
  ENDIF
END LESSER$OF;

LET$CH$WP:          PROC (CHAR) BYTE;
  DCL CHAR BYTE;
   RETURN
   ( (CHAR >= 'a' AND CHAR <= 'z') OR
     (CHAR >= 'A' AND CHAR <= 'Z')  );
END LET$CH$WP;

DIG$CH$WP:          PROC (CHAR) BYTE;
  DCL CHAR BYTE;
  RETURN ((CHAR >= '0' AND CHAR <= '9'));
END DIG$CH$WP;

LET$OR$DIG$CH$WP:   PROC (CHAR) BYTE;
  DCL CHAR BYTE;
  RETURN (LET$CH$WP(CHAR) OR DIG$CH$WP(CHAR));
END LET$OR$DIG$CH$WP;

DOT$CH$WP:          PROC (CHAR) BYTE;
  DCL CHAR BYTE;
  RETURN (CHAR = '.');
END DOT$CH$WP;

COLON$CH$WP:        PROC (CHAR) BYTE;
   DCL CHAR BYTE;
   RETURN (CHAR = ':');
END COLON$CH$WP;

FILE$CH$WP:          PROC (CHAR) BYTE;
   DCL CHAR BYTE;
   RETURN( LET$OR$DIG$CH$WP(CHAR) OR DOT$CH$WP(CHAR) OR COLON$CH$WP(CHAR));
END FILE$CH$WP;

BLANK$CH$WP:         PROC (CHAR) BYTE;
   DCL CHAR BYTE;
   RETURN (CHAR = ' ');
END BLANK$CH$WP;

LENGTH$OF:       PROC (PROC$PTR) ADDRESS;
  DCL (PROC$PTR,TMP$PTR,LEN) ADDRESS;
  TMP$PTR = SCANP;
  CALL SCANWHILE(PROC$PTR);
  LEN = SCANP - TMP$PTR;
  SCANP = TMP$PTR;
  RETURN LEN;
END LENGTH$OF;

NULL$PROC: PROC;
  SCANP = SCANP;
END NULL$PROC;

ENFORCE$LESS$OR$EQUAL: PROC (VAL,LIM$VAL,PROC$PTR);
   DCL(VAL,LIM$VAL,PROC$PTR) ADDRESS;
   IF VAL > LIM$VAL THEN CALL PROC$PTR;
END ENFORCE$LESS$OR$EQUAL;

ENFORCE$GREATER$OR$EQUAL: PROC (VAL,LIM$VAL,PROC$PTR);
   DCL(VAL,LIM$VAL,PROC$PTR) ADDRESS;
   IF VAL < LIM$VAL THEN CALL PROC$PTR;
END ENFORCE$GREATER$OR$EQUAL;

ENFORCE$WITHIN$BOUNDS: PROC (VAL,HI$LIM,LO$LIM,PROC$PTR);
   DCL(VAL,HI$LIM,LO$LIM,PROC$PTR) ADDRESS;
   CALL ENFORCE$LESS$OR$EQUAL(VAL,HI$LIM,PROC$PTR);
   CALL ENFORCE$GREATER$OR$EQUAL(VAL,LO$LIM,PROC$PTR);
END ENFORCE$WITHIN$BOUNDS;

LET$CH:          PROC BYTE;
  RETURN(LET$CH$WP(SCANBYTE));
END LET$CH;

LP:              PROC BYTE;
  RETURN(SCANBYTE='(');
END LP;

COMMA:           PROC BYTE;
  RETURN(SCANBYTE=',');
END COMMA;

DIG$CH:          PROC BYTE;
  RETURN(DIG$CH$WP(SCANBYTE));
END DIG$CH;

LET$OR$DIG$CH:   PROC BYTE;
  RETURN (LET$OR$DIG$CH$WP(SCANBYTE));
END LET$OR$DIG$CH;

DOT$CH:          PROC BYTE;
  RETURN(DOT$CH$WP(SCANBYTE));
END DOT$CH;

COLON$CH:        PROC BYTE;
  RETURN(COLON$CH$WP(SCANBYTE));
END COLON$CH;

FILE$CH:          PROC BYTE;
   RETURN(LET$OR$DIG$CH$WP(SCANBYTE)
   OR DOT$CH$WP(SCANBYTE)OR COLON$CH$WP(SCANBYTE) );
END FILE$CH;

BLANK$CH:         PROC BYTE;
   RETURN(BLANK$CH$WP(SCANBYTE));
END BLANK$CH;

NULL$CH:          PROC BYTE;
   RETURN (SCANBYTE = NULL);
END NULL$CH;

ENFORCE$NO$TOKENS: PROC;
  DO WHILE NOT TERM$CH ;
     IF NOT  BLANK$CH  THENN
       CALL PRINT$CR$EXIT(.('only blanks allowed after &',0));
     ENDIF
     SCANP = SCANP + 1;
  ENDDO
END ENFORCE$NO$TOKENS;

RESTORE: PROC;
  /* this procedure interprets the restore command in the xlate2.cs file */
  /* restores the previous :ci: file and deletes the xlate2.cs file      */
  DCL NAME$CI (16) BYTE;
  DCL CI$PTR ADDRESS;
  LP: PROC BYTE;
      RETURN (SCANBYTE='(');
  END LP;
  COMMA: PROC BYTE;
      RETURN (SCANBYTE=',');
  END COMMA;
  comtrace DCL PROC$NAME (*) BYTE DATA('restore',0);               /* opt */
  comtrace CALL BEG$PR$DEBUG(.PROC$NAME,1,.NULL$PROC);             /* opt */
  CALL FMOVE(15,.BLANK$STR,.NAME$CI);                     /* current :ci: */
  CALL WHOCI(.NAME$CI);    /* current :ci: name saved, file to be deleted */
  CALL CONS(CI$PTR:=DEBLANK(SCANP),.(':CO: '));    /* new :ci:, same :co: */
  SCANP = CI$PTR + 1;
  IF SCANBYTE = 'F' THENN                /* old :ci: = :f?:... --> delete */
     DCL MSG(*) BYTE DATA('xlate2 error: restore seek',0);
     CALL DEL(.NAME$CI);                 /* and console over to old pos   */
     CALL CHK$STATUS(.('cannot delete .cs file',0));
     CALL SCANUNTIL(.LP);
     BLOKNO = DEC$IN;
     CALL SCANUNTIL(.COMMA);
     BYTENO = DEC$IN;
     CALL SEEK(1,2,.BLOKNO,.BYTENO,.STATUS);
     CALL CHK$STATUS(.MSG);
  ENDIF
  CALL EXIT;                           /* f i n i s h e d  ! ! ! */
  comtrace CALL END$PR$DEBUG(.PROC$NAME,1,.NULL$PROC); /* opt */
END RESTORE;

$EJECT

/***************************************************
           I N I T I A L I Z A T I O N
***************************************************/

FIRST$INIT: PROC;
   DCL TMP$PTR ADDRESS;
   comtrace DCL PROC$NAME (*) BYTE DATA('first$init',0); /* opt */
   comtrace CALL BEG$PR$DEBUG(.PROC$NAME,1,.NULL$PROC); /* opt */
   REPORT = FALSE;              /* set sys.lib status checking to false */
   CALL FMOVE(16,.BLANK$STR,.INVOK$NAME);
   NAME$INDEX = 0;
   FILL$INDEX = 0;
   READBUF(128) = CR;
   comtrace CALL END$PR$DEBUG(.PROC$NAME,1,.NULL$PROC); /* opt */
END FIRST$INIT;

$EJECT

/****************************************************
       T E M P L A T E   P R O C E S S I N G
               P R O C E D U R E S
****************************************************/
/****************************************************
   these procedures
   1) read in the template file
   2) expand the template file at the substitution
      characters
   3) fills an array of pointers into
      the expanded template.
   4) fill an array describing the type of sub.
      parameter, preceding drive # , etc.
*****************************************************/

BUILD$TEMPLATE: PROC ;
   DCL (BEG$SUB$PTR,END$SUB$PTR) ADDRESS;

   SUBSTITUTION$FOUND: PROC (F$INDEX,B$PTR$PTR,E$PTR$PTR,LIMIT) BYTE;
     DCL (F$INDEX, B$PTR$PTR, E$PTR$PTR, LIMIT, TMP$PTR) ADDRESS;

     SET$FILL$DRIVE: PROC (F$INDEX,B$PTR$PTR);
       DCL (F$INDEX,B$PTR$PTR) ADDRESS, B$PTR BASED B$PTR$PTR ADDRESS;
       DCL TMP$PTR ADDRESS;
       comtrace DCL PROC$NAME (*) BYTE DATA('set$fill$drive',0);
                   PR$DEBUG: PROC;
                   CALL PRINT(.('fill index : ',0));
                   OBUFP = .MSG$BUF;
                   CALL OUT$DEC$R(F$INDEX,5);
                   CALL OUT$CHAR(NULL);
                   CALL PRINT$CR(.MSG$BUF);
                END PR$DEBUG;
                CALL BEG$PR$DEBUG(.PROC$NAME,3,.PR$DEBUG);       /* opt */

       TMP$PTR = SCANP;
       SCANP = SCANP - 2;
       IF          COLON$CH          THENN
          SCANP = SCANP - 3;
          B$PTR = SCANP;
          CALL FMOVE(4,SCANP,.FILL$ARRAY(F$INDEX).DRIVE);
          SCANP = SCANP + 2;
          IF   SCANBYTE = '?'   THENN
             CALL FMOVE(1,.DIR$TO$SEARCH,.FILL$ARRAY(F$INDEX).DRIVE(2));
          ENDIF
       ELLSE
          CALL FMOVE(4,.NULL$STRING,.FILL$ARRAY(F$INDEX).DRIVE);
          B$PTR = SCANP + 1;
       ENDIF
       SCANP = TMP$PTR;
       comtrace CALL END$PR$DEBUG(.PROC$NAME,3,.NULL$PROC); /* opt */
     END SET$FILL$DRIVE;

     SET$FILL$EXT: PROC (F$INDEX,E$PTR$PTR);
        DCL (F$INDEX,E$PTR$PTR) ADDRESS,
             E$PTR BASED E$PTR$PTR ADDRESS;
        comtrace DCL PROC$NAME (*) BYTE DATA('set$fill$ext',0); /* opt */
        comtrace CALL BEG$PR$DEBUG(.PROC$NAME,3,.NULL$PROC);    /* opt */
        SCANP = SCANP - 1;
        IF           SCANBYTE = '#'               THENN
           E$PTR,SCANP = SCANP + 2;
           FILL$ARRAY(F$INDEX).TYPE = NUMB$0$TYPE;
        ELSIF        SCANBYTE = '%'               THENN
           SCANP = SCANP + 2;
           IF         BLANK$CH            THENN
              E$PTR = SCANP;
              FILL$ARRAY(F$INDEX).TYPE = PCNT$0$TYPE;
           ELSIF       DOT$CH             THENN
              SCANP = SCANP + 1;
              IF NOT (LET$OR$DIG$CH) THENN
                 E$PTR = SCANP;
                 FILL$ARRAY(F$INDEX).TYPE = PCNT$0$DOT$TYPE;
              ELLSE
                    DCL LEN$EXT ADDRESS;
                    FILL$ARRAY(F$INDEX).TYPE = PCNT$0$DOT$EXT$TYPE;
                    LEN$EXT = LENGTH$OF(.LET$OR$DIG$CH);
                    IF LEN$EXT > 3 THENN
                       CALL PRINT$CR$EXIT(.('ext part too long',0));
                    ELLSE
                       CALL FMOVE(3,.BLANK$STR ,.FILL$ARRAY(F$INDEX).EXT);
                       CALL FMOVE(LEN$EXT,SCANP,.FILL$ARRAY(F$INDEX).EXT);
                       E$PTR,SCANP = SCANP + LEN$EXT;
                    ENDIF
              ENDIF
           ELLSE
              FILL$ARRAY(F$INDEX).TYPE = UNKNOWN$TYPE;
              E$PTR = SCANP;
           ENDIF
        ELLSE
           CALL PRINT$CR$EXIT(.('xlate2 error: set$fill$index',0));
        ENDIF
        E$PTR = LESSER$OF(E$PTR,.TEMPLATE+FRONT$EXT+ACTUAL);
        comtrace CALL END$PR$DEBUG(.PROC$NAME,3,.NULL$PROC);       /* opt */
     END SET$FILL$EXT;

     comtrace DCL PROC$NAME (*) BYTE DATA('substitution$found',0); /* opt */
     comtrace CALL BEG$PR$DEBUG(.PROC$NAME,2,.NULL$PROC);          /* opt */
     DO WHILE TRUE;
        DO WHILE SCANBYTE <> '%' AND SCANBYTE <> '#' ;
           SCANP = SCANP + 1;
        ENDDO
        SCANP = SCANP + 1;
        IF           SCANBYTE = '0' AND SCANP <= LIMIT          THENN
           DCL TMP$PTR ADDRESS;
           TMP$PTR = SCANP;
           CALL SET$FILL$DRIVE(F$INDEX,B$PTR$PTR);
           CALL SET$FILL$EXT(F$INDEX,E$PTR$PTR);
           SCANP = TMP$PTR;
           comtrace CALL END$PR$DEBUG(.PROC$NAME,2,.NULL$PROC);    /* opt */
           RETURN TRUE;
        ELSIF                 SCANP > LIMIT                     THENN
           comtrace CALL END$PR$DEBUG(.PROC$NAME,2,.NULL$PROC);    /* opt */
           RETURN FALSE;
        ENDIF
     ENDDO
   END SUBSTITUTION$FOUND;

   comtrace DCL PROC$NAME (*) BYTE DATA('build$template',0);       /* opt */
   comtrace CALL BEG$PR$DEBUG(.PROC$NAME,1,.NULL$PROC);            /* opt */
   CALL READI(.TEMPLATE+FRONT$EXT, READ$LEN);
   CALL CHK$STATUS(.('cannot read template file',0));
   TEMPLATE(FRONT$EXT + ACTUAL) = NULL;
   IF ACTUAL = 1024 THENN                  /* syntax chk opt */
      CALL PRINT$CR$EXIT(.('template file too large',0));
   ENDIF
   FROM$PTR,SCANP = .TEMPLATE+FRONT$EXT;
   FILL$PTR = .TEMPLATE;
   DO WHILE SUBSTITUTION$FOUND(FILL$INDEX,.BEG$SUB$PTR,.END$SUB$PTR,
                               .TEMPLATE(FRONT$EXT+ACTUAL-1));
      CALL FMOVE(BEG$SUB$PTR-FROM$PTR,FROM$PTR,FILL$PTR);
      FILL$PTR = FILL$PTR + BEG$SUB$PTR-FROM$PTR;
      FILL$ARRAY(FILL$INDEX).FILL$PTR = FILL$PTR;
      FILL$PTR = FILL$PTR + 16;
      FROM$PTR,SCANP = END$SUB$PTR;
      IF (FILL$INDEX := FILL$INDEX + 1) > MAX$FILLS THENN
         CALL PRINT$CR$EXIT(.('maximum substitutions exceeded',0));
      ENDIF
   ENDDO
   IF FILL$INDEX = 0 THENN
      CALL PRINT$CR$EXIT(
         .('no substitution signs in the template',0));
   ELLSE
      FILL$INDEX = FILL$INDEX - 1;
   ENDIF
   IF FROM$PTR  >  .TEMPLATE+ACTUAL+FRONT$EXT THENN
      CALL PRINT$CR$EXIT(.('xlate2 error: build$template',0));
   ENDIF
   CALL FMOVE(.TEMPLATE+FRONT$EXT+ACTUAL-FROM$PTR, FROM$PTR, FILL$PTR);
   /* this is a kludge, we want to add the -1 in the fmove but
      dont because we might end up with a 64k move, so we only
      adjust the fill$ptr accordingly.
   */
   FILL$PTR = FILL$PTR + .TEMPLATE+FRONT$EXT+ACTUAL - FROM$PTR;
   LENGTH$TO$WRITE$FROM$TEMPLATE = FILL$PTR - .TEMPLATE;
   CALL FMOVE(1,.(0),(FILL$PTR+1));
   comtrace CALL END$PR$DEBUG(.PROC$NAME,1,.NULL$PROC);     /* opt */
END BUILD$TEMPLATE;

$ EJECT

/**************************************************
  D I R E C T O R Y   M A N I P U L A T I N G
                P R O C E D U R E S
***************************************************/

READ$DIRECTORY:  PROC (NAKED$DEVICE$NUMBER) ;
   DCL NAKED$DEVICE$NUMBER BYTE;
   DCL BUFFER(12) BYTE;
   DCL COUNT ADDRESS;
   DCL FREE$SPACE ADDRESS;
   DCL ACTUAL$ENTRY ADDRESS;
   DCL ENTRY ADDRESS;

   comtrace DCL PROC$NAME (*) BYTE DATA('read$directory',0);
   CALL BEG$PR$DEBUG(.PROC$NAME,1,.NULL$PROC);          /* opt */

   DIR$NAME(2) = NAKED$DEVICE$NUMBER;

   CALL SPATH(.DIRECTORY$NAME,.BUFFER,.STATUS); CHK;
   IF BUFFER(10) = 3  AND  BUFFER(11) = 5  THEN
       DO;
         MEM$TOP = MEM$CK - 13;
         IF MEM$TOP < 0E800H  THEN
           CALL CHK$STATUS(.('insufficient memory',0));
         ELSE
           DO;
              FREE$SPACE = 0E800H - .MEMORY;
              COUNT = FREE$SPACE/16;
              CALL LOAD(.(':F0:ISIS.OV0 '),0,0,.ENTRY,.STATUS); CHK;
              CALL GETD(NAKED$DEVICE$NUMBER-'0',.CONNECTION,COUNT,
                        .ACTUAL$ENTRY,.DIR$BUF,.STATUS); CHK;
              IF ACTUAL$ENTRY >= COUNT  THEN
                 CALL CHK$STATUS(.('remote directory too large',0));
              READING$REMOTE = TRUE;
              END$OF$DIRECTORY = .DIR$BUF + (ACTUAL$ENTRY * 16);
           END;
       END;
   ELSE
       DO;
          CALL OPEN1(.DIRECTORY$NAME,1);
          CALL CHK$STATUS(.('cannot open directory file',0));
          CALL READ1(.DIR$BUF,SIZE(DIR$BUF));
          CALL CHK$STATUS(.('cannot read directory file',0));
          /*	Dir$buf is larger than an ISIS V4.0 hard disk directory  */
          CALL CLOSE1;
          CALL CHK$STATUS(.('cannot close directory file',0));

          READING$REMOTE = FALSE;
          END$OF$DIRECTORY = .DIR$BUF + ACTUAL;
          comtrace CALL END$PR$DEBUG(.PROC$NAME,1,.NULL$PROC);        /* opt */
       END;
END READ$DIRECTORY;

GREATEST$EXT: PROC (NAME$PART$PTR) ADDRESS;
   DCL NAME$PART$PTR ADDRESS;
   DCL LARGEST$EXTENSION ADDRESS;
   DCL NUM$EXTENSION$FOUND BYTE;
   NUMERIC$EXTENSION: PROC (PTR) BYTE;
        /*	Given a pointer into memory, this procedure determines
                whether the byte pointed to, and the next two contiguous
                bytes, constitute a wholly numeric ascii sequence.
        */
        DCL PTR ADDRESS,
            CHAR BASED PTR (10) BYTE;
        DCL L BYTE;
        DO L=0 TO 2;
                IF NOT DIG$CH$WP(CHAR(L)) THENN
                        RETURN FALSE;
                ENDIF
        ENDDO
        RETURN TRUE;
   END NUMERIC$EXTENSION;

   VALUE: PROC (DIR$EXT$PTR) ADDRESS;
        DCL DIR$EXT$PTR ADDRESS;
        DCL CHAR BASED DIR$EXT$PTR (3) BYTE;
        DCL T BYTE;
        DCL RESULT ADDRESS;
        RESULT = 0;
        DO T = 0 TO 2;
                RESULT = (RESULT * 10) + CHAR(T) - '0';
        ENDDO
        RETURN RESULT;
   END VALUE;

   NAME$PARTS$MATCH: PROC (NAME$PTR$1,NAME$PTR$2) BYTE;
           DCL (NAME$PTR$1,NAME$PTR$2) ADDRESS,
               TMP ADDRESS, COMP$BUF (7) BYTE, MATCH BYTE,
               (LEN$1,LEN$2) ADDRESS;
      TMP = SCANP;
      SCANP = NAME$PTR$1;
      LEN$1 = LESSER$OF(6,LENGTH$OF(.LET$OR$DIG$CH));
      SCANP = NAME$PTR$2;
      LEN$2 = LESSER$OF(6,LENGTH$OF(.LET$OR$DIG$CH));
      SCANP = TMP;
      IF                LEN$1    <>    LEN$2                THENN
         RETURN FALSE;
      ELLSE
         CALL FMOVE(LEN$1,NAME$PTR$1,.COMP$BUF);
         CALL FMOVE(1,.(0),.COMP$BUF(LEN$1));
         TMP = SCANP;
         SCANP = NAME$PTR$2;
         MATCH = SCAN$MATCH(.COMP$BUF);
         SCANP = TMP;
         RETURN MATCH;
      ENDIF
   END NAME$PARTS$MATCH;

   comtrace DCL PROC$NAME (*) BYTE DATA('greatest$ext',0);      /* opt */
   comtrace CALL BEG$PR$DEBUG(.PROC$NAME,1,.NULL$PROC);         /* opt */
   DIR$ENTRY$PTR = .DIR$BUF;
   NUM$EXTENSION$FOUND = FALSE;
   LARGEST$EXTENSION = 0;
   /*	Grand directory search loop. */
   DO WHILE  DIR$ENTRY$PTR < END$OF$DIRECTORY;
      IF NOT READING$REMOTE  THEN
        DO;
          IF DIR$ENTRY.PRESENCE = 7FH  THEN
             GO TO NO$MORE$DIR;
          IF DIR$ENTRY.PRESENCE = 0FFH  THEN
             GO TO BUMP$PTR;
        END;
      IF NAME$PARTS$MATCH(.DIR$ENTRY.FILENAME,NAME$PART$PTR) AND
               (DIR$ENTRY.PRESENCE <> 0FFH)                           THENN
         IF NUMERIC$EXTENSION(.DIR$ENTRY.EXTENSION) THENN
            DCL EXTENSION$NUM ADDRESS;
            NUM$EXTENSION$FOUND = TRUE;
            EXTENSION$NUM = VALUE(.DIR$ENTRY.EXTENSION);
            IF EXTENSION$NUM > LARGEST$EXTENSION THENN
               LARGEST$EXTENSION = EXTENSION$NUM;
            ENDIF
         ENDIF
      ENDIF
      bump$ptr:
      DIR$ENTRY$PTR = DIR$ENTRY$PTR + 16;
   ENDDO
   no$more$dir:
   IF      NUM$EXTENSION$FOUND       THENN
      comtrace CALL END$PR$DEBUG(.PROC$NAME,1,.NULL$PROC);          /* opt */
      RETURN LARGEST$EXTENSION;
   ELLSE
      comtrace CALL END$PR$DEBUG(.PROC$NAME,1,.NULL$PROC);          /* opt */
      RETURN NO$NUM$EXTENSION;
   ENDIF
END GREATEST$EXT;

$EJECT

/********************************************************
         O U T P U T     P R O C E D U R E S
********************************************************/

FILL$NAME: PROC (N$INDEX, F$INDEX);
  DCL (N$INDEX,F$INDEX) ADDRESS, (N$TYPE,F$TYPE) BYTE;
  DCL TMP$BUF (16) BYTE, LENGTH$NAME$PART BYTE;
  DCL MSG (*) BYTE DATA('xlate2 error: fill$name',0);
  N$TYPE = NAME$LIST(N$INDEX).TYPE;
  F$TYPE = FILL$ARRAY(F$INDEX).TYPE;
  SCANP = .NAME$LIST(N$INDEX).NAME;
  OBUFP = .TMP$BUF;
  LENGTH$NAME$PART = LESSER$OF(6,LENGTH$OF(.LET$OR$DIG$CH));
  CALL FMOVE(16,.BLANK$STR,OBUFP);
  IF FILL$ARRAY(F$INDEX).DRIVE(2) = '?' THENN
     FILL$ARRAY(F$INDEX).DRIVE(2) = DIR$TO$SEARCH;
  ENDIF
  IF FILL$ARRAY(F$INDEX).DRIVE(0) <> NULL THENN
     CALL FMOVE(4,.FILL$ARRAY(F$INDEX).DRIVE,OBUFP);
  ENDIF;
  OBUFP = OBUFP + 4;
  CALL FMOVE(LENGTH$NAME$PART,.NAME$LIST(N$INDEX).NAME,OBUFP);
  OBUFP = OBUFP + LENGTH$NAME$PART;
  IF                 F$TYPE <= 3                   THENN
     DO CASE F$TYPE;
        /* PCNT$0$TYPE */
        DO;
          IF N$TYPE = NAME$DOT$EXT$TYPE THENN
             DCL LENGTH$EXT BYTE;
             CALL OUTCHAR('.');
             SCANP = .NAME$LIST(N$INDEX).EXT;
             LENGTH$EXT = LESSER$OF(3,LENGTH$OF(.LET$OR$DIG$CH));
             CALL FMOVE(LENGTH$EXT,.NAME$LIST(N$INDEX).EXT,OBUFP);
          ENDIF
        ENDDO
        /* PCNT$0$DOT$TYPE */
        DO;
        ENDDO
        /* PCNT$0$DOT$EXT$TYPE */
        DO;
          DCL LENGTH$EXT BYTE;
          SCANP = .FILL$ARRAY(F$INDEX).EXT;
          LENGTH$EXT = LESSER$OF(3,LENGTH$OF(.LET$OR$DIG$CH));
          CALL OUTCHAR('.');
          CALL FMOVE(LENGTH$EXT,.FILL$ARRAY(F$INDEX).EXT,OBUFP);
        ENDDO
        /* NUMB$0$TYPE */
        DO;
          IF N$TYPE <> NAME$DOT$TYPE THENN
             DCL NUMB$EXT ADDRESS;
             DCL NAMEPART (7) BYTE;
             CALL OUT$CHAR('.');
             NUMB$EXT = GREATEST$EXT(.NAME$LIST(N$INDEX).NAME);
             /*   For the first version a wholly numeric 3 digit
                extension is required */
             IF NUMB$EXT >= 1000 THENN
                CALL PRINT(.('filename : ',0));
                SCANP = .NAME$LIST(N$INDEX).NAME;
                CALL FMOVE(7,.NULL$STRING,.MSG$BUF);
                CALL FMOVE(LESSEROF(6,LENGTHOF(.LET$OR$DIG$CH)),SCANP,.MSGBUF);
                OBUFP = .MSG$BUF(6);
                CALL OUTCHAR(NULL);
                CALL PRINT(.MSGBUF);
                CALL PRINT$CR(.(' has no numeric extension',0));
             ENDIF
             LEADCHAR = '0';
             CALL OUT$DEC$R(NUMB$EXT,3);
             LEADCHAR = ' ';
          ENDIF
        ENDDO
     ENDDO
  ELSIF          F$TYPE <> UNKNOWN$TYPE             THENN
     CALL PRINT$CR(.MSG);
     CALL PRINT(.('xlate2 error: fill$name, type = ',0));
     OBUFP = .MSG$BUF;
     CALL OUTDECR(F$TYPE,3);
     CALL OUTCHAR(NULL);
     CALL PRINT(.MSG$BUF);
     CALL PRINT(.(' on the ',0));
     OBUFP = .MSG$BUF;
     CALL OUTDECR(F$INDEX+1,3);
     CALL PRINT(.MSG$BUF);
     CALL PRINT$CR$EXIT(.(' template substitution',0));
  ENDIF
  CALL FMOVE(16,.TMP$BUF,FILL$ARRAY(F$INDEX).FILL$PTR);
END FILL$NAME;

OUTPUT$LIST: PROC;
  DCL TMP$FILL$INDEX  ADDRESS,
      TMP$NAME$INDEX  ADDRESS;
  DCL FILE$NAME (16) BYTE DATA(':F0:XLATE2.CS  ',0);
  DCL FILE$TO$EXECUTE (16) BYTE;
  
  OPEN$CONSOLE$FILE: PROC;
    DCL TMP$PTR ADDRESS;
    TMP$PTR = SCANP;
    CALL FMOVE(16,.FILENAME,.MSG$BUF);
    SCANP = DEBLANK(.INVOK$NAME);
    IF COLON$CH THENN
       SCANP = SCANP + 2;
       IF DIG$CH THENN
          CALL FMOVE(1,SCANP,.MSG$BUF(2));
       ENDIF
    ENDIF
    CALL FMOVE(16,.MSG$BUF,.FILE$TO$EXECUTE);
    SCANP = TMP$PTR;
    CALL OPENO(.MSG$BUF);
    CALL CHK$STATUS(.('cannot open .cs file',0));
  END OPEN$CONSOLE$FILE;
  
  MAKE$RESTORE$COMMAND: PROC;
    OBUFP = .MSG$BUF;
    CALL SEEK(1,0,.BLOKNO,.BYTENO,.STATUS);
    IF STATUS <> 0 THENN
       BLOKNO,BYTENO = 0;
    ENDIF
    CALL FMOVE(15,.INVOK$NAME,OBUFP);
    OBUFP = OBUFP + 15;
    CALL OUTPRINT(.(' RESTORE ',0));
    CALL FMOVE(15,.BLANK$STR,OBUFP);
    CALL WHOCI(OBUFP);
    OBUFP = OBUFP + 15;
    CALL OUTCHAR('(');
    CALL OUT$DEC$R(BLOKNO,5);
    CALL OUTCHAR(',');
    CALL OUT$DEC$R(BYTENO,5);
    CALL OUTPRINT(.(')',CR,LF,0));
    CALL WRITEO(.MSG$BUF,OBUFP-.MSG$BUF);
  END MAKE$RESTORE$COMMAND;
  
  comtrace DCL PROC$NAME (*) BYTE DATA('output$list',0);          /* opt */
  comtrace CALL BEG$PR$DEBUG(.PROC$NAME,1,.NULL$PROC);            /* opt */
  CALL READ$DIRECTORY(DIR$TO$SEARCH);
  CALL OPEN$CONSOLE$FILE;
  TMP$NAME$INDEX = 0;
  DO WHILE TMP$NAME$INDEX <= NAME$INDEX;
     TMP$FILL$INDEX = 0;
     DO WHILE TMP$FILL$INDEX <= FILL$INDEX;
        CALL FILL$NAME(TMP$NAME$INDEX,TMP$FILL$INDEX);
        TMP$FILL$INDEX = TMP$FILL$INDEX + 1;
     ENDDO
     TMP$NAME$INDEX = TMP$NAME$INDEX + 1;
     CALL WRITEO(.TEMPLATE,LENGTH$TO$WRITE$FROM$TEMPLATE);
  ENDDO
  CALL WRITEO(.(CR,LF),2);
  CALL MAKE$RESTORE$COMMAND;
  CALL CLOSEO;
  IF NOT HALT$FLAG THENN
     CALL CONS(.FILE$TO$EXECUTE,.(':CO: '));
  ENDIF
  comtrace CALL END$PR$DEBUG(.PROC$NAME,1,.NULL$PROC);         /* opt */
END OUTPUT$LIST;

/*********************************************************
         D E B U G G I N G   P R O C E D U R E S
**********************************************************/

/*
PRINTLIST: PROC;
  DCL TMP$INDEX ADDRESS;
  TMP$INDEX = 0;
  DO WHILE TMP$INDEX <= NAMEINDEX;
     DO;
       DCL SPACE(7) BYTE;
       SPACE(6) = NULL;
       CALL FMOVE(6,.NAMELIST(TMP$INDEX).NAME,.SPACE);
       CALL PRINT$CR(.SPACE);
       IF NAMELIST(TMPINDEX).TYPE < 3 THENN
          DO CASE NAMELIST(TMPINDEX).TYPE;
             DO;
                CALL PRINT$CR(.('name$dot$type',0));
             ENDDO
             DO;
                CALL PRINT$CR(.('name$dot$ext$type',0));
             ENDDO
             DO;
                CALL PRINT$CR(.('name$only$type',0));
             ENDDO
          ENDDO
       ELSIF NAMELIST(TMPINDEX).TYPE = UNKNOWN$TYPE THENN
          CALL PRINT$CR(.('unknown$type',0));
       ELLSE
          CALL PRINT$CR(.('bad name type',0));
       ENDIF
       TMP$INDEX = TMP$INDEX + 1;
     ENDDO
  ENDDO 
  OBUFP = .MSG$BUF;
  CALL OUT$DEC$R(NAME$INDEX+1,5);
  CALL OUT$PRINT(.(' filenames read from list',0));
  CALL OUT$CHAR(NULL);
  CALL PRINT$CR(.MSG$BUF);
END PRINTLIST; 
*/

/*
BULL: PROC; 
  DCL TMP$INDEX BYTE;
  TMP$INDEX = 0; 
  OBUFP = .MSG$BUF;
  CALL OUT$DEC$R(FILL$INDEX+1,3);
  CALL OUT$PRINT(.(' substitutions',0));
  CALL OUT$CHAR(NULL);
  CALL PRINT$CR(.MSG$BUF);
  DO WHILE TMP$INDEX <= FILL$INDEX;
     IF FILL$ARRAY(TMP$INDEX).TYPE < 4 THENN
        DO CASE FILL$ARRAY(TMP$INDEX).TYPE;
          CALL PRINT$CR(.('   %0 type',0));
          CALL PRINT$CR(.('   %0. type',0));
          CALL PRINT$CR(.('   %0.ext type',0));
          CALL PRINT$CR(.('   #0 type',0));
        ENDDO
     ELSIF FILL$ARRAY(TMP$INDEX).TYPE = UNKNOWN$TYPE  THENN
        CALL PRINT$CR(.('   unknown type',0));
     ELLSE
       CALL PRINT$CR(.('bogus type',0));
     ENDIF
     TMP$INDEX = TMP$INDEX + 1;
  ENDDO
  CALL PRINT$CR(.(' expanded template:',0));
  CALL PRINT$CR(.TEMPLATE);
END BULL;
*/

$EJECT

/******************************************************
     C O M M A N D    L I N E  P R O C E S S I N G
                 P R O C E D U R E S
******************************************************/

PROCESS$COMMAND$LINE: PROC;
   GET$TEMPLATE$FILENAME: PROC;
     DCL STAT$MSG (*) BYTE DATA('process$command$line',0);
     comtrace DCL PROC$NAME (*) BYTE DATA('get$template$filename',0);/* opt */
     comtrace CALL BEG$PR$DEBUG(.PROC$NAME,2,.NULL$PROC);            /* opt */
     CALL RESCAN(1,.STATUS);  
     CALL CHK$STATUS(.STAT$MSG);
     CALL READC(.READBUF,128);  
     CALL CHK$STATUS(.STAT$MSG);
     SCANP = DEBLANK(.READBUF);
     DEBUG$FLAG = SCANMATCH(.('DEBUG',0));
     SCANP = DEBLANK(SCANP);
     SCANP$TMP = SCANP;
     CALL SCANWHILE(.FILE$CH);
     CALL FMOVE(SCANP-SCANP$TMP,SCANP$TMP,.INVOK$NAME);
     SCANP = DEBLANK(SCANP);
     HALT$FLAG = SCANMATCH(.('HALT!',0));
     SCANP = DEBLANK(SCANP);
     IF         SCANMATCH(.('?',0))         THENN 
        DCL VERNO (*) BYTE DATA('xlate2 X004',0);
        CALL PRINT$CR$EXIT(.VERNO);
     ELSIF      SCANMATCH(.('RESTORE',0))   THENN
        CALL RESTORE;
     ENDIF
     CALL OPENI(DEBLANK(SCANP));
     CALL CHK$STATUS(.('cannot open template file',0));
     CALL SCANWHILE(.FILE$CH);
     SCANP = DEBLANK(SCANP);
     IF DIG$CH THENN
        DIR$TO$SEARCH = SCANBYTE;
        SCANP = DEBLANK(SCANP+1);
     ELLSE
        CALL PRINT$CR$EXIT(.('missing drive #',0));
     ENDIF
     comtrace CALL END$PR$DEBUG(.PROC$NAME,2,.NULL$PROC);            /* opt */
   END GET$TEMPLATE$FILENAME;
   
   MAKE$LIST: PROC;
      DCL FLAG BYTE;
      
         ADD$FILENAME: PROC BYTE;
         
         ADD$DRIVE: PROC (N$INDEX);
            DCL N$INDEX ADDRESS;
            IF COLON$CH THENN
               CALL FMOVE(4,SCANP,.NAME$LIST(N$INDEX).DRIVE);
               SCANP = SCANP + 4;
            ELLSE
               CALL FMOVE(4,.DR$STR,.NAME$LIST(N$INDEX).DRIVE);
               CALL FMOVE(1,.DIR$TO$SEARCH,.NAME$LIST(N$INDEX).DRIVE(2));
            ENDIF
         END ADD$DRIVE;

         ADD$NAME: PROC (N$INDEX);
            DCL (N$INDEX,LEN$NAME$PART)  ADDRESS;
            IF (LEN$NAME$PART :=LENGTH$OF(.LET$OR$DIG$CH)) > 6  THENN
               CALL PRINT$CR(.('name too long: ',0));
               SCANP = SCANP + 7; 
               SCANBYTE = NULL;
               CALL PRINT$CR$EXIT(SCANP-7);
            ELLSE
               CALL FMOVE(6,.NULL$STRING,.NAMELIST(N$INDEX).NAME);
               CALL FMOVE(LEN$NAME$PART,SCANP,.NAME$LIST(N$INDEX).NAME);
               /* set type field in the event that it will be used */
               SCANP = SCANP + LEN$NAME$PART;
               IF        BLANK$CH OR TERM$CH             THENN
                  NAMELIST(N$INDEX).TYPE = NAME$ONLY$TYPE;
               ELSIF      DOT$CH                 THENN
                  SCAN$P = SCANP + 1;
                  IF    LET$OR$DIG$CH     THENN
                     NAMELIST(N$INDEX).TYPE = NAME$DOT$EXT$TYPE;
                  ELLSE
                     NAMELIST(N$INDEX).TYPE = NAME$DOT$TYPE;
                  ENDIF
               ELLSE
                  CALL PRINT$CR$EXIT(.('a blank or dot must follow name part',0));
               ENDIF
            ENDIF
         END ADD$NAME; 

         ADD$EXT: PROC (N$INDEX);
            DCL (N$INDEX,LEN$EXT) ADDRESS;
            IF                    LET$OR$DIG$CH                    THENN
               IF (LEN$EXT := LENGTH$OF(.LET$OR$DIG$CH)) > 3 THENN
                  CALL PRINT$CR$EXIT(.('ext > 3 chars',0));
               ELLSE
                  CALL FMOVE(3,.NULL$STRING,.NAME$LIST(N$INDEX).EXT);
                  CALL FMOVE(LEN$EXT,SCANP,.NAME$LIST(N$INDEX).EXT);
                  SCANP = SCANP + LEN$EXT;
               ENDIF
            ENDIF
         END ADD$EXT;

$EJECT
         comtrace DCL PROC$NAME (*) BYTE DATA('add$filename',0);    /* opt */
         comtrace CALL BEG$PR$DEBUG(.PROC$NAME,3,.NULL$PROC);       /* opt */ 
         SCANP = DEBLANK(SCANP);
         IF TERM$CH                              THENN
            comtrace CALL END$PR$DEBUG(.PROC$NAME,3,.NULL$PROC);    /* opt */
            RETURN DONE;
         ELSIF SCANMATCH(.('&',0))     THENN
            CALL ENFORCE$NO$TOKENS;
            CALL PRINT(.('**',0));
            CALL READC(.READBUF,128);
            SCANP = DEBLANK(.READBUF);
            comtrace CALL END$PR$DEBUG(.PROC$NAME,3,.NULL$PROC);    /* opt */
            RETURN NEW$LINE;
         ELSIF FILE$CH                 THENN 
            CALL ADD$DRIVE(NAME$INDEX);
            CALL ADD$NAME(NAME$INDEX);
            CALL ADD$EXT(NAME$INDEX);
            NAME$INDEX = NAME$INDEX + 1;
            comtrace CALL END$PR$DEBUG(.PROC$NAME,3,.NULL$PROC);    /* opt */
            RETURN NAME$ADDED;
         ELLSE                                          /* syntax chk opt */
            DCL TEMP$PTR ADDRESS;
            TEMP$PTR = SCANP;
            DO WHILE NOT(BLANK$CH) AND NOT(TERM$CH);
               SCANP = SCANP + 1;
            ENDDO
            SCAN$BYTE = NULL;
            CALL PRINT(TEMP$PTR);
            CALL PRINT$CR$EXIT(.(' not a filename',0));
         ENDIF 
         comtrace CALL END$PR$DEBUG(.PROC$NAME,3,.NULL$PROC);       /* opt */
      END ADDFILENAME;
        
      comtrace DCL PROC$NAME (*) BYTE DATA('make$list',0);          /* opt */ 
      comtrace CALL BEG$PR$DEBUG(.PROC$NAME,2,.NULL$PROC);          /* opt */
      FLAG = NOT DONE;
      DO WHILE FLAG <> DONE;
         FLAG = ADD$FILENAME;
      ENDDO 
      IF NAME$INDEX = 0 THENN
         CALL PRINT$CR$EXIT(.('0 filenames on command line',0));
      ELLSE
         NAME$INDEX = NAME$INDEX - 1;
      ENDIF
      comtrace CALL END$PR$DEBUG(.PROC$NAME,2,.NULL$PROC);          /* opt */
   END MAKE$LIST; 

   comtrace DCL PROC$NAME (*) BYTE DATA('process$command$line',0);  /* opt */
   comtrace CALL BEG$PR$DEBUG(.PROC$NAME,1,.NULL$PROC);             /* opt */
   CALL GET$TEMPLATE$FILENAME;
   CALL MAKE$LIST;
   comtrace CALL END$PR$DEBUG(.PROC$NAME,1,.NULL$PROC);             /* opt */
END PROCESS$COMMAND$LINE;

$EJECT

/*********************************************************
     F I R S T      E X E C U T A B L E      C O D E
*********************************************************/

CALL FIRST$INIT;
CALL PROCESS$COMMAND$LINE;
CALL BUILD$TEMPLATE;
CALL OUTPUT$LIST;
/* CALL PRINTLIST; CALL BULL; */       /* debug opt */
CALL EXIT;

END XLATE2$MOD;
       
