(* 3.12.1985 *) FUNCTION FPARM:INTEGER; (*LIEST DEN FORMALEN PARAMETERTEIL UND LIEFERT *) (*DIE ANZAHL DER PARAMETER ALS ERGEBNIS. ALLE *) (*PARAMETER WERDEN AB TX ABGELEGT. *) VAR OLDTX,I:INTEGER; BEGIN OLDTX:=TX; IF SYM=KLAUF THEN BEGIN GETSYM; REPEAT IF SYM=161(*VAR*) THEN BEGIN GETSYM;PARDCL(TRUE,TRUE) END ELSE PARDCL(TRUE,FALSE); I:=SYM;GETSYM UNTIL I<>SEMI; IF I<>KLZU THEN ERROR(4); END; FPARM:=TX-OLDTX END;(*FPARM*) PROCEDURE MOVE(UPROIND:INTEGER); (*FALLS BLOCK VALUE PARAMETER: MOV COMPILIEREN *) VAR I,TYP:INTEGER; BEGIN FOR I:=UPROIND+1 TO UPROIND+TABA2[UPROIND] DO BEGIN TYP:=TABA3[I]; IF TYP>=0 THEN IF INTEST(TYP,FELDTYP,VERBTYP)THEN BEGIN ZU.ACCESS:=BASEOFFSET;ZU.OFFSET:=TABA1[I]; ZU.LEVEL:=TABA2[I];GENF(ZU);GENLS(LSYM,ZU); GEN(MOVSYM);GENA(LEN(TYP)) END END END;(*MOVE*) PROCEDURE CHANGE(BLK:INTEGER); (*STEUERT ZUGRIFF AUF PARAMETER UND ERGEBNIS *) (*DES UNTERPROGRAMMES MIT DEM INDEX 'BLK' *) VAR K:INTEGER; BEGIN FOR K:=1 TO TABA2[BLK] DO TABBEZ[BLK+K,0]:=-TABBEZ[BLK+K,0]; IF TABART[BLK]=FKT THEN BEGIN K:=BLK+TABA2[BLK]+1; TABA1[K]:=NOT(TABA1[K]) END END;(*CHANGE*) BEGIN(*BLOCK*) LAST2:=LAST;GETSYM;IF SYM<>IDENT THEN ERROR(2); BLK:=POSITION(ID); IF BLKTYP=NUL THEN (*HAUPTPROGRAMM *) BEGIN GETSYM; IF SYM<>KLAUF THEN ERROR(505) ELSE BEGIN REPEAT GETSYM;K:=GETID; IF(K<>INFILE)AND(K<>OUTFILE) THEN ERROR(503); UNTIL SYM<>KOMMA; TEST(KLZU,4) END; DX:=HEAD-2;(*RA IM DESCRIPTOR NICHT BENUTZT *) LAST:=TX;ISFWD:=TRUE END ELSE BEGIN ISFWD:=BLK>=LAST; IF ISFWD THEN (*WAR UPRO FORWARD DEKLARIERT? *) ISFWD:=(TABART[BLK]=BLKTYP)AND(TABA3[BLK]<0); IF ISFWD THEN (*VERVOLLSTAENDIGE DEKLARATION *) BEGIN FWD:=FWD-1; FIXUP(ADDU(TABA1[BLK],3),PC); TABA3[BLK]:=-TABA3[BLK];LAST:=TX; IF TABA3[BLK]<>LVL-1 THEN ERROR(510); DX:=PARLENGTH(BLK);(*WERT BEI DEKLARATION *) CHANGE(BLK);GETSYM END ELSE (*PROZEDURKOPF AUSWERTEN *) BEGIN BLK:=TX;DX:=HEAD; EINTRAG(ID,BLKTYP,PC,0,LVL-1);GETSYM; LAST:=TX;K:=FPARM;TABA2[BLK]:=K; GENA(DX-2);(*LAGE DES SEGMENTDESCRIPTORS *) IF BLKTYP=FKT THEN BEGIN (*LOKALE ERG.VARIABLE EINFUEHREN *) TEST(DPKT,5);K:=GETID; IF TABART[K]=SAMET THEN K:=TABA1[K]; IF NOT INTEST(K,STDTYP,AUSSCH)AND (TABART[K]<>ZEIGTYP) THEN BEGIN ERROR(120);K:=INT END; EINTRAG(DUMMY,VARBLE,0,LVL,K) END END END; TEST(SEMI,14);DX2:=DX;(*INCL. PARAMETERTEIL *) TX2:=TX;FIXADR:=0;LBLI2:=LBLIND;FWDTYP:=-1; IF SYM=140(*FORWARD*)THEN BEGIN IF ISFWD THEN ERROR(161); TABA3[BLK]:=-TABA3[BLK];(*LVL<0 => FORWARD *) FWD:=FWD+1;GEN(JMPSYM);FRE; GETSYM;TEST(SEMI,14) END ELSE BEGIN (*BLOCK*) IF SYM=145(*LABEL*) THEN BEGIN GETSYM;LBLDECL END; IF SYM=132(*CONST*) THEN BEGIN GETSYM;CSTDECL END; IF SYM=159(*TYPE *) THEN BEGIN GETSYM;TYPDECL; IF FWDTYP<>-1 THEN BEGIN ERROR(117);FWDTYP:=-1 END; END; IF SYM=161(*VAR *) THEN BEGIN GETSYM;VARDECL END; WHILE(SYM=152)OR(SYM=141) DO BEGIN FIXFRE; IF SYM=152 THEN BLOCK(PROZ,LVL+1,LBLIND) ELSE BLOCK(FKT ,LVL+1,LBLIND) END; IF FIXADR<>0 THEN FIXUP(FIXADR,PC); (*ALLOCIERE PLATZ FUER LOKALE VAR*) IF DX>DX2 THEN BEGIN GEN(ALCSYM);GENA(DX-DX2) END; IF BLKTYP<>NUL THEN MOVE(BLK); (*INTERRUPTS ZULASSEN*) SYS(-28);IF PEEK(780)=3 THEN INTERRUPT; IF SYM<>130(*BEGIN*)THEN BEGIN ERROR(17);SYM:=130 END; STATEMENT; WHILE LBLIND>LBLI2 DO BEGIN LBLIND:=LBLIND-1; IF LBL[LBLIND].LEV<0 THEN ERROR(168) END; CASE BLKTYP OF FKT :BEGIN TEST(SEMI,14);(*ERGEBNISTYP: *) IF TABA3[BLK+TABA2[BLK]+1]=REALS THEN GEN(RFRSYM) ELSE GEN(RFISYM); CHANGE(BLK) END; PROZ:BEGIN GEN(RPRSYM);TEST(SEMI,14); CHANGE(BLK) END; NUL :BEGIN GEN(HLTSYM); IF SYM<>PUNKT THEN ERROR(20) END END END; TX:=TX2;LAST:=LAST2 END;(*BLOCK*) BEGIN(*MAIN PROGRAM*) WRITELN("“PASCAL 1.4"); WRITELN("·········· "); WRITELN("SELECT OPTION: "); WRITELN("0 CHECK SYNTAX"); WRITELN("1 GENERATE CODE"); WRITELN("ELSE LOCATE ADDRESS"); WRITE(" ==>1?");READLN(ERRORPC); CASE ERRORPC OF 0:GENFLG:=SYNTAX; 1:GENFLG:=MEMORY; ELSE GENFLG:=DETECT END;(*CASE*) WRITE(" P-CODE START ==>",ORG,"????"); READLN(STARTPC); (*\CROSS WRITELN("OFFSET IBUF OBUF HEAPPTR"); READLN(OFFSET,IBUF,OBUF,HEAPTR); (*CROSS*) WRITE(" LISTING TO PRINTER? ==>N?"); READLN(CH);PRTFLG:=CH<>"N"; OPEN(INCLUDE,3,0);(*LOG. FILENUMMER 1 BELEGEN *) IF PRTFLG THEN OPEN(LIST,4,0) ELSE OPEN(LIST,3,0); TX:=0;LAST:=0;FEHLER:=0;TSTFLG:=FALSE; WITHIND:=0;(*KEIN WITH-STATEMENT AKTIV *) DUMMY[0]:=STERN; OPCODE[0 ]:=PLUS ;OPCODE[1 ]:=MINUS; OPCODE[2 ]:=STERN ;OPCODE[3 ]:=133; OPCODE[4 ]:=146 ;OPCODE[5 ]:=128; OPCODE[6 ]:=150 ;OPCODE[7 ]:=255; OPCODE[8 ]:=GLEICH ;OPCODE[9 ]:=172; OPCODE[10]:=KLEINER ;OPCODE[11]:=173; OPCODE[12]:=GROESSER;OPCODE[13]:=171; EINTRAG(DUMMY,KONST ,BOOL ,0 ,0); EINTRAG(DUMMY,KONST ,BOOL ,1 ,0); EINTRAG(DUMMY,STDTYP ,1 ,BOOL ,0); EINTRAG(DUMMY,KONST ,INT ,32767,0); EINTRAG(DUMMY,STDTYP ,32767,INT ,0); EINTRAG(DUMMY,STDTYP ,255 ,CHART,0); EINTRAG(DUMMY,STDTYP ,32767,REALS,0); EINTRAG(DUMMY,ZEIGTYP,2 ,-1 ,0); EINTRAG(DUMMY,FELDTYP,0 ,INT ,CHART); EINTRAG(DUMMY,MENGE ,(SETSIZE+1)DIV 8,0,0); EINTRAG(DUMMY,SEQTYP ,8 ,CHART,0); FOR FWD:=11 TO 24 DO EINTRAG(DUMMY,PROZ,0,0,0); FOR FWD:=25 TO 44 DO EINTRAG(DUMMY,FKT ,0,0,0); EINTRAG(DUMMY,VARBLE,IBUF,0,TXTF); EINTRAG(DUMMY,VARBLE,OBUF,0,TXTF); PC:=VORBEL; FOR FWD:=0 TO 46 DO BEGIN TABBEZ[FWD,0]:=PEEK(PC )+256*PEEK(PC+1); TABBEZ[FWD,1]:=PEEK(PC+2)+256*PEEK(PC+3); TABBEZ[FWD,2]:=PEEK(PC+4)+256*PEEK(PC+5); TABBEZ[FWD,3]:=PEEK(PC+6)+8192; TABBEZ[FWD,4]:=8224; TABBEZ[FWD,5]:=8224; TABBEZ[FWD,6]:=8224; PC:=PC+7 END; SYS(UINIT);IF SYM<>153(*PROGRAM*)THEN ERROR(3); PC:=STARTPC;LAST:=TX;FWD:=0;FRE;BLOCK(NUL,1,0); FIXUP(STARTPC,PC);IF FWD<>0 THEN ERROR(117); WRITELN(LIST,"ERRORS DETECTED:",FEHLER); IF GENFLG<>SYNTAX THEN WRITELN(LIST,"P-CODE FROM",STARTPC," TO",PC); 8:WRITELN(" (HIT RETURN FOR MENU)");READLN(CH); 9:(*ABORT LABEL*) CLOSE(INCLUDE);CLOSE(LIST); (*\C-64 POKE(TEMPFLG,0); IF GENFLG=ONFILE THEN BEGIN CLOSE(FFILE);CLOSE(CFILE);CLOSE(COMMAND); POKE(TEMPFLG,1) END; (*C-64*) END.