Retro1.org codex

CONVRT1 
* /---   FILE TYPE = E
* /---   BLOCK      CONBIN     00 000   80/07/10  15.01 
C 'PROGRAM TO CONVERT OBJECT OUTPUT FROM 'ZILAS ASSEMBLER 
C TO 60 BIT BINARY FOR 'CYBER.
      PROGRAM CONVRT1(INPUT,OUTPUT,TAPE7=INPUT,TAPE10)
      IMPLICIT INTEGER(A-Z) 
      DIMENSION MEM(16400),IN(80),BUFF(3000)
      REWIND 7 $ REWIND 10
      DO 5 I = 1,16400
    5    MEM(I) = 0 
      DO 10 I = 1,3000
   10    BUFF(I) = 0
   15 READ (7,20) IN
   20 FORMAT(80R1)
      IF (EOF(7)) 105,25
   25 IF (IN(1) .NE. 1R9) GO TO 15
      BUFF(1) = 77000011000000000000B 
      DO 50 I = 9,16
         TEMP = IN(I) .AND. 77B 
   50    BUFF(2) = SHIFT(BUFF(2),6) .OR. TEMP 
      BUFF(2) = BUFF(2) .AND. 77777777777777000000B 
      BUFF(3) = DATE(A) 
      BUFF(4) = CLOCK(A)
      BUFF(5) = 55161723553457355555B 
      BUFF(6) = 03171520012323553657B 
      BUFF(7) = 36463736445555555555B 
      BUFF(8) = 55321114012355555555B 
      BUFF(9) = 55555555555555555555B 
      BUFF(11) = SHIFT(5,57)
      FWA = CAH(IN(17)) * 4096 + CAH(IN(18)) * 256
     X      +CAH(IN(19)) * 16 + CAH(IN(20)) 
      LEN = CAH(IN(21)) * 4096 + CAH(IN(22)) * 256
     X      +CAH(IN(23)) * 16 + CAH(IN(24)) 
      BUFF(11) = BUFF(11) .OR. FWA
      LEN = LEN .AND. 777777B 
      BUFF(11) = BUFF(11) .OR. SHIFT(LEN,30)
      IF (LEN .GT. 16400) GO TO 110 
   65 READ(7,20) IN 
      IF (EOF(7)) 120,70
   70 IF (IN(1) .EQ. 1R8) GO TO 90
      IF (IN(1) .NE. 1R6) GO TO 65
      COL = CAH(IN(3)) * 16 + CAH(IN(4))
      INDEX = CAH(IN(5)) * 4096 + CAH(IN(6)) * 256
     "        +CAH(IN(7)) * 16 + CAH(IN(8)) 
      INDEX = INDEX - FWA + 1 
      DO 80 I = 9,COL,2 
         MEM(INDEX) = CAH(IN(I)) * 16 + CAH(IN(I+1))
   80    INDEX = INDEX + 1
      GO TO 65
   90 ENTRY = CAH(IN(17)) * 4096 + CAH(IN(18)) * 256
     X        +CAH(IN(19)) * 16 + CAH(IN(20)) 
      SIZE = LEN/6 + 12 
      INDEX = 0 
      DO 100 I = 12,SIZE
         DO 100 J = 1,3 
            DO 100 K = 1,2
            INDEX = INDEX + 1 
            IS = (K-1)*8+(J-1)*20 
  100       BUFF(I) = BUFF(I) .OR.
     "                 SHIFT((MEM(INDEX) .AND. 377B),IS)
      BUFF(SIZE+1) = 23000000000000000000B
      BUFFER OUT(10,0)(BUFF(1),BUFF(SIZE+1))
      IF (UNIT(10)) 1000,1000,130 
  105 STOP 105
  110 STOP 110
  120 STOP 120
  130 STOP 130
 1000 STOP
      END 
* /---   BLOCK      CONBIN     00 000   80/07/10  15.02 
      INTEGER FUNCTION CAH(ASCII) 
      INTEGER ASCII 
      I = ASCII .AND. 377B
      IF (I .LT. 1RA) GO TO 50
      IF (I .GT. 1RF) GO TO 20
      I = I + 9 
      GO TO 40
   20 IF (I .LT. 1R0) GO TO 50
      IF (I .GT. 1R9) GO TO 50
      I = I - 27
   40 CAH = I 
      RETURN
   50 WRITE 80,ASCII
   80 FORMAT(///,10X,*ILLEGAL ASCII CHAR. = *,R1) 
      STOP 150
      END