DataMuseum.dk

Presents historical artifacts from the history of:

CP/M

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about CP/M

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦dda59e944⟧ TextFile

    Length: 3840 (0xf00)
    Types: TextFile
    Names: »HASHTAB.PAS«

Derivation

└─⟦08ea08c61⟧ Bits:30003924 PolyPascal programmer
    └─ ⟦this⟧ »HASHTAB.PAS« 
└─⟦092727b26⟧ Bits:30005927 Demoprogrammer til Pascal bog (Jet-80)
    └─ ⟦this⟧ »HASHTAB.PAS« 
└─⟦3702e543b⟧ Bits:30003064 Demoprogrammer A-J til Pascal bog
    └─ ⟦this⟧ »HASHTAB.PAS« 
└─⟦f983c2ef3⟧ Bits:30004681 Pascal opgaver (Butler)
    └─ ⟦this⟧ »HASHTAB.PAS« 

TextFile

        PROGRAM hashtab;
        
          (* cpr-kontrollen i dette program checker kun *)
          (* om de tre sidste tegn er lovlige           *)
          
          TYPE
            str10 = STRING(.10.);
            indextype = 0 .. 999;
            pointer = ^ post;
            post = RECORD
                     naeste : pointer;
                     nummer : str10;
                   END;
            hashtabel = ARRAY(.indextype.) OF pointer;
          
          VAR
            tabel : hashtabel;
            cpr : str10;
            ch : CHAR;
            index : indextype;
            i, test : INTEGER;
            
          FUNCTION soeg(tabpointer : pointer; nr : str10) : BOOLEAN;
          
            VAR
              fundet : BOOLEAN;
            
            BEGIN (* soeg *)
              fundet :=FALSE;
              WHILE (tabpointer <> NIL) AND NOT fundet DO
                IF tabpointer^.nummer = nr
                  THEN fundet := TRUE
                  ELSE tabpointer := tabpointer^.naeste;
              soeg := fundet;
            END; (* soeg *)
            
          PROCEDURE indsaet(VAR tab : hashtabel; nr : str10);
          
            VAR
              index : indextype;
              naeste, pp : pointer;
              test : INTEGER;
              ch : CHAR;
              
            BEGIN (* indsaet *)
              VAL(COPY(nr, 8, 3), index, test);
              IF  (test <> 0) OR (LEN(nr) < 10)
                THEN
                  BEGIN
                    WRITE('Ulovligt cprnr. - tast <RETURN>');
                    READLN(ch);
                  END
              ELSE IF  NOT soeg(tab(.index.), nr)
                THEN
                  BEGIN
                    NEW(pp);
                    pp^.naeste := tab(.index.);
                    pp^.nummer := nr;
                    tab(.index.) := pp;
                  END
              ELSE
                  BEGIN
                    WRITE(nr, ' findes allerede - tast <RETURN>');
                    READLN(ch);
                  END;
            END; (* indsaet *)
          
          BEGIN (* hashtab *)
            FOR i := 0 TO 999 DO
              tabel(.i.) := NIL;
            REPEAT
              WRITE(CLRHOM);
              WRITELN('     I. Indsæt');
              WRITELN;
              WRITELN('     S. Søg');
              WRITELN;
              WRITELN('     A. Afslut');
              WRITELN;
              REPEAT
                READ(KBD, ch);
              UNTIL ch IN (.'I', 'i', 'S', 's', 'A', 'a'.);
              CASE ch OF
                'I', 'i' : BEGIN
                             WRITE('Tast cprnummer: ');
                             BUFLEN := 10;
                             READLN(cpr);
                             indsaet(tabel, cpr);
                           END;
                'S', 's' : BEGIN
                             WRITE('Hvilket cprnummer søges: ');
                             BUFLEN := 10;
                             READLN(cpr);
                             VAL(COPY(cpr, 8, 3), index, test);
                             IF (test <> 0) OR (LEN(cpr) < 10)
                               THEN
                                 WRITELN('Ulovligt cprnr.')
                               ELSE
                                 IF soeg(tabel(.index.), cpr)
                                   THEN WRITELN(cpr, ' findes')
                                   ELSE WRITELN(cpr, ' findes ikke');
                             WRITE('Tast <RETURN> ');
                             READLN(ch);
                           END;
              END;
            UNTIL ch IN (.'A', 'a'.);
          END. (* hashtab *)
«eof»