(*23.6.1985 *) (*MIT MARK/RELEASE *) FUNCTION CALL(I:INTEGER):INTEGER; (*PROZEDUR-/FUNKTIONSAUFRUF COMPILIEREN: *) VAR J,K,TYPFORM:INTEGER;V:VARDESCRIPTOR; FUNCTION STD(I:INTEGER):INTEGER; (*STANDARD-PROZEDUR/FUNKTION *) (*FALLS FUNKTION: ERGEBNIS VON STD IST TYPINDEX*) CONST NEWSYM=14;SYSSYM=22; OPNSYM=52;CLSSYM=53;SICSYM=54;SOCSYM=55; CLRSYM=56;PUTSYM=57; GTSYM=58;RDISYM=59; RDCSYM=60;RDLSYM=61;WRISYM=62;WRCSYM=63; WRLSYM=64;WRSSYM=65;WRRSYM=66;RDRSYM=67; VAR X,FIND:INTEGER; (*FIND ZEIGT AUF TYPEINTRAG FUER LFD. FILE *) PROCEDURE INTEXP; (*AUSDRUCK VOM TYP INTEGER COMPILIEREN *) VAR T:INTEGER; BEGIN T:=EXPRESSION;TYPTEST(T,INT,144) END;(*INTEXP*) PROCEDURE RW(ISLN,ISREAD:BOOLEAN); LABEL 7; VAR FIRST,NOPAR:BOOLEAN;X:INTEGER; PROCEDURE DEFLT; (*FILE INPUT ODER OUTPUT ALS DEFAULT *) BEGIN IF ISREAD THEN BEGIN GENLDC(TABA1[ INFILE]);GEN(SICSYM) END ELSE BEGIN GENLDC(TABA1[OUTFILE]);GEN(SOCSYM) END END;(*DEFLT*) PROCEDURE CHECKF; (*TESTET X AUF FILEBEZEICNER UND CODIERT DANN*) (*ENTSPRECHENDE SIC/SOC SEQUENZ. *) (*AUSSERDEM TYPANPASSUNG X FUER AUSSCH *) BEGIN IF TABART[ZU.VTYP]=AUSSCH THEN X:=TABA2[ZU.VTYP] ELSE X:=ZU.VTYP; IF FIRST THEN BEGIN FIRST:=FALSE; IF TABART[X]=SEQTYP THEN BEGIN (*DESCRIPTOR-ADR. SCHON AUF STACK *) IF TABA2[X]<>CHART THEN ERROR(173); IF ISREAD THEN GEN(SICSYM) ELSE GEN(SOCSYM); GOTO 7 END ELSE DEFLT END END;(*CHECKF*) BEGIN(*RW*) NOPAR:=TRUE;FIRST:=TRUE; IF SYM<>KLAUF THEN DEFLT ELSE BEGIN GETSYM;(*PARAMETER LESEN *) REPEAT IF ISREAD THEN BEGIN IF SYM<>IDENT THEN ERROR(154); ZUW1(POSITION(ID));CHECKF; CASE X OF INT :GEN(RDISYM); CHART :GEN(RDCSYM); REALS :GEN(RDRSYM) ELSE ERROR(116) END;(*CASE*) ZUW2(X);(*EVTL. TEST BEI AUSSCH*) END ELSE BEGIN (*WRITE*) ZU.VTYP:=EXPRESSION;CHECKF; IF X=STRNG THEN BEGIN GENLDC(TABA1[STRNG])END; IF SYM=DPKT THEN BEGIN GETSYM;INTEXP END ELSE BEGIN GENLDC(0) END; CASE X OF CHART:GEN(WRCSYM); INT :GEN(WRISYM); STRNG:GEN(WRSSYM); REALS:GEN(WRRSYM) ELSE(*CASE*) ERROR(116) END(*CASE*) END; NOPAR:=FALSE; 7:X:=SYM;GETSYM UNTIL X<>KOMMA; IF X<>KLZU THEN ERROR(4) END; IF NOPAR AND NOT ISLN THEN ERROR(172); IF ISLN THEN IF ISREAD THEN GEN(RDLSYM) ELSE GEN(WRLSYM); GEN(CLRSYM) END;(*RW*) PROCEDURE FADR; (*FILEBEZEICHNER LESEN UND ADRESSE DES FILE- *) (*DESCRIPTOR COMPILIEREN. (FIND -> FILETYP) *) VAR V:VARDESCRIPTOR; BEGIN IF SYM<>IDENT THEN BEGIN ERROR(2);FIND:=INFILE END ELSE FIND:=POSITION(ID); VARIABLE(FIND,V);GENF(V);FIND:=V.VTYP; IF TABART[FIND]<>SEQTYP THEN BEGIN ERROR(171);FIND:=TXTF END END;(*FADR*) PROCEDURE FOPER(DIFF:INTEGER); (*FUER EOF/EOLN/STATUS: ADRESSE COMPILIEREN *) VAR V:VARDESCRIPTOR; BEGIN IF SYM=KLAUF THEN BEGIN GETSYM;FADR;TEST(KLZU,4); IF DIFF<>0 THEN BEGIN GENLDC(DIFF);GEN(ADUSYM) END END ELSE BEGIN FIND:=TXTF;GENLDC(TABA1[INFILE]+DIFF) END; V.ACCESS:=ABSOLUTE;GENLS(LSYM,V) END;(*FOPER*) PROCEDURE BRACKET; BEGIN TEST(KLAUF,9);INTEXP;TEST(KLZU,4) END;(*BRACKET*) BEGIN(*STD*) CASE I OF 11:(*OPEN*)BEGIN TEST(KLAUF,9);FADR; TEST(KOMMA,22);INTEXP;TEST(KOMMA,22); INTEXP;IF SYM=KOMMA THEN BEGIN GETSYM;X:=EXPRESSION; IF X<>STRNG THEN ERROR(116); GENLDC(TABA1[STRNG]) END ELSE BEGIN GENLDC(0);GENLDC(0) END; GEN(OPNSYM);TEST(KLZU,4) END; 12:(*CLOSE*)BEGIN TEST(KLAUF,9);FADR; GEN(CLSSYM);TEST(KLZU,4) END; 13:(*GET*)BEGIN TEST(KLAUF,9);FADR;GEN(SICSYM); GENLDC(LEN(TABA2[FIND]));GEN(GTSYM); GEN(CLRSYM);TEST(KLZU,4) END; 14:(*PUT*)BEGIN TEST(KLAUF,9);FADR;GEN(SOCSYM); GENLDC(LEN(TABA2[FIND]));GEN(PUTSYM); GEN(CLRSYM);TEST(KLZU,4) END; 15:(*WRITE*) RW(FALSE,FALSE); 16:(*WRITELN*)RW(TRUE ,FALSE); 17:(*READ*) RW(FALSE,TRUE ); 18:(*READLN*) RW(TRUE ,TRUE ); 19:(*POKE*) BEGIN TEST(KLAUF,9);INTEXP; TEST(KOMMA,22);INTEXP;TEST(KLZU,4); GEN(SPASYM) END; 20:(*SYS*) BEGIN BRACKET;GEN(SYSSYM) END; 21:(*HALT*)GEN(HLTSYM); 22:(*NEW*) BEGIN TEST(KLAUF,9);IF SYM<>IDENT THEN ERROR(2); ZUW1(POSITION(ID)); IF TABART[ZU.VTYP]<>ZEIGTYP THEN ERROR(116); GENLDC(LEN(TABA2[ZU.VTYP]));(*LAENGE OBJ.*) GEN(NEWSYM);ZUW2(ZU.VTYP);TEST(KLZU,4) END; 23:(*MARK*) BEGIN TEST(KLAUF,9);IF SYM<>IDENT THEN ERROR(2); ZUW1(POSITION(ID)); IF TABART[ZU.VTYP]<>ZEIGTYP THEN ERROR(116); GENLDC(HEAPPTR);(*ADR. HEAPPOINTER *) V.ACCESS:=ABSOLUTE;GENLS(LSYM,V); ZUW2(ZU.VTYP);TEST(KLZU,4) END; 24:(*RELEASE*) BEGIN TEST(KLAUF,9); GENLDC(HEAPPTR);(*ADR. HEAPPOINTER *) IF TABART[EXPRESSION]<>ZEIGTYP THEN ERROR(116); V.ACCESS:=ABSOLUTE;GENLS(SSYM,V); TEST(KLZU,4) END; 25:(*ORD*) BEGIN TEST(KLAUF,9); IF ISLONG(EXPRESSION)THEN ERROR(144); TEST(KLZU,4);STD:=INT END; 26:(*CHR*) BEGIN BRACKET;STD:=CHART END; 27,28:(*SUCC/PRED*) BEGIN TEST(KLAUF,9);X:=EXPRESSION; IF ISLONG(X) THEN BEGIN ERROR(144);X:=INT END; TEST(KLZU,4);GENLDC(1); IF I=27 (*SUCC*) THEN GENOP(PLUS) ELSE GENOP(MINUS); IF TSTFLG THEN (*LAUFZEITTEST*) CASE TABART[X] OF AUSSCH:BEGIN GEN(TSTSYM);GENA(TABA3[X]); GENA(TABA3[X]+TABA1[X]) END; AUFZHL:BEGIN GEN(TSTSYM);GENA(0); GENA(TABA1[X]) END ELSE(*KEIN TEST*) END;(*CASE*) STD:=X; END; 29:(*PEEK*) BEGIN BRACKET;GEN(LPASYM);STD:=INT END; 30:(*EOLN*) BEGIN FOPER(2);IF FIND<>TXTF THEN ERROR(173); STD:=BOOL END; 31:(*EOF *)BEGIN FOPER(0);STD:=BOOL END; 32:(*STATUS*)BEGIN FOPER(4);STD:=INT END; 33:(*ODD*) BEGIN BRACKET;GENLDC(1);GENOP(128);(*LDC 1, AND*) STD:=BOOL END; 34:(*ABS*) BEGIN TEST(KLAUF,9);X:=EXPRESSION; IF X<>REALS THEN BEGIN TYPTEST(X,INT,125);GEN(ABISYM) END ELSE GENROP(6); TEST(KLZU,4);STD:=X END; 35,36,37,38,39,40,41: BEGIN (*SQRT,LN,EXP,SIN,COS,TAN,ATN*) TEST(KLAUF,9); X:=EXPRESSION;TYPTEST(X,REALS,125); GENROP(I-35+7); TEST(KLZU,4);STD:=REALS END; 42:(*INT*) BEGIN TEST(KLAUF,9); IF EXPRESSION<>REALS THEN ERROR(125) ELSE GEN(INTSYM); TEST(KLZU,4);STD:=INT END; 43:(*POWER*) BEGIN TEST(KLAUF,9);X:=EXPRESSION; TYPTEST(X,REALS,125);TEST(KOMMA,22); X:=EXPRESSION;TYPTEST(X,REALS,125); GENROP(4);TEST(KLZU,4);STD:=REALS END; 44:(*ADDU *) BEGIN TEST(KLAUF,9);INTEXP; TEST(KOMMA,22);INTEXP;TEST(KLZU,4); GEN(ADUSYM);STD:=INT END END(*CASE*) END;(*STD*) BEGIN(*CALL*) IF TABA1[I]=0 THEN CALL:=STD(I) ELSE BEGIN GEN(MSTSYM);(*RESERVIERE PLATZ: FR,DL,SR,RA *) IF TABA2[I]=0 THEN BEGIN IF SYM=KLAUF THEN ERROR(126) END ELSE BEGIN TEST(KLAUF,9);J:=I+1; REPEAT (*PARAMETER AUF DEN STACK *) TYPFORM:=TABA3[J]; IF TYPFORM<0 THEN BEGIN(*REFERENCE=> ABSOLUTE ADR. AUF STACK*) IF SYM<>IDENT THEN ERROR(154); VARIABLE(POSITION(ID),V);GENF(V); IF V.ISPACKED THEN ERROR(504); IF V.VTYP<>-TYPFORM THEN ERROR(127) END(*REF*) ELSE BEGIN(*CALL BY VALUE *) K:=EXPRESSION; TYPTEST(K,TYPFORM,127); IF INTEST(K,FELDTYP,VERBTYP)THEN BEGIN (*ADRESSE, ABER PLATZ FUER OBJEKT *) GEN(ALCSYM);GENA(LEN(K)-2) END END;(*VALUE*) J:=J+1;K:=SYM;GETSYM; UNTIL K<>KOMMA; IF K<>KLZU THEN ERROR(4); IF J<>I+TABA2[I]+1 THEN ERROR(126); END; GEN(CUPSYM);GENA(TABA1[I]); GEN(LVL-ABS(TABA3[I]));(*STATIC LEVEL DES UPRO*) IF TABART[I]=FKT THEN CALL:=TABA3[I+TABA2[I]+1]; (*ERGEBNISTYP BEI FUNKTIONEN UEBERGEBEN *) END END;(*CALL*)