|
DataMuseum.dkPresents historical artifacts from the history of: MIKADOS |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about MIKADOS Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 17888 (0x45e0)
Notes: Mikados TextFile, Mikados_K
Names: »PXREF«
└─⟦89d8689a3⟧ Bits:30003591 MIKADOS Pascal compiler (01.02.1982 E)
└─ ⟦this⟧ »PXREF«
PROGRAM PXREF;
(* Based on program in Peter Grogono : "Programming in PASCAL"
Modified for DDE use DI - 811207
PASCAL Cross Reference program *)
CONST
MAXLINES = 1999;
MAXWORDLEN = 20;
MAXLINELEN = 79;
MAXONPAGE = 61;
MAXPAGES = 99;
HEADINGSIZE = 3;
ENTRYGAP = 0;
NUMBERGAP = 2;
RADIX = 10;
MAXKEYWORD = 36;
BLANK = ' ';
HEADING = 'Pascal cross-reference list of : ';
TYPE
PARMARRAY = PACKED ARRAY (1..40) OF CHAR;
CLOCKRECORD = RECORD
DATE: PACKED ARRAY (1..10) OF CHAR;
TIME: PACKED ARRAY (1..8) OF CHAR
END;
COUNTER = 1 .. MAXLINES;
WORDINDEX = 1 .. MAXWORDLEN;
PAGEINDEX = 1 .. MAXONPAGE;
PAGENUMBER = 1 .. MAXPAGES;
LINEINDEX = 1 .. MAXLINELEN;
WORDTYPE = STRING(MAXWORDLEN);
QUEUEPOINTER = ^QUEUEITEM;
QUEUEITEM =
RECORD
LINENUMBER: COUNTER;
NEXTINQUEUE: QUEUEPOINTER
END;
ENTRYTYPE =
RECORD
WORDVALUE: WORDTYPE;
FIRSTINQUEUE,LASTINQUEUE: QUEUEPOINTER
END;
TREEPOINTER = ^NODE;
NODE =
RECORD
ENTRY: ENTRYTYPE;
LEFT, RIGHT: TREEPOINTER
END;
VAR
PARM: ^PARMARRAY;
CLOCK: ^CLOCKRECORD;
WORDTREE: TREEPOINTER;
LETTERS, TALOGTEGN: SET OF CHAR;
INDFIL: TEXT;
FILNAVN: STRING(20);
JANEJ: STRING(1);
SMÅTILSTORE: BOOLEAN;
KEYWORDLIST: ARRAY (1..MAXKEYWORD) OF STRING(9);
KEYWORD: BOOLEAN;
POINTLIST: BOOLEAN; (* point list on terminal *)
I: INTEGER;
INCLUDEFIL: TEXT; (* include file *)
INCLUDENAME: STRING(20);
INCLUDE: BOOLEAN;
PROCEDURE SLUT;
BEGIN
WRITELN('Cross-reference of ',FILNAVN,' aborted');
EXIT(PXREF)
END;
PROCEDURE LÆSKEYWORD;
BEGIN
KEYWORDLIST(01) := 'AND';
KEYWORDLIST(02) := 'ARRAY';
KEYWORDLIST(03) := 'BEGIN';
KEYWORDLIST(04) := 'CASE';
KEYWORDLIST(05) := 'CONST';
KEYWORDLIST(06) := 'DIV';
KEYWORDLIST(07) := 'DO';
KEYWORDLIST(08) := 'DOWNTO';
KEYWORDLIST(09) := 'ELSE';
KEYWORDLIST(10) := 'END';
KEYWORDLIST(11) := 'FILE';
KEYWORDLIST(12) := 'FOR';
KEYWORDLIST(13) := 'FUNCTION';
KEYWORDLIST(14) := 'GOTO';
KEYWORDLIST(15) := 'IF';
KEYWORDLIST(16) := 'IN';
KEYWORDLIST(17) := 'LABEL';
KEYWORDLIST(18) := 'MOD';
KEYWORDLIST(19) := 'NIL';
KEYWORDLIST(20) := 'NOT';
KEYWORDLIST(21) := 'OF';
KEYWORDLIST(22) := 'OR';
KEYWORDLIST(23) := 'OTHERWISE';
KEYWORDLIST(24) := 'PACKED';
KEYWORDLIST(25) := 'PROCEDURE';
KEYWORDLIST(26) := 'PROGRAM';
KEYWORDLIST(27) := 'RECORD';
KEYWORDLIST(28) := 'REPEAT';
KEYWORDLIST(29) := 'SET';
KEYWORDLIST(30) := 'THEN';
KEYWORDLIST(31) := 'TO';
KEYWORDLIST(32) := 'TYPE';
KEYWORDLIST(33) := 'UNTIL';
KEYWORDLIST(34) := 'VAR';
KEYWORDLIST(35) := 'WHILE';
KEYWORDLIST(36) := 'WITH';
END;
PROCEDURE SØGKEYWORD(SØGEORD: WORDTYPE);
VAR
FIRST, LAST,I: 1 .. MAXKEYWORD;
BEGIN
FIRST:=1;
LAST:=MAXKEYWORD;
WHILE FIRST<LAST DO
BEGIN
I:=(LAST+FIRST) DIV 2;
IF SØGEORD > KEYWORDLIST(I) THEN
BEGIN
FIRST:=I+1;
IF FIRST>LAST THEN
FIRST:=LAST;
END
ELSE
IF SØGEORD < KEYWORDLIST(I) THEN
BEGIN
LAST:=I-1;
IF FIRST>LAST THEN
LAST:=FIRST;
END
ELSE
BEGIN
LAST:=I;
FIRST:=LAST;
END;
END;
KEYWORD:= SØGEORD = KEYWORDLIST(FIRST);
IF NOT KEYWORD THEN
END;
PROCEDURE BUILDTREE( VAR TREE: TREEPOINTER);
VAR
CURRENTWORD: WORDTYPE;
CURRENTLINE: COUNTER;
TILSTAND: INTEGER;
PROCEDURE GETWORD ( VAR WORD: WORDTYPE;
VAR LINE: COUNTER);
VAR
CURRENTCHAR: CHAR;
INDEX, BLANKINDEX: 0 .. MAXWORDLEN;
PROCEDURE GETCHAR ( VAR CH: CHAR;
VAR LIN: COUNTER);
BEGIN (* GETCHAR *)
IF EOF(OUTPUT) THEN SLUT;
IF INCLUDE THEN
BEGIN
IF EOF(INCLUDEFIL) THEN
BEGIN
INCLUDE:=FALSE;
CLOSE(INCLUDEFIL);
CH := BLANK;
END
ELSE
IF ((EOLN(INCLUDEFIL)) AND (CH IN LETTERS+TALOGTEGN)) THEN
CH:=BLANK
ELSE
IF EOLN(INCLUDEFIL) THEN
BEGIN
CH := BLANK;
LIN := LIN +1;
IF POINTLIST THEN
BEGIN
WRITE('.');
IF (LIN MOD 50) = 0 THEN
BEGIN
WRITELN;
WRITE('<><',LIN:4,'>');
END;
END;
READLN(INCLUDEFIL)
END
ELSE
READ(INCLUDEFIL,CH);
END
ELSE
IF EOF(INDFIL) THEN
CH := BLANK
ELSE
IF ((EOLN(INDFIL)) AND (CH IN LETTERS+TALOGTEGN)) THEN
CH:=BLANK
ELSE
IF EOLN(INDFIL) THEN
BEGIN
CH := BLANK;
LIN := LIN +1;
IF POINTLIST THEN
BEGIN
WRITE('.');
IF (LIN MOD 50) = 0 THEN
BEGIN
WRITELN;
WRITE('<><',LIN:4,'>');
END;
END;
READLN(INDFIL)
END
ELSE
READ(INDFIL,CH);
IF (CH IN (. 'a'..'å' .)) AND SMÅTILSTORE THEN
CH := CHR( ORD(CH) - (ORD('a') - ORD('A')));
END; (* GETCHAR *)
BEGIN (* GETWORD *)
INCLUDENAME:='';
WORD:=' ';
TILSTAND:=1;
REPEAT
GETCHAR(CURRENTCHAR,LINE);
CASE TILSTAND OF
(* Normal *) 1: IF (CURRENTCHAR = '''') THEN
TILSTAND := 2
ELSE
IF (CURRENTCHAR = '(') THEN
TILSTAND := 3;
(* After ' *) 2: IF (CURRENTCHAR = '''') THEN
TILSTAND := 1;
(* After ( *) 3: IF (CURRENTCHAR = '*') THEN
TILSTAND := 4
ELSE
IF (CURRENTCHAR = '''') THEN
TILSTAND := 2
ELSE
TILSTAND := 1;
(* After (* *) 4: IF (CURRENTCHAR = '$') THEN
TILSTAND := 7
ELSE
TILSTAND := 5;
(* Comment *) 5: IF (CURRENTCHAR = '*') THEN
TILSTAND := 6;
(* After * *) 6: IF (CURRENTCHAR = ')') THEN
TILSTAND := 1
ELSE
TILSTAND := 5;
(* Option *) 7: IF (CURRENTCHAR = 'I') THEN
TILSTAND := 9
ELSE
TILSTAND := 8;
(* Op.not I *) 8: IF (CURRENTCHAR = ',') THEN
TILSTAND := 7
ELSE
IF (CURRENTCHAR = '*') THEN
TILSTAND := 6;
(* Include *) 9: IF (CURRENTCHAR = '*') THEN
BEGIN
INCLUDE:=TRUE;
RESET(INCLUDEFIL,INCLUDENAME);
READLN(INCLUDEFILE);
TILSTAND:=1;
LINE:=LINE+1;
END
ELSE
BEGIN
(*$R-*)
INCLUDENAME(0):= CHR(ORD(INCLUDENAME(0))+1);
(*$R+*)
INCLUDENAME(LENGTH(INCLUDENAME)):=CURRENTCHAR;
END;
END;
UNTIL ((CURRENTCHAR IN LETTERS) AND (TILSTAND = 1)) OR EOF(INDFIL);
IF NOT EOF(INDFIL) THEN
BEGIN
INDEX := 0;
WHILE CURRENTCHAR IN LETTERS+TALOGTEGN DO
BEGIN
IF INDEX < MAXWORDLEN THEN
BEGIN
INDEX := INDEX +1;
WORD(INDEX) := CURRENTCHAR;
END;
IF EOF(INDFIL) THEN
CURRENTCHAR := BLANK
ELSE
GETCHAR(CURRENTCHAR,LINE)
END; (* WHILE *)
(*$R-*) WORD(0):=CHR(INDEX); (*$R+*)
END
END; (* GETWORD *)
PROCEDURE ENTERTREE ( VAR SUBTREE: TREEPOINTER;
WORD: WORDTYPE;
LINE: COUNTER);
VAR
NEXTITEM: QUEUEPOINTER;
BEGIN (* ENTERTREE *)
IF SUBTREE = NIL THEN
BEGIN (* CREATE NEW ENTRY *)
NEW(SUBTREE);
WITH SUBTREE^ DO
BEGIN
LEFT := NIL;
RIGHT := NIL;
WITH ENTRY DO
BEGIN
WORDVALUE := WORD;
NEW(FIRSTINQUEUE);
LASTINQUEUE := FIRSTINQUEUE;
WITH FIRSTINQUEUE^ DO
BEGIN
LINENUMBER := LINE;
NEXTINQUEUE := NIL
END (* WITH FIRSTINQUEUE^ *)
END (* WITH ENTRY *)
END (* WITH SUBTREE^ *)
END
ELSE (* APPEND A LIST ITEM *)
WITH SUBTREE^,ENTRY DO
IF WORD = WORDVALUE THEN
BEGIN
IF LASTINQUEUE^.LINENUMBER <> LINE THEN
BEGIN
NEW(NEXTITEM);
WITH NEXTITEM^ DO
BEGIN
LINENUMBER := LINE;
NEXTINQUEUE := NIL
END; (* WITH NEXTITEM^ *)
LASTINQUEUE^.NEXTINQUEUE := NEXTITEM;
LASTINQUEUE := NEXTITEM
END
END
ELSE
IF WORD < WORDVALUE THEN
ENTERTREE(LEFT,WORD,LINE)
ELSE
ENTERTREE(RIGHT,WORD,LINE)
END; (* ENTERTREE *)
BEGIN (* BUILDTREE *)
CURRENTLINE := 1;
WHILE NOT EOF(INDFIL) DO
BEGIN
GETWORD(CURRENTWORD,CURRENTLINE);
SØGKEYWORD(CURRENTWORD);
IF NOT EOF(INDFIL) AND (NOT KEYWORD) THEN
ENTERTREE(TREE,CURRENTWORD,CURRENTLINE)
END (* WHILE *)
END; (* BUILDTREE *)
PROCEDURE PRINTTREE ( TREE: TREEPOINTER);
VAR
PAGEPOSITION: PAGEINDEX;
NUMBERWIDTH, MAXONLINE: LINEINDEX;
PAGECOUNTER: PAGENUMBER;
PROCEDURE PRINTENTRY ( SUBTREE: TREEPOINTER;
VAR POSITION: PAGEINDEX);
VAR
INDEX: WORDINDEX;
ITEMCOUNT: 0 .. MAXLINELEN;
ITEMPTR: QUEUEPOINTER;
PROCEDURE PRINTLINE ( VAR CURRENTPOSITION: PAGEINDEX;
NEWLINES: PAGEINDEX);
VAR
LINECOUNTER: PAGEINDEX;
BEGIN (* PRINTLINE *)
IF CURRENTPOSITION + NEWLINES < MAXONPAGE THEN
BEGIN
FOR LINECOUNTER := 1 TO NEWLINES DO
WRITELN(LIST);
CURRENTPOSITION := CURRENTPOSITION + NEWLINES
END
ELSE
BEGIN
WRITELN(LIST);
IF PAGECOUNTER > 1 THEN
PAGE( LIST );
WRITE(LIST,HEADING,FILNAVN:12,'DATE: ':15,CLOCK^.DATE);
WRITELN(LIST,' - PAGE ',PAGECOUNTER);
FOR LINECOUNTER := 1 TO HEADINGSIZE - 1 DO
WRITELN(LIST);
CURRENTPOSITION := HEADINGSIZE + 1;
PAGECOUNTER := PAGECOUNTER + 1
END
END; (* PRINTLINE *)
BEGIN (* PRINTENTRY *)
IF EOF(OUTPUT) THEN SLUT;
IF SUBTREE <> NIL THEN
WITH SUBTREE^ DO
BEGIN
PRINTENTRY(LEFT,POSITION);
PRINTLINE(POSITION,ENTRYGAP + 1);
WITH ENTRY DO
BEGIN
WRITE(LIST,WORDVALUE,'':(MAXWORDLEN-LENGTH(WORDVALUE)));
ITEMCOUNT := 0;
ITEMPTR := FIRSTINQUEUE;
WHILE ITEMPTR <> NIL DO
BEGIN
ITEMCOUNT := ITEMCOUNT + 1;
IF ITEMCOUNT > MAXONLINE THEN
BEGIN
PRINTLINE(POSITION,1);
WRITE(LIST,BLANK : MAXWORDLEN);
ITEMCOUNT := 1
END;
WRITE(LIST,ITEMPTR^.LINENUMBER : NUMBERWIDTH);
ITEMPTR := ITEMPTR^.NEXTINQUEUE
END (* WHILE *)
END; (* WITH ENTRY *)
PRINTENTRY(RIGHT,POSITION)
END (* WITH SUBTREE *)
END; (* PRINTENTRY *)
BEGIN (* PRINTTREE *)
NUMBERWIDTH := TRUNC(LN(MAXLINES)/LN(RADIX)) + 1 + NUMBERGAP;
MAXONLINE := (MAXLINELEN - MAXWORDLEN) DIV NUMBERWIDTH;
PAGEPOSITION := MAXONPAGE;
PAGECOUNTER := 1;
PRINTENTRY(TREE,PAGEPOSITION);
WRITELN(LIST);
PAGE( LIST )
END; (* PRINTTREE *)
BEGIN (* PXREF *)
WRITELN;
WRITELN('Pascal cross-reference program initiated');
LÆSKEYWORD;
IF PARM^(1) <> ' ' THEN
BEGIN
FILNAVN:=' ';
I:=1;
WHILE (PARM^(I)<> ' ') AND (PARM^(I)<>',') DO
BEGIN
FILNAVN(I):=PARM^(I);
I:=I+1;
END;
(*$R-*) FILNAVN(0):=CHR(I-1); (*$R+*)
RESET( INDFIL,FILNAVN );
IF IORESULT = 1 THEN
BEGIN
WRITELN('File not found');
SLUT;
END;
READLN( INDFIL );
POINTLIST := FALSE;
IF PARM^(I) = ',' THEN
POINTLIST:= PARM^(I+1) = 'L';
SMÅTILSTORE := TRUE;
LETTERS := (. 'A'..'Å' .);
END
ELSE
BEGIN
WRITELN;
FILNAVN := ' ';
WRITE('Enter file name: ');
READLN;
READ(FILNAVN);
IF EOF THEN SLUT;
RESET( INDFIL,FILNAVN );
IF IORESULT = 1 THEN
BEGIN
WRITELN('File not found');
SLUT;
END;
READLN( INDFIL );
POINTLIST:=TRUE;
JANEJ := 'Y';
WRITE('Convert small letters ? ');
EDIT( JANEJ );
IF EOF THEN SLUT;
IF JANEJ(1) IN (. 'y','Y' .) THEN
BEGIN
SMÅTILSTORE := TRUE;
LETTERS := (. 'A'..'Å' .);
END
ELSE
BEGIN
LETTERS := (. 'A'..'Å','a'..'å' .);
SMÅTILSTORE := FALSE;
END;
END;
IF POINTLIST THEN
WRITE('<>< 0>.');
INCLUDE:=FALSE;
TALOGTEGN := (. '0'..'9','^','_' .);
WORDTREE := NIL;
BUILDTREE(WORDTREE);
IF POINTLIST THEN
WRITELN;
PRINTTREE(WORDTREE);
CLOSE(INDFIL);
WRITELN('Cross-reference of ',FILNAVN,' completed');
END. (* PXREF *)