MERG86: 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.6',0);


DECLARE CR                  LITERALLY '0DH';
DECLARE LF                  LITERALLY '0AH';
DECLARE FF                  LITERALLY '0CH';

DECLARE SIGN$ON$MSG (*) BYTE            /* 01/21/81 */
 DATA (CR, LF, 'ISIS-II MERG86, V1.6 - LINK86 & LOC86/PLM86 MERGE PROGRAM',0);

$NOLIST
/* PEX */
DECLARE SCANP ADDRESS EXTERNAL;
DECLARE SCANADDR BASED SCANP ADDRESS;
DECLARE OBUFP ADDRESS EXTERNAL;
DECLARE TARLEN BYTE EXTERNAL;
DECLARE GIVEUP ADDRESS EXTERNAL;
BLNKCH :PROCEDURE BYTE EXTERNAL;END;
BUMPSCANP :PROCEDURE  EXTERNAL;END;
CONSOLEIN :PROCEDURE  EXTERNAL;END;
DDIGCH :PROCEDURE BYTE EXTERNAL;END;
DECIN :PROCEDURE ADDRESS EXTERNAL;END;
ERRORMESSAGE :PROCEDURE (ZZ1) EXTERNAL;DECLARE (ZZ1)ADDRESS;END;
FILL :PROCEDURE (ZZ1,ZZ2,ZZ3) EXTERNAL;DECLARE (ZZ1,ZZ2)ADDRESS,(ZZ3)BYTE;END;
FMOVE :PROCEDURE (ZZ1,ZZ2,ZZ3) EXTERNAL;DECLARE (ZZ1,ZZ2,ZZ3)ADDRESS;END;
BLTSYM: PROCEDURE EXTERNAL;END;
SORT :PROCEDURE (ZZ1,ZZ2,ZZ3) EXTERNAL;DECLARE (ZZ1,ZZ2,ZZ3)ADDRESS;END;
FORCUP :PROCEDURE BYTE EXTERNAL;END;
HEXIN :PROCEDURE ADDRESS EXTERNAL;END;
LENSTRNUL :PROCEDURE (ZZ1)BYTE EXTERNAL;DECLARE (ZZ1)ADDRESS;END;
LTNMCH :PROCEDURE BYTE EXTERNAL;END;
TOKNCH :PROCEDURE BYTE EXTERNAL; END;
MAX :PROCEDURE (ZZ1,ZZ2)ADDRESS EXTERNAL;DECLARE (ZZ1,ZZ2)ADDRESS;END;
MIN :PROCEDURE (ZZ1,ZZ2)ADDRESS EXTERNAL;DECLARE (ZZ1,ZZ2)ADDRESS;END;
OHEXB :PROCEDURE (ZZ1) EXTERNAL;DECLARE (ZZ1)BYTE;END;
OHEXW :PROCEDURE (ZZ1) EXTERNAL;DECLARE (ZZ1)ADDRESS;END;
OUTBLANK :PROCEDURE  EXTERNAL;END;
OUTCHAR :PROCEDURE (ZZ1) EXTERNAL;DECLARE (ZZ1)BYTE;END;
OUTCRLF :PROCEDURE  EXTERNAL;END;
OUTSCANBYTE :PROCEDURE  EXTERNAL;END;
OUTSCANSTRING :PROCEDURE  EXTERNAL;END;
OUTWRITE :PROCEDURE (ZZ1,ZZ2) EXTERNAL;DECLARE (ZZ1)ADDRESS,(ZZ2)BYTE;END;
SCANEXPECT :PROCEDURE (ZZ1) EXTERNAL;DECLARE (ZZ1)ADDRESS;END;
SCANMATCH :PROCEDURE (ZZ1)BYTE EXTERNAL;DECLARE (ZZ1)ADDRESS;END;
SETOB :PROCEDURE (ZZ1) EXTERNAL;DECLARE (ZZ1)ADDRESS;END;
SETSC :PROCEDURE (ZZ1) EXTERNAL;DECLARE (ZZ1)ADDRESS;END;
SFOUND :PROCEDURE BYTE EXTERNAL;END;
STRINGLENGTH :PROCEDURE (ZZ1,ZZ2)BYTE EXTERNAL;DECLARE (ZZ1,ZZ2)ADDRESS;END;
TERMCH :PROCEDURE BYTE EXTERNAL;END;
PRINTCR: PROCEDURE (ZZ1) EXTERNAL; DECLARE ZZ1 ADDRESS; END;
SCANWHILE: PROCEDURE (ZZ1) EXTERNAL; DECLARE ZZ1 ADDRESS; END;
SCANUNTIL: PROCEDURE (ZZ1) EXTERNAL; DECLARE ZZ1 ADDRESS; END;
DECLARE FATAL BYTE EXTERNAL;
DECLARE ACTUAL ADDRESS EXTERNAL;
EX :PROCEDURE  EXTERNAL;END;
MEMCK :PROCEDURE ADDRESS EXTERNAL;END;
OPENI :PROCEDURE (ZZ1) EXTERNAL;DECLARE (ZZ1)ADDRESS;END;
OPENU :PROCEDURE (ZZ1) EXTERNAL;DECLARE (ZZ1)ADDRESS;END;
READI :PROCEDURE (ZZ1,ZZ2) EXTERNAL;DECLARE (ZZ1,ZZ2)ADDRESS;END;
READU :PROCEDURE (ZZ1,ZZ2) EXTERNAL;DECLARE (ZZ1,ZZ2)ADDRESS;END;
SBYTEU :PROCEDURE (ZZ1) EXTERNAL;DECLARE (ZZ1)ADDRESS;END;
WRITEU :PROCEDURE (ZZ1,ZZ2) EXTERNAL;DECLARE (ZZ1,ZZ2)ADDRESS;END;
DECLARE FILENAMELIMIT BYTE EXTERNAL;
MOVEPARENSFILENAME :PROCEDURE (ZZ1) EXTERNAL;DECLARE (ZZ1)ADDRESS;END;
OPENSCAN :PROCEDURE (ZZ1) EXTERNAL;DECLARE (ZZ1)ADDRESS;END;
DECLARE FALSE LITERALLY'0';
DECLARE NUL LITERALLY',0))';
DECLARE STR LITERALLY'(.(';
DECLARE TRUE LITERALLY'255';
DECLARE SCANBYTE BASED SCANP BYTE;
OUTPRINT :PROCEDURE (ZZ1) EXTERNAL;DECLARE (ZZ1)ADDRESS;END;
/* ENDPEX */
$LIST

