home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 02 / proccall.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-02-06  |  26.8 KB  |  759 lines
  1.       PROCEDURE CallProcedure (ESets: Symbolmenge; BezPtr: KonstP);
  2.  
  3.       VAR StdProcIndex: 1..17;  Umfang: INTEGER;
  4.  
  5.  
  6.         PROCEDURE Variable (ESets: Symbolmenge;
  7.                             VAR TopNew,StkMax: INTEGER;
  8.                             VAR KonstPtr: CstPtrArray;
  9.                             VAR KonstPtrIndex: INTEGER;
  10.                             VAR PInf: KonstP);
  11.  
  12.         VAR locc: KonstP;
  13.  
  14.         BEGIN
  15.           IF Symb = Bezeich THEN BEGIN
  16.             FindeBez([VarClass,FieldClass],locc);  GetSymbol
  17.           END
  18.           ELSE BEGIN
  19.             Error(2);  locc := UVarPtr
  20.           END;
  21.           Selector(ESets,locc,TopNew,StkMax,KonstPtr,KonstPtrIndex,PInf);
  22.         END;
  23.  
  24.  
  25.         FUNCTION FileOperation: BOOLEAN;
  26.  
  27.         VAR ok: BOOLEAN;
  28.  
  29.         BEGIN
  30.           ok := FALSE;
  31.           Variable(ESets+[rBrace],TopNew,StkMax,KonstPtr,KonstPtrIndex,PInf);
  32.           WITH Attr DO
  33.             IF TyPtr = NIL THEN Error(2)
  34.             ELSE IF TyPtr^.Form <> Files THEN Error(116)
  35.             ELSE BEGIN
  36.               PushAddress(TopNew,StkMax,KonstPtr,KonstPtrIndex); (* FIBADRESSE *)
  37.               G2(51,(*LDC*)1(*I*),TyPtr^.Size-1,TopNew,StkMax,KonstPtr);
  38.               (* LAENGE DES FILEPUFFERS *)
  39.               ok := TRUE;
  40.             END;
  41.             FileOperation := ok
  42.         END;
  43.  
  44.  
  45.         PROCEDURE GetPut;
  46.  
  47.         BEGIN
  48.           IF FileOperation THEN G1(30,StdProcIndex,TopNew,StkMax,KonstPtr)
  49.         END;
  50.  
  51.  
  52.         PROCEDURE Close;
  53.  
  54.         BEGIN
  55.           Variable(ESets+[rBrace],TopNew,StkMax,KonstPtr,KonstPtrIndex,PInf);
  56.           WITH Attr DO
  57.             IF TyPtr <> NIL THEN
  58.               IF TyPtr^.Form <> Files THEN Error(116)
  59.               ELSE BEGIN
  60.                 PushAddress(TopNew,StkMax,KonstPtr,KonstPtrIndex);
  61.                 G2(51,(*LDC*)1,TyPtr^.Size-1,TopNew,StkMax,KonstPtr);
  62.                 (* FILEPUFFERLAENGE*)
  63.                 G1(30,33(*CLS*),TopNew,StkMax,KonstPtr)
  64.               END
  65.         END;
  66.  
  67.  
  68.         FUNCTION OpenFile: BOOLEAN;
  69.  
  70.         VAR IsTextFile, ok: BOOLEAN;
  71.  
  72.         BEGIN
  73.           ok := FALSE;
  74.           Variable(ESets+[CommaSymb,rBrace],TopNew,StkMax,
  75.                    KonstPtr,KonstPtrIndex,PInf);
  76.           WITH Attr DO
  77.             IF TyPtr <> NIL THEN
  78.               IF TyPtr^.Form <> Files THEN Error(116)
  79.               ELSE BEGIN
  80.                 IsTextFile := TyPtr^.FileType = CharPtr;
  81.                 PushAddress(TopNew,StkMax,KonstPtr,KonstPtrIndex);
  82.                 (* LAENGE FILEPUFFER *)
  83.                 G2(51(*LDC*),1,TyPtr^.Size-1,TopNew,StkMax,KonstPtr);
  84.               END;
  85.           IF Symb <> CommaSymb THEN Error(20)
  86.           ELSE BEGIN
  87.             GetSymbol;   Expression(ESets+[rBrace]);
  88.             IF Attr.TyPtr = NIL THEN Error(116)
  89.             ELSE PushAddress(TopNew,StkMax,KonstPtr,KonstPtrIndex);
  90.             G2(51,1,Attr.TyPtr^.Size,TopNew,StkMax,KonstPtr);
  91.             ok := TRUE;
  92.           END;
  93.           G2(51,1,Ord(IsTextFile),TopNew,StkMax,KonstPtr);
  94.           OpenFile := ok;
  95.         END;
  96.  
  97.  
  98.         PROCEDURE ReWrite;
  99.  
  100.         BEGIN
  101.           IF OpenFile THEN G1(30,31(*RWR*),TopNew,StkMax,KonstPtr);
  102.         END;
  103.  
  104.  
  105.         PROCEDURE ReSet;
  106.  
  107.         BEGIN
  108.           IF OpenFile THEN G1(30,32(*RES*),TopNew,StkMax,KonstPtr)
  109.         END;
  110.  
  111.  
  112.         PROCEDURE Read;
  113.  
  114.         VAR
  115.           locc: KonstP;
  116.           ActBSt: BStRange;
  117.           ToAddr: AddressRange;
  118.           SavSP:StP;
  119.  
  120.         BEGIN
  121.           ActBSt := 1;  ToAddr := VirginLocStk;
  122.           IF Symb = lBraces THEN BEGIN
  123.             GetSymbol;
  124.             Variable(ESets+[CommaSymb,rBrace],TopNew,StkMax,
  125.                      KonstPtr,KonstPtrIndex,PInf);
  126.             SavSP := Attr.TyPtr;  Stop := FALSE;
  127.             IF SavSP <> NIL THEN
  128.               IF SavSP^.Form = Files THEN
  129.                 WITH Attr,SavSP^ DO BEGIN
  130.                   IF FileType = CharPtr THEN BEGIN
  131.                     ActBSt := VarBSt;  ToAddr := OffSet
  132.                   END
  133.                   ELSE Error(399);
  134.                   IF Symb = rBrace THEN BEGIN
  135.                     IF StdProcIndex = 5 THEN Error(116);
  136.                     Stop := TRUE
  137.                   END
  138.                   ELSE IF Symb <> CommaSymb THEN BEGIN
  139.                     Error(116);
  140.                     Recover(ESets+[CommaSymb,rBrace])
  141.                   END;
  142.                   IF Symb = CommaSymb THEN BEGIN
  143.                     GetSymbol;
  144.                     Variable(ESets+[CommaSymb,rBrace],TopNew,StkMax,
  145.                              KonstPtr,KonstPtrIndex,PInf);
  146.                   END
  147.                   ELSE Stop := TRUE
  148.                 END;  (* WITH *)
  149.             IF NOT Stop THEN
  150.               REPEAT
  151.                 PushAddress(TopNew,StkMax,KonstPtr,KonstPtrIndex);
  152.                 G2(50,Bst-ActBSt,ToAddr,TopNew,StkMax,KonstPtr);
  153.                 IF Attr.TyPtr <> NIL THEN
  154.                   IF Attr.TyPtr^.Form <= SubRange THEN
  155.                     IF IsCompatible(IntPtr,Attr.TyPtr) THEN
  156.                       G1(30,3,TopNew,StkMax,KonstPtr)
  157.                     ELSE IF IsCompatible(RealPtr,Attr.TyPtr) THEN
  158.                       G1(30,4,TopNew,StkMax,KonstPtr)
  159.                     ELSE IF IsCompatible(CharPtr,Attr.TyPtr) THEN
  160.                       G1(30,5,TopNew,StkMax,KonstPtr)
  161.                     ELSE IF IsCompatible(LongPtr,Attr.TyPtr) THEN
  162.                       G1(30,29(*RDL*),TopNew,StkMax,KonstPtr)
  163.                     ELSE Error(399)
  164.                   ELSE Error(116);
  165.                 Stop := Symb<>CommaSymb;
  166.                 IF NOT Stop THEN BEGIN
  167.                   GetSymbol;
  168.                   Variable(ESets+[CommaSymb,rBrace],TopNew,StkMax,
  169.                            KonstPtr,KonstPtrIndex,PInf)
  170.                 END
  171.               UNTIL Stop;
  172.             IF Symb = rBrace THEN GetSymbol ELSE Error(4)
  173.           END (* IF SYMB = LBRACES *)
  174.           ELSE IF StdProcIndex = 5 THEN Error(116);
  175.           IF StdProcIndex = 11 THEN BEGIN
  176.             G2(50,Bst-ActBSt,ToAddr,TopNew,StkMax,KonstPtr);
  177.             G1(30,21,TopNew,StkMax,KonstPtr)
  178.           END;
  179.         END;
  180.  
  181.  
  182.         PROCEDURE Write;
  183.  
  184.         VAR
  185.           SavSP: StP;
  186.           Default: BOOLEAN;
  187.           IsStdProc: 1..17;
  188.           locc: KonstP;
  189.           ActBSt: BStRange;
  190.           ToAddr,SLaenge: AddressRange;
  191.  
  192.         BEGIN
  193.           IsStdProc := StdProcIndex;  ActBSt := 1;  ToAddr := VirginLocStk+2;
  194.           IF Symb = lBraces THEN BEGIN
  195.             GetSymbol;
  196.             Expression(ESets+[CommaSymb,ColonSymb,rBrace]);
  197.             SavSP := Attr.TyPtr;  Stop := FALSE;
  198.             IF SavSP <> NIL THEN
  199.               IF SavSP^.Form = Files THEN
  200.                 WITH Attr,SavSP^ DO BEGIN
  201.                   IF FileType = CharPtr THEN BEGIN
  202.                     ActBSt := VarBSt;
  203.                     ToAddr := OffSet (* +FIBSIZE+ORD(ODD(DPLMT)) *)
  204.                   END
  205.                   ELSE Error(125);
  206.                   IF Symb = rBrace THEN BEGIN
  207.                     IF IsStdProc = 6 THEN Error(116);
  208.                     Stop := TRUE
  209.                   END
  210.                   ELSE IF Symb <> CommaSymb THEN BEGIN
  211.                     Error(116);
  212.                     Recover(ESets+[CommaSymb,rBrace])
  213.                   END;
  214.                   IF Symb = CommaSymb THEN BEGIN
  215.                     GetSymbol;
  216.                     Expression(ESets+[CommaSymb,ColonSymb,rBrace]);
  217.                   END
  218.                   ELSE Stop := TRUE
  219.                 END (* WITH *)
  220.               ELSE ;
  221.             IF NOT Stop THEN
  222.               REPEAT
  223.                 SavSP := Attr.TyPtr;
  224.                 IF SavSP <> NIL THEN
  225.                   IF SavSP^.Form <= SubRange THEN
  226.                     PushContents(TopNew,StkMax,KonstPtr,KonstPtrIndex)
  227.                   ELSE
  228.                     PushAddress(TopNew,StkMax,KonstPtr,KonstPtrIndex);
  229.                 (* IF LSP=REALPTR THEN GEN2(51,7,0); *)
  230.                 IF Symb = ColonSymb THEN BEGIN
  231.                   GetSymbol;
  232.                   Expression(ESets+[CommaSymb,ColonSymb,rBrace]);
  233.                   IF Attr.TyPtr <> NIL THEN
  234.                     IF (Attr.TyPtr <> IntPtr) AND (Attr.TyPtr <> LongPtr) THEN
  235.                       Error(166);
  236.                   PushContents(TopNew,StkMax,KonstPtr,KonstPtrIndex);
  237.                   Default := FALSE
  238.                 END
  239.                 ELSE Default := TRUE;
  240.                 IF Symb = ColonSymb THEN BEGIN
  241.                   GetSymbol;
  242.                   Expression(ESets+[CommaSymb,rBrace]);
  243.                   IF Attr.TyPtr <> NIL THEN
  244.                     IF Attr.TyPtr <> IntPtr THEN Error(116);
  245.                   IF SavSP <> RealPtr THEN Error(124);
  246.                   PushContents(TopNew,StkMax,KonstPtr,KonstPtrIndex);
  247.                   (* DEF1 := FALSE; *)
  248.                 END
  249.                 ELSE (* DEF1 := TRUE; *)
  250.                 IF SavSP = IntPtr THEN BEGIN
  251.                   IF Default THEN
  252.                     G2(51,1,1,TopNew,StkMax,KonstPtr);
  253.                   G2(50,Bst-ActBSt,ToAddr,TopNew,StkMax,KonstPtr);
  254.                   G1(30,6,TopNew,StkMax,KonstPtr)
  255.                 END
  256.                 ELSE IF SavSP = RealPtr THEN BEGIN
  257.                   IF Default THEN
  258.                     G2(51,1,10,TopNew,StkMax,KonstPtr);
  259.                   (* IF DEF1 THEN GEN2(51,1,4); *)
  260.                   G2(50,Bst-ActBSt,ToAddr,TopNew,StkMax,KonstPtr);
  261.                   G1(30,8,TopNew,StkMax,KonstPtr)
  262.                 END
  263.                 ELSE IF SavSP = CharPtr THEN BEGIN
  264.                   IF Default THEN
  265.                     G2(51,1,1,TopNew,StkMax,KonstPtr);
  266.                   G2(50,Bst-ActBSt,ToAddr,TopNew,StkMax,KonstPtr);
  267.                   G1(30,9,TopNew,StkMax,KonstPtr)
  268.                 END
  269.                 ELSE IF SavSP = LongPtr THEN BEGIN
  270.                   IF Default THEN
  271.                     G2(51,1,1,TopNew,StkMax,KonstPtr);
  272.                   G2(50,Bst-ActBSt,ToAddr,TopNew,StkMax,KonstPtr);
  273.                   G1(30,30(*WRL*),TopNew,StkMax,KonstPtr);
  274.                 END
  275.                 ELSE IF SavSP <> NIL THEN BEGIN
  276.                   IF SavSP^.Form = Scalar THEN Error(399)
  277.                   ELSE IF Strng(SavSP) THEN BEGIN
  278.                     SLaenge := SavSP^.Size DIV CharMax;
  279.                     IF Default THEN
  280.                       G2(51,1,SLaenge,TopNew,StkMax,KonstPtr);
  281.                     G2(51,1,SLaenge,TopNew,StkMax,KonstPtr);
  282.                     G2(50,Bst-ActBSt,ToAddr,TopNew,StkMax,KonstPtr);
  283.                     G1(30,10,TopNew,StkMax,KonstPtr)
  284.                   END
  285.                   ELSE Error(116)
  286.                 END;
  287.                 Stop := Symb <> CommaSymb;
  288.                 IF NOT Stop THEN BEGIN
  289.                   GetSymbol;      (*GEN2(51,7,0); *)
  290.                   Expression(ESets+[CommaSymb,ColonSymb,rBrace])
  291.                 END
  292.               UNTIL Stop;
  293.             IF Symb = rBrace THEN GetSymbol ELSE Error(4)
  294.           END (* IF SYMB = LBRACES *)
  295.           ELSE IF StdProcIndex = 6 THEN Error(116);
  296.           IF IsStdProc = 12 THEN BEGIN
  297.             G2(50,Bst-ActBSt,ToAddr,TopNew,StkMax,KonstPtr);
  298.             G1(30,22,TopNew,StkMax,KonstPtr)
  299.           END;
  300.         END;
  301.  
  302.  
  303.         PROCEDURE Pack;
  304.  
  305.         VAR
  306.           SavSP,SavSP1: StP;
  307.           LastAttr: Attribut;
  308.           Moved: INTEGER;
  309.  
  310.         BEGIN
  311.           Variable(ESets+[CommaSymb,rBrace],TopNew,StkMax,
  312.                    KonstPtr,KonstPtrIndex,PInf);
  313.           SavSP := NIL;  SavSP1 := NIL;
  314.           IF Attr.TyPtr <> NIL THEN
  315.             WITH Attr.TyPtr^ DO
  316.               IF Form = Arrays THEN BEGIN
  317.                 PushAddress(TopNew,StkMax,KonstPtr,KonstPtrIndex);
  318.                 LastAttr := Attr;  SavSP := IndexType;  SavSP1 := ElemType;
  319.               END
  320.               ELSE Error(116);
  321.           IF Symb = CommaSymb THEN GetSymbol ELSE Error(20);
  322.           Expression(ESets+[CommaSymb,rBrace]);
  323.           IF Attr.TyPtr <> NIL THEN
  324.             IF Attr.TyPtr^.Form <> Scalar THEN Error(116)
  325.             ELSE IF NOT IsCompatible(SavSP,Attr.TyPtr) THEN Error(116)
  326.             ELSE BEGIN (* ALLES OK *)
  327.               PushContents(TopNew,StkMax,KonstPtr,KonstPtrIndex);
  328.               (* STARTINDEX AUF STACK *)
  329.               WITH LastAttr.TyPtr^ DO BEGIN
  330.                 G2(51,1,INDEXTYPE^.Min.GanzeZahl,TopNew,StkMax,KonstPtr);
  331.                 (* LOWBOUND AUF STACK *)
  332.                 G0(21(* SBI *),TopNew,StkMax);
  333.                 G2(51,(* LDC *)1,ELEMTYPE^.Size,TopNew,StkMax,KonstPtr);
  334.                 (* SIZE(TYP(QUELLE)) AUF STACK *)
  335.                 G0(15(* MPI *),TopNew,StkMax);
  336.                 G0(2(* ADI *),TopNew,StkMax);
  337.               END;
  338.             END;
  339.           IF Symb = CommaSymb THEN GetSymbol ELSE Error(20);
  340.           Variable(ESets+[rBrace],TopNew,StkMax,
  341.                    KonstPtr,KonstPtrIndex,PInf);
  342.           IF Attr.TyPtr <> NIL THEN
  343.             WITH Attr.TyPtr^ DO
  344.               IF Form = Arrays THEN BEGIN
  345.                 IF NOT IsCompatible(ElemType,SavSP1)
  346.                 OR NOT IsCompatible(IndexType,SavSP) THEN
  347.                   Error(116)
  348.                 ELSE (* OK *) BEGIN
  349.                   PushAddress(TopNew,StkMax,KonstPtr,KonstPtrIndex);
  350.                   WITH Attr.TyPtr^ DO BEGIN
  351.                     Moved := (INDEXTYPE^.Max.GanzeZahl-INDEXTYPE^.Min.GanzeZahl+1)
  352.                              * ELEMTYPE^.Size;
  353.                     G1(40,(* MOV *)Moved,TopNew,StkMax,KonstPtr);
  354.                   END
  355.                 END
  356.               END
  357.               ELSE Error(116);
  358.         END;
  359.  
  360.  
  361.         PROCEDURE UnPack;
  362.  
  363.         VAR SavSP,SavSP1: StP;
  364.  
  365.         BEGIN
  366.           Error(399);
  367.           Variable(ESets+[CommaSymb,rBrace],TopNew,StkMax,
  368.                    KonstPtr,KonstPtrIndex,PInf);
  369.           SavSP := NIL;   SavSP1 := NIL;
  370.           IF Attr.TyPtr <> NIL THEN
  371.             WITH Attr.TyPtr^ DO
  372.               IF Form = Arrays THEN BEGIN
  373.                 SavSP := IndexType;  SavSP1 := ElemType
  374.               END
  375.               ELSE Error(116);
  376.           IF Symb = CommaSymb THEN GetSymbol ELSE Error(20);
  377.           Variable(ESets+[CommaSymb,rBrace],TopNew,StkMax,
  378.                    KonstPtr,KonstPtrIndex,PInf);
  379.           IF Attr.TyPtr <> NIL THEN
  380.             WITH Attr.TyPtr^ DO
  381.               IF Form = Arrays THEN BEGIN
  382.                 IF NOT IsCompatible(ElemType,SavSP1)
  383.                 OR NOT IsCompatible(IndexType,SavSP) THEN
  384.                   Error(116)
  385.               END
  386.               ELSE Error(116);
  387.           IF Symb = CommaSymb THEN GetSymbol ELSE Error(20);
  388.           Expression(ESets+[rBrace]);
  389.           IF Attr.TyPtr <> NIL THEN
  390.             IF Attr.TyPtr^.Form <> Scalar THEN Error(116)
  391.             ELSE IF NOT IsCompatible(SavSP,Attr.TyPtr) THEN Error(116);
  392.         END;
  393.  
  394.  
  395.         PROCEDURE New;
  396.  
  397.         LABEL 1;
  398.  
  399.         VAR
  400.           SavSP,SavSP1: StP;
  401.           NoOfVariants,lmin,lmax: INTEGER;
  402.           ActSize,lsz: AddressRange;
  403.           SavVal: Value;
  404.  
  405.         BEGIN
  406.           Variable(ESets+[CommaSymb,rBrace],TopNew,StkMax,
  407.                    KonstPtr,KonstPtrIndex,PInf);
  408.           PushAddress(TopNew,StkMax,KonstPtr,KonstPtrIndex);
  409.           SavSP := NIL;  NoOfVariants := 0;  ActSize := 0;
  410.           IF Attr.TyPtr <> NIL THEN
  411.             WITH Attr.TyPtr^ DO
  412.               IF Form = Pointers THEN BEGIN
  413.                 IF ElType <> NIL THEN BEGIN
  414.                   ActSize := ElType^.Size;
  415.                   IF ElType^.Form = Records THEN SavSP := ElType^.RecVar
  416.                 END
  417.               END
  418.               ELSE Error(116);
  419.           WHILE Symb = CommaSymb DO BEGIN
  420.             GetSymbol;
  421.             GConstant(ESets+[CommaSymb,rBrace],SavSP1,SavVal);
  422.             NoOfVariants := NoOfVariants+1;
  423.             IF SavSP = NIL THEN Error(158)
  424.             ELSE IF SavSP^.Form <> TagFld THEN Error(162)
  425.             ELSE IF SavSP^.TagFieldP <> NIL THEN
  426.               IF Strng(SavSP1) OR (SavSP1 = RealPtr) THEN Error(159)
  427.               ELSE IF IsCompatible(SavSP^.TAGFIELDP^.BezType,SavSP1) THEN BEGIN
  428.                 SavSP1 := SavSP^.FirstVar;
  429.                 WHILE SavSP1 <> NIL DO
  430.                   WITH SavSP1^ DO
  431.                     IF VarWert.GanzeZahl = SavVal.GanzeZahl THEN BEGIN
  432.                       ActSize := Size;  SavSP := VarTVar;
  433.                       GOTO 1
  434.                     END
  435.                     ELSE SavSP1 := NxtVar;
  436.                 ActSize := SavSP^.Size;  SavSP := NIL;
  437.               END
  438.               ELSE Error(116);
  439.           1:
  440.           END;
  441.           G2(51,1,ActSize,TopNew,StkMax,KonstPtr);
  442.           G1(30,12,TopNew,StkMax,KonstPtr);
  443.         END;
  444.  
  445.  
  446.         (* DISPOSE NEU EINGEFUEGT. P-CODE : "DSP" *)
  447.         PROCEDURE Dispos;
  448.  
  449.         BEGIN
  450.           Variable(ESets+[rBrace],TopNew,StkMax,
  451.                    KonstPtr,KonstPtrIndex,PInf);
  452.           IF Attr.TyPtr <> NIL THEN
  453.             IF Attr.TyPtr^.Form = Pointers THEN BEGIN
  454.               PushContents(TopNew,StkMax,KonstPtr,KonstPtrIndex);
  455.               G1(30,28(*DSP*),TopNew,StkMax,KonstPtr)
  456.             END
  457.             ELSE Error(116)
  458.         END;
  459.  
  460.  
  461.         PROCEDURE Mark;
  462.  
  463.         BEGIN
  464.           Variable(ESets+[rBrace],TopNew,StkMax,
  465.                    KonstPtr,KonstPtrIndex,PInf);
  466.           IF Attr.TyPtr <> NIL THEN
  467.             IF Attr.TyPtr^.Form = Pointers THEN BEGIN
  468.               PushAddress(TopNew,StkMax,KonstPtr,KonstPtrIndex);
  469.               G1(30,23,TopNew,StkMax,KonstPtr)
  470.             END
  471.             ELSE Error(116);
  472.         END;
  473.  
  474.  
  475.         PROCEDURE Release;
  476.  
  477.         BEGIN
  478.           Variable(ESets+[rBrace],TopNew,StkMax,
  479.                    KonstPtr,KonstPtrIndex,PInf);
  480.           IF Attr.TyPtr <> NIL THEN
  481.             IF Attr.TyPtr^.Form = Pointers THEN BEGIN
  482.               PushContents(TopNew,StkMax,KonstPtr,KonstPtrIndex);
  483.               G1(30,13,TopNew,StkMax,KonstPtr) END
  484.             ELSE Error(116);
  485.         END;
  486.  
  487.  
  488.         PROCEDURE Abs;
  489.  
  490.         BEGIN
  491.           IF Attr.TyPtr <> NIL THEN
  492.             IF Attr.TyPtr = IntPtr THEN G0(0,TopNew,StkMax)
  493.             ELSE IF Attr.TyPtr = RealPtr THEN G0(1,TopNew,StkMax)
  494.             ELSE BEGIN Error(125);  Attr.TyPtr := IntPtr END;
  495.         END;
  496.  
  497.  
  498.         PROCEDURE Sqr;
  499.  
  500.         BEGIN
  501.           IF Attr.TyPtr <> NIL THEN
  502.             IF Attr.TyPtr = IntPtr THEN G0(24,TopNew,StkMax)
  503.             ELSE IF Attr.TyPtr = RealPtr THEN G0(25,TopNew,StkMax)
  504.             ELSE BEGIN Error(125);  Attr.TyPtr := IntPtr END
  505.         END;
  506.  
  507.  
  508.         PROCEDURE Trunc;
  509.  
  510.         BEGIN
  511.           IF Attr.TyPtr <> NIL THEN
  512.             IF Attr.TyPtr <> RealPtr THEN Error(125);
  513.           G0(27,TopNew,StkMax);
  514.           Attr.TyPtr := IntPtr
  515.         END;
  516.  
  517.  
  518.         PROCEDURE Round;
  519.  
  520.         BEGIN
  521.           IF Symb = lBraces THEN BEGIN
  522.             GetSymbol;  Expression(ESets+[rBrace]);
  523.             PushContents(TopNew,StkMax,KonstPtr,KonstPtrIndex);
  524.           END
  525.           ELSE Error(9);
  526.           IF Attr.TyPtr <> NIL THEN
  527.             IF Attr.TyPtr <> RealPtr THEN Error(125);
  528.           G1(30,34(*RND*),TopNew,StkMax,KonstPtr);
  529.           Attr.TyPtr := IntPtr;
  530.           IF Symb = rBrace THEN GetSymbol ELSE Error(4);
  531.         END;
  532.  
  533.  
  534.         PROCEDURE Odd;
  535.  
  536.         BEGIN
  537.           IF Attr.TyPtr <> NIL THEN
  538.             IF Attr.TyPtr <> IntPtr THEN Error(125);
  539.           G0(20,TopNew,StkMax);
  540.           Attr.TyPtr := BooleanPtr
  541.         END;
  542.  
  543.  
  544.         PROCEDURE Ord;
  545.  
  546.         BEGIN
  547.           IF Attr.TyPtr <> NIL THEN
  548.             IF Attr.TyPtr^.Form >= Power THEN Error(125);
  549.           G0T(58,Attr.TyPtr,TopNew,StkMax);
  550.           Attr.TyPtr := IntPtr
  551.         END;
  552.  
  553.  
  554.         PROCEDURE Chr;
  555.  
  556.         BEGIN
  557.           IF Attr.TyPtr <> NIL THEN
  558.             IF Attr.TyPtr <> IntPtr THEN Error(125);
  559.           G0(59,TopNew,StkMax);
  560.           Attr.TyPtr := CharPtr
  561.         END;
  562.  
  563.  
  564.         PROCEDURE PredSucc;
  565.  
  566.         BEGIN
  567.           IF Attr.TyPtr <> NIL THEN
  568.             IF Attr.TyPtr^.Form <> Scalar THEN Error(125);
  569.           IF StdProcIndex = 7 THEN G1T(31,1,Attr.TyPtr,TopNew,StkMax)
  570.           ELSE G1T(34,1,Attr.TyPtr,TopNew,StkMax)
  571.         END;
  572.  
  573.  
  574.         PROCEDURE EoFEoLn;
  575.  
  576.         CONST InputOffset = 182;
  577.  
  578.         BEGIN
  579.           IF Symb = lBraces THEN BEGIN
  580.             GetSymbol;
  581.             Variable(ESets+[rBrace],TopNew,StkMax,
  582.                      KonstPtr,KonstPtrIndex,PInf);
  583.             IF  Symb = rBrace THEN GetSymbol ELSE Error(4)
  584.           END
  585.           ELSE
  586.             WITH Attr DO BEGIN
  587.               TyPtr := TextPtr;  Art := IsVar;  Zugriff := Direkt;
  588.               VarBSt := 1;  OffSet := InputOffset;
  589.             END;
  590.           PushAddress(TopNew,StkMax,KonstPtr,KonstPtrIndex);
  591.           G2(51,(*LDC*)1,Attr.TyPtr^.Size-1,TopNew,StkMax,KonstPtr);
  592.           IF Attr.TyPtr <> NIL THEN
  593.             IF Attr.TyPtr^.Form <> Files THEN Error(125);
  594.           IF StdProcIndex = 9 THEN G0(8,TopNew,StkMax)
  595.           ELSE G1(30,14,TopNew,StkMax,KonstPtr);
  596.           Attr.TyPtr := BooleanPtr
  597.         END;
  598.  
  599.  
  600.         PROCEDURE ExtendedCall;
  601.  
  602.         VAR
  603.           Nxt,locc: KonstP;
  604.           SavSP: StP;
  605.           LBezArt: BezArt;
  606.           PassFuncProc: BOOLEAN;
  607.           LocParSize,SavLocStk: AddressRange;
  608.  
  609.         BEGIN
  610.           LocParSize := 0;
  611.           WITH BezPtr^ DO BEGIN
  612.             Nxt := Next;  LBezArt := IsKind;
  613.             IF NOT Extern THEN G1(41,Bst-ProcBSt,TopNew,StkMax,KonstPtr)
  614.           END;
  615.           IF Symb = lBraces THEN BEGIN
  616.             SavLocStk := LocStk;
  617.             REPEAT
  618.               PassFuncProc := FALSE;
  619.               IF LBezArt = Actual THEN BEGIN
  620.                 IF Nxt = NIL THEN Error(126)
  621.                 ELSE PassFuncProc := Nxt^.Klass IN [ProcClass,FuncClass]
  622.               END
  623.               ELSE Error(399);
  624.               GetSymbol;
  625.               IF PassFuncProc THEN BEGIN
  626.                 Error(399);
  627.                 IF Symb <> Bezeich THEN BEGIN
  628.                   Error(2);  Recover(ESets+[CommaSymb,rBrace])
  629.                 END
  630.                 ELSE BEGIN
  631.                   IF Nxt^.Klass = ProcClass THEN FindeBez([ProcClass],locc)
  632.                   ELSE BEGIN
  633.                     FindeBez([FuncClass],locc);
  634.                     IF NOT IsCompatible(locc^.BezType,Nxt^.BezType) THEN
  635.                       Error(128)
  636.                   END;
  637.                   GetSymbol;
  638.                   IF NOT (Symb IN ESets + [CommaSymb,rBrace]) THEN BEGIN
  639.                     Error(6);  Recover(ESets+[CommaSymb,rBrace])
  640.                   END
  641.                 END
  642.               END
  643.               ELSE BEGIN
  644.                 Expression(ESets+[CommaSymb,rBrace]);
  645.                 IF Attr.TyPtr <> NIL THEN
  646.                   IF LBezArt = Actual THEN BEGIN
  647.                     IF Nxt <> NIL THEN BEGIN
  648.                       SavSP := Nxt^.BezType;
  649.                       IF SavSP <> NIL THEN BEGIN
  650.                         IF (Nxt^.VarKind = Actual) THEN
  651.                           IF SavSP^.Form <= Power THEN BEGIN
  652.                             PushContents(TopNew,StkMax,KonstPtr,KonstPtrIndex);
  653.                             IF Debug THEN CheckBounds(SavSP,TopNew,StkMax);
  654.                             IF IsCompatible(RealPtr,SavSP) THEN BEGIN
  655.                               IF Attr.TyPtr = IntPtr THEN BEGIN
  656.                                 G0(10,TopNew,StkMax);
  657.                                 Attr.TyPtr := RealPtr
  658.                               END
  659.                               ELSE IF Attr.TyPtr = LongPtr THEN BEGIN
  660.                                 G0(71(*LFT*),TopNew,StkMax);
  661.                                 Attr.TyPtr := RealPtr
  662.                               END
  663.                             END
  664.                             ELSE IF IsCompatible(LongPtr,SavSP)
  665.                             AND (Attr.TyPtr = IntPtr) THEN BEGIN
  666.                               G0(67(*ILT*),TopNew,StkMax);
  667.                               Attr.TyPtr := LongPtr
  668.                             END;
  669.                             LocParSize := LocParSize+SavSP^.Size;
  670.                           END
  671.                           ELSE BEGIN
  672.                             PushAddress(TopNew,StkMax,KonstPtr,KonstPtrIndex);
  673.                             LocParSize := LocParSize+PtrSize;
  674.                           END
  675.                         ELSE IF Attr.Art = IsVar THEN BEGIN
  676.                           PushAddress(TopNew,StkMax,KonstPtr,KonstPtrIndex);
  677.                           LocParSize := LocParSize+PtrSize;
  678.                         END
  679.                         ELSE Error(154);
  680.                         IF NOT IsCompatible(SavSP,Attr.TyPtr) THEN Error(142)
  681.                       END
  682.                     END
  683.                   END
  684.                   ELSE BEGIN
  685.                   END
  686.               END;
  687.               IF (LBezArt = Actual) AND (Nxt <> NIL) THEN Nxt := Nxt^.Next
  688.             UNTIL Symb <> CommaSymb;
  689.             LocStk := SavLocStk;
  690.             IF Symb = rBrace THEN GetSymbol ELSE Error(4)
  691.           END;
  692.           IF LBezArt = Actual THEN BEGIN
  693.             IF Nxt <> NIL THEN Error(126);
  694.             WITH BezPtr^ DO BEGIN
  695.               IF Extern THEN
  696.                 IF ProcLabel >= 24 THEN BEGIN
  697.                   G2(51,1,Zahl,TopNew,StkMax,KonstPtr);
  698.                   G1(30,ProcLabel,TopNew,StkMax,KonstPtr);
  699.                 END
  700.                 ELSE G1(30,ProcLabel,TopNew,StkMax,KonstPtr)
  701.               ELSE BEGIN
  702.                 GenDBG(Name);
  703.                 GProcCall(46,LocParSize,ProcLabel,TopNew,StkMax)
  704.               END
  705.             END
  706.           END;
  707.           Attr.TyPtr := BezPtr^.BezType;
  708.         END;
  709.  
  710.  
  711.       BEGIN (* CALL *)
  712.         IF BezPtr^.IsDeclDas  = Standard THEN BEGIN
  713.           StdProcIndex := BezPtr^.Key;
  714.           IF BezPtr^.Klass = ProcClass THEN BEGIN
  715.             IF NOT(StdProcIndex IN [5,6,11,12]) THEN
  716.               IF Symb = lBraces THEN GetSymbol ELSE Error(9);
  717.             CASE StdProcIndex OF
  718.               1,2: GetPut;
  719.                17: Close;
  720.                 3: ReSet;
  721.                 4: ReWrite;
  722.              5,11: Read;
  723.              6,12: Write;
  724.                 7: Pack;
  725.                 8: UnPack;
  726.                 9: New;
  727.                16: Dispos;
  728.                10: Release;
  729.                13: Mark
  730.             END;
  731.             IF NOT (StdProcIndex IN [5,6,11,12]) THEN
  732.               IF Symb = rBrace THEN GetSymbol ELSE Error(4)
  733.           END
  734.           ELSE BEGIN
  735.             IF StdProcIndex <= 8 THEN BEGIN
  736.               IF Symb = lBraces THEN GetSymbol ELSE Error(9);
  737.               Expression(ESets+[rBrace]);
  738.               PushContents(TopNew,StkMax,KonstPtr,KonstPtrIndex);
  739.             END;
  740.             CASE StdProcIndex OF
  741.                  1: ABS;
  742.                  2: Sqr;
  743.                  3: Trunc;
  744.                  4: Odd;
  745.                  5: Ord;
  746.                  6: Chr;
  747.                7,8: PredSucc;
  748.               9,10: EoFEoLn;
  749.                 11: Round;
  750.             END;
  751.             IF StdProcIndex <= 8 THEN
  752.               IF Symb = rBrace THEN GetSymbol ELSE Error(4)
  753.           END;
  754.         END
  755.         ELSE ExtendedCall;
  756.       END;
  757.  
  758.  
  759.