!*****************************************************
!*                                                   *
!* THIS ROUTINE TAKES A SQ FILE IN OMF FORMAT AS     *
!* INPUT BY THE BATPIN PROGRAM FROM A BATCH          *
!* ARCHIVE TAPE, AND ASSUMING THERE IS ONLY ONE AREA *
!* FORMING A MICRO PROGRAM TRANSLATES THIS INTO      *
!* A SOURCE FORMAT SUITABLE FOR INCLUSION IN IMP     *
!* COMPILATION.                                      *
!*                                                   *
!*****************************************************
!!
!!

EXTERNALROUTINE  CMP(STRING  (63) S)
EXTERNALROUTINESPEC  OPENOMF(STRING  (32) S, INTEGER  CH, MODE)
EXTERNALROUTINESPEC  READOMF(INTEGER  CH, A, INTEGERNAME  L)
SYSTEMROUTINESPEC  OUTFILE(STRING  (15) S,  C 
      INTEGER  LEN, MAXLEN, PROT, INTEGERNAME  CONAD, LAG)
SYSTEMROUTINESPEC  MOVE(INTEGER  LEN, FROMAD, TOAD)
EXTERNALROUTINESPEC  DESTROY(STRING  (63) S)
SYSTEMROUTINESPEC  PHEX(INTEGER  N)
!!
STRING  (17) INFILE, OUTF
CONSTINTEGERARRAY  POWER(0 : 9) =  C 
1,10,100,1000,10000,100000,1000000, C 
10000000,100000000,1000000000
INTEGER  TOTAL, I, J, K, L, CONAD, FLAG, F, NEWL, TENS
RECORDFORMAT  BFM(BYTEINTEGER  TYPE, LASTENTRY, IIN0, IIN1,  C 
      INTEGER  DISP, LEN)
RECORDNAME  BHEAD(BFM)
RECORDFORMAT  FPFM(BYTEINTEGER  TYPE, PROPERTIES, ESIZE0,  C 
      ESIZE1, IIN0, IIN1, NAME USE, STRING  (32) NAME)
RECORDNAME  FP(FPFM)
ROUTINESPEC  HXWORD(INTEGERNAME  FROMAD, TOAD)
OWNINTEGER  LAST
INTEGER  ESIZE, LASTWORD, DUPS, N, P, G, FIG, ST, NUM
BYTEINTEGERARRAY  B(0 : 4120)
!!
!!
   -> ERRORP UNLESS  S -> INFILE.(",").OUTF
!!
   OPENOMF(INFILE,1,0)
!!
   READOMF(1,ADDR(B(0)),L);             ! PROPERTIES RECORD MUST COME FIRST
   IF  B(0) = 0 START ;                 ! CHECK PROPERTIES RECORD
      J = 0
      CYCLE ;                           ! THROUGH PROPERTIES ENTRIES
! CYCLE THROUGH PROPERTIES RECORD TO GET LENGTH OF AREA
         FP == RECORD(ADDR(B(J)))
         ESIZE = (FP_ESIZE0<<8)!FP_ESIZE1
         IF  FP_TYPE = 1 START 
            ESIZE = (FP_ESIZE0<<8)!FP_ESIZE1
            K = 8+LENGTH(FP_NAME)
            WHILE  ((K+3)>>2) < ESIZE THEN  CYCLE 
                                        ! THROUGH OPTIONAL WORDS
               IF  BYTEINTEGER(ADDR(B(J+K))) = 0 C 
                  THEN  TOTAL = INTEGER(ADDR(B(J+K))) AND  -> OK
               K = K+4
            REPEAT 
         FINISH ;                       ! OF TYPE 1
         -> ERRORN IF  FP_NAME USE&1 = 1;    ! END OFP PROPERTIES RECORD
         J = J+(ESIZE<<2)
      REPEAT 
   FINISH 
