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