(* COPYRIGHT (C) 1978, REGENTS OF THE *) (* UNIVERSITY OF CALIFORNIA, SAN DIEGO *) PROCEDURE USESDECLARATION(MAGIC: BOOLEAN); LABEL 1; TYPE DCREC = RECORD DISKADDR: INTEGER; CODELENG: INTEGER END; VAR SEGDICT: RECORD DANDC: ARRAY[SEGRANGE] OF DCREC; SEGNAME: ARRAY[SEGRANGE] OF ALPHA; SEGKIND: ARRAY[SEGRANGE] OF INTEGER; TEXTADDR: ARRAY[SEGRANGE] OF INTEGER; FILLER: ARRAY[0..127] OF INTEGER END; FOUND: BOOLEAN; BEGADDR: INTEGER; LCP: CTP; LLEXSTK: LEXSTKREC; LNAME: ALPHA; LSY: SYMBOL; LOP: OPERATOR; LID: ALPHA; PROCEDURE GETTEXT(VAR FOUND: BOOLEAN); VAR LCP: CTP; SEGINDEX: INTEGER; BEGIN FOUND := FALSE; LCP := MODPTR; WHILE (LCP <> NIL) AND NOT FOUND DO IF LCP^.NAME = ID THEN FOUND := TRUE ELSE LCP := LCP^.NEXT; IF FOUND THEN BEGIN LSEPPROC := SEGTABLE[LCP^.SEGID].SEGKIND = 4; IF NOT LSEPPROC THEN BEGIN SEG := LCP^.SEGID; NEXTPROC := 1 END; BEGADDR := SEGTABLE[LCP^.SEGID].TEXTADDR; USEFILE := WORKCODE; END ELSE BEGIN FOUND := TRUE; IF LIBNOTOPEN THEN BEGIN RESET(LIBRARY,SYSTEMLIB); IF IORESULT <> 0 THEN BEGIN ERROR(187); FOUND := FALSE END ELSE IF BLOCKREAD(LIBRARY,SEGDICT,1,0) <> 1 THEN BEGIN ERROR(187); FOUND := FALSE END; END; IF FOUND THEN BEGIN LIBNOTOPEN := FALSE; SEGINDEX := 0; FOUND := FALSE; WHILE (SEGINDEX <= MAXSEG) AND (NOT FOUND) DO IF MAGIC THEN IF SEGDICT.SEGNAME[SEGINDEX] = LNAME THEN FOUND := TRUE ELSE SEGINDEX := SEGINDEX + 1 ELSE IF SEGDICT.SEGNAME[SEGINDEX] = ID THEN FOUND := TRUE ELSE SEGINDEX := SEGINDEX + 1; IF FOUND THEN BEGIN USEFILE := SYSLIBRARY; BEGADDR := SEGDICT.TEXTADDR[SEGINDEX]; LSEPPROC := SEGDICT.SEGKIND[SEGINDEX] = 4; IF NOT LSEPPROC THEN BEGIN IF MAGIC THEN SEG := 6 ELSE BEGIN SEG := NEXTSEG; NEXTSEG := NEXTSEG + 1; IF NEXTSEG > MAXSEG THEN ERROR(250) END; WITH SEGTABLE[SEG] DO BEGIN DISKADDR := 0; CODELENG := 0; SEGNAME := SEGDICT.SEGNAME[SEGINDEX]; IF INMODULE OR MAGIC THEN SEGKIND := 0 ELSE SEGKIND := SEGDICT.SEGKIND[SEGINDEX]; TEXTADDR := 0 END; NEXTPROC := 1 END END ELSE ERROR(190) (*NOT IN LIBRARY*) END END; IF BEGADDR = 0 THEN BEGIN ERROR(195); FOUND := FALSE END; IF FOUND THEN BEGIN USING := TRUE; PREVSYMCURSOR := SYMCURSOR; PREVLINESTART := LINESTART; PREVSYMBLK := SYMBLK - 2; SYMBLK := BEGADDR; GETNEXTPAGE; INSYMBOL END END (*GETTEXT*) ; BEGIN (*USESDECLARATION*) IF LEVEL <> 1 THEN ERROR(189); IF INMODULE AND NOT ININTERFACE THEN ERROR(192); IF NOT MAGIC THEN DLINKERINFO := TRUE; IF NOT USING THEN USINGLIST := NIL; REPEAT IF (NOT MAGIC) AND (SY <> IDENT) THEN ERROR(2) ELSE IF USING THEN BEGIN LCP := USINGLIST; WHILE LCP <> NIL DO IF LCP^.NAME = ID THEN GOTO 1 ELSE LCP := LCP^.NEXT; ERROR(188)(*UNIT MUST BE PREDECLARED IN MAIN PROG*); 1: END ELSE BEGIN IF MAGIC THEN BEGIN LNAME := 'TURTLE '; LSY := SY; LOP := OP; LID := ID END ELSE BEGIN LNAME := ID; WRITELN(OUTPUT); WRITELN(OUTPUT,ID,' [',MEMAVAIL:5,' words]'); WRITE(OUTPUT,'<',SCREENDOTS:4,'>') END; WITH LLEXSTK DO BEGIN DOLDSEG := SEG; SOLDPROC := NEXTPROC END; GETTEXT(FOUND); IF FOUND THEN BEGIN NEW(LCP,MODULE); WITH LCP^ DO BEGIN NAME := LNAME; NEXT := USINGLIST; IDTYPE := NIL; KLASS := MODULE; IF LSEPPROC THEN SEGID := -1 (*NO SEG*) ELSE SEGID := SEG END; ENTERID(LCP); USINGLIST := LCP; DECLARATIONPART(FSYS + [ENDSY]); IF NEXTPROC=1 (*NO PROCS DECLARED*) THEN LCP^.SEGID := -1; (*NO SEG*) SYMBLK := 9999; (*FORCE RETURN TO SOURCEFILE*) GETNEXTPAGE END; IF NOT LSEPPROC THEN WITH LLEXSTK DO BEGIN SEG := DOLDSEG; NEXTPROC := SOLDPROC END; LSEPPROC := FALSE; END; IF NOT MAGIC THEN BEGIN INSYMBOL; TEST := SY <> COMMA; IF TEST THEN IF SY <> SEMICOLON THEN ERROR(20) ELSE ELSE INSYMBOL END UNTIL TEST OR MAGIC; IF NOT MAGIC THEN IF SY = SEMICOLON THEN INSYMBOL ELSE ERROR(14) ELSE BEGIN SY := LSY; OP := LOP; ID := LID END; IF NOT USING THEN BEGIN IF INMODULE THEN USINGLIST := NIL; CLOSE(LIBRARY,LOCK); LIBNOTOPEN := TRUE END END (*USESDECLARATION*) ; PROCEDURE LABELDECLARATION; VAR LLP: LABELP; REDEF: BOOLEAN; BEGIN REPEAT IF SY = INTCONST THEN WITH DISPLAY[TOP] DO BEGIN LLP := FLABEL; REDEF := FALSE; WHILE (LLP <> NIL) AND NOT REDEF DO IF LLP^.LABVAL <> VAL.IVAL THEN LLP := LLP^.NEXTLAB ELSE BEGIN REDEF := TRUE; ERROR(166) END; IF NOT REDEF THEN BEGIN NEW(LLP); WITH LLP^ DO BEGIN LABVAL := VAL.IVAL; CODELBP := NIL; NEXTLAB := FLABEL END; FLABEL := LLP END; INSYMBOL END ELSE ERROR(15); IF NOT ( SY IN FSYS + [COMMA, SEMICOLON] ) THEN BEGIN ERROR(6); SKIP(FSYS+[COMMA,SEMICOLON]) END; TEST := SY <> COMMA; IF NOT TEST THEN INSYMBOL UNTIL TEST; IF SY = SEMICOLON THEN INSYMBOL ELSE ERROR(14) END (* LABELDECLARATION *) ; PROCEDURE CONSTDECLARATION; VAR LCP: CTP; LSP: STP; LVALU: VALU; BEGIN IF SY <> IDENT THEN BEGIN ERROR(2); SKIP(FSYS + [IDENT]) END; WHILE SY = IDENT DO BEGIN NEW(LCP,KONST); WITH LCP^ DO BEGIN NAME := ID; IDTYPE := NIL; NEXT := NIL; KLASS := KONST END; INSYMBOL; IF (SY = RELOP) AND (OP = EQOP) THEN INSYMBOL ELSE ERROR(16); CONSTANT(FSYS + [SEMICOLON],LSP,LVALU); ENTERID(LCP); LCP^.IDTYPE := LSP; LCP^.VALUES := LVALU; IF SY = SEMICOLON THEN BEGIN INSYMBOL; IF NOT (SY IN FSYS + [IDENT]) THEN BEGIN ERROR(6); SKIP(FSYS + [IDENT]) END END ELSE IF NOT ((SY = ENDSY) AND (INMODULE)) THEN ERROR(14) END END (*CONSTDECLARATION*) ; PROCEDURE TYPEDECLARATION; VAR LCP,LCP1,LCP2: CTP; LSP: STP; LSIZE: ADDRRANGE; BEGIN IF SY <> IDENT THEN BEGIN ERROR(2); SKIP(FSYS + [IDENT]) END; WHILE SY = IDENT DO BEGIN NEW(LCP,TYPES); WITH LCP^ DO BEGIN NAME := ID; IDTYPE := NIL; KLASS := TYPES END; INSYMBOL; IF (SY = RELOP) AND (OP = EQOP) THEN INSYMBOL ELSE ERROR(16); TYP(FSYS + [SEMICOLON],LSP,LSIZE); ENTERID(LCP); LCP^.IDTYPE := LSP; LCP1 := FWPTR; WHILE LCP1 <> NIL DO BEGIN IF LCP1^.NAME = LCP^.NAME THEN BEGIN LCP1^.IDTYPE^.ELTYPE := LCP^.IDTYPE; IF LCP1 <> FWPTR THEN LCP2^.NEXT := LCP1^.NEXT ELSE FWPTR := LCP1^.NEXT; END; LCP2 := LCP1; LCP1 := LCP1^.NEXT END; IF SY = SEMICOLON THEN BEGIN INSYMBOL; IF NOT (SY IN FSYS + [IDENT]) THEN BEGIN ERROR(6); SKIP(FSYS + [IDENT]) END END ELSE IF NOT ((SY = ENDSY) AND (INMODULE)) THEN ERROR(14) END; IF FWPTR <> NIL THEN BEGIN ERROR(117); FWPTR := NIL END END (*TYPEDECLARATION*) ; PROCEDURE VARDECLARATION; VAR LCP,NXT,IDLIST: CTP; LSP: STP; LSIZE: ADDRRANGE; BEGIN NXT := NIL; REPEAT REPEAT IF SY = IDENT THEN BEGIN IF INMODULE THEN NEW(LCP,ACTUALVARS,TRUE) ELSE NEW(LCP,ACTUALVARS,FALSE); WITH LCP^ DO BEGIN NAME := ID; NEXT := NXT; KLASS := ACTUALVARS; IDTYPE := NIL; VLEV := LEVEL; IF INMODULE THEN IF ININTERFACE THEN PUBLIC := TRUE ELSE PUBLIC := FALSE END; ENTERID(LCP); NXT := LCP; INSYMBOL; END ELSE ERROR(2); IF NOT (SY IN FSYS + [COMMA,COLON] + TYPEDELS) THEN BEGIN ERROR(6); SKIP(FSYS+[COMMA,COLON,SEMICOLON]+TYPEDELS) END; TEST := SY <> COMMA; IF NOT TEST THEN INSYMBOL UNTIL TEST; IF SY = COLON THEN INSYMBOL ELSE ERROR(5); IDLIST := NXT; TYP(FSYS + [SEMICOLON] + TYPEDELS,LSP,LSIZE); WHILE NXT <> NIL DO WITH NXT^ DO BEGIN IDTYPE := LSP; VADDR := LC; LC := LC + LSIZE; NXT := NEXT; IF NEXT = NIL THEN IF LSP <> NIL THEN IF LSP^.FORM = FILES THEN BEGIN (*PUT IDLIST INTO LOCAL FILE LIST*) NEXT := DISPLAY[TOP].FFILE; DISPLAY[TOP].FFILE := IDLIST END END; IF SY = SEMICOLON THEN BEGIN INSYMBOL; IF NOT (SY IN FSYS + [IDENT]) THEN BEGIN ERROR(6); SKIP(FSYS + [IDENT]) END END ELSE IF NOT ((SY = ENDSY) AND (INMODULE)) THEN ERROR(14) UNTIL (SY <> IDENT) AND NOT (SY IN TYPEDELS); IF FWPTR <> NIL THEN BEGIN ERROR(117); FWPTR := NIL END END (*VARDECLARATION*) ;