ICL 1900 Series Computers

Sample PLAN Program

The following PLAN program is designed to run under GEORGE 3 and makes use of special G3 peripherals (File Handler and Command Issuer) to produce a directory and tree listings from filestore. The source is shown together with an example macro to run the program.

Program Source

#STE           LIST,OBJECT
#PRO           BDIR90/MAKETREE
#
#
#     AUTHOR:            B W SPOOR
#     DATE WRITTEN:      JANUARY 1981
#     SYSTEM:            G3 FILESTORE MAINTENANCE
#
#     FUNCTION:          TO PRODUCE AN ALPHABETIC LIST DIRECTORY
#                        OF ALL DIRECTORIES IN A FILESTORE LIMB
#                        AND A 'TREE' LISTING OF THAT LIMB
#
#     PERIPHERALS:       *LP0 - DIRECTORY DETAILS
#                        *LP1 - TREE DETAILS
#                        *FH0 - READ DIRECTORY COPY
#                        *CI0 - ISSUE G3 SET UP COMMANDS
#
#     LIBRARY ROUTINES:  FLSORT - MEMORY (BUBBLE) TABLE SORT
#                        BDCN   - CONVERT BINARY TO CHARACTER DATE
#
#
#PAG
#UPP           TABLE(20000)
#LOW
DIRSIZE        0
LIMBSIZE       0
LEVEL          0
NEXTLEVEL      1
STACK          16H
               STACKCONT(800)
STACKTOP       /STACKTOP
STACKPTR       1/STACK
               STPCONT(63)
CSB            /STACK+4
PSB            /STACK+4
               PSBCONT(63)
STARTDIR       60/2,0,12,/STACK
G3AS           60/1,0,8,/G3AS+4,8HAS *FH,!
G3CE           60/1,0,4,/G3CE+4,4HCE !
G3CY           60/1,0,18,/G3CY+4,20HCY :            ,!
G3ER           60/1,0,4,/G3ER+4,4HER !
G3TG           60/1,0,51,/G3TG+4
               40HTG :            (OWNERACC),:
               12H,GROUP,READ
LPHOF          2/0,0,1,/LPHOF+4.3,#11
LPBLANK1       2/0,0,1,/LPBLANK1+4.3,#01
LPBLANK2       2/0,0,1,/LPBLANK2+4.3,#02
LP0HEAD1       2/0,0,81,/LP0HEAD1+4.3,#51
               40H    #BDIR/1A  LISTING OF DIRECTORY :
               40H         AT          ON
LP0HEAD2       2/0,0,121,/LP0HEAD2+4.3,#42
               40H    TYPE    NAME           FGN  LANG
               40HFORMAT   SIZE  ONL  WRITTEN   LAST ACCES
               40HS  DUMP INCR / TAPE DETAILS
LP0CON         2/0,0,121,/LP0CON+4.3,#41
               LP0BUFF(30)
LP1HEAD        2/0,0,81,/LP1HEAD+4.3,#51
               40H    #BDIR/1A  FILESTORE TREE FROM  :
               40H         AT          ON
LP1CON         2/0,0,121,/LP1CON+4.3,#42
               LP1BUFF(30)
               X1,X7,DATE(3)
XTUSER         28H (USERNAME = :            )
XTSER          40H (SERIAL NO.= *        ,RL    RTN    )
XTFILE         4HFILE
XTMULT         4HMULT
XTMAGS         4HMAGS
XTDIR          4HDIR
XTPDIR         4HPDIR
XTE            4H(E)
XTP            4H(P)
XTT            4H(T)
XT0            8HAMORPH
XT1            8HMIXED*TP
XT2            8HNORMAL
XT5            8H*MT
XT6            8H*DA
XT11           8H*DR
XT12           8HGRAPHIC
XT22           8HALLCHAR
YES            4HY
FHCON          52/2,0,40,0
SYMBOL1        0,40,/TABLE,0,20/2.0
               SYMBOL2(40)
               SYMBOL3(20)
