%RECORDFORMAT NAMEF(%C
 %STRING(8)    NAME,
 %INTEGER      ID,
               ADDR,                    {-1=NOT KNOWN,OTHERWISE ABSOLUTE ADRS}
                                        {OF NAME}
               CHAIN,                   {0 NO OUTSTANDING RELOCATIONS OTHERWISE}
                                        {PTR TO HEAD OF CHAIN OF RELOCATIONS}
               LNTH,                    {OF AREA FOR SD, HOME SD NO FOR AN LD}
               OFFSET,                  { OFFSET OF LD WITHIN HOME SD}
 %BYTE         TYPE,                    {STANDARD TYPES SD,LD ETC}
               COMMON)
!
!
!
%RECORDFORMAT RR(%INTEGER CONAD,FTYPE,DSTART,DEND)
%SYSTEMINTEGERFNSPEC PSTOI(%STRING(63)S)
%EXTERNALSTRING(8)%FNSPEC IBM NAME(%STRING(1) PREFIX,%STRINGNAME NAME)
%EXTERNALROUTINESPEC PROMPT(%STRING(15) S)
%EXTERNALROUTINESPEC DEFINE(%STRING(255)PARM)
%SYSTEMROUTINESPEC OUTFILE(%STRING(31)FILE,%INTEGER SIZE,HOLE,PROT,
         %INTEGERNAME CONAD,FLAG)
%SYSTEMROUTINESPEC CHANGEFILESIZE(%STRING(31)FILE,%INTEGER NEWSIZE,%INTEGERNAME FLAG)
%SYSTEMROUTINESPEC PSYSMES(%INTEGER ROOT,FLAG)
%SYSTEMROUTINESPEC SETPAR(%STRING(255)PARM)
%SYSTEMSTRINGFNSPEC SPAR(%INTEGER N)
%SYSTEMROUTINESPEC DISCONNECT(%STRING(31)FILE,%INTEGERNAME FLAG)
%SYSTEMROUTINESPEC CONNECT(%STRING(31)FILE,%INTEGER MODE,HOLE,PROT,
         %RECORD(RR)%NAME FINFO,%INTEGERNAME FLAG)
%SYSTEMROUTINESPEC ETOI(%INTEGER ADR,LNTH)
%SYSTEMROUTINESPEC MOVE(%INTEGER LNTH,FROMAD,TOAD)
!
!                                       OUT HEX
!
%ROUTINE OUTHEX(%INTEGER VAL,WIDTH)
 %CONSTBYTEARRAY HX(0:15)='0','1','2','3','4','5','6','7',
                          '8','9','A','B','C','D','E','F'
 %INTEGER I
 %FOR I=WIDTH-4,-4,0 %CYCLE
      PRINTSYMBOL(HX((VAL>>I)&15))
 %REPEAT
%END
!
!                                       BYTE
!
%INTEGERFN BYTE(%INTEGER I)
 %RESULT = BYTE INTEGER(I)
%END
!
!                                       HALF
!
%INTEGERFN HALF(%INTEGER I)
 %RESULT=BYTE(I)<<8 ! BYTE(I+1)
%END
!
!                                       THREE
!
%INTEGERFN THREE(%INTEGER I)
 %RESULT = BYTE(I)<<16 ! BYTE(I+1)<<8 ! BYTE(I+2)
%END
!
!
!
%CONSTSTRING(1) NULL="",HASH="#",AT="@",CODE="^"
%CONSTINTEGER INVALID OPCODE=0
%CONSTINTEGER LENTRY=100{4095}
%OWNRECORD(NAMEF)%ARRAY ENTRY(0:LENTRY)
%OWNRECORD(NAMEF)%ARRAY SENTRY(0:LENTRY)
%CONSTINTEGER SEGMENT=256*1024
%CONSTBYTEINTEGER SD=0,LD=1,ER=2,CM=5;
%OWNINTEGER WORKFREE,WORKTOP,WORKBASE
%OWNINTEGER LAST ENTRY,BASE CSECT  {LAST ENTRY IN ENTRY, ENTRY CORRESPONDING TO}
                                   {FIRST ENTRY FOR CURRENT CSECT}
%OWNINTEGER LAST SENTRY                 {LAST ENTRY IN SYMBOL}
%OWNSTRING(31) SEGF,PARM ENTRY
%OWNINTEGER ICONAD
%OWNINTEGER FREESTORE,BASE ADRS,SEG END,STACK LENGTH=8192
%RECORDFORMAT RELF(%C
 %INTEGER      LOCATION,                {ABSOLUTE ADRS TO BE RELOCATED}
                                        {<0 => NEGATIVE RELOCATION}
               LINK)                    {TO NEXT RELOCN REQ}
