!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
!         DIR   LISTS CURRENT DIRECTORY
!
!   W.S.C.    8TH APRIL 1980
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
!   STACK=2000          STREAMS=1
%CONTROL K'101011'
%BEGIN


!   DATA AREAS

%CONSTINTEGER SERV=3
%CONSTINTEGER FSERV=4
%CONSTINTEGER DIRBLK=97

%CONSTINTEGER EXAMINE=0
%CONSTINTEGER GET NEXT=1
%CONSTINTEGER DESTROY=2
%CONSTINTEGER CREATE=3
%CONSTINTEGER APPEND=4
%CONSTINTEGER RENAME=5
%CONSTINTEGER LP SER=12
%CONSTINTEGER DREAD=0
%CONSTINTEGER DWRITE=1

%RECORDFORMAT STRDF(%INTEGER A,B,C,%BYTEINTEGER SERV,REP,UNIT,FSYS)
%RECORDFORMAT STRPF(%RECORD(STRDF)%NAME ST)
%CONSTRECORD(STRPF)%NAME STRP1=K'160034'
%RECORD(STRDF)%NAME INSTR1
%CONSTRECORD(STRDF)%NAME NULL=0
%CONSTBYTEINTEGERNAME DF=K'160055'
%CONSTBYTEINTEGERNAME INT=K'160060'
%CONSTBYTEINTEGERNAME ID=K'160030'

%RECORDFORMAT FILEF(%BYTEINTEGERARRAY NAME(0:5),%C
  %INTEGER FIRST,PR)
%RECORD(FILEF)%ARRAY DIRECT(0:50)

%RECORDFORMAT PF(%BYTEINTEGER SERVICE,REPLY,%INTEGER A1,%C
  %RECORD(FILEF)%NAME A2,%INTEGER A3)
%RECORD(PF) P

%INTEGER CURFSYS,REP,QUEST,I,J,K,UNIT

%BYTEINTEGERARRAY SNAME(0:5)
!*******************************************************************
!********************************************************************


%ROUTINE GETDIR
  %INTEGER BLOCK
  P_SERVICE=SERV
  P_REPLY=ID
  P_A1=0;              !READ ONLY
  P_A2==DIRECT(0)
  P_A3=DIRBLK+CURFSYS
 P_A3=P_A3!K'020000' %IF UNIT=1
  PONOFF(P)
  %IF P_A1#0 %START
    PRINTSTRING('DIRECTORY BLOCK READ ERROR')
    NEWLINE
    %STOP
  %FINISH
%END




%ROUTINE PRINTFILE(%INTEGER IND)
  %INTEGER X
  SPACES(2)
 %IF DIRECT(IND)_NAME(0)>127 %THEN PRINTSYMBOL('#') %ELSE SPACE
  %CYCLE X=0,1,5
    PRINTSYMBOL(DIRECT(IND)_NAME(X))
  %REPEAT
  SPACES(2)
%END



%INTEGERFN NFILE
  %INTEGER X,Y
  Y=0
  %CYCLE X=0,1,50
    %IF DIRECT(X)_FIRST#0 %THEN Y=Y+1
  %REPEAT
  %RESULT=Y
%END



%INTEGERFN PNFILE
  %INTEGER X
  X=NFILE
  WRITE(X,2)
  PRINTSTRING(' FILES')
  NEWLINES(2)
  %RESULT=X
%END


%ROUTINE CURLOG
  %INTEGER X
 NEWLINE
  PRINTSTRING('FSYS=')
 WRITE(UNIT,1); PRINTSYMBOL('.')
  X=CURFSYS//8
  PRINTSYMBOL(X+'0')
  PRINTSYMBOL(CURFSYS-(X*8)+'0')
   SPACES(3)
%END




!*****************************************************************
!*******************************************************************

!CODE STARTS HERE

INSTR1==STRP1_ST
%IF INSTR1==NULL %START
   CURFSYS=DF; UNIT=0
%ELSE
   CURFSYS=INSTR1_FSYS
   UNIT=INSTR1_UNIT
%FINISH
GETDIR
CURLOG
%IF PNFILE#0 %START
  REP=-1
  QUEST=0
  %CYCLE
    %CYCLE I=0,1,5
      SNAME(I)=255
    %REPEAT
    %CYCLE J=0,1,50
      %IF DIRECT(J)_FIRST#0 %START
        %CYCLE I=0,1,5
          %EXIT %IF DIRECT(J)_NAME(I)>SNAME(I)
          %IF DIRECT(J)_NAME(I)<SNAME(I) %START
            %CYCLE K=0,1,5
              SNAME(K)=DIRECT(J)_NAME(K)
            %REPEAT
            REP=J
            %EXIT
          %FINISH
        %REPEAT
      %FINISH
    %REPEAT
      %IF REP=-1 %START
         NEWLINES(2); %STOP
      %FINISH
      PRINTFILE(REP)
      %IF QUEST=4 %THEN NEWLINE %AND QUEST =0 %C
        %ELSE QUEST=QUEST+1
      DIRECT(REP)_FIRST=0
      REP=-1
  %REPEAT
%FINISH
%STOP
%ENDOFPROGRAM