EXEC XCOMP XCOMP TEST1 XCOMP TEST2 -M9 FILEDEF INPUT TERM ( RECFM V FILEDEF OUTPUT TERM ( RECFM V FILEDEF PASTRACE TERM ( RECFM F FILEDEF INFILE1 DISK XCOMP TEST1 ( RECFM F FILEDEF INFILE2 DISK XCOMP TEST2 ( RECFM F EXEC PASRUN XCOMP -M9 XCOMP (Pascal Version 1.1) - 20.10.2016 Vergleich Datei 1 <<< mit Datei 2 >>> Eingelesene Parameter: parm: length = 4 parm: <-M9 > eingelesen: minmatch : 9 ================================================================ 136 <<< (* *) 137 <<< (* Sep.2016 - Extensions to the Compiler by Bernd Oppolzer *) 138 <<< (* (berndoppolzer@yahoo.com) *) 139 <<< (* *) 140 <<< (* New functions added to support the construction of a new *) 141 <<< (* storage management library using Pascal: *) 142 <<< (* *) 143 <<< (* - ADDR to get the address of any variable; *) 144 <<< (* the result of this function is a pointer without type *) 145 <<< (* (aka void pointer) similar to the NIL pointer, *) 146 <<< (* which is compatible with every other pointer type *) 147 <<< (* *) 148 <<< (* - PTRADD to add an integer expression to a pointer *) 149 <<< (* (of any type) - this adds addresses in contrast to C, *) 150 <<< (* where element sizes are added; PTRADD without a *) 151 <<< (* second argument (which is the same as PTRADD (X,0)) *) 152 <<< (* can be used to convert a typed pointer to a void pointer *) 153 <<< (* *) 154 <<< (* - PTRDIFF, that subtracts two pointers (of any type), *) 155 <<< (* giving an integer result *) 156 <<< (* *) 157 <<< (* - SIZEOF, which works much the same as the C function *) 158 <<< (* of the same name; as with C, you can specify a variable *) 159 <<< (* as argument or a type identifier *) 160 <<< (* *) 161 <<< (* - PTR2INT, which converts a pointer to an integer value *) 162 <<< (* *) 163 <<< (********************************************************************) 164 <<< (* *) 165 <<< (* Sep.2016 - Extensions to the Compiler by Bernd Oppolzer *) 166 <<< (* (berndoppolzer@yahoo.com) *) 167 <<< (* *) 168 <<< (* New keyword MODULE; a module is a collection of *) 169 <<< (* external procedures without a main program. The keyword *) 170 <<< (* MODULE replaces the keyword PROGRAM on modules. *) 171 <<< (* It sets the compiler switch X implicitly and enforces that *) 172 <<< (* the main block (which still has to be coded) is empty, *) 173 <<< (* that is: "begin end.". No main block is generated, so *) 174 <<< (* it is now possible to add multiply modules to a Pascal *) 175 <<< (* program without name conflicts. *) 176 <<< (* *) 177 <<< (********************************************************************) 178 <<< (* *) 179 <<< (* Sep.2016 - Extensions to the Compiler by Bernd Oppolzer *) 180 <<< (* (berndoppolzer@yahoo.com) *) 181 <<< (* *) 182 <<< (* Standard functions and procedures may not only be *) 183 <<< (* implemented by inline code or CSP calls; another *) 184 <<< (* possible (new) technique is to call an external function *) 185 <<< (* in a library module. *) 186 <<< (* *) 187 <<< (* To support this, several atributes have been added to the *) 188 <<< (* internal Standard procedure description: *) 189 <<< (* *) 190 <<< (* STANDARD : *) 191 <<< (* ( KEY : 0 .. NSPROC ; *) 192 <<< (* LIBNAME : EXTNAMTP ; *) 193 <<< (* FUNCCODE : INTEGER ; *) 194 <<< (* PARMCNT : INTEGER ; *) 195 <<< (* PROCTYP : CHAR ) ; *) 196 <<< (* *) 197 <<< (* KEY is the only attribute that was present before and *) 198 <<< (* is the number of the CSP call. *) 199 <<< (* *) 200 <<< (* If LIBNAME is not blank, the Standard Proc is implemented *) 201 <<< (* by a library function call. It gets the FUNCCODE as first *) 202 <<< (* parameter; PARMCNT and PROCTYP are other attributes that *) 203 <<< (* are needed to set up the CUP call for the library function *) 204 <<< (* *) 205 <<< (********************************************************************) 206 <<< (* *) 207 <<< (* Sep.2016 - Extensions to the Compiler by Bernd Oppolzer *) 208 <<< (* (berndoppolzer@yahoo.com) *) 209 <<< (* *) 210 <<< (* Four new standard functions have been added using *) 211 <<< (* the library function facility: *) 212 <<< (* *) 213 <<< (* - ALLOC, which gets a length and returns a pointer *) 214 <<< (* to a new area of that length *) 215 <<< (* *) 216 <<< (* - ALLOCX, which does the same, but does not use the *) 217 <<< (* (yet to come) sophisticated logic like LE, but does a pure *) 218 <<< (* GETMAIN on every ALLOCX call, which is simple, but slow *) 219 <<< (* *) 220 <<< (* - FREE, which frees the storage retrieved by ALLOC *) 221 <<< (* *) 222 <<< (* - FREEX, which frees the storage retrieved by ALLOCX, *) 223 <<< (* that is: FREEMAIN *) 224 <<< (* *) 225 <<< (* The four new functions are implemented in the module *) 226 <<< (* PASLIBX, seperate from the compiler (in Pascal) *) 227 <<< (* *) 228 <<< (********************************************************************) ================================================================ 353 <<< (************************************************) 354 <<< (* EXTERNAL NAME LENGTH *) 355 <<< (* SAVE AREAS, FUNCTION RETURN VALUE SPACE, *) 356 <<< (* DISPLAY AREA, ETC. *) 357 <<< (************************************************) ---------------------------------------------------------------- 260 >>> (*****************************************) 261 >>> (* EXTERNAL NAME LENGTH *) 262 >>> (*SAVE AREAS, FUNCTION RETURN VALUE SPAC *) 263 >>> (*E, DISPLAY AREA, ETC. *) 264 >>> (*****************************************) ================================================================ 545 <<< ( KEY : 0 .. NSPROC ; 546 <<< LIBNAME : EXTNAMTP ; 547 <<< FUNCCODE : INTEGER ; 548 <<< PARMCNT : INTEGER ; 549 <<< PROCTYP : CHAR ) ; ---------------------------------------------------------------- 452 >>> ( KEY : 0 .. NSPROC ) ; ================================================================ 1182 <<< 'EIO' , 'MSG' , 'SKP' , 'LIM' , 'TRA' , 'WRP' , ' ' , ' ' ) ---------------------------------------------------------------- 1085 >>> 'EIO' , 'MSG' , 'SKP' , 'LIM' , 'TRA' , ' ' , ' ' , ' ' ) ================================================================ 6501 <<< LCCALLER : ADDRRANGE ; 6502 <<< LCPARM : ADDRRANGE ; ================================================================ 6524 <<< procedure PREPLIBRARYFUNC ( var LCCALLER : ADDRRANGE ; var 6525 <<< LCPARM : ADDRRANGE ) ; 6526 <<< 6527 <<< begin (* PREPLIBRARYFUNC *) 6528 <<< 6529 <<< (********) 6530 <<< (*mst *) 6531 <<< (********) 6532 <<< 6533 <<< GEN2 ( 41 , 0 , 0 ) ; 6534 <<< 6535 <<< (***************************************************) 6536 <<< (* adresse fuer parameter ermitteln und ausrichten *) 6537 <<< (***************************************************) 6538 <<< 6539 <<< LCCALLER := LC ; 6540 <<< ALIGN ( LCCALLER , MXDATASZE ) ; 6541 <<< LCPARM := LCCALLER + LCAFTMST + FPSAVEAREA 6542 <<< end (* PREPLIBRARYFUNC *) ; 6543 <<< 6544 <<< 6545 <<< procedure CALLLIBRARYFUNC ( FCP : CTP ; LLCALLER : 6546 <<< ADDRRANGE ) ; 6547 <<< 6548 <<< begin (* CALLLIBRARYFUNC *) 6549 <<< if PRCODE then 6550 <<< begin 6551 <<< PUTIC ; 6552 <<< 6553 <<< (********) 6554 <<< (*CUP *) 6555 <<< (********) 6556 <<< 6557 <<< WRITE ( PRR , MN [ 46 ] ) ; 6558 <<< WRITE ( PRR , FCP -> . PROCTYP : 2 ) ; 6559 <<< WRITE ( PRR , ',' , FCP -> . PARMCNT * 2 + 3 : 1 ) 6560 <<< ; 6561 <<< WRITE ( PRR , ',' , FCP -> . LIBNAME ) ; 6562 <<< WRITELN ( PRR , ',' , LLCALLER : 1 ) ; 6563 <<< end (* then *) ; 6564 <<< end (* CALLLIBRARYFUNC *) ; 6565 <<< 6566 <<< ================================================================ 6852 <<< 6853 <<< procedure WRITE2 ; 6854 <<< 6855 <<< begin (* WRITE2 *) 6856 <<< if LSP = NIL then 6857 <<< return ; 6858 <<< 6859 <<< (************************) 6860 <<< (* write integer values *) 6861 <<< (************************) 6862 <<< 6863 <<< if LSP = INTPTR then 6864 <<< begin 6865 <<< if DEFAULT then 6866 <<< 6867 <<< (********) 6868 <<< (*LDC *) 6869 <<< (********) 6870 <<< 6871 <<< GEN2 ( 51 , 1 , 12 ) ; 6872 <<< CSPNO := 6 ; 6873 <<< 6874 <<< (********) 6875 <<< (*WRI *) 6876 <<< (********) 6877 <<< 6878 <<< return 6879 <<< end (* then *) ; 6880 <<< 6881 <<< (*********************) 6882 <<< (* write real values *) 6883 <<< (*********************) 6884 <<< 6885 <<< if LSP = REALPTR then 6886 <<< begin 6887 <<< if DEFAULT then 6888 <<< 6889 <<< (********) 6890 <<< (*LDC *) 6891 <<< (********) 6892 <<< 6893 <<< GEN2 ( 51 , 1 , 14 ) ; 6894 <<< if DEFAULT1 then 6895 <<< 6896 <<< (********) 6897 <<< (*LDC *) 6898 <<< (********) 6899 <<< 6900 <<< GEN2 ( 51 , 1 , 0 ) ; 6901 <<< CSPNO := 8 ; 6902 <<< 6903 <<< (********) 6904 <<< (*WRR *) 6905 <<< (********) 6906 <<< 6907 <<< return 6908 <<< end (* then *) ; 6909 <<< 6910 <<< (*********************) 6911 <<< (* write char values *) 6912 <<< (*********************) 6913 <<< 6914 <<< if LSP = CHARPTR then 6915 <<< begin 6916 <<< if DEFAULT then 6917 <<< 6918 <<< (********) 6919 <<< (*LDC *) 6920 <<< (********) 6921 <<< 6922 <<< GEN2 ( 51 , 1 , 1 ) ; 6923 <<< CSPNO := 9 ; 6924 <<< 6925 <<< (********) 6926 <<< (*WRC *) 6927 <<< (********) 6928 <<< 6929 <<< return 6930 <<< end (* then *) ; 6931 <<< 6932 <<< (************************) 6933 <<< (* write boolean values *) 6934 <<< (************************) 6935 <<< 6936 <<< if LSP = BOOLPTR then 6937 <<< begin 6938 <<< if DEFAULT then 6939 <<< 6940 <<< (********) 6941 <<< (*LDC *) 6942 <<< (********) 6943 <<< 6944 <<< GEN2 ( 51 , 1 , 5 ) ; 6945 <<< CSPNO := 13 ; 6946 <<< 6947 <<< (********) 6948 <<< (*WRB *) 6949 <<< (********) 6950 <<< 6951 <<< return 6952 <<< end (* then *) ; 6953 <<< 6954 <<< (************************) 6955 <<< (* write pointer values *) 6956 <<< (************************) 6957 <<< 6958 <<< if LSP -> . FORM = POINTER then 6959 <<< begin 6960 <<< if DEFAULT then 6961 <<< 6962 <<< (********) 6963 <<< (*LDC *) 6964 <<< (********) 6965 <<< 6966 <<< GEN2 ( 51 , 1 , 8 ) ; 6967 <<< CSPNO := 37 ; 6968 <<< 6969 <<< (********) 6970 <<< (*WRI *) 6971 <<< (********) 6972 <<< 6973 <<< return 6974 <<< end (* then *) ; 6975 <<< 6976 <<< (***********************) 6977 <<< (* write scalar values *) 6978 <<< (* not yet implemented *) 6979 <<< (***********************) 6980 <<< 6981 <<< if LSP -> . FORM = SCALAR then 6982 <<< begin 6983 <<< ERROR ( 398 ) ; 6984 <<< return 6985 <<< end (* then *) ; 6986 <<< 6987 <<< (************************************) 6988 <<< (* write string vars and constants *) 6989 <<< (************************************) 6990 <<< 6991 <<< if XSTRING ( LSP ) then 6992 <<< begin 6993 <<< LEN := LSP -> . SIZE DIV CHARSIZE ; 6994 <<< if DEFAULT then 6995 <<< 6996 <<< (********) 6997 <<< (*LDC *) 6998 <<< (********) 6999 <<< 7000 <<< GEN2 ( 51 , 1 , LEN ) ; 7001 <<< 7002 <<< (********) 7003 <<< (*LDC *) 7004 <<< (********) 7005 <<< 7006 <<< GEN2 ( 51 , 1 , LEN ) ; 7007 <<< CSPNO := 10 ; 7008 <<< return 7009 <<< 7010 <<< (********) 7011 <<< (*WRS *) 7012 <<< (********) 7013 <<< 7014 <<< end (* then *) ; 7015 <<< 7016 <<< (***********************) 7017 <<< (* erroneous parameter *) 7018 <<< (***********************) 7019 <<< 7020 <<< ERROR ( 116 ) ; 7021 <<< CSPNO := 6 7022 <<< end (* WRITE2 *) ; 7023 <<< ================================================================ 7052 <<< if LSP -> . FORM <= POINTER then ---------------------------------------------------------------- 6738 >>> if LSP -> . FORM <= SUBRANGE then ================================================================ 7084 <<< 7085 <<< (**************************************) 7086 <<< (* call write funcs depending on type *) 7087 <<< (**************************************) 7088 <<< 7089 <<< WRITE2 ---------------------------------------------------------------- 6770 >>> if LSP = INTPTR then 6771 >>> begin 6772 >>> if DEFAULT then 6773 >>> 6774 >>> (********) 6775 >>> (*LDC *) 6776 >>> (********) 6777 >>> 6778 >>> GEN2 ( 51 , 1 , 12 ) ; 6779 >>> CSPNO := 6 6780 >>> 6781 >>> (********) 6782 >>> (*WRI *) 6783 >>> (********) 6784 >>> 6785 >>> end (* then *) 6786 >>> else 6787 >>> if LSP = REALPTR then 6788 >>> begin 6789 >>> if DEFAULT then 6790 >>> 6791 >>> (********) 6792 >>> (*LDC *) 6793 >>> (********) 6794 >>> 6795 >>> GEN2 ( 51 , 1 , 14 ) ; 6796 >>> if DEFAULT1 then 6797 >>> 6798 >>> (********) 6799 >>> (*LDC *) 6800 >>> (********) 6801 >>> 6802 >>> GEN2 ( 51 , 1 , 0 ) ; 6803 >>> CSPNO := 8 6804 >>> 6805 >>> (********) 6806 >>> (*WRR *) 6807 >>> (********) 6808 >>> 6809 >>> end (* then *) 6810 >>> else 6811 >>> if LSP = CHARPTR then 6812 >>> begin 6813 >>> if DEFAULT then 6814 >>> 6815 >>> (********) 6816 >>> (*LDC *) 6817 >>> (********) 6818 >>> 6819 >>> GEN2 ( 51 , 1 , 1 ) ; 6820 >>> CSPNO := 9 6821 >>> 6822 >>> (********) 6823 >>> (*WRC *) 6824 >>> (********) 6825 >>> 6826 >>> end (* then *) 6827 >>> else 6828 >>> if LSP = BOOLPTR then 6829 >>> begin 6830 >>> if DEFAULT then 6831 >>> 6832 >>> (********) 6833 >>> (*LDC *) 6834 >>> (********) 6835 >>> 6836 >>> GEN2 ( 51 , 1 , 5 ) ; 6837 >>> CSPNO := 13 6838 >>> 6839 >>> (********) 6840 >>> (*WRB *) 6841 >>> (********) 6842 >>> 6843 >>> end (* then *) 6844 >>> else 6845 >>> if LSP <> NIL then 6846 >>> begin 6847 >>> if LSP -> . FORM = SCALAR then 6848 >>> ERROR ( 398 ) 6849 >>> else 6850 >>> if XSTRING ( LSP ) then 6851 >>> begin 6852 >>> LEN := LSP -> . SIZE DIV 6853 >>> CHARSIZE ; 6854 >>> if DEFAULT then 6855 >>> 6856 >>> (********) 6857 >>> (*LDC *) 6858 >>> (********) 6859 >>> 6860 >>> GEN2 ( 51 , 1 , LEN ) 6861 >>> ; 6862 >>> 6863 >>> (********) 6864 >>> (*LDC *) 6865 >>> (********) 6866 >>> 6867 >>> GEN2 ( 51 , 1 , LEN ) ; 6868 >>> CSPNO := 10 6869 >>> 6870 >>> (********) 6871 >>> (*WRS *) 6872 >>> (********) 6873 >>> 6874 >>> end (* then *) 6875 >>> else 6876 >>> begin 6877 >>> ERROR ( 116 ) ; 6878 >>> CSPNO := 6 6879 >>> end (* else *) 6880 >>> end (* then *) ================================================================ 7630 <<< begin 7631 <<< 7632 <<< (******************************************) 7633 <<< (* if only one parameter, then simply *) 7634 <<< (* cast pointer to void pointer type *) 7635 <<< (* so assignments of any pointer types *) 7636 <<< (* are possible using ptradd *) 7637 <<< (******************************************) 7638 <<< 7639 <<< GATTR . TYPTR := VOIDPTR ; 7640 <<< return ; 7641 <<< end (* else *) ; ---------------------------------------------------------------- 7421 >>> return ; ================================================================ 7772 <<< procedure ALLOC1 ; 7773 <<< 7774 <<< var LLC1 : ADDRRANGE ; 7775 <<< 7776 <<< begin (* ALLOC1 *) 7777 <<< EXPRESSION ( FSYS + [ RPARENT ] ) ; 7778 <<< 7779 <<< (******************************************) 7780 <<< (* if type of expr = integer then load it *) 7781 <<< (******************************************) 7782 <<< 7783 <<< if GATTR . TYPTR <> NIL then 7784 <<< if GATTR . TYPTR <> INTPTR then 7785 <<< ERROR ( 191 ) 7786 <<< else 7787 <<< LOAD ; 7788 <<< LCPARM := LCPARM + INTSIZE ; 7789 <<< GEN3 ( 56 , ORD ( 'I' ) , LEVEL , LCPARM ) ; 7790 <<< CALLLIBRARYFUNC ( FCP , LCCALLER ) ; 7791 <<< GATTR . TYPTR := VOIDPTR ; 7792 <<< end (* ALLOC1 *) ; 7793 <<< 7794 <<< 7795 <<< procedure ALLOCX1 ; 7796 <<< 7797 <<< var LLC1 : ADDRRANGE ; 7798 <<< 7799 <<< begin (* ALLOCX1 *) 7800 <<< EXPRESSION ( FSYS + [ RPARENT ] ) ; 7801 <<< 7802 <<< (******************************************) 7803 <<< (* if type of expr = integer then load it *) 7804 <<< (******************************************) 7805 <<< 7806 <<< if GATTR . TYPTR <> NIL then 7807 <<< if GATTR . TYPTR <> INTPTR then 7808 <<< ERROR ( 191 ) 7809 <<< else 7810 <<< LOAD ; 7811 <<< LCPARM := LCPARM + INTSIZE ; 7812 <<< GEN3 ( 56 , ORD ( 'I' ) , LEVEL , LCPARM ) ; 7813 <<< CALLLIBRARYFUNC ( FCP , LCCALLER ) ; 7814 <<< GATTR . TYPTR := VOIDPTR ; 7815 <<< end (* ALLOCX1 *) ; 7816 <<< 7817 <<< 7818 <<< procedure FREE1 ; 7819 <<< 7820 <<< begin (* FREE1 *) 7821 <<< EXPRESSION ( FSYS + [ RPARENT ] ) ; 7822 <<< 7823 <<< (******************************************) 7824 <<< (* if type of expr = pointer then load it *) 7825 <<< (******************************************) 7826 <<< 7827 <<< if GATTR . TYPTR <> NIL then 7828 <<< if GATTR . TYPTR -> . FORM <> POINTER then 7829 <<< ERROR ( 190 ) 7830 <<< else 7831 <<< LOAD ; 7832 <<< LCPARM := LCPARM + PTRSIZE ; 7833 <<< GEN3 ( 56 , ORD ( 'A' ) , LEVEL , LCPARM ) ; 7834 <<< CALLLIBRARYFUNC ( FCP , LCCALLER ) ; 7835 <<< end (* FREE1 *) ; 7836 <<< 7837 <<< 7838 <<< procedure FREEX1 ; 7839 <<< 7840 <<< begin (* FREEX1 *) 7841 <<< EXPRESSION ( FSYS + [ RPARENT ] ) ; 7842 <<< 7843 <<< (******************************************) 7844 <<< (* if type of expr = pointer then load it *) 7845 <<< (******************************************) 7846 <<< 7847 <<< if GATTR . TYPTR <> NIL then 7848 <<< if GATTR . TYPTR -> . FORM <> POINTER then 7849 <<< ERROR ( 190 ) 7850 <<< else 7851 <<< LOAD ; 7852 <<< LCPARM := LCPARM + PTRSIZE ; 7853 <<< GEN3 ( 56 , ORD ( 'A' ) , LEVEL , LCPARM ) ; 7854 <<< CALLLIBRARYFUNC ( FCP , LCCALLER ) ; 7855 <<< end (* FREEX1 *) ; 7856 <<< 7857 <<< ================================================================ 8760 <<< 8761 <<< (************************************************) 8762 <<< (* if library routine, that is: *) 8763 <<< (* implemented using external pascal module *) 8764 <<< (* insert funccode as first parameter *) 8765 <<< (* for external procedure *) 8766 <<< (* opp / 06.2016 *) 8767 <<< (************************************************) 8768 <<< 8769 <<< if FCP -> . LIBNAME [ 1 ] <> ' ' then 8770 <<< begin 8771 <<< PREPLIBRARYFUNC ( LCCALLER , LCPARM ) ; 8772 <<< GEN2 ( 51 , 1 , FCP -> . FUNCCODE ) ; 8773 <<< GEN3 ( 56 , ORD ( 'I' ) , LEVEL , LCPARM ) ; 8774 <<< end (* then *) ; 8775 <<< 8776 <<< (************************************************) 8777 <<< (* opp / 06.2016 - end insertion *) 8778 <<< (************************************************) 8779 <<< ================================================================ 8860 <<< 61 : ALLOC1 ; 8861 <<< 62 : ALLOCX1 ; 8862 <<< 63 : FREE1 ; 8863 <<< 64 : FREEX1 ; 8864 <<< end (* case *) ; 8865 <<< if LKEY in [ 16 .. 26 , 28 , 29 , 33 , 38 , 39 , 40 , 8866 <<< 41 , 42 , 43 , 44 , 63 , 64 ] then ---------------------------------------------------------------- 8534 >>> end (* case *) ; 8535 >>> if LKEY in [ 16 .. 26 , 28 , 29 , 33 , 38 , 39 , 40 , 8536 >>> 41 , 42 , 43 , 44 ] then ================================================================ 11792 <<< XSTDPROC = record 11793 <<< NAME : ALPHA ; 11794 <<< KEY : INTEGER ; 11795 <<< KLASS : IDCLASS ; 11796 <<< LIBNAME : EXTNAMTP ; 11797 <<< FUNCCODE : INTEGER ; 11798 <<< PARMCNT : INTEGER ; 11799 <<< PROCTYP : CHAR ; 11800 <<< end ; 11801 <<< 11802 <<< var CP , CP1 : CTP ; 11803 <<< I , J : INTEGER ; 11804 <<< SP : STDPROC ; 11805 <<< ESP : ESTDPROC ; 11806 <<< XSP : XSTDPROC ; ---------------------------------------------------------------- 11462 >>> 11463 >>> var CP , CP1 : CTP ; 11464 >>> I , J : INTEGER ; 11465 >>> SP : STDPROC ; 11466 >>> ESP : ESTDPROC ; ================================================================ 11849 <<< XSTDP : array [ 1 .. 10 ] of XSTDPROC = 11850 <<< ( ( 'ALLOC ' , 61 , FUNC , '$PASLIB ' , 1 , 1 , 'A' ) , 11851 <<< ( 'ALLOCX ' , 62 , FUNC , '$PASLIB ' , 2 , 1 , 'A' ) , 11852 <<< ( 'FREE ' , 63 , PROC , '$PASLIB ' , 3 , 1 , 'P' ) , 11853 <<< ( 'FREEX ' , 64 , PROC , '$PASLIB ' , 4 , 1 , 'P' ) , 11854 <<< ( ' ' , - 1 , PROC , ' ' , - 1 , 0 ) , 11855 <<< ( ' ' , - 1 , PROC , ' ' , - 1 , 0 ) , 11856 <<< ( ' ' , - 1 , PROC , ' ' , - 1 , 0 ) , 11857 <<< ( ' ' , - 1 , PROC , ' ' , - 1 , 0 ) , 11858 <<< ( ' ' , - 1 , PROC , ' ' , - 1 , 0 ) , 11859 <<< ( ' ' , - 1 , PROC , ' ' , - 1 , 0 ) ) 11860 <<< ; ================================================================ 12146 <<< LIBNAME := ' ' ; 12147 <<< FUNCCODE := - 1 ; 12148 <<< PARMCNT := 0 ; ================================================================ 12202 <<< (***********************************) 12203 <<< (* external library functions *) 12204 <<< (***********************************) 12205 <<< 12206 <<< for I := 1 to 10 do 12207 <<< begin 12208 <<< XSP := XSTDP [ I ] ; 12209 <<< if XSP . NAME [ 1 ] = ' ' then 12210 <<< break ; 12211 <<< NEW ( CP , PROC , STANDARD ) ; 12212 <<< with CP -> do 12213 <<< begin 12214 <<< NAME := XSP . NAME ; 12215 <<< IDTYPE := NIL ; 12216 <<< NEXT := NIL ; 12217 <<< KEY := XSP . KEY ; 12218 <<< KLASS := XSP . KLASS ; 12219 <<< PFDECKIND := STANDARD ; 12220 <<< LIBNAME := XSP . LIBNAME ; 12221 <<< FUNCCODE := XSP . FUNCCODE ; 12222 <<< PARMCNT := XSP . PARMCNT ; 12223 <<< PROCTYP := XSP . PROCTYP ; 12224 <<< end (* with *) ; 12225 <<< ENTERID ( CP ) ; 12226 <<< end (* for *) ; 12227 <<< 12228 <<< (**************************************) 12229 <<< (* SNAPSHOT *) 12230 <<< (**************************************) 12231 <<< 12232 <<< NEW ( CP , PROC , DECLARED ) ; 12233 <<< with CP -> do 12234 <<< begin 12235 <<< NAME := 'SNAPSHOT ' ; ---------------------------------------------------------------- 11847 >>> (**************************************) 11848 >>> (* SNAPSHOT *) 11849 >>> (**************************************) 11850 >>> 11851 >>> NEW ( CP , PROC , DECLARED ) ; 11852 >>> with CP -> do 11853 >>> begin 11854 >>> NAME := '$PASSNAP ' ; ================================================================ 11903 >>> 11904 >>> (**************************************) 11905 >>> (* $PASLIB *) 11906 >>> (**************************************) 11907 >>> 11908 >>> NEW ( CP , PROC , DECLARED ) ; 11909 >>> with CP -> do 11910 >>> begin 11911 >>> NAME := '$PASLIB ' ; 11912 >>> IDTYPE := NIL ; 11913 >>> FRTRN := FALSE ; 11914 >>> FWDECL := FALSE ; 11915 >>> EXTRN := TRUE ; 11916 >>> PFLEV := 0 ; 11917 >>> PFNAME := 0 ; 11918 >>> KLASS := PROC ; 11919 >>> PFDECKIND := DECLARED ; 11920 >>> PFKIND := ACTUAL ; 11921 >>> EXTNAME := '$PASLIB ' ; 11922 >>> NEXT := NIL ; 11923 >>> end (* with *) ; 11924 >>> ENTERID ( CP ) ; 11925 >>> 11926 >>> (*******************************) 11927 >>> (* FIRST PARAMETER OF SNAPSHOT *) 11928 >>> (*******************************) 11929 >>> 11930 >>> NEW ( CP -> . PRMPTR , VARS ) ; 11931 >>> 11932 >>> (********************************) 11933 >>> (* SECOND PARAMETER OF SNAPSHOT *) 11934 >>> (********************************) 11935 >>> 11936 >>> NEW ( CP1 , VARS ) ; 11937 >>> with CP1 -> do 11938 >>> begin 11939 >>> IDTYPE := VOIDPTR ; 11940 >>> KLASS := VARS ; 11941 >>> VKIND := ACTUAL ; 11942 >>> NEXT := NIL ; 11943 >>> VLEV := 1 ; 11944 >>> VADDR := LCAFTMST + FPSAVEAREA + INTSIZE 11945 >>> end (* with *) ; 11946 >>> 11947 >>> (*******************************) 11948 >>> (* FIRST PARAMETER OF SNAPSHOT *) 11949 >>> (*******************************) 11950 >>> 11951 >>> with CP -> . PRMPTR -> do 11952 >>> begin 11953 >>> IDTYPE := INTPTR ; 11954 >>> KLASS := VARS ; 11955 >>> VKIND := ACTUAL ; 11956 >>> NEXT := CP1 ; 11957 >>> VLEV := 1 ; 11958 >>> VADDR := LCAFTMST + FPSAVEAREA 11959 >>> end (* with *) ; EXEC CONSSTOP CP SPOOL CONS STOP CLOSE