%OWNSTRING(8) ENTRY PT="        "
%OWNINTEGER ENTRY PT OFFSET
!
!                                       RCL
!
%ROUTINE RCL(%STRINGNAME S,%INTEGER BL,%INTEGERNAME RES)
 %INTEGER I
 %RETURN %IF BL<0
 S=""
 %WHILE NEXT SYMBOL#10 %CYCLE
      READ SYMBOL(I)
      S=S.TOSTRING(I)
 %REPEAT
 READ SYMBOL(I)
%END
!
!                                       WORKSPACE
!
 %INTEGERFN WORKSPACE(%INTEGER LNTH)
 %INTEGER FLAG
  %IF WORKFREE+LNTH>WORKTOP %START
      WORKTOP=(WORKTOP+LNTH+4096)&X'FFFFF000'{ENSURE AT LEAST ONE PAGE ADDED}
      CHANGEFILESIZE("T#IBMWORK",WORKTOP-WORKBASE+1,FLAG)
      %IF FLAG # 0 %THENSTART
         PSYSMES(10,FLAG)
         %STOP
      %FINISH
  %FINISH
  WORKFREE=WORKFREE+LNTH
  %RESULT=WORKFREE-LNTH
 %END
!
!                                       INC FREE STOR
!
%ROUTINE INC FREE STORE(%INTEGER INC)
 FREE STORE = (FREE STORE + INC + 7) & X'FFFFFFF8'
 %IF FREE STORE>BASE ADRS + SEGMENT - 8096 %START
      PRINT STRING("TOO LARGE TO LOAD IN SEGMENT");NEWLINE
      %STOP
 %FINISH
%END
!
!                                       FIX UP
!
%ROUTINE FIX UP(%RECORD(NAMEF)%NAME ENT)
 %RECORD(RELF)%NAME REL
 %INTEGER VALUE
 VALUE = ENT_ADDR
 REL==RECORD(ENT_CHAIN)
 %WHILE ADDR(REL)#0 %CYCLE
      %IF REL_LOCATION<0 %START
         INTEGER(REL_LOCATION&X'7FFFFFFF')=INTEGER(REL_LOCATION&X'7FFFFFFF')-VALUE
      %FINISHELSESTART
         INTEGER(REL_LOCATION)=INTEGER(REL_LOCATION)+VALUE
      %FINISH
      REL==RECORD(REL_LINK)
 %REPEAT
 ENT_CHAIN=0
%END
!
!                                       FIND DEFN
!
%INTEGERFN FIND DEFN(%STRING(8)NM)
 %INTEGER J,TYPE
 %FOR J= 0,1,LAST SENTRY %CYCLE
      %RESULT=J %IF NM=SENTRY(J)_NAME
 %REPEAT
 %RESULT=-1
%END
!
!                                       INDEX ID
!
%INTEGERFN INDEX ID(%INTEGER ID)
 %INTEGER J
 %FOR J=LAST ENTRY,-1,BASE CSECT %CYCLE
      %RESULT = J %IF ID=ENTRY(J)_ID
 %REPEAT
 PRINT STRING("UNABLE TO FIND ENTRY FOR ESD ID = "); WRITE(ID,1); NEWLINE
 %MONITOR