OK:
   PRINTSTRING("
SIZE OF THE AREA IS ")
   PHEX(TOTAL)
   PRINTSTRING("(HEX) BYTES. ")
   F = 0
   OUTFILE("SS#SWRK",TOTAL,0,0,F,FLAG)
   -> ERRORO UNLESS  FLAG = 0
!!
!!
   CYCLE ;                              ! THROUGH RECORDS IN SQ FILE
      READOMF(1,ADDR(B(0)),L)
      EXIT  IF  L = 0
      BHEAD == RECORD(ADDR(B(0)))
      -> NEXT IF  BHEAD_TYPE # 8
      MOVE(BHEAD_LEN,ADDR(B(12)),F+BHEAD_DISP)
NEXT:
   REPEAT 
!!
!!
   OUTFILE(OUTF,X'40000',0,0,CONAD,FLAG)
   -> ERRORO UNLESS  FLAG = 0
   I = CONAD+32
   DUPS = 0
   NEWL = 0
   LASTWORD = -500;                     ! HOPE THIS NEVER IS THE FIRST VALUE
   TOTAL = F+TOTAL
   NUM = 0
   UNTIL  F >= TOTAL THEN  CYCLE 
      NUM = NUM+1
      IF  INTEGER(F) = LASTWORD THEN  DUPS = DUPS+1 ELSE  START 
         IF  DUPS > 0 START 
BACKIN:
            N = I-1
            BYTEINTEGER(N) = '('
            G = 1
            DUPS = DUPS+1
            ST = 0
            CYCLE  P = 9,-1,0
               TENS = POWER(P)
               IF  DUPS >= TENS OR  ST = 1 C 
                  THEN  BYTEINTEGER(N+G) = '0'+(DUPS//(TENS)) C 
                  AND  G = G+1 AND  FIG = DUPS//TENS C 
                  AND  DUPS = DUPS-(FIG*TENS) AND  ST = 1
            REPEAT 
            I = N+G
            BYTEINTEGER(I) = ')'
            BYTEINTEGER(I+1) = ','
            I = I+2
            -> END IF  LAST = 1
         FINISH 
         DUPS = 0
         LASTWORD = INTEGER(F)
         NEWL = NEWL+1
         IF  NEWL = 5 THEN  BYTEINTEGER(I) = NL C 
            AND  I = I+1 AND  NEWL = 0
         HXWORD(F,I)
      FINISH 
      F = F+4
   REPEAT 
   IF  DUPS > 0 THEN  LAST = 1 AND  -> BACKIN
END:

   IF  NEWL = 0 THEN  BYTEINTEGER(I-2) = NL C 
      ELSE  BYTEINTEGER(I-1) = NL
! GET RID OF LAST COMMA
!!
!! FILL IN HEADER
!!
   INTEGER(CONAD) = I-CONAD;            ! ACTUAL LENGTH OF FILE CONTENTS
   INTEGER(CONAD+4) = 32;               ! LENGTH OF FILE HEADER
   INTEGER(CONAD+8) = (I-CONAD)+16;     ! MAXIMUM FILE LENGTH
   INTEGER(CONAD+12) = 3
   WRITE(NUM,0);  PRINTSTRING(" WORDS ");  NEWLINE
   DESTROY("SS#SWRK")
   STOP 
!!
!!
!!

   ROUTINE  HXWORD(INTEGERNAME  FROMAD, TOAD)
   CONSTBYTEINTEGERARRAY  HX(0 : 15) =     C 
 '0','1','2','3','4', C 
'5','6','7','8','9','A','B','C','D','E','F'
   INTEGER  I
      BYTEINTEGER(TOAD) = 'X'
      BYTEINTEGER(TOAD+1) = ''''
      TOAD = TOAD+2
      CYCLE  I = FROMAD,1,FROMAD+3
         BYTEINTEGER(TOAD) = HX(BYTEINTEGER(I)>>4)
         BYTEINTEGER(TOAD+1) = HX(BYTEINTEGER(I)&15)
         TOAD = TOAD+2
      REPEAT 
      BYTEINTEGER(TOAD) = ''''
      BYTEINTEGER(TOAD+1) = ','
      TOAD = TOAD+2
   END 
ERRORP:

   PRINTSTRING("
PARAMETERS - SHOULD BE IN FORM INFILE/OUTFILE ")
   STOP 
ERRORO:

   PRINTSTRING("
OUTFILE FAILS FLAG = ")
   WRITE(FLAG,0)
   STOP 
ERRORN:

   PRINTSTRING("
NO AREA RECORD IN PROPERTIES ")
   STOP 
END ;                                   ! OF OMFTOSRC
ENDOFFILE