DataMuseum.dk

top - metrics - download

    Length: 2304 (0x900)
    Types: TextFile
    Names: »STRIP.SRC«

└─⟦8dcf1351b⟧ Bits:30004118/disk2.imd SW1720/I5 Pascal/MT+ Release 5.5
    └─⟦this⟧ »STRIP.SRC« 

TextFile

PROGRAM STRIPIT; (* PROGRAM TO STRIP ENTRY POINT NAMES FROM AN OVERLAY *)

TYPE
  ALPHA = PACKED ARRAY Æ1..8Å OF CHAR;

  NAMEREC = RECORD
                NAME : ALPHA;
                ADDR : INTEGER
            END;
  NAMEARR = ARRAY Æ0..0Å OF NAMEREC;
  SECTOR = ARRAY Æ0..127Å OF BYTE;

VAR
  NAMELIST : ^NAMEARR;
  I : INTEGER;
  BASE : INTEGER;
  TITLE : STRING;
  INFILE : FILE OF SECTOR;
  OUTFILE : FILE OF SECTOR;
  BUF : ARRAY Æ0..192Å OF SECTOR;      (* OVERLAY LOADING AREA *)
  COUNT : INTEGER;
  INLINE : STRING;
  DONE : BOOLEAN;
  NEWSIZE : INTEGER;

PROCEDURE KRUNCH(I:INTEGER);
VAR
  J : INTEGER;
BEGIN
  REPEAT
    NAMELIST^ÆIÅ := NAMELIST^ÆI+1Å;
    I := I + 1;
  UNTIL ORD(NAMELIST^ÆIÅ.NAMEÆ1Å) = 0
END;

BEGIN
  WRITE('File name? ');
  READLN(TITLE);
  ASSIGN(INFILE,TITLE);
  RESET(INFILE);
  COUNT := 0;
  WHILE IORESULT <> 1 DO
    BEGIN
      COUNT := COUNT + 1;
      BUFÆCOUNT-1Å := INFILE^;
      SEEKREAD(INFILE,COUNT);
    END;
  WRITELN(Count,' sectors');

  WRITE('Base addr? ');
  READHEX(INPUT,BASE,2);

  MOVE(BUFÆ0,1Å,I,2);

  WRITE('Table starts at Offset = '); WRITEHEX(OUTPUT,I-BASE,2); WRITELN;

  NAMELIST := ORD(ADDR(BUF)) + (I-BASE);

  DONE := FALSE;
  I := 0;
  WHILE NOT DONE DO
    BEGIN
      WRITE(NAMELIST^ÆIÅ.NAME,'?');
      READLN(INLINE);
      IF (length(inline) <> 0) and (INLINEÆ1Å IN Æ'N','n'Å) THEN
        KRUNCH(I)
      ELSE
        I := I + 1;
      DONE := (NAMELIST^ÆIÅ.NAMEÆ1Å=CHR(0)) OR (INLINEÆ1Å = '.')
    END;

  (* Now write it out *)

  I := 0;
  REPEAT
    WRITELN(NAMELIST^ÆIÅ.NAME);
    I := I + 1
  UNTIL (NAMELIST^ÆIÅ.NAMEÆ1Å = CHR(0));

  WRITELN(i,' symbols remain');

  NEWSIZE := (ORD(ADDR(NAMELIST^ÆIÅ.NAME))-ORD(ADDR(BUF)));
  IF (NEWSIZE MOD 128) <> 0 THEN
    NEWSIZE := NEWSIZE + 128;

  WRITELN('New size is ',NEWSIZE DIV 128,' sectors');

  COUNT := NEWSIZE DIV 128;

  WRITE('Writeit? ');
  READLN(INLINE);
  IF INLINE <> 'YESDOIT' THEN
    EXIT;

  ASSIGN(OUTFILE,TITLE);
  REWRITE(OUTFILE);
  FOR I := 0 TO COUNT-1 DO
    BEGIN
      OUTFILE^ := BUFÆIÅ;
      SEEKWRITE(OUTFILE,I)
    END;
  CLOSE(OUTFILE,I)
END.
«eof»