%END
!
!                                       ADD ESD
!
%ROUTINE ADD ESD(%STRING(8) NM,%INTEGER ID,TYPE,ADRS,LNTH)
 %RECORD(NAMEF)%NAME ENT
 %INTEGER J,NLNTH,L
 %IF LAST ENTRY>=LENTRY %START
      PRINT STRING("TOO MANY NAMES FOR LOADER"); NEWLINE
      %STOP
 %FINISH
 LAST ENTRY = LAST ENTRY + 1
 ENT == ENTRY(LAST ENTRY)
 ENT_NAME=NM
 ENT_ID = ID
 ENT_ADDR = -1
 ENT_CHAIN=0
 ENT_TYPE=TYPE
 ENT_LNTH=LNTH
 ENT_OFFSET=ADRS
 ENT_COMMON=0
 %IF TYPE=SD %START
      ENT_ADDR = FREE STORE
      INC FREE STORE(LNTH)
 %FINISH
 %IF ENT_TYPE=LD %START
      { FIX ABSOLUTE ADDRESS OF THE ENTRY PT}
      L = INDEX ID(ENT_LNTH)
      L = FIND DEFN(ENTRY(L)_NAME)
      %IF L<0 %START
         PRINT STRING(NM." - LD ENCOUNTERED BEFORE SD INSERTED IN TABLE"); NEWLINE
         %STOP
      %FINISH
      ENT_ADDR = SENTRY(L)_ADDR + ENT_OFFSET
 %FINISH
 J = FIND DEFN(NM)
 %IF J<0 %START
      %IF LAST SENTRY>=LENTRY %START
         PRINT STRING("TOO MANY NAMES TO BE LOADED");NEWLINE
         %STOP
      %FINISH
      LAST SENTRY = LAST SENTRY + 1
      %IF ENT_TYPE=CM %START
         ENT_COMMON=1
         ENT_TYPE=ER
      %FINISH
      SENTRY(LAST SENTRY) = ENT
 %FINISHELSESTART
      %IF SENTRY(J)_TYPE # ER %AND ENT_TYPE # ER %START
         PRINT STRING(NM." - DECLARED TWICE, FIRST DEFN USED");NEWLINE
      %FINISHELSESTART
         %IF SENTRY(J)_COMMON#0 %START
            NLNTH=SENTRY(J)_LNTH
            %IF NLNTH>ENT_LNTH %THEN ENT_LNTH=NLNTH
         %FINISH
         %IF SENTRY(J)_TYPE = ER %AND ENT_TYPE#ER %START
            SENTRY(J)_TYPE = ENT_TYPE
            SENTRY(J)_ADDR = ENT_ADDR
            SENTRY(J)_LNTH = ENT_LNTH
            SENTRY(J)_OFFSET = ENT_OFFSET
            SENTRY(J)_COMMON = 0
            FIX UP(SENTRY(J))
         %FINISH
      %FINISH
 %FINISH
%END
!
!                                       DUMP TXT
!
%ROUTINE DUMP TXT(%INTEGER ADR)
 %INTEGER A,LOCN,ID,OFFSET,LNTH
 A=ADR-1
 ID = HALF(A+15)
 ID=INDEXID(ID)
 LOCN=ENTRY(ID)_ADDR+THREE(A+6)
 LNTH = HALF(A+11)
 %IF LOCN+LNTH>SEG END %START
      SEG END = (LNTH+LOCN+4095)&X'FFFFF000'
      CHANGEFILESIZE(SEGF,SEG END-BASE ADRS,ID)
      %IF ID#0 %START
         SELECT OUTPUT(0)
         PSYSMES(10,ID)
         %STOP
      %FINISH
 %FINISH
 MOVE(LNTH,A+17,LOCN)
%END
!
!                                       FIND R
!
%INTEGERFN FIND R(%INTEGER RID)
 %INTEGER NDX,I,INDX
 %RECORD(NAMEF)%NAME ENT
 INDX=INDEX ID(RID)
 NDX = FIND DEFN(ENTRY(INDX)_NAME)
 %IF NDX<0 %START
      PRINT STRING("UNABLE TO FIND ENTRY FOR ESD ID = ");WRITE(RID,1);
      PRINT STRING("(".ENTRY(INDX)_NAME." IN SYMBOL TABLE");NEWLINE
      %STOP
 %FINISH
 %RESULT=NDX
%END
!
!                                       PROCESS RLD
!
%ROUTINE PROCESS RLD(%INTEGER R,P,OFFSET,S)
 %INTEGER PNDX,LOCN,IR
 %RECORD(NAMEF)%NAME ENT
 %RECORD(RELF)%NAME REL
 IR = FIND R(R)
 ENT == SENTRY(IR)
 PNDX = INDEX ID(P)
 LOCN = ENTRY(PNDX)_ADDR+OFFSET
 %IF ENT_ADDR#-1 %START
      %IF S#0 %START
         INTEGER(LOCN)=INTEGER(LOCN)-ENT_ADDR
      %FINISHELSESTART
         INTEGER(LOCN)=INTEGER(LOCN)+ENT_ADDR
      %FINISH
 %FINISHELSESTART
      REL==RECORD(WORKSPACE(8))
      REL_LOCATION =S!LOCN
      REL_LINK = ENT_CHAIN
      ENT_CHAIN = ADDR(REL)
 %FINISH
