nassts.p 2.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100
  1. 38900 #include "rundecs.h"
  2. 38910 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
  3. 38920 (**)
  4. 38930 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN;
  5. 38940 PROCEDURE ERRORR(N :INTEGER); EXTERN;
  6. 38950 PROCEDURE TESTCC(TARGET: OBJECTP); EXTERN ;
  7. 38960 PROCEDURE TESTSS (REFSTRUCT: OBJECTP); EXTERN ;
  8. 38970 (**)
  9. 38980 (**)
  10. 38990 PROCEDURE NASSTCMN(ANOBJECT: OBJECTP);
  11. 39000 BEGIN
  12. 39010 WITH ANOBJECT^ DO
  13. 39020 CASE ANCESTOR^.SORT OF
  14. 39030 REFR, RECR:
  15. 39040 TESTCC(ANOBJECT);
  16. 39050 RECN, REFN:
  17. 39060 TESTSS(ANCESTOR);
  18. 39070 UNDEF:
  19. 39080 ERRORR(RSEL);
  20. 39090 NILL:
  21. 39100 ERRORR(RSELNIL)
  22. 39110 END
  23. 39120 END;
  24. 39130 (**)
  25. 39140 (**)
  26. 39150 (*-01() (*-05()
  27. 39160 FUNCTION NASSTS(TEMP: NAKEGER; SOURCE: A68INT): ASNAKED;
  28. 39170 (*PASSIGNNT*)
  29. 39180 VAR DEST: UNDRESSP;
  30. 39190 BEGIN
  31. 39200 WITH TEMP.NAK, STOWEDVAL^.ANCESTOR^ DO
  32. 39210 BEGIN
  33. 39220 IF FPTWO(PVALUE^) THEN
  34. 39230 NASSTCMN(STOWEDVAL);
  35. 39240 PVALUE^.OSCOPE := 0;
  36. 39250 DEST := INCPTR(PVALUE, POSITION)
  37. 39260 END;
  38. 39270 DEST^.FIRSTINT := SOURCE;
  39. 39280 NASSTS := TEMP.ASNAK;
  40. 39290 END;
  41. 39300 (**)
  42. 39310 (**)
  43. 39320 FUNCTION NASSTS2(TEMP: NAKEGER; SOURCE: A68LONG): ASNAKED;
  44. 39330 (*PASSIGNNT+1*)
  45. 39340 VAR DEST: UNDRESSP;
  46. 39350 BEGIN
  47. 39360 WITH TEMP.NAK, STOWEDVAL^.ANCESTOR^ DO
  48. 39370 BEGIN
  49. 39380 IF FPTWO(PVALUE^) THEN
  50. 39390 NASSTCMN(STOWEDVAL);
  51. 39400 PVALUE^.OSCOPE := 0;
  52. 39410 DEST := INCPTR(PVALUE, POSITION)
  53. 39420 END;
  54. 39430 DEST^.FIRSTLONG := SOURCE;
  55. 39440 NASSTS2 := TEMP.ASNAK;
  56. 39450 END;
  57. 39460 ()-05*) ()-01*)
  58. 39470 (**)
  59. 39480 (**)
  60. 39490 FUNCTION NASSTPT(TEMP: NAKEGER; SOURCE: OBJECTP): ASNAKED;
  61. 39500 (*+01() EXTERN ; ()+01*)
  62. 39510 (*-01()
  63. 39520 (*PASSIGNNT+2*)
  64. 39530 VAR DEST: UNDRESSP;
  65. 39540 BEGIN
  66. 39550 WITH TEMP.NAK, STOWEDVAL^.ANCESTOR^ DO
  67. 39560 BEGIN
  68. 39570 IF FPTWO(PVALUE^) THEN
  69. 39580 NASSTCMN(STOWEDVAL);
  70. 39590 PVALUE^.OSCOPE := 0;
  71. 39600 DEST := INCPTR(PVALUE, POSITION)
  72. 39610 END;
  73. 39620 WITH DEST^ DO
  74. 39630 BEGIN
  75. 39640 FPINC(SOURCE^);
  76. 39650 FPDEC(FIRSTPTR^); IF FPTST(FIRSTPTR^) THEN GARBAGE(FIRSTPTR);
  77. 39660 FIRSTPTR := SOURCE;
  78. 39670 END;
  79. 39680 NASSTPT := TEMP.ASNAK;
  80. 39690 END;
  81. 39700 ()-01*)
  82. 39710 FUNCTION SCPNTPT(TEMP: NAKEGER; SOURCE: OBJECTP): ASNAKED;
  83. 39720 (*PSCOPENT+2*)
  84. 39730 BEGIN
  85. 39740 WITH SOURCE^ DO
  86. 39750 BEGIN
  87. 39760 IF TEMP.NAK.STOWEDVAL^.OSCOPE<OSCOPE THEN ERRORR(RSCOPE);
  88. 39770 END;
  89. 39780 SCPNTPT := NASSTPT(TEMP, SOURCE);
  90. 39790 END;
  91. 39800 (**)
  92. 39810 (**)
  93. 39820 (*-02()
  94. 39830 BEGIN
  95. 39840 END;
  96. 39850 ()-02*)
  97. 39860 (*+01()
  98. 39870 BEGIN (*OF MAIN PROGRAM*)
  99. 39880 END (*OF EVERYTHING*).
  100. 39890 ()+01*)