%OWNINTEGER SQL
%RECORDFORMAT NRFDFMT(%INTEGER LINK,DSNUM,   %C
  %BYTEINTEGER STATUS, ACCESS ROUTE, VALIDACTION, CUR STATE,   %C
  %BYTEINTEGER MODEOFUSE, MODE, FILE ORG, DEV CLASS,   %C
  %BYTEINTEGER REC TYPE, FLAGS, LM, RM,   %C
  %INTEGER ASVAR,AREC,RECSIZE,MINREC,MAXREC, MAXSIZE,ROUTECCY,   %C
  %INTEGER C0, C1, C2, C3, TRANSFERS,   %C
  %INTEGER DARECNUM,SPARE1,SPARE2,   %C
  %STRING(31) IDEN)
%SYSTEMINTEGERFNSPEC FORTRANDF(%INTEGER DSNUM, NUMBLOCKS, BLKSIZE, %C
  ASVARD)
%SYSTEMROUTINESPEC DATIME(%STRINGNAME DATE,TIME)
%SYSTEMROUTINESPEC SSERR(%INTEGER ERROR)
%SYSTEMROUTINESPEC IOCP(%INTEGER EP,N)
%SYSTEMINTEGERFNSPEC NEWFILEOP(%INTEGER DSNUM,ACTION,TYPE,   %C
  %INTEGERNAME AFD)
%SYSTEMINTEGERFNSPEC INREC
%SYSTEMINTEGERFNSPEC OUTREC(%INTEGER LENGTH)
%SYSTEMROUTINESPEC SIGNAL(%INTEGER EP,P1,P2,%INTEGERNAME F)
%SYSTEMINTEGERMAPSPEC COMREG(%INTEGER I)
!
!
%ROUTINE MOVE(%INTEGER LENGTH, FROM, TO)
%INTEGER I
      %RETURNIF LENGTH <= 0
      I = X'18000000'!LENGTH
      *LSS_FROM
      *LUH_I
      *LDTB_I
      *LDA_TO
      *MV_%L=%DR
%END;                                   !OF MOVE
%ROUTINE FILL(%INTEGER LENGTH, FROM,FILLER)
%INTEGER I
      %RETURNIF LENGTH <= 0
      I = X'18000000'!LENGTH
      *LDTB_I
      *LDA_FROM
      *LB_FILLER
      *MVL_%L=%DR
%END;
!
%INTEGERFN NAMEL(%INTEGER DR0)
!THIS FUNCTION DECODES THE TOP HALF OF A DESCRIPTOR PASSED BY THE IMP 
!%NAME PARAMETER AND RETURNS THE LENGTH - IN BYTES - OF THE ENTITY NAMED
%CONSTBYTEINTEGERARRAY SLEN(3:7) = 1,2,4,8,16; ! LENGTHS FOR SCALED
                                               ! DESCRIPTORS
  %IF DR0&X'02000000' = 0 %THEN %RESULT = SLEN((DR0>>27)&7)
                                 ! SCALED - CODE IN SIZE
  %RESULT = DR0&X'FFFFFF';       ! UNSCALED - LENGTH IN BOUND
