!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
!         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