Retro1.org codex

User Tools

Site Tools

Trace: • COMPRT
plato:source:plaopl:comprt

Table of Contents

COMPRT

Table Of Contents

Source Code

COMPRT.txt 
  1. COMPRT
  2. * /---   FILE TYPE = E
  3. * /---   BLOCK      START      00 000   81/10/30  15.12 
  4.       PROGRAM COMPRT(INPUT=1002,TAPE2,OUTPUT=1002,
  5.      X               TAPE1=INPUT,TAPE4=OUTPUT)
  6. * 
  7. *   THIS PROGRAM PRINTS A CROSS-REFERENCE LISTING OF
  8. *   THE COMMON SYMBOL TABLE FOR THE PLATO SYSTEM. 
  9. * 
  10. *   WRITTEN BY DOUG BROWN 
  11. *   CONVERTED TO NOS BY TIM HALVORSEN 
  12. * 
  13. * 
  14. *   CALL PROGRAM WITH FOLLOWING CARD -- 
  15. * 
  16. *   LGO,SOURCE,BINARY.
  17. * 
  18. *   WHERE *SOURCE* IS THE OUTPUT FILE FROM THE
  19. *   COMPILATION OF THE COMMON STUFF. *BINARY* 
  20. *   IS THE BINARY OF THE SYSTEM TO CROSS REFERENCE. 
  21. * 
  22.       IMPLICIT INTEGER(A-Z) 
  23.  
  24.       LOGICAL ERROR 
  25.  
  26.       COMMON /PRINT/ SUBHEAD(13),PLINES,DATIME(2),
  27.      X               LASTLET,MESSAGE(3),BLKLTH
  28.  
  29. * 
  30. *   THESE TABLES SHOULD HAVE THE FOLLOWING SIZES -- 
  31. * 
  32. *     BUFFER -- BUFLTH
  33. *     LINKS -- NLINKS 
  34. *     COMMONS,CINFO,LCT -- NCOMS
  35. *     TEXTS -- TEXTL
  36. *     CGUNK -- TCOML
  37. * 
  38.       DIMENSION BUFFER(8000)
  39.       DIMENSION LINKS(8000) 
  40.       DIMENSION COMMONS(40),CINFO(40),LCT(40) 
  41.       DIMENSION TEXTS(600)
  42.       DIMENSION CGUNK(8000) 
  43. * 
  44. *   THE FOLLOWING DECLARATIONS ARE FIXED SIZE --
  45. * 
  46.       DIMENSION QREF(6,14)
  47.       DIMENSION PSH(3)
  48.       DIMENSION QLINKS(2),QBUFF(2),QCOM(2)
  49.       DIMENSION QGUNK(2),QTEXT(2) 
  50.       DIMENSION NAMER(7),ADDRR(6),BLOCKR(7) 
  51.  
  52. * 
  53. *   THESE ARE THE PARAMETERS TO FUSS WITH --
  54. *   BE SURE TO CHANGE THE DIMENSIONS OF THE ABOVE 
  55. *   ARRAYS THAT ALSO REFERENCE A PARAMETER. 
  56. * 
  57. *     --NOTE--  NLINKS AND TCOML CANNOT EXCEED 16000 UNLESS 
  58. *               THE TABLE FORMATS ARE CHANGED.  MWW  80/6/9.
  59. * 
  60.       DATA (NLINKS=8000),(BUFLTH=8000),(NCOMS=40) 
  61.       DATA (LOADFWA=111B),(TEXTL=600),(TCOML=8000)
  62.       DATA (BLKLTH=320) 
  63. * 
  64. *   COMPILER PARAMETERS 
  65. * 
  66.       DATA (COLNAME=11),(COLADDR=22),(COLBLOK=33) 
  67.  
  68. * 
  69. *   THESE ARE MASKS; DONT FUSS WITH THEM -- 
  70. * 
  71.       DATA (L9= 7777 7777 7777 7777 7700 B) 
  72.       DATA (L8= 7777 7777 7777 7777 0000 B) 
  73.       DATA (L7= 7777 7777 7777 7700 0000 B) 
  74.       DATA (L6= 7777 7777 7777 0000 0000 B) 
  75.       DATA (L5= 7777 7777 7700 0000 0000 B) 
  76.       DATA (L4= 7777 7777 0000 0000 0000 B) 
  77.       DATA (L3= 7777 7700 0000 0000 0000 B) 
  78.       DATA (L2= 7777 0000 0000 0000 0000 B) 
  79.       DATA (L1= 7700 0000 0000 0000 0000 B) 
  80.       DATA (R9= 0077 7777 7777 7777 7777 B) 
  81.       DATA (R8= 0000 7777 7777 7777 7777 B) 
  82.       DATA (R7= 0000 0077 7777 7777 7777 B) 
  83.       DATA (R6= 0000 0000 7777 7777 7777 B) 
  84.       DATA (R5= 0000 0000 0077 7777 7777 B) 
  85.       DATA (R4= 0000 0000 0000 7777 7777 B) 
  86.       DATA (R3= 0000 0000 0000 0077 7777 B) 
  87.       DATA (R2= 0000 0000 0000 0000 7777 B) 
  88.       DATA (R1= 0000 0000 0000 0000 0077 B) 
  89.       DATA (HISIGN= 4000 0000 0000 0000 0000 B) 
  90.       DATA (LOSIGN= 0000 0000 0040 0000 0000 B) 
  91. * 
  92. * /---   BLOCK      FORMATS    00 000   80/06/10  03.08 
  93. * 
  94. *         TAPE USAGE
  95. *         1=FIXED INPUT - COMPILER OUTPUT WITH COMMON NAMES 
  96. *         2=FIXED INPUT - BINARY
  97. *         4=OUTPUT
  98. * 
  99. * 
  100. *         THIS IS THE TABLE STRUCTURE - 
  101. * 
  102. *         LINKS(X)=42/PROGRAM,4/N.REFS,14/NEXT.LINK 
  103. *         NLI IS LENGTH (LAST USED INDEX) 
  104. *         NLINKS IS MAXIMUM LENGTH
  105. * 
  106. *         COMMONS(ALPHA)=42/NAME,18/PTR 
  107. *         CINFO(PTR)=6/0,18/A.ADDR,18/LTH,18/FWA
  108. *         NCO IS LENGTH 
  109. *         LCT(CHRON)=SAME AS CINFO
  110. *         LCTLTH IS LENGTH
  111. *         NCOMS IS MAXIMUM LENGTH OF ALL
  112. * 
  113. *         TEXTS(WHATEVER)=10/0,5/WC,18/B.ADDR,9/LR,18/L 
  114. *         NTXT IS LENGTH
  115. *         TEXTL IS MAXIMUM LENGTH 
  116. * 
  117. *         ECS RESIDENT -- USES WORDS 0 THROUGH (TCOML-1)
  118. *         CGUNK(FWA+VALUE)=24/0,18/FIRST,18/LAST
  119. *           (PASS 2 = 42/NAME,18/FIRST) 
  120. *         CGL IS LENGTH 
  121. *         TCOML IS MAXIMUM LENGTH 
  122. *           CGUNK(FWA+BL) IS AOR (VALUE .GE. BL)
  123. *           CGUNK(FWA+BL+1) IS GOK (NOT DONE BY TEXT) 
  124. * 
  125. * /---   BLOCK      INITIAL    00 000   80/06/13  10.01 
  126. * 
  127. *   GET THE PROPER AMOUNT OF ECS (USED BY GETNAME 
  128. *   FOR SWAPPING AREA FOR THE *COMMONS* TABLE)
  129. * 
  130.       CALL GETECX(BLKLTH+NCOMS) 
  131.  
  132. * 
  133. *   THIS IS FOR THE PAGE HEADERS
  134. * 
  135.       CALL DATE(DATIME(2))
  136.       CALL TIME(DATIME(1))
  137.       CALL NEWPAGE
  138.  
  139. * 
  140. *   THESE ARE FOR THE GENERAL ERROR CHECKS
  141. *   AND BOMB-OFF MESSAGES.
  142. * 
  143.       QLINKS(1)=NLINKS
  144.       QLINKS(2)=10HNLINKS 
  145.       QBUFF(1)=BUFLTH 
  146.       QBUFF(2)=10HBUFLTH
  147.       QCOM(1)=NCOMS 
  148.       QCOM(2)=10HNCOMS
  149.       QGUNK(1)=TCOML
  150.       QGUNK(2)=10HTCOML 
  151.       QTEXT(1)=TEXTL
  152.       QTEXT(2)=10HTEXTL 
  153.  
  154. * 
  155. *   NOW TO INITIALIZE THE TABLES
  156. * 
  157.       DO 10 I=1,TCOML 
  158. *      CALL WRITEC(0,I-1,1) 
  159.       CGUNK(I)=0
  160.    10 CONTINUE
  161.       CGL=0 
  162.  
  163.       PSH(1)=0
  164.       PSH(2)=45 
  165.       PSH(3)=30 
  166.  
  167.       NLI=0 
  168.  
  169.       MAXBUF=0
  170.       MAXTXT=0
  171.  
  172.       NCO=0 
  173.  
  174. * 
  175. *   START LOADING AT *NWA*
  176. * 
  177.       NWA=LOADFWA 
  178.  
  179. * 
  180. *   (0,0) LOAD ADDRESS
  181. * 
  182.       OVERA=0 
  183.  
  184.       REWIND 1
  185.       REWIND 2
  186. * /---   BLOCK      LINKING    00 000   76/12/15  14.29 
  187. * 
  188. *     NOW SEARCH THROUGH THE BINARY 
  189. * 
  190.   300 MESSAGE(1)=10H  LINKING 
  191.       MESSAGE(3)=0
  192.  
  193. * 
  194. *     READ A RECORD FROM THE BINARY 
  195. * 
  196.   310 BUFFER IN(2,1)(BUFFER(1),BUFFER(BUFLTH))
  197.       IF(UNIT(2))330,500,500
  198.  
  199.   330 NN=LENGTH(2)
  200.       CALL CHECK(NN,QBUFF)
  201.       MAXBUF=MAX0(NN,MAXBUF)
  202.  
  203.       IF((BUFFER(1).AND.L7).NE.7LOVERLAY)GOTO 337 
  204.       IF(NWA.EQ.LOADFWA) GOTO 310 
  205.       IF(OVERA.EQ.0)OVERA=NWA+1 
  206.       NWA=OVERA 
  207.       GOTO 310
  208.  
  209. *     BUFFER POINTER
  210.   337 PT=1
  211.       PIDL=LCTLTH=NTXT=0
  212. *     CODE NUMBER 
  213.   340 CN=SHIFT(BUFFER(PT),6).AND.77B
  214. *     WORD COUNT
  215.       WC=SHIFT(BUFFER(PT),24).AND.7777B 
  216. *     RELOCATION
  217.       LR=SHIFT(BUFFER(PT),-18).AND.777B 
  218. *     LOAD ADDRESS
  219.       LLL=BUFFER(PT).AND.777777B
  220. * 
  221. *     DETERMINE IF TABLE WITH INFO THAT WE WANT 
  222. * 
  223. *     TEXT
  224.       IF(CN.EQ.40B)GOTO 360 
  225. *     FILL
  226.       IF(CN.EQ.42B)GOTO 370 
  227. *     PIDL
  228.       IF(CN.EQ.34B)GOTO 390 
  229. * 
  230. *     GO ON TO NEXT TABLE 
  231. * 
  232.   350 PT=PT+WC+1
  233.       IF(PT.LE.NN)GOTO 340
  234.       GOTO 310
  235.  
  236. * 
  237. *     -TEXT- TABLE
  238. *     USE TO GET WHICH WORD OF COMMON BLOCK REFERENCED
  239. * 
  240.   360 CALL CHECK(NTXT,QTEXT)
  241.       NTXT=NTXT+1 
  242.       MAXTXT=MAX0(NTXT,MAXTXT)
  243.       TEXTS(NTXT)=SHIFT(WC-2,45).OR.SHIFT(PT+2,27)
  244.      X            .OR.SHIFT(LR,18).OR.LLL 
  245.       GOTO 350
  246. * /---   BLOCK      LINKING    00 000   80/06/10  03.13 
  247. * 
  248. *     -FILL- TABLE
  249. *     TELLS REFERENCES TO COMMON
  250. * 
  251.   370 DO 389 SUBPT=1,WC 
  252.       WORD=BUFFER(PT+SUBPT) 
  253.       HW=0
  254.   372 IF(WORD.LT.0)GOTO 374 
  255.       AR=SHIFT(WORD,30).AND.777B
  256.       GOTO 385
  257.   374 IF(AR.LE.2)GOTO 385 
  258.       FWA=LCT(AR-2).AND.R3
  259.       BL=SHIFT(LCT(AR-2),-18).AND.R3
  260.       RLOC=SHIFT(WORD,30).AND.777 777 777 B 
  261.       PPP=SHIFT(WORD,3).AND.3 
  262.       DO 375 TT=1,NTXT
  263.       TTT=TEXTS(TT).AND.777 777 777 B 
  264.       IF(RLOC.LT.TTT)GOTO 375 
  265.       UUU=TTT+(SHIFT(TEXTS(TT),15).AND.37B) 
  266.       IF(RLOC.GT.UUU)GOTO 375 
  267.       BADD=SHIFT(TEXTS(TT),33).AND.R3 
  268.       BADD=BADD+RLOC-TTT
  269.       BITSHF=PSH(PPP+1) 
  270.       CADD=SHIFT(BUFFER(BADD),BITSHF).AND.R3
  271.       IF(CADD.GT.BL)CADD=BL 
  272.       GOTO 376
  273.   375 CONTINUE
  274.       CADD=BL+1 
  275.   376 CALL CHECK(NLI,QLINKS)
  276.       CADD=CADD+FWA 
  277. *      CALL READEC(ECGUNK,CADD,1) 
  278.       ECGUNK=CGUNK(1+CADD)
  279. *     IF NOT FIRST LINK 
  280.       IF(ECGUNK.NE.0)GOTO 378 
  281.       NLI=NLI+1 
  282.       ECGUNK=NLI.OR.SHIFT(NLI,18) 
  283. *      CALL WRITEC(ECGUNK,CADD,1) 
  284.       CGUNK(1+CADD)=ECGUNK
  285.       LINKS(NLI)=IDENT.OR.SHIFT(1,14) 
  286.       GOTO 385
  287.   378 LLAST=ECGUNK.AND.R3 
  288.       LASTP=LINKS(LLAST).AND.L7 
  289. *     SENSE NEW PROGRAM 
  290.       IF(LASTP.NE.IDENT)GOTO 382
  291.       NUM=SHIFT(LINKS(LLAST),-14).AND.17B 
  292.       IF(NUM.LT.15)NUM=NUM+1
  293.       LINKS(LLAST)=IDENT.OR.SHIFT(NUM,14) 
  294.       GOTO 385
  295.   382 NLI=NLI+1 
  296.       LINKS(NLI)=IDENT.OR.SHIFT(1,14) 
  297.       LINKS(LLAST)=LINKS(LLAST).OR.NLI
  298.       ECGUNK=(ECGUNK.AND.L7).OR.NLI 
  299. *      CALL WRITEC(ECGUNK,CADD,1) 
  300.       CGUNK(1+CADD)=ECGUNK
  301.  
  302.   385 IF(HW.NE.0)GOTO 389 
  303.       WORD=SHIFT(WORD,30) 
  304.       HW=1
  305.       GOTO 372
  306.   389 CONTINUE
  307.       GOTO 350
  308.  
  309. * 
  310. *     -PIDL- TABLE
  311. *     HAS THE PROGRAM AND COMMON BLOCK LENGTHS
  312. * 
  313.   390 IDENT=BUFFER(PT+1).AND.L7 
  314.       PL=BUFFER(PT+1).AND.R3
  315.       IF(WC.LT.2)GOTO 397 
  316.       DO 395 I=2,WC 
  317.       CNAME=BUFFER(PT+I).AND.L7 
  318.       BL=BUFFER(PT+I).AND.R3
  319.       OLDLTH=NCO
  320.       CALL GETNAME(CNAME,COMMONS,NCO,QCOM,RET)
  321. *     IF ALREADY THERE, BYPASS FOLLOWING
  322.       IF(OLDLTH.EQ.NCO)GOTO 393 
  323.       CINFO(RET)=SHIFT(BL,18).OR.CGL.OR.SHIFT(NWA,36) 
  324.       CGL=CGL+BL+2
  325.       CALL CHECK(CGL,QGUNK) 
  326.       NWA=NWA+BL
  327.   393 CONTINUE
  328.       LCTLTH=LCTLTH+1 
  329.       LCT(LCTLTH)=CINFO(RET).AND.R6 
  330.   395 CONTINUE
  331. *     SENSE NOT FIRST ONE IN RECORD 
  332.   397 IF(PIDL.NE.0) GOTO 350
  333.       PIDL=1
  334. *     THIS PROGRAM ADDRESS
  335.       TPA=NWA 
  336. *     AND UPDATE NEXT-WORD-ADDRESS
  337.       NWA=NWA+PL
  338.       MESSAGE(2)=IDENT
  339.       CALL BDISP(MESSAGE) 
  340.       GOTO 350
  341. * /---   BLOCK      NAMING     00 000   80/06/10  03.16 
  342. * 
  343. *     GET THE NAMES OF THE COMMON VARIABLES 
  344. * 
  345.   500 CONTINUE
  346.       MESSAGE(1)=10HGETTING CO
  347.       MESSAGE(2)=10HMMON NAMES
  348.       CALL BDISP(MESSAGE) 
  349.  
  350.       CALL ECHECK(NCO,7HCOMMONS)
  351. * 
  352. *     MAKE ROOM FOR THE NAMES 
  353. * 
  354.       DO 510 I=1,CGL
  355. *      ECA=I-1
  356. *      CALL READEC(ECGUNK,ECA,1)
  357. *      ECGUNK=SHIFT(ECGUNK,-12) 
  358. *      CALL WRITEC(ECGUNK,ECA,1)
  359.       CGUNK(I)=SHIFT(CGUNK(I),-18)
  360.   510 CONTINUE
  361.  
  362.   520 READ(1,5200)D1,NAMER,D2,ADDRR,D3,BLOCKR,D4
  363.  5200 FORMAT(R8,7R1,R2,6R1,R5,7R1,R8) 
  364.       IF(EOF(1))400,522 
  365.   522 IF(D1.NE.8R         )GOTO 520 
  366.       IF(D2.NE.2R         )GOTO 520 
  367.       IF(D3.NE.5R         )GOTO 520 
  368.       IF(D4.NE.8R         )GOTO 520 
  369.       CALL NAMIT(NAMER,NAME)
  370.       IF(NAME.EQ.0) GOTO 520
  371.       CALL NAMIT(BLOCKR,BLOCK)
  372.       IF(BLOCK.EQ.0)GOTO 520
  373.       CALL ATOO(ADDRR,ADDR) 
  374.       IF(ADDR.LT.0)GOTO 520 
  375.  
  376.       CALL BCHOP(BLOCK,COMMONS,NCO,RET) 
  377.       IF(RET.LT.0)GOTO 520
  378.       RET=COMMONS(RET).AND.R3 
  379.       FWA=CINFO(RET).AND.R3 
  380.       LTH=SHIFT(CINFO(RET),-18).AND.R3
  381.       IF(ADDR.GE.LTH)GOTO 520 
  382.       ECA=FWA+ADDR
  383. *      CALL READEC(ECGUNK,ECA,1)
  384.       ECGUNK=CGUNK(1+ECA) 
  385.       ECGUNK=NAME.OR.(ECGUNK.AND.R3)
  386. *      CALL WRITEC(ECGUNK,ECA,1)
  387.       CGUNK(1+ECA)=ECGUNK 
  388.       GOTO 520
  389. * /---   BLOCK      PRINTING   00 000   80/06/10  03.47 
  390. * 
  391. *     NOW TO PRINT THE TABLES 
  392. * 
  393.   400 MESSAGE(1)=10H PRINTING 
  394.       MESSAGE(3)=0
  395.       ENCODE(130,4200,SUBHEAD)
  396.  4200 FORMAT(6X,*BLOCK     RELATIVE  ABSOLUTE  NAME*
  397.      X       6X,*PROGRAMS WITH REFERENCES*
  398.      X       *(NUMBER OF REFERENCES)*)
  399.  
  400.       DO 490 PT=1,NCO 
  401.       HI=COMMONS(PT).AND.L7 
  402.       PTR=COMMONS(PT).AND.R3
  403.       MESSAGE(2)=HI 
  404.       CALL BDISP(MESSAGE) 
  405.       CALL CSLASH(HI) 
  406.       FWA=CINFO(PTR).AND.R3 
  407.       LTH=SHIFT(CINFO(PTR),-18).AND.R3
  408.       ABS=SHIFT(CINFO(PTR),-36).AND.R3
  409.       IF(LTH.EQ.0) GOTO 490 
  410.       QZONK=LTH+2 
  411.       DO 489 FAKPT=1,QZONK
  412.       SUBPT=FAKPT-1 
  413.       J=SUBPT 
  414.       CALL OTOA(J,HJ) 
  415.       K=ABS+J 
  416.       CALL OTOA(K,HK) 
  417.       ECA=FWA+SUBPT 
  418. *      CALL READEC(ECGUNK,ECA,1)
  419.       ECGUNK=CGUNK(1+ECA) 
  420.       HL=ECGUNK.AND.L7
  421.       NL=ECGUNK.AND.R3
  422.  
  423. *     IGNORE IF NO REFERENCES 
  424.       IF(NL.EQ.0)GOTO 489 
  425.  
  426. *     SENSE IF REGULAR OR NOT 
  427.       IF(SUBPT.LT.LTH)GOTO 440
  428.       IF(SUBPT.EQ.LTH)HL=5H*AOR*
  429.       IF(SUBPT.EQ.(LTH+1))HL=5H*GOK*
  430.   440 CALL CLEAN(HL)
  431. * 
  432. *     GET LINKS AND NUMBER OF REFS AND PRINT THEM 
  433. * 
  434.       LP=0
  435.   450 LP=LP+1 
  436.       NAME=LINKS(NL).AND.L7 
  437.       NUMBER=SHIFT(LINKS(NL),-14).AND.17B 
  438.       IF(NUMBER.EQ.15)NUMBER=63 
  439.       CALL PACK(NAME,NUMBER,QREF(LP,1)) 
  440.       NL=LINKS(NL).AND.37777B 
  441. *     TEST IF OUTPUT LINE FULL
  442.       IF(LP.EQ.6)GOTO 460 
  443. *     SEE IF ANY MORE REFERENCES
  444.       IF(NL.NE.0)GOTO 450 
  445.   460 CALL NEXTLN 
  446.       PRINT 4600,HI,HJ,HK,HL,((QREF(M,N),N=1,14),M=1,LP)
  447.  4600 FORMAT(6X,4A10,84R1)
  448.       HI=1H 
  449.       IF(NL.EQ.0)GOTO 489 
  450. *     THE FOLLOWING IS FOR CONTINUED LINES
  451.       HJ=HK=HL=1H 
  452.       GOTO 440
  453.   489 CONTINUE
  454.   490 CONTINUE
  455. * 
  456. *     ALL DONE - PRINT TABLE LENGTH INFO
  457. * 
  458.       PRINT 4900,NLI,NLINKS,NCO,NCOMS,MAXTXT,TEXTL, 
  459.      X           CGL,TCOML,MAXBUF,BUFLTH
  460.  4900 FORMAT(/////*      REFERENCES *I5*/*I5
  461.      X       *,     COMMON BLOCKS *I5*/*I5
  462.      X       *,     TEXT TABLES *I5*/*I5 /
  463.      X       *,     COMMON WORDS *I5*/*I5 
  464.      X       *,     MAXIMUM RECORD SIZE *I5*/*I5) 
  465.       STOP
  466.       END 
  467. * /---   BLOCK      ROUTINES   00 000   76/12/15  14.07 
  468.       SUBROUTINE ATOO(IN,OUT) 
  469. * 
  470. *     ALPHA TO OCTAL CONVERSION ROUTINE 
  471. * 
  472.       IMPLICIT INTEGER(A-Z) 
  473.       DIMENSION IN(6) 
  474.       OUT=0 
  475.       DO 10 I=1,6 
  476.       TEMP=IN(I)
  477.       IF(TEMP.EQ.1R )GOTO 10
  478.       IF(TEMP.GT.1R7)GOTO 99
  479.       IF(TEMP.LT.1R0)GOTO 99
  480.       OUT=SHIFT(OUT,3).OR.(TEMP-1R0)
  481.    10 CONTINUE
  482.       RETURN
  483.    99 OUT=-1
  484.       END 
  485.  
  486.       SUBROUTINE NAMIT(IN,OUT)
  487. * 
  488. *     CONVERT AN NAME IN THE FORM OF AN ARRAY (ONE CHARACTER
  489. *     PER ENTRY) TO A SINGLE WORD, LEFT-JUSTIFIED.
  490. * 
  491.       IMPLICIT INTEGER(A-Z) 
  492.       DIMENSION IN(7) 
  493.       OUT=0 
  494.       BITSHF=54 
  495.       DO 10 I=1,7 
  496.       TEMP=IN(I)
  497.       IF(TEMP.EQ.1R )RETURN 
  498.       OUT=OUT.OR.SHIFT(TEMP,BITSHF) 
  499.       BITSHF=BITSHF-6 
  500.    10 CONTINUE
  501.       NAME=0
  502.       RETURN
  503.       END
plato/source/plaopl/comprt.txt · Last modified: 2023/08/05 18:54 by Site Administrator