%END
!
!                                       DUMP ESD
!
%ROUTINE DUMP ESD(%INTEGER ADR)
 %INTEGER I,A
 %OWNSTRING(8) NAME="        "
 %INTEGER ID,TID
 A=ADR-1{TO ENABLE OFFSETS AS IN DOC}
 ID=HALF(A+15)
 %FOR I=A+17,16,A+1+HALF(A+11) %CYCLE
      %IF BYTE(I+8)=LD %THEN TID=0 %ELSESTART
         TID=ID
         ID = ID + 1
      %FINISH
      MOVE(8,I,ADDR(NAME)+1)
      ETOI(ADDR(NAME)+1,8)
      ADD ESD(NAME,TID,BYTE(I+8),THREE(I+9),THREE(I+13))
 %REPEAT
%END
!
!                                       DUMP RLD
!
%ROUTINE DUMP RLD(%INTEGER ADR)
 %INTEGER A,I,NB,R,P,SIGN,S
 A=ADR-1
 NB=HALF(A+11)
 R=-1
 I=A+17
 %WHILE I<=A+16+NB %CYCLE
      %IF R<0 %START
         R=HALF(I)
         P=HALF(I+2)
         I=I+4
      %FINISH
      %IF BYTE(I)&2=0 %THEN SIGN=0 %ELSE SIGN=X'80000000'
      PROCESS RLD(R,P,THREE(I+1),SIGN)
      %IF BYTE(I)&1=0 %THEN R=-1
      I=I+4
 %REPEAT
%END
!
!                                       FIX ALL
!
%ROUTINE    FIX ALL
 %INTEGER J
 %FOR J= 0,1,LAST SENTRY %CYCLE
      %IF SENTRY(J)_CHAIN#0 %AND SENTRY(J)_ADDR#-1 %START
         FIX UP(SENTRY(J))
      %FINISH
 %REPEAT
%END
!
!                                       DUMP END
!
%ROUTINE DUMP END(%INTEGER ADR)
 %INTEGER A,I
 %OWNSTRING(8) NM="        "
 A=ADR-1
 %IF BYTE(A+17)=X'40' %START
      %IF HALF(A+15)#X'4040' %START
         I=INDEX ID(HALF(A+15))
         NM=ENTRY(I)_NAME
      %FINISH
 %FINISHELSESTART
      MOVE(8,A+17,ADDR(NM)+1)
      ETOI(ADDR(NM)+1,8)
 %FINISH
 %IF THREE(A+6)#X'404040' %START
      ENTRY PT OFFSET=THREE(A+6)
 %FINISH
      ENTRY PT = NM
%END
!
!                                       DUMP REC
!
%ROUTINE DUMP REC(%INTEGER ADR)
 %IF BYTE(ADR)#2 %START
      PRINTSTRING("INVALID RECORD ENCOUNTERED"); NEWLINE
      %RETURN
 %FINISH
 %IF BYTE(ADR+1)=X'C5' %AND BYTE(ADR+2)=X'E2' %THEN DUMP ESD(ADR) %AND %RETURN
 %IF BYTE(ADR+1)=X'E3' %AND BYTE(ADR+2)=X'E7' %THEN DUMP TXT(ADR) %ANDRETURN
 %IF BYTE(ADR+1)=X'D9' %AND BYTE(ADR+2)=X'D3' %THEN DUMP RLD(ADR) %ANDRETURN
 %IF BYTE(ADR+1)=X'C5' %AND BYTE(ADR+2)=X'D5' %THEN DUMP END(ADR) %ANDRETURN
 PRINT STRING("UNRECOGNISED RECORD TYPE"); NEWLINE
