|
|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 2304 (0x900)
Types: TextFile
Names: »STRIP.SRC«
└─⟦02f213fda⟧ Bits:30008919 MT+ SPP 2/3
└─⟦this⟧ »STRIP.SRC«
└─⟦8dcf1351b⟧ Bits:30004118/disk2.imd SW1720/I5 Pascal/MT+ Release 5.5
└─⟦this⟧ »STRIP.SRC«
└─⟦e44a40b06⟧ Bits:30005968 SW1820/I8 RC855 Pascal MT+ Release 5.5
└─⟦this⟧ »STRIP.SRC«
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»