DECLARE TARGET (45) BYTE PUBLIC;
DECLARE TARGADDR ADDRESS AT (.TARGET);
DECLARE TEMP ADDRESS;
DECLARE SYM$MAX ADDRESS;
DECLARE ASSEMBLY$LANGUAGE BYTE INITIAL (0);
DECLARE OUT$P ADDRESS;
DECLARE OUTBYTE BASED OBUF$P BYTE;
DECLARE OUTWORD BASED OBUF$P ADDRESS;
DECLARE OUT$ADDR BASED OUT$P (1) ADDRESS;
DECLARE I BYTE;
DECLARE COL$MAX BYTE;
DECLARE COL$LENGTH BYTE;
DECLARE PTR$INDEX ADDRESS;
DECLARE SYM$COUNT ADDRESS;
DECLARE SYM$BASE ADDRESS;
DECLARE NAMES$TOP ADDRESS;
DECLARE LINES$TOP ADDRESS;
DECLARE LINES$TOP$BYTE BASED LINES$TOP (1) BYTE;
DECLARE CAPACITY$BYTES ADDRESS;
DECLARE SEPARATOR BYTE INITIAL (0CH);
DECLARE SORTING BYTE INITIAL (0FFH);
DECLARE GIVE$UP$BYTE BASED GIVE$UP (3) BYTE;
DECLARE OLD$SYMTAB$SEEN BYTE;
DECLARE LOW$INDEX ADDRESS;
DECLARE INDEX ADDRESS;
DECLARE LIN$BASE ADDRESS;
DECLARE LIN BASED LIN$BASE (1) ADDRESS;
DECLARE SYM$LINE (*) BYTE DATA ('H SYM  ');
DECLARE BAS$LINE (*) BYTE DATA ('H BAS  ');
DECLARE LIN$LINE (*) BYTE DATA ('H LIN  ');
DECLARE STACK$BASE (*) BYTE DATA ('STACK  ');
DECLARE START$OF$RECORD ADDRESS;
DECLARE ARROW (5) BYTE INITIAL ('==>  ');  /* goes right before MOD$NAME */
DECLARE MOD$NAME (32) BYTE INITIAL (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
                                    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
DECLARE MOD$NAME$LENGTH BYTE;
DECLARE CLOSE$ARROW (5) BYTE DATA ('  <==');
DECLARE OLD$INDEX ADDRESS;

/* NEW DECLARATIONS FOR VERSION X150, 01/15/81 */

DECLARE WIDTH$OF$TYPE$COL   LITERALLY '3';

DECLARE LINES$IN$HEADER  BYTE INITIAL (3);
DECLARE OFFSET$COL       BYTE INITIAL (8);
DECLARE TYPE$COL         BYTE INITIAL (15);
DECLARE SYMBOL$COL       BYTE INITIAL (20);
DECLARE LINE$COL         LITERALLY 'SYMBOL$COL';

$EJECT

READ$NOT$FINISHED: PROCEDURE BYTE;
  RETURN (ACTUAL = CAPACITY$BYTES);
END;

FLUSH: PROCEDURE;
  IF ACTUAL > 32766 THEN
   DO;
    CALL SBYTEU(-32512);
    CALL SBYTEU(32512 - ACTUAL);
   END;
  ELSE CALL SBYTEU(-ACTUAL);
  CALL WRITEU(LINES$TOP,SCAN$P-LINES$TOP);
  IF OLD$SYMTAB$SEEN THEN ACTUAL = 0;
  ELSE CALL READU(LINES$TOP,CAPACITY$BYTES);
  SCAN$P = LINES$TOP;
  GIVE$UP = LINES$TOP + ACTUAL;
  GIVEUP$BYTE(3) = 0;
  TARLEN = 2;
  TARGADDR = 0C00H;
  IF SFOUND THEN
   DO;
    OLD$SYMTAB$SEEN = TRUE;
    SCAN$P = SCAN$P - 2;
    GIVEUP = SCAN$P;
    CAPACITY$BYTES = ACTUAL + 1;
    SCAN$P = LINES$TOP;
   END;
END;

NEXT$CHAR$BLANK: PROCEDURE BYTE;
  CALL SET$SC(SCAN$P+1);
  RETURN BLNK$CH;
END;

NEXT$TRY: PROCEDURE BYTE;
  TARLEN = 1;
  TARGET(0) = 0AH;
   DO WHILE NOT (DDIG$CH AND NEXT$CHAR$BLANK);
    SCAN$P = SCAN$P - 3;
    IF NOT SFOUND THEN RETURN FALSE;
     DO WHILE TERM$CH;
      IF NOT SFOUND THEN RETURN FALSE;
     END;
    SCAN$P = SCAN$P + 3;
   END;
  SCAN$P = SCAN$P - 3;
  OBUF$P = SCAN$P + 6;
  RETURN TRUE;
END;

$EJECT

NEXT$LINE$NUMBER$FOUND: PROCEDURE BYTE;
  DECLARE DUMMY BYTE;
 TRY$LOOP:
  IF NEXT$TRY THEN RETURN TRUE;
  IF READ$NOT$FINISHED THEN
   DO;
    SCAN$P = GIVEUP - 255;
    DUMMY = SFOUND;
    CALL FLUSH;
    GO TO TRY$LOOP;
   END;
  RETURN FALSE;
END;

OUT$LIN: PROCEDURE (VALUE);
  DECLARE VALUE ADDRESS;
  IF VALUE < LOW$INDEX THEN GO TO DASHES;
  IF VALUE > INDEX THEN GO TO DASHES;
  IF LIN(VALUE) = 0 THEN GO TO DASHES;
  CALL OHEXW(LIN(VALUE));
  RETURN;
 DASHES:
  CALL OUT$WRITE(.('----'),4);
END;

GET$LINE$OFFSET: PROCEDURE;
  SCAN$P = START$OF$RECORD + OFFSET$COL;  /* POINT TO OFFSET COLUMN */
  LIN(INDEX) = HEXIN;
  START$OF$RECORD, SCAN$P = SCAN$P + 15;  /* MOVE TO NEXT RECORD */
END;

READ: PROCEDURE (PTR);
  DECLARE PTR ADDRESS;
  CALL READI(PTR,(CAPACITY$BYTES:=(MEMCK-PTR)));
  SCAN$P = .MEMORY;
  GIVEUP = PTR + ACTUAL;
END;

CHECK$GIVE$UP: PROCEDURE;
  CALL FMOVE(GIVEUP-SCAN$P,SCAN$P,.MEMORY);
  CALL READ(GIVEUP - SCAN$P + .MEMORY);
  SCAN$P = .MEMORY;
  CALL SCAN$WHILE(.TERMCH);
  START$OF$RECORD = SCAN$P;
END;

$EJECT

PUT$SYM$ADDR: PROCEDURE;
  SCAN$P = START$OF$RECORD;
  IF SCAN$BYTE = 'G' THEN
    DO;  /* BASE IS A GROUP */
      TEMP = DECIN;
      OUTBYTE = 0;
      OBUF$P = OBUF$P + 1;
      CALL OUT$CHAR (LOW(TEMP));
      CALL OUT$CHAR (HIGH(TEMP));
    END;
  ELSE IF SCAN$BYTE = 'S' THEN
    DO;
      SCAN$P = SCAN$P + 1;
      IF SCAN$BYTE = '(' THEN
        DO;  /* BASE IS A SEGMENT */
          TEMP = DECIN;
          OUTBYTE = 1;
          OBUF$P = OBUF$P + 1;
          CALL OUT$CHAR (LOW(TEMP));
          CALL OUT$CHAR (HIGH(TEMP));
        END;
      ELSE
        DO;  /* BASE IS STACK */
          OUTBYTE = 2;
          OBUF$P = OBUF$P + 1;
          OUT$WORD = 0;
          OBUF$P = OBUF$P + 2;
          SCAN$P = SCAN$P + 4; /* SKIP PASSED 'STACK' */
        END;
    END;
  ELSE
    DO;  /* BASE IS A FRAME NUMBER */
      OUTBYTE = 3;
      OBUF$P = OBUF$P + 1;
      TEMP = HEXIN;                   /* GET BASE ADDRESS AND OUTPUT IT */
      CALL OUT$CHAR(LOW (TEMP));
      CALL OUT$CHAR(HIGH (TEMP));
    END;
  TEMP = HEXIN;                   /* GET OFFSET ADDRESS AND OUTPUT IT */
  CALL OUT$CHAR(LOW (TEMP));
  CALL OUT$CHAR(HIGH (TEMP));
END;

$EJECT

CHECK$FOR$WARNING: PROCEDURE BYTE;

DECLARE I BYTE;

  IF SCAN$MATCH(.('WARNING:')) THEN
    DO I = 1 TO 4;
      CALL SCAN$UNTIL(.TERMCH);
      SCAN$P = SCAN$P + 2;
      RETURN TRUE;
    END;
  RETURN FALSE;

END CHECK$FOR$WARNING;

$EJECT

STILL$SYMBOLS: PROCEDURE BYTE;

CALL SET$SC(START$OF$RECORD);
SCAN$P = SCAN$P + TYPE$COL;            /* POINT TO TYPE OF RECORD */
IF (SCAN$MATCH(.('SYM',0))) OR (SCAN$MATCH(.('BAS',0))) THEN RETURN TRUE;
ELSE
  DO;
    SCAN$P = START$OF$RECORD;
    IF CHECK$FOR$WARNING THEN
      DO;
        START$OF$RECORD = SCAN$P;
        SCAN$P = SCAN$P + TYPE$COL;
        IF (SCAN$MATCH(.('SYM',0))) OR (SCAN$MATCH(.('BAS',0))) THEN
          RETURN TRUE;
        ELSE RETURN FALSE;
      END;
    ELSE RETURN FALSE;
  END;
RETURN FALSE;

END STILL$SYMBOLS;

COLLECT$SYMBOL$NAMES: PROCEDURE;
  SYM$MAX = 0;
  SYM$COUNT = 0;
  OUT$P = MEMCK;
  OBUF$P = .MEMORY;
   DO WHILE STILL$SYMBOLS;
    OUT$P = OUT$P - 2;
    SYM$COUNT = SYM$COUNT + 1;
    OUT$ADDR(0) = OBUF$P + 1; /* STORE POINTER TO NAME RECORD */
    CALL PUT$SYM$ADDR;
    SCAN$P = START$OF$RECORD + SYMBOL$COL; /* POINT TO SYMBOL NAME */
    SYM$BASE = OBUF$P;
     DO WHILE TOKNCH;
      CALL OUT$SCAN$BYTE;
     END;
    START$OF$RECORD, SCAN$P = SCAN$P + 2;            /* SKIP OVER CRLF */
    SYM$MAX = MAX(OBUF$P-SYM$BASE,SYM$MAX);
    CALL OUT$CHAR(0);
   END;
  NAMES$TOP = OBUF$P;
END;

$EJECT

STILL$LINES: PROCEDURE BYTE;

CALL SET$SC(START$OF$RECORD);
SCAN$P = SCAN$P + TYPE$COL;
IF SCAN$MATCH(.('LIN',0)) THEN RETURN TRUE;
ELSE
  DO;
    SCAN$P = START$OF$RECORD;
    IF CHECK$FOR$WARNING THEN
      DO;
        START$OF$RECORD = SCAN$P;
        SCAN$P = SCAN$P + TYPE$COL;
        IF SCAN$MATCH(.('LIN',0)) THEN RETURN TRUE;
        ELSE RETURN FALSE;
      END;
    ELSE RETURN FALSE;
  END;
RETURN FALSE;

END STILL$LINES;

COLLECT$LINE$NUMBERS: PROCEDURE;

  IF STILL$LINES THEN
   DO;
    SCAN$P = START$OF$RECORD + LINE$COL;  /* POINT TO LINE NUMBER */
    INDEX = (LOW$INDEX := DECIN);         /* INDEX = FIRST LINE NUMBER */
    LIN$BASE = NAMES$TOP - (2*LOW$INDEX); /* LINBASE SET SO INDEX AFTER NAMESTOP */
    CALL GET$LINE$OFFSET;
     DO WHILE STILL$LINES;
      SCAN$P = START$OF$RECORD + LINE$COL; /* POINT TO LINE NUMBER */
      OLD$INDEX = INDEX;
      INDEX = DECIN;
       DO WHILE OLD$INDEX < INDEX - 1;
        OLD$INDEX = OLD$INDEX + 1;
        LIN(OLD$INDEX) = 0;
       END;
      CALL GET$LINE$OFFSET;
     END;
    LINES$TOP = .LIN(INDEX+2);
    LINES$TOP$BYTE(0FFFFH) = 0AH;
   END;
  ELSE /* NO LINE RECORDS FOUND */
   DO;
    ASSEMBLY$LANGUAGE = TRUE;
    LOW$INDEX = 0FFFFH;
    LINES$TOP = NAMES$TOP;
   END;
END;

$EJECT

PROCESS$LOCATE$FILE: PROCEDURE;
  DECLARE I BYTE;

  CALL SET$SC(.MEMORY);
  CALL READ(.MEMORY);                 /* READ IN LOCATE LISTING INTO MEMORY */
  IF SCAN$MATCH (.(FF, 'ISIS-II', 0)) THEN /* FILE OUTPUT BY CROSS LOC86 */
   DO;
    CALL FMOVE(MOD$NAME$LENGTH, .MOD$NAME, .TARGET);
    TARLEN = MOD$NAME$LENGTH + 1;
    CALL FMOVE(3, .(':  '),.TARGET(MOD$NAME$LENGTH));
    LINES$IN$HEADER = 1;
    OFFSET$COL = 7;
    TYPE$COL = 14;
    SYMBOL$COL = 19;
   END;
  ELSE /* FILE OUTPUT BY RESIDENT LINK86 OR LOC86 */
   DO;
    TARLEN = MOD$NAME$LENGTH + 4;
    CALL FMOVE(2, .('= '), .TARGET);
    CALL FMOVE(MOD$NAME$LENGTH, .MOD$NAME, .TARGET(2));
    CALL FMOVE(2, .(CR,LF), .TARGET(MOD$NAME$LENGTH+2));
   END;
   DO WHILE NOT SFOUND;
    IF READ$NOT$FINISHED THEN
     DO;
      CALL FMOVE(TARLEN,GIVEUP-TARLEN,.MEMORY);
      CALL READ(.MEMORY+TARLEN);
     END;
    ELSE
     DO;
      CALL ERROR$MESSAGE STR 'MOD NAME NOT FOUND' NUL;
      CALL EX;
     END;
   END;
  DO I = 1 TO LINES$IN$HEADER;  /* POINT TO FIRST RECORD */
    CALL SCAN$UNTIL(.TERMCH);
    SCAN$P = SCAN$P + 2;
  END;
  START$OF$RECORD = SCAN$P;
  CALL CHECK$GIVEUP;
  CALL COLLECT$SYMBOL$NAMES;
  CALL COLLECT$LINE$NUMBERS;
END;

$EJECT

OUT$SYM$NAME: PROCEDURE;
  DECLARE BASE$TYPE BYTE;

  CALL SET$OB(OBUF$P);
  SCAN$P = OUT$ADDR(PTR$INDEX) - 1;
  BASE$TYPE = SCAN$BYTE AND 0000$0011B;
  SCAN$P = SCAN$P + 1;
  DO CASE BASE$TYPE;  /* OUTPUT BASE */

    /* CASE 0: GROUP INDEX */
    DO;
      CALL OUT$PRINT (.('G=',0));
      CALL OHEXB(SCAN$BYTE);
      CALL OUT$BLANK;
    END;

    /* CASE 1: SEGMENT INDEX */
    DO;
      CALL OUT$PRINT (.('S=',0));
      CALL OHEXB(SCAN$BYTE);
      CALL OUT$BLANK;
    END;

    /* CASE 2: STACK SYMBOL */
    DO;
      CALL OUT$PRINT(.('STAK ',0));
    END;

    /* CASE 3: ABSOLUTE BASE */
    DO;
      CALL OHEXW(SCAN$ADDR);            /* OUTPUT BASE ADDRESS */
      CALL OUT$BLANK;
    END;
  END; /* DO CASE */
  SCAN$P = SCAN$P + 2;              /* SKIP BASE ADDRESS */
  CALL OHEXW(SCAN$ADDR);            /* OUTPUT OFFSET ADDRESS */
  SCAN$P = SCAN$P +2;               /* SKIP OFFSET ADDRESS */
  CALL OUT$BLANK;
  CALL OUT$SCAN$STRING;
END;

OUTPUT$SYMBOLS: PROCEDURE;
  CALL FILL(15000,NAMES$TOP,' ');
  SYM$MAX = SYM$MAX + 14;
  COL$MAX = 128 / SYM$MAX;
  COL$LENGTH = MAX (60, SYM$COUNT/COL$MAX + 1);
  COL$LENGTH = MIN (COL$LENGTH,SYM$COUNT);
  OBUF$P = NAMES$TOP;
  CALL OUT$CHAR(0);
  CALL OUT$CHAR(SEPARATOR);
  CALL OUT$PRINT(.ARROW);
  CALL OUT$WRITE(.CLOSE$ARROW,4);
  CALL OUT$CRLF;
  I = COL$LENGTH;
   DO WHILE I > 0;
    PTR$INDEX = SYM$COUNT + (I := I - 1);
    OBUF$P = OBUF$P + 4;
     DO WHILE PTR$INDEX >= COL$LENGTH;
      PTR$INDEX = PTR$INDEX - COL$LENGTH;
      CALL OUT$SYM$NAME;
      OBUF$P = OBUF$P + SYM$MAX;
     END;
    CALL OUT$CRLF;
   END;
  CALL OUT$CRLF;
  CALL WRITEU(NAMES$TOP,OBUF$P - NAMES$TOP);
END;

$EJECT

SCAN$BACK: PROCEDURE (CHAR);
  DECLARE CHAR BYTE;
   DO WHILE SCAN$BYTE <> CHAR;
    SCAN$P = SCAN$P - 1;
   END;
END;

READ$MOD$NAME: PROCEDURE;
  IF ASSEMBLY$LANGUAGE THEN RETURN;
  TARLEN = 3;
  CALL FMOVE(3,.('DO;'),.TARGET);
  IF NOT SFOUND THEN
   DO;
    TARGADDR = 'od';
    IF NOT SFOUND THEN RETURN;
   END;
  CALL SCAN$BACK(':');
  CALL SCAN$BACK(0AH);
  SCAN$P = SCAN$P + 12;
  CALL SET$OB(.MOD$NAME);
   DO WHILE SCAN$BYTE <> ':';
    IF TOKNCH THEN CALL OUT$SCAN$BYTE;
    ELSE SCAN$P = SCAN$P + 1;
   END;
  CALL OUT$CHAR(0);
END;

$EJECT

/* MAIN LINE CODE */

FATAL = TRUE;
CALL CONSOLE$IN;
CALL PRINT$CR(.SIGN$ON$MSG);
CALL OPEN$SCAN(.OPENI);                  /* OPEN LOCATE LISTING FILE */
FILE$NAME$LIMIT = 31;
CALL MOVE$PARENS$FILE$NAME(.MOD$NAME);   /* GET MODNAME FOR (MODNAME) */
MOD$NAME$LENGTH = LEN$STR$NUL(.MOD$NAME);
I = SCAN$MATCH STR 'IN' NUL;
CALL SCAN$EXPECT STR 'TO' NUL;           /* SCAN FOR 'INTO' IN COMMAND LINE */
CALL PROCESS$LOCATE$FILE;
CALL OPEN$SCAN(.OPENU);                  /* OPEN PLM80 LIST FILE */
 DO WHILE NOT TERM$CH;                   /* SCAN FOR ANY OPTIONS */
  IF FORCUP = 'N' THEN SORTING = FALSE;
  IF FORCUP = 'L' THEN SEPARATOR = 0AH;
  CALL BUMP$SCAN$P;
 END;
CAPACITY$BYTES = OUT$P - LINES$TOP - 4;
OLD$SYMTAB$SEEN = FALSE;
SCAN$P = LINES$TOP;
ACTUAL = 0;
CALL FLUSH;
CALL READ$MOD$NAME;
TARLEN = 1;
TARGET(0) = 0AH;
SCAN$P = SCAN$P + 3;
 DO WHILE NEXT$LINE$NUMBER$FOUND;
  CALL OUTLIN(DECIN);
  CALL OUT$BLANK;
  SCAN$P = SCAN$P + 6;
 END;
SCAN$P = GIVE$UP;
CALL FLUSH;
IF SORTING THEN CALL SORT(OUT$P,SYM$COUNT,.BLTSYM);
CALL OUTPUT$SYMBOLS;
CALL EX;

END;