%END
!
!                                       FIX REGS
!
%ROUTINE FIX REGS
 %INTEGER BASE REG,UNDEF,INLINE,FLAG,L,J,NEXT INS,CODE,HCODE,GLA,SIMUL,ISTKTOP
 %CONSTINTEGER ENDSIM=15
 %CONSTSTRING(8)%ARRAY SIM(1:ENDSIM) = %C
  "S#NDIAG ","S#IOCP  ","S#STOP  ","S#WRITE ","S#PRINT ",
  "S#PHEX  ","S#IEXP  ","S#ILOG  ","S#ISQRT ","S#PRINTF",
  "S#SUBSTR","S#READ  ","PROMPT  ","RDFILEAD","NWFILEAS"
 BASE REG = BASE ADRS + X'20'
 NEXT INS = BASE ADRS + X'100'
 {FIX UP COMMON}
 %FOR J = 0,1,LAST SENTRY %CYCLE
      %IF SENTRY(J)_COMMON#0 %AND SENTRY(J)_ADDR=-1 %START
         SENTRY(J)_ADDR = FREE STORE
         INC FREESTORE(SENTRY(J)_LNTH)
      %FINISH
 %REPEAT
 {SET UP CODE START,LNTH GLA START,LNTH AND STACK START,LNTH}
 INTEGER(BASE REG+4*16) = NEXT INS
 INTEGER(BASE REG+4*17) = FREESTORE - NEXT INS {LENGTH OF CODE AREA}
 INTEGER(BASE REG+4*18) = BASE ADRS +X'1000' {START OF GLA}
 INTEGER(BASE REG+4*19) = FREESTORE-INTEGER(BASE REG+4*18) {LENGTH GLA}
  ISTKTOP = (FREESTORE+7)&X'FFFFFFF8'
 INTEGER(BASE REG+4*20) = ISTKTOP+8 {START OF STACK}
 INTEGER(BASE REG+4*21) = STACK LENGTH
 FREESTORE = INTEGER(BASE REG+4*20)+STACK LENGTH
 {FIX UP STACK TOP IF NECESSARY}
 J=FIND DEFN("I#STKTOP")
 %IF J>=0 %START
      %IF SENTRY(J)_ADDR=-1 %START
         SENTRY(J)_ADDR = ISTKTOP
      %FINISH
      INTEGER(SENTRY(J)_ADDR)=FREESTORE-1
 %FINISH
 NEXT INS = BASE REG + X'104'
 FIX ALL
 NEWLINE
 PRINT STRING("                SYMBOL TABLE")
 NEWLINES(2)
 SIMUL=0;UNDEF=0;INLINE=0
 %FOR J = 0,1,LAST SENTRY %CYCLE
      PRINT STRING(SENTRY(J)_NAME)
      SPACE
      %IF SENTRY(J)_ADDR = -1 %START
         {FIX UP TO SIMULATED ENTRY PT?}
         %FOR L = 1,1,END SIM %CYCLE
            %IF SIM(L)=SENTRY(J)_NAME %START
               SIMUL = SIMUL + 1
               SENTRY(J)_ADDR = X'FFFFF000' ! L
               FIX UP(SENTRY(J))
               %EXIT
            %FINISH
         %REPEAT
      %FINISH
      %IF SENTRY(J)_ADDR = -1 %START
         UNDEF=UNDEF+1
         INTEGER(NEXTINS)=INVALID OPCODE
         OUT HEX(NEXT INS,32)
         PRINT STRING("*")
         SENTRY(J)_ADDR = NEXT INS
         FIX UP(SENTRY(J))
         %IF NEXT INS+4<=BASE ADRS + 4096 %THEN NEXT INS = NEXT INS +4
      %FINISHELSESTART
         OUT HEX(SENTRY(J)_ADDR,32)
         SPACE
      %FINISH
      SPACES(3)
      INLINE = INLINE + 1
      %IF INLINE>2 %START
         NEWLINE
         INLINE=0
      %FINISH
 %REPEAT
 NEWLINE
 %IF SIMUL>0 %START
      PRINT STRING("NO. OF SIMULATED REFERENCES = ")
      WRITE(SIMUL,1)
      NEWLINE
 %FINISH
 %IF UNDEF>0 %START
      PRINT STRING("NO. OF UNDEFINED REFERENCES = ")
      WRITE(UNDEF,1)
 %FINISH
 NEWLINE
 J=-1
 CODE=-1;HCODE=-1;GLA=-1
 %IF ENTRY PT = "        " %AND PARM ENTRY # "" %START
      %IF LENGTH(PARM ENTRY)<=8 %START
         PARM ENTRY = PARM ENTRY."        "
      %FINISH
      ENTRY PT = SUBSTRING(PARM ENTRY,1,8)
 %FINISH
 %IF ENTRY PT#"        " %START
      J=FIND DEFN(ENTRY PT)
      %IF J>=0 %START 
         CODE=SENTRY(J)_ADDR+ENTRY PT OFFSET
         ENTRY PT = IBM NAME(AT,ENTRY PT)
         J = FIND DEFN(ENTRY PT)
         %IF J>=0 %START
            HCODE=SENTRY(J)_ADDR
            ENTRY PT = IBM NAME(HASH,ENTRY PT)
            J = FIND DEFN(ENTRY PT)
            %IF J>=0 %THEN GLA = SENTRY(J)_ADDR
         %FINISH
      %FINISH
 %FINISH
 INTEGER(BASE REG+4*11)=INTEGER(BASE REG+4*20){STACK POINTER}
 INTEGER(BASE REG+4*12)=HCODE
 INTEGER(BASE REG+4*13)=GLA
 INTEGER(BASE REG+4*14)=CODE
 INTEGER(BASE REG+4*15)=X'FFFFF003' {S#STOP}
 INTEGER(BASE ADRS) = FREE STORE - BASE ADRS
 %IF INTEGER(BASE ADRS)+BASE ADRS>SEG END %START
      CHANGE FILE SIZE(SEGF,INTEGER(BASE ADRS),FLAG)
      %IF FLAG#0 %START
         SELECT OUTPUT(0)
         PSYSMES(10,FLAG)
         %STOP
      %FINISH
      BYTEINTEGER(FREE STORE-1)=0
 %FINISH
 INTEGER(BASE ADRS+4)=X'1000'
 INTEGER(BASE ADRS+8) = (FREE STORE-BASE ADRS+4095) &X'FFFFF000'
 INTEGER(BASE ADRS+12) = 1 {OBJECT FILE}
 %IF CODE=-1 %OR HCODE=-1 %OR GLA=-1 %START
      PRINT STRING("ENTRY PT OR HCODE OR GLA NOT FIXED UP ");NEWLINE
 %FINISH
%END
!
!                                       IBMLOAD
!
%EXTERNALROUTINE IBMLOAD(%STRING(255) PARM)
 %STRING(31) INFILE,LIST,STK,TEMP
 %RECORD(RR) FINFO
 %INTEGER FLAG,LNTH,NEXT
!
!                                       SET UP WORK SPACE
!
 OUTFILE("T#IBMWORK",8192,257<<10,0,WORKBASE,FLAG)
 %IF FLAG#0 %START
      PSYSMES(10,FLAG)
      %RETURN
 %FINISH
 WORKFREE=WORKBASE+32      {NEXT FREE BYTE OF WORK SPACE}
 WORKTOP=WORKBASE+8191     {LAST BYTE OF WORK SPACE}
!
!
!
 SETPAR(PARM)
 LIST=SPAR(1)
 PARM ENTRY=SPAR(2)
 STK=SPAR(3)
 %IF LIST="" %THEN LIST=".OUT"
 DEFINE("1,".LIST)
 SELECTOUTPUT(1)
 ENTRY PT = "        "; ENTRY PT OFFSET = 0
 %IF STK#"" %START
      LNTH = PSTOI(STK)
      %IF LNTH<=0 %START
         PRINT STRING("Invalid stack length specified");NEWLINE
         %RETURN
      %FINISH
      STACK LENGTH = LNTH
 %FINISH
 LAST ENTRY=-1; LAST SENTRY=-1
 RCL(SEGF,-1,FLAG)
 %CYCLE
      PROMPT("SEGMENT:")
      RCL(SEGF,1,FLAG)
      %EXIT %IF SEGF#""
 %REPEAT
 %FOR NEXT ='0',1,'9' %CYCLE
      TEMP = "T#AA".TOSTRING(NEXT)
      DISCONNECT(TEMP,FLAG)
      %EXIT %IF FLAG=0
 %REPEAT
 DISCONNECT("T#AA0",FLAG)
 OUTFILE(SEGF,4*4096,SEGMENT,0,BASE ADRS,FLAG)
 %IF FLAG#0 %START
      SELECT OUTPUT(0)
      PSYSMES(10,FLAG)
      %RETURN
 %FINISH
 FREE STORE = BASE ADRS + 4096
 SEG END = BASE ADRS + 4*4096
 %CYCLE
      PROMPT("FILE:")
      RCL(INFILE,1,FLAG)
      %EXIT %IF INFILE=".END"
      %CONTINUE %IF INFILE=""
      BASE CSECT=0;LAST ENTRY=-1
      CONNECT(INFILE,0,0,0,FINFO,FLAG)
      %IF FLAG#0 %THENSTART
        SELECTOUTPUT(0)
        PSYSMES(8,FLAG)
        SELECT OUTPUT(1)
        %CONTINUE
      %FINISH
      ICONAD = FINFO_CONAD
      LNTH=INTEGER(ICONAD)
      NEXT=INTEGER(ICONAD+4)
      %WHILE NEXT+80<=LNTH %CYCLE
           DUMP REC(ICONAD+NEXT)
           NEXT = NEXT + 80
      %REPEAT
 %REPEAT
 FIX REGS
 SELECT OUTPUT(0)
 CLOSESTREAM(1)
%END
%ENDOFFILE