DataMuseum.dk

top - download

    Length: 2528 (0x9e0)
    Notes: Mikados TextFile, Mikados_K
    Names: »DUMP«

└─⟦89d8689a3⟧ Bits:30003591 MIKADOS Pascal compiler (01.02.1982 E)
    └─ ⟦this⟧ »DUMP« 

Text

PROGRAM DUMP;  (* AN 800104 *)
TYPE BLOCK = PACKED ARRAY (0..255) OF CHAR;
VAR DISCBUFFER: BLOCK;
    DISC, TRACK, SECTOR, IOCODE, ERRORCODE,
    I, J, K, L, P, CHARCODE, DIG1, DIG2: INTEGER;
    OUTBUF: STRING;
    
PROCEDURE PSCIU(VAR DISCBUFFER: BLOCK; DISC, TRACK, SECTOR,
                IOCODE: INTEGER; VAR ERRORCODE: INTEGER);
                                                EXTERNAL;
                                                
PROCEDURE WRITEHEX(I: INTEGER);
BEGIN
  P := P+1;
  IF I < 10 THEN OUTBUF(P):=CHR(I+48) ELSE OUTBUF(P):=CHR(I+55);
END;
 
 
PROCEDURE MAIN;
BEGIN
  OUTBUF := ' 0';
  (*$R-*) OUTBUF(0) := CHR(64) (*$R+*);
  FILLCHAR(OUTBUF(3),62,' ');
  ERRORCODE := 0;
  REPEAT
   WRITE('Enter disk identification: P');
   READLN;
   IF EOF THEN EXIT(MAIN);
   READ(DISC);
   WRITE('Enter track number: ');
   READLN;
   IF EOF THEN EXIT(MAIN);
   READ(TRACK);
   WRITE('Enter sector number: ');
   READLN;
   IF EOF THEN EXIT(MAIN);
   READ(SECTOR);
   IOCODE := 1;
   PSCIU(DISCBUFFER,DISC,TRACK,SECTOR,IOCODE,ERRORCODE);
   IF ERRORCODE <> 0 THEN EXIT(MAIN);
   WRITELN(LIST,'Dump from disk P',DISC:1,',   track ',TRACK:3,
                ',   sector ',SECTOR:2);
   WRITELN(LIST);
   FOR I := 0 TO 15 DO
   BEGIN
      P := 0;
      WRITEHEX(I);
      P := 5;
      J := I * 16;
      K := J + 15;
      FOR L := J TO K DO
      BEGIN
            IF L MOD 4 = 0 THEN P := P+1;
            P := P+1;
            DIG1 := ORD(DISCBUFFER(L)) MOD 128;
            IF (DIG1 <= 126) AND
               (DIG1 >=  32) THEN
               OUTBUF(P) := CHR(DIG1)
            ELSE
               OUTBUF(P) := '.';
      END;
      P := P+3;
      FOR L := J TO K DO
      BEGIN
            IF L MOD 4 = 0 THEN P:=P+1;
            DIG1 := ORD(DISCBUFFER(L)) DIV 16;
            DIG2 := ORD(DISCBUFFER(L)) MOD 16;
            WRITEHEX(DIG1);
            WRITEHEX(DIG2);
      END;
      WRITELN(LIST,OUTBUF);
   END;
  WRITELN(LIST,CHR(12));
  UNTIL FALSE;
 END;
 
BEGIN
  WRITELN('Dump one sector');
  MAIN;
  IF ERRORCODE <> 0 THEN WRITELN ('Error code:', ERRORCODE:4);
  WRITELN('DUMP terminated');
END.