#PAG
#
#     DIRECTORY RECORD DEFINITION
#
#
#DEF           ERECLEN=40
#DEF           ERES=0
#DEF           ESER=ERES+1
#DEF           ELOC1=ESER+1
#DEF           ELOC2=ELOC1+1
#DEF           ELOC3=ELOC2+1
#DEF           EREEL=ELOC3+1
#DEF           EGEN=EREEL+1
#DEF           ERET=EGEN+1
#DEF           EWRITDAY=ERET+1
#DEF           EWRITTIME=EWRITDAY+1
#DEF           EGMTLA=EWRITTIME+1
#DEF           ET=EGMTLA
#DEF           ENUSE=EGMTLA+1
#DEF           ELAN=ENUSE+1
#DEF           ETM=ELAN+1
#DEF           EBLL=ETM+1
#DEF           EINF1=EBLL+1
#DEF           EINF2=EINF1+1
#DEF           EINF3=EINF2+1
#DEF           EU=EINF3+1
#DEF           EFLOW=EU+1
#DEF           EORG=EFLOW+1
#DEF           EINDEX=EORG+1
#DEF           EKEY=EINDEX
#DEF           EENDBUCK=EINDEX+1
#DEF           EVERSION=EENDBUCK+1
#DEF           ESTREND=EVERSION
#DEF           ESPARE1=EVERSION+1
#DEF           EFILNUM=ESPARE1
#DEF           EWKNAME1=ESPARE1
#DEF           ESPARE2=ESPARE1+1
#DEF           ESVCT=ESPARE2
#DEF           EWKNAME2=ESPARE2
#DEF           ESPARE3=ESPARE2+1
#DEF           EWKNAME3=ESPARE3
#DEF           ESPARE4=ESPARE3+1
#DEF           EALLOC=ESPARE4
#DEF           EWKLEVEL=ESPARE4
#DEF           EDLA=ESPARE4+1
#DEF           ETLA=EDLA+1
#DEF           EAVACC=ETLA+1
#DEF           EDLD=EAVACC+1
#DEF           ETLD=EDLD+1
#DEF           EINCLOOK=ETLD+1
#DEF           EINC=EINCLOOK+1
#DEF           EAUTOCOUNT=EINC+1
#DEF           ECOPS=EAUTOCOUNT+1
#DEF           EUSE1=ECOPS+1
#DEF           EUSE2=EUSE1+1
#DEF           EUSE3=EUSE2+1
#PAG
#PRO
#ENT           0
      PERI  0  STARTDIR            [READ START DIRECTORY NAME INTO TABLE
      LDN   4  STACK
      LDN   5  LP1HEAD+14
      MOVE  4  3                   [MOVE NAME INTO 'TREE' LIST HEADING
      LDN   5  G3TG+11
      MOVE  4  3                   [MOVE DIR NAME INTO 'TG' COMMAND
      GIVE  4  1                   [GET DATE IN CHARACTER FORMAT
      STO   4  LP0HEAD1+21
      STO   5  LP0HEAD1+22
      STO   4  LP1HEAD+21
      STO   5  LP1HEAD+22
      GIVE  4  2                   [GET TIME IN CHARACTER FORMAT
      STO   4  LP1HEAD+18
      STO   5  LP1HEAD+19
      PERI  1  LP1HEAD             [PRINT 'TREE' HEADING
      PERI  1  LPBLANK2            [THROW 2 LINES
      PERI  0  G3CE                [CREATE A ! (TEMP WORK) FILE
      LDX   1  LEVEL               [X1 = CURRENT STACK LEVEL
      LDX   2  NEXTLEVEL           [X2 = NEXT STACK LEVEL
      LDX   3  STACKPTR            [POINT TO FIRST STACK ENTRY
#
#
#     DIRECTORY STACK CONTROL ROUTINE
#
#
OPEND STOZ     DIRSIZE             [CLEAR CUMULATIVE BLOCK COUNT
      LDN   4  G3CY+5
      MOVE  3  3                   [MOVE DIR NAME TO 'ASSIGN' COMMAND
      LDN   4  G3TG+5
      MOVE  3  3                   [MOVE DIR NAME TO 'TRAPGO' COMMAND
      LDN   4  LP0HEAD1+14
      MOVE  3  3                   [AND TO DIRECTORY LIST HEADING
      GIVE  4  2                   [GET TIME IN CHARACTER FORMAT
      STO   4  LP0HEAD1+18
      STO   5  LP0HEAD1+19
      PERI  0  LP0HEAD1            [PRINT DIRECTORY LIST HEADING
      PERI  0  LPBLANK2            [THROW 2 LINES
      PERI  0  LP0HEAD2            [PRINT DIRECTORY LIST SUB-HEADING
      PERI  0  LPBLANK1            [THROW 1 LINE
      LDX   4  '4H    '
      STO   4  LP1BUFF
      LDN   4  LP1BUFF
      LDN   5  LP1BUFF+1
      MOVE  4  29                  [CLEAR PRINT BUFFER FOR 'TREE' LIST
      LDX   4  1
      TXL   4  '13'
      BCS      OPD0A               [J IF LEVEL WILL FIT ON PAGE
      LDN   4  25                  [SET PAGE OVERFLOW LEVEL POSITION
      BRN      OPD0B
OPD0A SLL   4  1
OPD0B ADN   4  LP1BUFF+2           [DIR NAME POSITION DEPENDS ON LEVEL
      MOVE  3  4                   [MOVE DIR NAME INTO 'TREE' LISTING
      LDX   0  G3TG+5
      TXU   0  STACK
      BCS      OPD1                [DON'T DO 'TG' FOR TOP LEVEL DIR
      LDX   0  G3TG+6
      TXU   0  STACK+1
      BCS      OPD1                [DON'T DO 'TG' FOR TOP LEVEL DIR
      LDX   0  G3TG+7
      TXU   0  STACK+2
      BCC      OPD2                [DON'T DO 'TG' FOR TOP LEVEL DIR
OPD1  PERI  0  G3TG                [ISSUE 'TG' FOR REQUIRED DIRECTORY
      LDCT  0  #20
      ANDX  0  G3TG+1
      BZE   0  OPD2                [J IF 'TRAPGO' OKAY
      SUSWT    #4345               [HALT:- CE
      BRN      EOF                 [IGNORE DIRECTORY
OPD2  PERI  0  G3CY                [COPY DIRECTORY TO ! FILE
      LDCT  0  #20
      ANDX  0  G3CY+1
      BZE   0  OPD3                [J IF 'COPY' OKAY
      SUSWT    #4345               [HALT:- CE
      BRN      EOF                 [IGNORE DIRECTORY
OPD3  PERI  0  G3AS                [ASSIGN ! FILE
      LDCT  0  #20
      ANDX  0  G3AS+1
      BZE   0  NEXT                [J IF OPEN OKAY
      SUSWT    #4345               [HALT:- CE
      BRN      EOF                 [CONTINUE WITH NEXT DIRECTORY
NEXT  CALL  0  READ                [GET DIRECTORY NAME RECORD
      BRN      EOF                 [END OF DIRECTORY REACHED
      LDX   2  NEXTLEVEL
      LDN   4  EUSE1(1)
      LDX   5  CSB
      MOVE  4  3                   [ADD DIRECTORY NAME TO STACK
      LDX   6  '4H    '
      LDX   4  EINF1(1)
      ANDN  4  #40
      BZE   4  NEXT0               [J IF PROPER DIRECTORY
      LDX   6  XTP
NEXT0 SMO      5
      STO   6  3                   [ADD '(P)' TO NAME IF PSEUDO
      ADN   5  4
      TXL   5  STACKTOP
      BCS      NEXT1               [J IF STILL SPACE IN STACK
      SUSWT    #6346               [HALT:- SF
      BRN      NEXT                [DON'T INCREMENT STACK POINTERS
NEXT1 STO   5  CSB                 [INCREMENT STACK POINTER
      LDN   5  1
      ADS   5  STACKPTR(2)         [COUNT NO. ITEMS ON STACK
      BRN      NEXT                [LOOP FOR NEXT DIRECTORY ENTRY
EOF   LDX   1  LEVEL
      LDX   2  NEXTLEVEL
      LDX   3  STACKPTR(2)
      BZE   3  EOF1                [J IF NO NEW DIRECTORIES FOUND
      LDCT  3  0(3)
      ADX   3  PSB(1)              [SET COUNTER/MODIFIER TO STACK POS.
EOF1  STO   3  STACKPTR(2)
      LDX   5  CSB
      STO   5  PSB(2)              [SET NEW START STACK POSITION
      LDX   3  STACKPTR(1)
      BUX   3  MORE                [J IF MORE ENTRIES AT THIS LEVEL
      NGN   3  3
MORE  ADN   3  3
      STO   3  STACKPTR(1)         [REMEMBER WHERE NEXT ENTRY IF ANY
      ADN   1  1                   [INCREMENT CURENT LEVEL
      ADN   2  1                   [INCREMENT NEXT LEVEL
AGAIN STO   1  LEVEL               [STORE NEW CURRENT LEVEL
      STO   2  NEXTLEVEL           [STORE NEW NEXT LEVEL
      LDX   3  STACKPTR(1)
      BNZ   3  OPEND               [J IF WE HAVE DIRS AT THIS LEVEL
      SBN   1  1                   [LET'S GO BACK DOWN A LEVEL
      BNG   1  FIN                 [J IF ALL LEVELS COMPLETED
      SBN   2  1
      LDX   5  PSB(1)
      STO   5  CSB                 [RESET CURRENT STACK BASE
      BRN      AGAIN               [REPEAT CHECKS FOR THIS LEVEL
#
#     END OF RUN
#
FIN   PERI  0  LPHOF               [THROW TO NEW PAGE ON 'DIR' LIST
      REL   0  2                   [RELEASE PRINTER FOR 'DIR' LIST
      LDX   4  '4H    '
      STO   4  LP1BUFF
      LDN   4  LP1BUFF
      LDN   5  LP1BUFF+1
      MOVE  4  27                  [SPACEFILL 'TREE' LIST BUFFER
      LDX   4  '4H----'
      STO   4  LP1BUFF+28
      STO   4  LP1BUFF+29
      PERI  1  LP1CON              [PRINT DASHES FOR TOTAL
      LDX   4  '4H    '
      STO   4  LP1BUFF+28
      STO   4  LP1BUFF+29
      LDCT  3  #205
      LDX   4  LIMBSIZE            [NO. KWORDS IN LIMB
      LDN   5  0
      DVR   4  '1000000'
      LDCT  6  #200
      MODE     1                   [LEADING ZERO SUPPRESS
      CBD   5  LP1BUFF+28(3)       [MOVE LIMB SIZE TO LIST BUFFER
      BCHX  3  *-1
      MODE     0
      CBD   5  LP1BUFF+28(3)
      BCHX  3  *+1
      LDN   5  #53
      DCH   5  LP1BUFF+28(3)       [ADD 'K'
      PERI  1  LP1CON              [PRINT 'TREE' LIST LAST LINE
      PERI  1  LPHOF               [THROW TO NEW PAGE ON 'TREE' LIST
      REL   1  2                   [RELEASE PRINTER FOR 'TREE' LIST
      PERI  0  G3ER                [ERASE ! (TEMP. WORK) FILE
      DEL      #5753               [DELETE:- OK
#PAG
#
#
#     READ DIRECTORY & ENTRY ROUTINE
#
#
READ  LDX   7  X7
      BNZ   7  READC               [J IF RE-ENTRY AFTER DIRECTORY
      LDX   1  SYMBOL1+2           [GET DATA BUFFER ADDRESS
READA STO   1  FHCON+3             [SET DATA ADDRESS INTO READ CONTROL
      PERI  0  FHCON               [READ DIRECTORY ENTRY
      LDX   3  FHCON+1
      LDN   3  0(3)
      TXU   3  FHCON+3
      BCC      REOF                [J IF END OF DIRECTORY REACHED
      LDX   4  ERES(1)
      BNZ   4  READA               [J IF NOT A NAME RECORD
      ADN   7  1                   [COUNT NO. ENTRIES
      ADN   1  ERECLEN             [INCREMENT BUFFER ADDRESS
      BRN      READA               [GET NEXT ENTRY
REOF  BZE   7  REOFA               [J IF DIRECTORY WAS EMPTY
      STO   7  X7
      STO   7  SYMBOL1             [STORE NO. ENTRIES READ
      CALL  1  FLSORT              [SORT INTO ALPHABETICAL ORDER
      LDN   3  SYMBOL1             [SORT PARAMETER 1
      LDN   3  SYMBOL2             [SORT PARAMETER 2
      LDN   3  SYMBOL3             [SORT PARAMETER 3
      LDX   1  SYMBOL1+2           [GET START ADDRESS OF ITEMS
      LDX   7  X7                  [GET NO. ITEMS
READB LDX   4  '4H    '
      STO   4  LP0BUFF
      LDN   4  LP0BUFF
      LDN   5  LP0BUFF+1
      MOVE  4  29                  [SPACEFILL 'DIR' LIST BUFFER
      LDN   4  ELOC1(1)
      LDN   5  LP0BUFF+3
      MOVE  4  3                   [MOVE FILENAME TO 'DIR' LIST BUFFER
      LDCT  3  #403
      LDN   5  0
      LDX   4  EGEN(1)
      DVR   4  '10000'
      LDCT  6  #200
      MODE     1                   [LEADING ZERO SUPPRESS
      CBD   5  LP0BUFF+6(3)        [MOVE FGN TO 'DIR' LIST BUFFER
      BCHX  3  *-1
      MODE     0
      CBD   5  LP0BUFF+6(3)
      LDX   4  ELAN(1)
      STO   4  LP0BUFF+8           [MOVE LANG. CODE TO 'DIR' LIST BUFFER
      STO   7  X7                  [TEMP. STORE RECORD COUNT
      STO   1  X1                  [TEMP. STORE RECORD POINTER
      LDX   4  EWRITDAY(1)
      STO   4  DATE
      CALL  1  BDCN                [CONVERT DATE WRITTEN TO CHARS
      LDN   3  DATE                [CONVERT PARAMETER 1
      LDN   3  DATE+1              [CONVERT PARAMETER 2
      LDN   4  DATE+1
      LDN   5  LP0BUFF+15
      MOVE  4  2                   [AND MOVE TO 'DIR' LIST BUFFER
      SMO      X1
      LDX   4  EDLA
      STO   4  DATE
      CALL  1  BDCN                [CONVERT DATE LAST ACCESSED TO CHARS
      LDN   3  DATE                [CONVERT PARAMETER 1
      LDN   3  DATE+1              [CONVERT PARAMETER 2
      LDN   4  DATE+1
      LDN   5  LP0BUFF+18
      MOVE  4  2                   [AND MOVE TO 'DIR' LIST BUFFER
      LDX   1  X1                  [RESTORE RECORD POINTER
      LDX   7  X7                  [RESTORE RECORD COUNT
      LDX   4  ESER(1)
      BNZ   4  RDPMT               [J IF 'MAGS' ENTRY
      LDEX  5  ECOPS(1)
      LDX   4  '4H    '
      BZE   5  *+2                 [J IF FILE IS OFFLINE
      LDX   4  YES
      STO   4  LP0BUFF+14          [SET ONLINE FLAG IN 'DIR' LIST BUFFER
      LDCT  3  #202
      LDX   4  ECOPS(1)
      SRL   45 16                  [EXTRACT NO. BLOCKS
      BPZ   5  *+2
      ADN   4  1                   [ROUND UP
      ADS   4  DIRSIZE             [ACCUMULATE BLOCKS IN DIRECTORY
      LDN   5  0
      DVR   4  '1000'
      LDCT  6  #200
      MODE     1                   [LEADING ZERO SUPPRESS
      CBD   5  LP0BUFF+12(3)       [MOVE FILE SIZE TO 'DIR' LIST BUFFER
      BCHX  3  *-1
      MODE     0
      CBD   5  LP0BUFF+12(3)
      BCHX  3  *+1
      LDN   5  #53
      DCH   5  LP0BUFF+12(3)       [ADD 'K'
      LDCT  3  6
      LDN   5  0
      LDX   4  EINC(1)
      DVR   4  '1000000'
      LDCT  6  #200
      MODE     1                   [LEADING ZERO SUPPRESS
      CBD   5  LP0BUFF+21(3)       [MOVE DUMP INC. TO 'DIR' LIST BUFFER
      BCHX  3  *-1
      LDX   5  ETM(1)              [LOAD FILE TYPE
      LDN   4  XT0
      BZE   5  RDP5                [J IF FILE IS AMORPHOUS
      ANDN  5  #77
      LDN   4  XT1
      SBN   5  #01
      BZE   5  RDP5                [J IF FILE IS MIXED *TP
      LDN   4  XT2
      SBN   5  #01
      BZE   5  RDP5                [J IF FILE IS NORMAL
      LDN   4  XT12
      SBN   5  #10
      BZE   5  RDP5                [J IF FILE IS GRAPHIC
      LDN   4  XT22
      SBN   5  #10
      BZE   5  RDP5                [J IF FILE IS ALLCHAR
      LDX   5  ETM(1)              [RELOAD FILE TYPE
      SRL   5  15
      ANDN  5  #77
      LDN   4  XT5
      SBN   5  #05
      BZE   5  RDP5                [J IF FILE IS *MT
      LDN   4  XT6
      SBN   5  #01
      BZE   5  RDP5                [J IF FILE IS *DA
      LDN   4  XT11                [MUST BE *DR
RDP5  LDN   5  LP0BUFF+10
      MOVE  4  2                   [MOVE FILE FORMAT TO 'DIR' LIST
      LDX   4  EUSE1(1)
      BNZ   4  RDPDY               [J IF FILE IS A DIRECTORY
      LDX   4  XTFILE
      LDCT  5  #060
      ANDX  5  EINF1(1)
      BZE   5  *+2                 [J IF NOT A MULTI-FILE
      LDX   4  XTMULT
      STO   4  LP0BUFF+1           [MOVE FILE TYPE TO 'DIR' LIST
      LDX   4  '4H    '
      LDCT  5  #240
      ANDX  5  EINF2(1)
      BZE   5  RDP7                [J IF NOT '(T)' OR '(E)'
      LDX   4  XTT
      SLL   5  1
      BNG   5  RDP7                [J IF FILE IS '(T)'
      LDX   4  XTE                 [FILE IS '(E)'
RDP7  STO   4  LP0BUFF+2           [MOVE TYPE FLAG TO 'DIR' LIST
RDPEN PERI  0  LP0CON              [PRINT 'DIR' LIST LINE
      ADN   1  ERECLEN             [POINT TO NEXT RECORD
      BCT   7  READB               [LOOP FOR ALL RECORDS
#
#
#     END OF DIRECTORY ROUTINE
#
#
REOFA LDCT  3  #205
      LDX   4  DIRSIZE             [NO. KWORDS IN DIRECTORY
      ADS   4  LIMBSIZE            [ACCUMULATE NO. KWORDS IN LIMB
      LDN   5  0
      DVR   4  '1000000'
      LDCT  6  #200
      MODE     1                   [LEADING ZERO SUPPRESS
      CBD   5  LP1BUFF+28(3)       [MOVE DIR SIZE TO LIST BUFFER
      BCHX  3  *-1
      MODE     0
      CBD   5  LP1BUFF+28(3)
      BCHX  3  *+1
      LDN   5  #53
      DCH   5  LP1BUFF+28(3)       [ADD 'K'
      PERI  1  LP1CON              [PRINT 'TREE' LIST LINE
      REL   0  52                  [CLOSE DIRECTORY
      STOZ     X7
      EXIT  0  0                   [RETURN - END OF FILE
#
#
#     'MAGS' ROUTINE
#
#
RDPMT LDX   4  XTMAGS
      STO   4  LP0BUFF+1           [STORE FILE TYPE IN 'DIR' BUFFER
      LDN   4  XT5
      LDN   5  LP0BUFF+10
      MOVE  4  2                   [STORE FILE FORMAT IN 'DIR' BUFFER
      LDCT  3  #610
      LDX   5  ESER(1)
RDPM1 LDN   4  0
      SLL   45 3
      DCH   4  XTSER+3(3)          [SET UP TAPE SERIAL NUMBER
      BCHX  3  RDPM1
      LDCT  3  #403
      LDX   4  EREEL(1)
      LDN   5  0
      DVR   4  '10000'
      LDCT  6  #200
      MODE     1                   [LEADING ZERO SUPPRESS
RDPM2 CBD   5  XTSER+6(3)          [SET UP REEL SEQUENCE NUMBER
      BCHX  3  RDPM2
      MODE     0
      CBD   5  XTSER+6(3)          [LAST DIGIT NOT ZERO SUPPRESSED
      LDCT  3  #203
      LDX   4  ERET(1)
      LDN   5  0
      DVR   4  '10000'
      LDCT  6  #200
      MODE     1                   [LEADING ZERO SUPPRESS
RDPM3 CBD   5  XTSER+8(3)          [SET UP RETENTION PERIOD
      BCHX  3  RDPM3
      MODE     0
      CBD   5  XTSER+8(3)          [LAST DIGIT NOT ZERO SUPPRESSED
      LDN   4  XTSER
      LDN   5  LP0BUFF+20
      MOVE  4  10                  [MOVE TAPE DETAILS TO 'DIR' BUFFER
      BRN      RDPEN
#
#
#     DIRECTORY ROUTINE
#
#
RDPDY LDX   4  XTDIR
      LDX   5  EINF1(1)
      ANDN  5  #40
      BZE   5  RDPD1               [J IF NOT PSEUDO DIRECTORY
      LDX   4  XTPDIR
RDPD1 STO   4  LP0BUFF+1           [SET DIRECTORY TYPE IN 'DIR' BUFFER
      LDN   4  XT0
      LDN   5  LP0BUFF+10
      MOVE  4  2                   [SET FILE FORMAT IN 'DIR' BUFFER
      LDN   4  EUSE1(1)
      LDCT  5  #400
      ADN   5  XTUSER+3
      MVCH  4  12                  [MOVE USERNAME TO PRESET TEXT
      LDN   4  XTUSER
      LDN   5  LP0BUFF+23
      MOVE  4  7                   [SET USER DETAILS IN 'DIR' BUFFER
      PERI  0  LP0CON              [PRINT DIRECTORY DETAILS
      STO   1  X1                  [REMEMBER RECORD ADDRESS
      STO   7  X7                  [REMEMBER RECORD COUNT
      EXIT  0  1                   [RETURN WITH DIRECTORY ENTRY
READC LDX   1  X1                  [COME BACK HERE FOR NEXT RECORD
      ADN   1  ERECLEN             [POINT TO NEXT RECORD
      BCT   7  READB               [LOOP FOR ALL RECORDS
      BRN      REOFA               [END OF DIRECTORY
#END
#FIN
#STO

Example macro

    WE COMERR,GO 9CE
    IF STR(%A)=(),SP A,(%Z)
    IF EXI(BDIRCORE),ER BDIRCORE
    LO PROGRAM BDIR
    CE !
    AS *LP0,!
    LF !,*LP
    ER !
    CE !
    AS *LP1,!
    LF !,*LP
    ER !
    EN 0,PARAM(%A)
    IF DEL(OK),GO 9OK
    DP 0,ERROR IN #BDIR RUN - ABORTED
    GO 9ER
9CE DP 0,COMMAND ERROR IN #BDIR RUN
9ER IF COR,PT BDIRCORE,ALL
    IF COR,DL
    GO 9EX
9OK DP 0,#BDIR RUN SUCCESSFUL
9EX EX