%EXTERNALROUTINE HFTB(%STRING(63) S)
!ROUTINE FOR CONVERTING HEX-PAIR FILES TO BINARY  
!J. BUTLER 1.9.78
%EXTERNALROUTINESPEC CHANGESM(%INTEGER CHAN,L)
%EXTERNALROUTINESPEC NEWSMFILE(%STRING(63) S)
%EXTERNALROUTINESPEC CLOSESM(%INTEGER CHANNEL)
%EXTERNALROUTINESPEC DEFINE(%STRING(63) S)
%EXTERNALINTEGERFNSPEC SMADDR(%INTEGER CHAN,%INTEGERNAME L)
%EXTERNALROUTINESPEC DESTROY(%STRING(63) S)
%EXTERNALINTEGERFNSPEC EXIST(%STRING(63) S)
%INTEGER INA,INL,OUTA,OUTL
%STRING(63) T,U
%UNLESS S->T.(",").U %THEN PRINTSTRING("Parameters?") %ANDRETURN
 

%IF EXIST(U)#0 %THEN DESTROY(U)
DEFINE("1,".T)
select input(1)
NEWSMFILE(U.",1")
DEFINE("2,".U)
CHANGESM(2,x'100000')
OUTA=SMADDR(2,OUTL)
%BEGIN
%BYTEINTEGERARRAYNAME IN
%BYTEINTEGERARRAYNAME OUT
%BYTEINTEGERARRAYFORMAT OUTF(0:OUTL-1)
%INTEGER I,J,A,B

%integer %fn get
      %integer i,j,n
      %owninteger last
      %if last # 0 %start
zero:    last = last-1
         %result = 0
      %finish

loop: readsymbol(n)
      %if n = '*' %then -> loop;      ! end of block marker
      j = n-'0'
      %if 0 <= j <= 9 %then %result = j
      %if 'A' <= n <= 'F' %then %result = n-'A'+10
      %if n=nl %then ->loop
      %if n = '(' %start
         read(last); skipsymbol
         -> zero
      %finish
      %if n = 'S' %then %result = -1
      %result = -1
%end

OUT==ARRAY(OUTA,OUTF)
I=0 ;J=0
%CYCLE 
SKIP1:
a=get
%IF a<0 %THENEXIT
->SKIP1 %UNLESS 0<=A<=15
SKIP2:
b=get
%IF b<0 %THENEXIT
->SKIP2 %UNLESS 0<=B<=15
OUT(J)=A<<4+B ;J=J+1
%REPEAT
INTEGER(OUTA&X'FFFF0000'+12)=3 ;!CHARACTER
CLOSESM(2)
CHANGESM(2,J)
%END
%END
%ENDOFFILE