%END;                            ! END OF NAMEL
!
%EXTERNALROUTINE SETMARGINS(%INTEGER STREAM,L,R)
%INTEGER I
%IF STREAM=COMREG(22) %THEN I=12 %ELSESTART
  %IF STREAM=COMREG(23) %THEN I=13 %ELSESTART
    PRINTSTRING('
 *** INVALID STREAM
')
    %MONITOR
    %STOP
  %FINISH
%FINISH
IOCP(I,L<<16!R)
%END
!
%EXTERNALROUTINE ISOCARD(%BYTEINTEGERARRAYNAME CARD)
      IOCP(10, ADDR(CARD(1)))
%END; 
!
%EXTERNALSTRINGFN DATE
%STRING (10) D, T
            D='YYYY.MM.DD'
            T='HH:MM:SS'
            DATIME(D,T)
            %RESULT = D
%END;                                   ! DATE
!
%EXTERNALROUTINE CLOSEDA(%INTEGER CHAN)
%SYSTEMROUTINESPEC CLOSEDA (%INTEGER CHANNEL)
     CLOSEDA (CHAN)
%END;
!
%EXTERNALROUTINE READDA(%INTEGER CHAN, %INTEGERNAME SECT, %INTEGER %C
  BD1, BD2, ED1, ED2)
      %OWNINTEGER FSECT
      %LONGINTEGER ADFSECT
      %RECORDNAME DAFD(NRFDFMT)
      %INTEGER START, FINISH, AFD, FLAG, SIZE, LEN, BOUND
      SSERR(164) %UNLESS 1<=CHAN<=99;  ! INVALID FILE NUMBER
      FLAG=NEW FILE OP(CHAN, 1, 3, AFD)
      SSERR(FLAG) %IF FLAG>0
      DAFD==RECORD(AFD)
      SSERR(178) %UNLESS DAFD_STATUS>=2
      START=BD2
      SIZE=NAMEL(BD1)
      FINISH=ED2+SIZE
      %IF FINISH<=START %THEN SSERR(177)
      FSECT=SECT
      ADFSECT=ADDR(FSECT)
         FLAG=FORTRANDF(CHAN, -1, 1024, ADDR(ADFSECT))
         SSERR(FLAG) %IF FLAG>0
         LEN = 1024
      %WHILE START<FINISH %THENCYCLE 
         %IF START + LEN > FINISH %THEN LEN = FINISH - START
         DAFD_DARECNUM=FSECT
         FLAG=INREC
         SSERR(FLAG) %IF FLAG>0
         MOVE(LEN,DAFD_AREC,START)
         START=START+LEN
      %REPEAT 
      SECT=FSECT-1
%END; 
!
%EXTERNALROUTINE OPENDA(%INTEGER CHAN)
%SYSTEMROUTINESPEC OPENDA (%INTEGER CHANNEL)
      OPENDA(CHAN)
%END; 
!
%EXTERNALROUTINE WRITEDA(%INTEGER CHAN, %INTEGERNAME SECT, %INTEGER %C
  BD1, BD2, ED1, ED2)
      %OWNINTEGER FSECT
      %LONGINTEGER ADFSECT
      %RECORDNAME DAFD(NRFDFMT)
      %INTEGER START, FINISH, AFD, FLAG, SIZE, BOUND
      SSERR(164) %UNLESS 1<=CHAN<=99;  ! INVALID FILE NUMBER
      FLAG=NEW FILE OP(CHAN, 2, 3, AFD)
      SSERR(FLAG) %IF FLAG>0
      DAFD==RECORD(AFD)
      SSERR(178) %UNLESS DAFD_STATUS>=2
      START=BD2
      SIZE=NAMEL(BD1)
      FINISH=ED2+SIZE
      %IF FINISH<=START %THEN SSERR(177)
      FSECT=SECT
      ADFSECT=ADDR(FSECT)
         FLAG=FORTRANDF(CHAN, -1, 1024, ADDR(ADFSECT))
         SSERR(FLAG) %IF FLAG>0
      %WHILE START<FINISH %THENCYCLE 
         DAFD_DARECNUM=FSECT
         MOVE(1024,START,DAFD_AREC)
         FLAG=OUTREC(1024)
         SSERR(FLAG) %IF FLAG>0
         START=START+1024
      %REPEAT 
      SECT=FSECT-1
%END; 
!
%EXTERNALROUTINE OPENSQ(%INTEGER CHAN)
%SYSTEMROUTINESPEC OPENSQ (%INTEGER CHANNEL)
      OPENSQ(CHAN)
%END; 
!
%EXTERNALROUTINE READSQ(%INTEGER CHAN, BD1, BD2, ED1, ED2)
      %RECORDNAME SQFD(NRFDFMT)
      %INTEGER START, FINISH, SIZE, AFD, FLAG, LENGTH, BOUND
      SSERR(164) %UNLESS 1<=CHAN<=99;  ! INVALID DATA SET NUMBER
      FLAG=NEW FILE OP(CHAN, 1, 2, AFD)
                                       ! OPEN FILE
      SSERR(FLAG) %IF FLAG>0;          ! INVALID OPERATION ON FILE
      SQFD==RECORD(AFD)
      SSERR(178) %IF SQFD_STATUS<2
      START=BD2
      SIZE=NAMEL(BD1)
      FINISH=ED2+SIZE
      LENGTH=FINISH-START
      %IF LENGTH<=0 %THEN SSERR(177);  ! ADDRESS INSIDE OUT
      FLAG=INREC;                      ! READ RECORD INTO BUFFER
      %IF FLAG>0 %THEN %START;     ! INPUT FILE ENDED
        SIGNAL(2,140,0,FLAG)
        %STOP
      %FINISH
      %IF SQFD_RECSIZE<LENGTH %START 
         MOVE(SQFD_RECSIZE, SQFD_AREC, START)
         FILL(LENGTH-SQFD_RECSIZE, START+SQFD_RECSIZE,0)
         LENGTH=SQFD_RECSIZE
      %FINISHELSE MOVE(LENGTH, SQFD_AREC, START)
      SQL=LENGTH
      %RETURN 
%END; 
!
%EXTERNALROUTINE WRITESQ(%INTEGER CHAN, BD1, BD2, ED1, ED2)
      %RECORDNAME SQFD(NRFDFMT)
      %INTEGER START, FINISH, SIZE, AFD, FLAG, LENGTH, BOUND
      SSERR(164) %UNLESS 1<=CHAN<=99;  ! INVALID DATA SET NUMBER
      FLAG=NEW FILE OP(CHAN, 2, 2, AFD)
                                       ! OPEN FILE
      SSERR(FLAG) %UNLESS FLAG <= 0
      START=BD2
      SIZE=NAMEL(BD1)
      FINISH=ED2+SIZE
      LENGTH=FINISH-START
      %IF LENGTH<=0 %THEN SSERR(177);  ! ADDRESS INSIDE OUT
      SQFD==RECORD(AFD)
      %UNLESS SQFD_MINREC<=LENGTH<=SQFD_MAXREC %THEN SSERR(161)
                                       !INVALID RECORD SIZE
      MOVE(LENGTH, START, SQFD_AREC)
      FLAG=OUTREC(LENGTH);             ! OUTPUT RECORD
      SSERR(FLAG) %UNLESS FLAG<=0;     ! INVALID OPERATION ON FILE
      %RETURN 
%END; 
%ENDOFFILE