File: DIR50.PA of Disk: V50/Source/Source-Listing-PAL-1
(Source file text)
/OS/8 DIRECT V50X FOR KBM V50
/
/
/
/
/
/
/COPYRIGHT (C) 1974 BY DIGITAL EQUIPMENT CORPORATION
/ AND 1979 BY DATAPLAN GMBH
/ AND 2015 W. VAN DER MARK
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/THIS PROGRAM HAS BEEN MODIFIED BY SEVERAL PEOPLE: LARRY FOWLER OF
/THE BOEING COMMERCIAL AIRPLANE COMPANY, SEATTLE, WASHINGTON STARTED
/BY ADDING THE "/A" OPTION TO ALPHABETIZE THE OUTPUT AND THE "/H"
/OPTION TO PRINT THE HEADER BLOCK INFORMATION USED BY DECSYSTEM-8.
/HE ALSO INCLUDED THE POSSIBILITY OF USING DIFFERENT DEVICE CODES FOR
/THE TERMINAL. 4/22/75
/
/DR. THOMAS W. MCINTYRE OF THE WEST VIRGINIA UNIVERSITY MEDICAL CENTER
/MORGANTOWN, WEST VIRGINIA ADDED THE COLUMN ORDERING ROUTINE SO THAT
/MULTIPLE COLUMN OUTPUT IS ORDERED VERTICALLY INSTEAD OF HORIZONTALLY.
/ 5/21/76
/
/JIM VAN ZEE OF THE CHEMISTRY DEPT, UNIV. OF WASHINGTON, SEATTLE, WA.
/ADDED THE "/N" OPTION FOR NUMERIC DATES AND THE "/D", "/T", AND "/X"
/OPTIONS TO SORT BY DATE OR EXTENSION. HE ALSO ADDED A 'FILE COUNT -
/# BLOCKS USED' SUMMARY, FIXED THE DATE FOR THE OS/8 V3D RELEASE, AND
/SQUEEZED EVERYTHING INTO THE ORIGINAL FILE SPACE! 9/10/76
/3/21/77, 4/15/77, 7/7/77, 1/1/78, 2/11/78, 4/15/78, 8/15/78, 11/7/78
/
/DIRECTORY LISTING PROGRAM
/JANUARY 17, 1974 H.J.
/APRIL 22, 1975 L.F.
/MAY 21, 1976 TMC
/SEPTEMBER 10, OCTOBER 20, 1976 JVZ
/MARCH 21, 1977 ADDED /X, FIXED /R/C JVZ
/APRIL 15, 1977 ADDED EXTENDED DATE JVZ
/MAY 15, 1977 ALLOWED /X BY ITSELF JVZ
/JULY 1, 1977 ADDED /D/T, OTHER THINGS JVZ
/JULY 7, 1977 MAJOR REWRITE FOR /A/B/E JVZ
/JANUARY 1, 1978 ADDED A FEW GOODIES JVZ
/FEBRUARY 11, 1978 ADDED A FEW MORE... JVZ
/APRIL 15, 1978 FIXED # COLS & /T BUG JVZ
/AUGUST 15, 1978 FIXED THE SORT ROUTINE JVZ
/NOVEMBER 7, 1978 FIXED SYMBIONT PROB JVZ
XR=10 /OTHERS ARE USED TOO
PTR=20
CNT=21
INFPTR=22
OUHAND=23
INHAND=24
LNCNT=25
EPTR=26
DAFLG=27
TEMP=30
MOIN=31
FILEC=32
OSWTCH=33
INFWDS=34
PFLAG=35
INSCNT=36
ALNCNT=37
AC2=CLA CLL CML RTL
AC4000=CLA CLL CML RAR
ALTOPT=7642
OPT1=7643
OPT2=7644
EQLS=7646 /EQUALS OPTION
DATE=7666
/ CRT=6722 /ALTERNATE CONSOLE DEVICE
IFDEF CRT <
INDVC=11
OUTDVC=12
KSF= INDVC^10+6001
KCC= INDVC^10+6002
KRS= INDVC^10+6004
KRB= KCC KRS
TSF= OUTDVC^10+6001
TLS= OUTDVC^10+6006>
DIRECT=3600
/DIRECTORY DESCRIPTION
NOPUNCH
*DIRECT
DIRBUF, 0 /ZBLOCK 2400
DIRSTR, 0
DIRNXT, 0
0
DIRADD, 0
0
DIRFIL, 0
*DIRECT+2400 /5*400 BLOCKS
DIRHDR, 0427
1203
HDRFLG, 0
HDRLEN, 0
HDRZEA, 0
HDRSQO, 0
HDRSQM, 0
HDRSYS, 0
HDRSTR, 7
HDRDID, 0
*DIRECT+2476
HDRZ6, 0 /ZBLOCK 6
HDRUDV, 0
HDRUSA, ZBLOCK 4
HDRBLK, /ZBLOCK 73
HDRVOL, 0
HDRSID, 0
HDRVER, 0
HDRREL, 0
HDR10, 0
HDR11, 0
HDRDAT, 1234
HDRBAT, 0600
*DIRECT+2600
HDRLBL, 0
ENPUNCH
FIELD 1
*4600 /KEEP THE SAME S.A.
SKP CLA /NORMAL ENTRY
JMP CHAIN /CHAIN ENTRY
CDCALL, JMS 200 /SEE WHAT THE PERSON WANTS
C5, 5
5200 /IN SPECIAL MODE
CHAIN, AC2 /GET OPTION /W
AND OPT2
SNA CLA /SKIP FOR VESION NUMBER
JMP EQUALT
JMS ERROR /PRINT VERSION NUMBER
VERNO+40 /AND IGNORE OTHER OPTIONS!
/SET UP FOR MULTIPLE ENTRIES ON A LINE
EQUALT, TAD (-14 /EQUALS OPTION WORD
STL /EXTEND THE SIGN
TAD EQLS /CHECK LEGALITY OF OPTION
SNL SZA CLA /SKIP IF GOOD
JMP BADEQ
/SUBSTITUTE .DI IF NULL EXTENSION
TAD 7604 /GET EXTENSION
SNA /SKIP IF GIVEN
TAD (411 /.DI
DCA 7604 /PUT EXTENSION BACK
/ CHECK FOR ? IN OUTPUT SPECIFICATION
TAD (-10
DCA CNT /A CNT OF -10 PUTS US AT FIRST CHAR
S1C, TAD (7605
JMS GTSXBT /GET A CHAR
TAD (-"?!7700 /CHECK FOR ?
SNA
JMP QINO
TAD ("?-"*
SNA CLA
JMP AINO
ISZ CNT
JMP S1C
/ CHECK FOR EMBEDDED * IN ANY SPECIFICATION
TAD (7605
S4L, DCA PTR
TAD (-10
DCA CNT
ACK, TAD PTR
JMS GTSXBT
TAD (-"*!7700
SZA CLA
JMP CNTUP
AC2
TAD CNT
SZA
TAD (6
SNA CLA
ISZ CNT
TAD PTR
JMS GTSXBT
SZA CLA
JMP AINO
CNTUP, ISZ CNT
JMP ACK
TAD I PTR
SNA CLA
JMP NULLCK
TAD C5
TAD PTR
JMP S4L
NULLCK, TAD (7201
DCA AO2
TAD (7201
DCA AO1
TAD 7600
SNA
JMP TTYHND
JMS 200
1
AO1, 7201
HLT
TAD AO1
JMP CMN
TTYHND, DCA TTY2
JMS 200
1
IFNDEF CRT <5524> /TTY COMPRESSED CODE
IFDEF CRT <CRT> /CRT COMPRESSED CODE
TTY2, 0
AO2, 7201
JMP IDBLVT
TAD TTY2
DCA 7600
TAD AO2
CMN, DCA OUHAND
TAD (7601
DCA BLCK
TAD 7600
JMS 200
3
BLCK, 7601
LENGTH, 0
JMP NOROOM
TAD BLCK
JMP PAGE10
BADEQ, JMS ERROR
BIGEQ+40
AINO, JMS ERROR
ILLA+40
QINO, JMS ERROR
ILLQ+40
IDBLVT, JMS ERROR
NOTTY+40
NOROOM, JMS ERROR
SPRBLM+40
ABORT, TAD ALTOPT /ABORT OPERATION AND GOTO ENDUP
SMA CLA
JMP CDCALL
CIF CDF 0
JMP 7605
PAGE 10
OUWDCT, 0 /PUT THIS AT THE BEGINNING
OCPTR, 0
PAGE10, DCA BLCKN
TAD BUFAD
DCA OCPTR
TAD (RPOS-1
DCA RPOS
TAD (-1200 /NUMBER OF WORDS IN BUFFER
DCA OUWDCT
DCA CLEN
TAD 7605
SNA
JMS DSK
DCA 7605
TAD (7605
DOMOIN, DCA INFPTR
TAD (6601
DCA AI1
TAD I INFPTR
SNA
JMP ENDCHK
JMS I O200
1
AI1, 6601
HLT
TAD AI1
DCA INHAND
JMP PAGE11
/THIS IS THE END OF OPERATION CODE
/IT CLOSES THE FILE AND HANDLES RETURNS
ENDCHK, ISZ ECHO
TAD (232
OLOOP, JMS OUTCHR
TAD (177 /GET -WORDS LEFT IN BUFFER
O200, AND OUWDCT /CHECK AGAINST NEW BUFFER #
SNA
TAD RPOS /CHECK MORE CAREFULLY!
CIA
TAD (RPOS-1
SZA CLA /SKIP IF JUST DUMPED ONE
JMP OLOOP /KEEP GOING TO DUMP ONE
TAD OUWDCT
TAD (1200 /DONT DUMP IF AT END
SZA CLA
JMS DUMP /DUMP BUFFER
TAD 7600
JMS I O200
4
7601
CLEN, 0
JMP CLOERR
JMP ABORT
OUTCHR, 0
JMP I RPOS
RPOS1, DCA I OCPTR
JMS RPOS
RPOS2, DCA HOLD
JMS RPOS
RPOS3, RTL
RTL
DCA HOLD2
TAD HOLD2
AND (7400
TAD I OCPTR
DCA I OCPTR
ISZ OCPTR
TAD HOLD2
RTL
RTL
AND (7400
TAD HOLD
DCA I OCPTR
ISZ OCPTR
ISZ OUWDCT
SKP
JMS DUMP
JMS RPOS
JMP RPOS1
RPOS, RPOS1
JMP I OUTCHR
HOLD=.
DUMP, 0
TAD LENGTH /GET LENGTH AVAILABLE
SNA /IF ZERO ITS NON FILE STRUCTURE
JMP NOMATR /IF ZERO DOESN'T MATTER
STL
TAD CLEN /ADD CURRENT SIZE
TAD (5 /ADD # OF BLOCKS
SNL SZA CLA /WE ARE OK IF SKIPS
JMP NOROOM
TAD CLEN /UPDATE CLOSING LENGTH
TAD (5 /BY NUMBER OF BLOCKS
DCA CLEN /SAVE FOR CLOSE
NOMATR, TAD OUWDCT
TAD (5210
DCA CTLWD
CIF 0
JMS I OUHAND
HOLD2=.
CTLWD, 5210 /OUTPUT BUFFER IN FIELD 1 IS
BUFAD, 5200 /5 BLOCKS LONG, ENDS AT 7577
BLCKN, 0
JMP WRTERR
TAD (5
TAD BLCKN /UPDATE BLOCK # BY 5
DCA BLCKN
TAD (-1200
DCA OUWDCT
TAD BUFAD
DCA OCPTR
JMP I DUMP
PAGE 11
*.&(2 /LOCATE COLUMN COUNT (NOW=2)
PAGE11, TAD I INFPTR /GET DEVICE NUMBER
TAD (7757
DCA TEMP
TAD I TEMP /IS IT A DIRECTORY DEVICE?
D7700, SMA CLA
JMP NFIN /NO
CIF 0
JMS I INHAND /YES, READ THE DIRECTORY
1400
DIRTY, DIRBUF
1
JMP INDERR
CDF 0
TAD I DIRTY /CODE TO CHECK FOR
CMA CLL
TAD I (DIRNXT /3602 /A LEGAL DIRECTORY
SNL
TAD D7700
SZL CLA
JMP BIDIR /DIRECTORY IS BAD
TAD DIRTY /POINT TO FIRST SEGMENT
DCA EPTR
TAD I (DIRADD /3604 /GET NO. OF INFO WORDS
CIA
DCA INFWDS
JMS REFRMT /CONVERT TO NEW FORMAT
DCA I XR /ZERO THE NEXT LOCATION
CDF 10
TAD OPT1
AND (4400 /CHECK OPTIONS A & D
DCA SORTOP
TAD OPT2
AND (21 /CHECK OPTIONS T & X
TAD SORTOP
DCA SORTOP /SAVE SORT OPTIONS
TAD SORTOP
SZA CLA
JMS SORT /DO AN INPLACE SORT
TAD EQLS
SNA
TAD (2 /OR 'TAD (3', ETC.
CIA /SET UP NEGATIVE COUNT
DCA ALNCNT /SAVE FOR LATER
TAD ALNCNT
DCA LNCNT
TAD OPT2 /CHECK DATE OPTION
RAL /N = 'NUMERIC'
SPA CLA /'SMA CLA' = 'NON-NUMERIC'
CMA
DCA DAFLG
TAD (OUTCHR /POINT TO THE HANDLER
DCA OSWTCH
JMS CRLF
CDF 0
TAD I (7777
JMS I (SETDAT
TAD DATE
JMS PDATE /PRINT THE CURRENT DATE
JMS CRLF
JMS CRLF
JMS HEADER
CMA
DCA PFLAG /INITIALIZE COLUMN OUTPUT
DCA FILEC
/ COUNT THE NUMBER OF INPUTS FROM THE SAME DEVICE
CDF 10
DCA INSCNT
TAD INFPTR
DCA MOIN
GETCNT, ISZ MOIN
TAD I MOIN
SZA CLA
JMP NOSUB
TAD (5200
DCA I MOIN
TAD (3
TAD MOIN
DCA TEMP
TAD (5200
DCA I TEMP
NOSUB, TAD MOIN
TAD (4
DCA MOIN
CMA
TAD INSCNT
DCA INSCNT
TAD OPT2 /U
AND (10
SNA CLA
TAD I MOIN
CIA
TAD I INFPTR
SNA CLA
JMP GETCNT
JMP PAGE12
NFIN, JMS ERROR
NFLEIN+40
INDERR, JMS ERROR
BADIRD+40
BIDIR, JMS ERROR
BADDIR+40
PAGE 12
/ THIS IS THE ** SUPERQUASIFACETED **
/ DIRECTORY PATTERN MATCHING ROUTINE
/THE INPUT DIRECTORY IS SEARCHED HERE, IF
/A MATCH IS FOUND USING THE INPUT GROUPING
/GOT1 GETS CONTROL WITH -BLOCKS IN THE AC
PAGE12, TAD OPT2 /CHECK /M
SPA CLA
JMP REPROC
DCA ACNT /RESET FILE COUNT
DCA BCNT / AND FILE LENGTH
REPROC, TAD FCNT
DCA MOVE1
DCA RFLAG
TAD (4 /OFFSET FOR SYMBIONT
DCA EPTR /POINT TO FIRST ENTRY
BLOOP, CDF 0
TAD I EPTR /GET FILENAME WORD
SNA CLA /SKIP IF FILE HERE
JMP HEMPTY /NO... ITS REALLY AN EMPTY
CDF 10
TAD (4 /CREATE A POINTER TO THE
TAD EPTR /END OF ENTRY FOR GTSXBT
DCA PTR
TAD RFLAG /CHECK /R
SZA CLA
JMP MATCH /EVERYTHING AFTER MATCHES
TAD INSCNT /SET NUMBER OF INPUTS
DCA XFORM /TO LOOK AT ALL AT ONCE
TAD INFPTR /ADDRESS OF FIRST INPUT
SKP
NEXTI, TAD XR /ADDRESS OF CURRENT INPUT
TAD (5 /GTSXBT SUBR REQUIRES US
DCA XR /TO POINT TO END OF FIELD
TAD (-10 /NUMBER OF CHARS TO LOOK AT
WILDX, DCA CNT
MLP, TAD XR /OK - GET A CHARACTER FROM INPUT
JMS GTSXBT
TAD (-"*!7700 /IS IT A * ?
SNA /SKIP IF NOT *
JMP WILDA /YEP... ITS A WILD CARD
TAD ("*-"? /IS IT A ?
SNA /SKIP IF NOT
JMP WILDQ /YES... FORCE MATCH ON THIS CHAR
TAD ("?&77 /RESTORE VALUE
CIA /NEGATE
DCA TEMP /AND SAVE
CDF 0
TAD PTR /NOW GET CHAR FROM DIRECTORY
JMS GTSXBT
CDF 10
TAD TEMP /DO CHARS MATCH
SNA CLA /SKIP IF THEY DO NOT
JMP WILDQ /A MATCH!!!!!!!
ISZ XFORM /HAVE WE CHECKED ALL THE INPUTS
JMP NEXTI /NO CHECK WHOLE GROUP
MEXT, DCA XFORM /NO MATCH ON THIS INPUT
TAD INFWDS /SET EPTR TO POINT TO
TAD PTR /BLOCK COUNT OF FILE
DCA EPTR
TAD XFORM /HAVE THERE BEEN ANY MATCHES?
TAD OPT2 /CHECK /V
AND (4 /ISOLATE THE BIT
/SKIPS IF INPUT DIRECTORY ENTRY IS NOT CANDIDATE
/THAT IS - IF A MATCH WAS NOT FOUND BETWEEN ANY
/OF THE INPUTS AND /V WAS NOT SPECIFIED OR
/A MATCH WAS FOUND AND /V WAS SPECIFIED
/THIS ALLOWS /V TO MEAN 'EVERYTHING BUT'
CDF 0
SZA CLA
TAD I EPTR /GET -NUMBER OF BLOCKS
CDF 10
SZA /SKIPS IF TENTATIVE OR NOT CANDIDATE
JMS GOT1 /LOOKS LIKE AN ENTRY
NEMPTY, ISZ EPTR /RETURN FROM HEMPTY
ISZ EPTR /POINT TO NEXT ENTRY
ISZ MOVE1 /CHECK NUMBER OF ENTRIES
JMP BLOOP /NOT DONE WITH SEGMENT
JMP PASSND /THE END OF A PASS, MAYBE ALL DONE
/HANDLE WILD CARDS
WILDQ, ISZ CNT /BUMP POINTER & CHAR COUNT
JMP MLP
WILDA, TAD CNT /GET CURRENT CHAR POSITION
TAD (6 /ADD SIZE OF FILENAME
SPA /SKIP IF IN EXTENSION FIELD
JMP WILDX /THIS BUMPS TO EXTENSION
CLA
MATCH, TAD (4 /SET THE MATCH FLAG
JMP MEXT /WILL INVERT /V SWITCH
/THIS ROUTINE TRANSFORMS THE DIRECTORY BY ADDING BLOCK
/NUMBERS AND EXPANDING THE 'EMPTIES' FOR EASY SORTING.
XFORM, 0 /TRANSFORM THE DIRECTORY
JMS MOVE1 /MOVE THE FIRST WORD
TAD (4
TAD INFWDS
CIA
DCA CNT /SET UP TO MOVE THE REST
TAD I PTR
SNA CLA /CHECK IF IT WAS AN EMPTY
JMP MOVMT /YES
JMS MOVE1 /NO
ISZ CNT
JMP .-2 /MOVE THE REST OF THE ENTRY
TAD I PTR /IS IT A TEMPORARY?
SZA /DON'T COUNT THOSE
ISZ ACNT /KEEP TRACK
TAD BCNT
DCA BCNT
MTRTN, TAD FILEC /NOW INSERT THE BLOCK NUMBER
DCA I XR
TAD I PTR
CIA
TAD FILEC /AND SET FOR THE NEXT ENTRY
DCA FILEC
ISZ I EPTR /DONE WITH THIS SEGMENT?
JMP XFORM+1 /NO
JMP I XFORM /YES
DCA I XR /EXPAND THE EMPTIES
MOVMT, ISZ CNT
JMP .-2
JMS MOVE1 /NOW MOVE THE LENGTH
TAD I PTR
TAD ECNT
DCA ECNT /AND SUM FOR LATER ON
JMP MTRTN
MOVE1, 0
ISZ PTR
TAD I PTR
DCA I XR
JMP I MOVE1
RFLAG= INHAND /RE-USE THIS LOCATION
PAGE
GOT1, 0
DCA TEMP /SAVE THE SIZE
TAD OPT2
AND G100 /CHECK /R
DCA RFLAG
TAD OPT1
JMS MDATE /CHECK /C
G100, 100
SZA CLA
JMP I GOT1
TAD OPT2
JMS MDATE /CHECK /O
XX60, STA STL
SNA CLA
JMP I GOT1
TAD OPT2 /CHECK /M
SPA CLA
JMP I GOT1
TAD PFLAG /CHECK PASS FLAG
SMA CLA
JMP .+5
ISZ ACNT /INCREMENT FILE COUNT
TAD TEMP
TAD BCNT /AND SUM FILE LENGTHS
DCA BCNT
JMS CHKR /SEE IF THIS IS TIME
JMP I GOT1 /NOT NOW LITTLE BEAVER
TAD OPT1
AND (10 /CHECK /I SWITCH
SZA CLA
TAD INFWDS /GET NUMBER OF ADDITIONAL WORDS
CLL CIA
IAC /USE -(INFWDS-1)
DCA PNBLK
SZL /CHECK FOR 0,1
JMP PNLOOP-2
TAD PTR
DCA XR
JMS OPRNT /DUMP ADDITIONAL INFORMATION WORDS
JMS CONVTP /SPACE
ISZ PNBLK /COUNT NUMBER
JMP .-3
TAD (-10
DCA CNT
PNLOOP, CDF 0 /PRINT FILE NAME
TAD PTR
JMS GTSXBT
JMS CONVTP
TAD (3
TAD CNT
SZA CLA
JMP .+3
TAD (".
JMS I OSWTCH
ISZ CNT
JMP PNLOOP
JMS PNBLK /PRINT BLOCK NO. (MAYBE)
JMP NODATE /F
TAD TEMP
CIA
JMS PRNUM /PRINT LENGTH
TAD INFWDS
SNA CLA
JMP NODATE
CDF 0
TAD I PTR
JMS PDATE /PRINT DATE
NODATE, JMS EOLIN
JMP I GOT1
PNBLK, 0
TAD OPT1 /B
RTL
SNL CLA
JMP SKPBLK
JMS CONVTP
TAD EPTR
DCA XR
JMS OPRNT
SKPBLK, TAD OPT1 /F
AND G100
SNA CLA
ISZ PNBLK
JMP I PNBLK
OPRNT, 0
CDF 0
TAD I XR
DCA MDATE
TAD (-4
DCA CNT
OPLP, TAD MDATE
CLL RAL
RTL
DCA MDATE
TAD MDATE
RAL
AND (7
TAD XX60
JMS CONVTP
ISZ CNT
JMP OPLP
JMP I OPRNT
MDATE, 0
RTL
SMA CLA
JMP I MDATE
ISZ MDATE /SKIP RETURN
CDF 0
TAD I PTR /GET DATE WORD
CIA
CDF 10
TAD DATE /COMPARE WITH MONITORS, 0 IF =
JMP I MDATE
PAGE
*.&(2 /LOCATE COLUMN SPACING
/ PROCESS THE EMPTIES . . .
HEMPTY, TAD (4 /POINT TO NEGATIVE SIZE
TAD INFWDS
TAD EPTR
DCA EPTR
TAD I EPTR
DCA TEMP
CDF 10
TAD OPT1 /CHECK /E
AND (200
SZA CLA
JMP LISTEM
TAD OPT2 /CHECK /M
SPA CLA
LISTEM, JMS CHKR /DO IT NOW OR JUST COUNT?
JMP NEMPTY /LATER ALLIGATOR
TAD OPT1 /CHECK /I
AND (10
SNA CLA /IF YES PAD BY ADDITIONAL INFO WORDS
JMP EMSG
TAD INFWDS
CLL RTL
TAD INFWDS /NUMBER OF SPACES=5*(INFWDS-1)
SZA
TAD (-5
SZA
JMS BLANK
EMSG, JMS MESAG
EMPTYM+40
JMS PNBLK /PRINT BLOCK ?
JMP NOSIZE /NO
TAD TEMP
CIA
JMS PRNUM /PRINT LENGTH
TAD INFWDS
SZA CLA
JMS PDATE /SPACE FOR DATE
NOSIZE, JMS EOLIN
JMP NEMPTY
EOLIN, 0
ISZ LNCNT /IS LINE FILLED?
JMP MOLIN /NO
JMS CRLF
TAD ALNCNT /RESET COUNT
DCA LNCNT
JMP I EOLIN
MOLIN, TAD (2 /OUTPUT 2 BLANKS - WAS 4
JMS BLANK
JMP I EOLIN
HEADPT, 0
CDF 0
TAD I (HDRVOL /6304
DCA TEMP
DCA I (HDRVOL /6304
TAD (HDRUSA-1 /6300-1
JMS PRINT
CDF 10
JMS MESAG
VOLMES+40
TAD TEMP
JMS PRNUM
JMS CRLF
TAD (HDRLBL-1 /6400-1
JMS PRINT
ISZ I (HDRSYS /6207 /DOES THE DEVICE HAVE A SYSTEM?
JMP HDEND /NOPE
JMS CRLF
JMS MESAG
SYSMES+40
CDF 0
TAD I (HDRSID /CHECKSYSTEM I.D.
CIA
JMS PRNUM
JMS MESAG
VERMES+40
CDF 0
TAD I (HDRVER
JMS PRNUM
CDF 0
TAD I (HDRREL
JMS CONVTP
HDEND, JMS CRLF
JMS MESAG
HDRINI+40
CDF 0
TAD I (HDRBAT
JMS I (SETDAT
CDF 0
TAD I (HDRDAT
JMS PDATE
CDF 0
TAD I (HDRDID
SZA
JMS I (DIRDAT
JMS CRLF
JMS CRLF
JMP I HEADPT
PAGE
/THIS CODE TESTS THE COLUMN COUNT, AND WHEN IT IS 2 OR MORE
/GENERATES THE OUTPUT IN COLUMN ORDER RATHER THAN ROW ORDER
/BY MAKING SEVERAL PASSES THROUGH THE DIRECTORY. ADDED BY
/TOM MCINTYRE, WVU MEDICAL CENTER 5/21/76. REVISED BY JVZ
C400, 400 /FIRST THING ON THE PAGE
CHKR, 0
TAD ALNCNT /CHECK COLUMN COUNT
CLL IAC
SNA CLA /IS IT > 1
ISZ CHKR /NO, SKIP CODE FOR SINGLE COLUMN
TAD PFLAG /GET PASS INDICATOR FLAG
SMA CLA /IF PASS FLAG<0 WE ARE COUNTING
JMP PROCF /IF PASS FLAG >=0 WE ARE PROCESSING
SNL /SET IF ALNCNT=-1
ISZ FILEC /INCREMENT FILE COUNT COUNTER
DCA COLCNT /CLEAR FOR SINGLE COLUMN OUTPUT
JMP I CHKR /CONTINUE DIRECTORY SCAN
/THIS CODE ACTUALLY COUNTS THE ENTRIES AND CALLS OUTPUT
PROCF, ISZ SKPCTR /DO THIS ONE?
JMP I CHKR /NO, SKIP TO NEXT
ISZ COLCTR /DO WE CHANGE IT YET?
SKP /NOT YET
ISZ SKPCNT /YES, ONE LESS PER COLUMN
TAD SKPCNT /YES, AND INIT COUNT FOR NEXT
DCA SKPCTR
ISZ CHKR /NOW IS THE TIME TO SKIP
ISZ FILEC /ARE WE ALL DONE?
JMP I CHKR /NO, GO DO IT
ALLDUN, TAD COLCNT /YES, FINISH UP
SZA CLA
JMS CRLF /ONLY 1 IF IT CAME OUT EVEN
JMS CRLF
TAD ACNT /PRINT FILE COUNT
JMS PRNUM
4
JMS MESAG
FILESM+40
TAD BCNT /BLOCKS USED. . .
CIA
JMS PRNUM
4
JMS MESAG
BLOCKM+40
TAD ECNT /AND SPACE REMAINING
CIA
JMS PRNUM
4 /FORCE A SINGLE 0 IF NONE
JMS MESAG
FRBLM+40
JMS CRLF
TAD OPT2 /P - CONTROLS PAGING
C200, AND C400 /INVERTED IN VER. 5H
SZA CLA /WAS 'SNA CLA'
TAD (14 /FORM FEED
JMS I OSWTCH /SAVE PAPER!
TAD MOIN
JMP DOMOIN
/COME HERE AFTER COMPARING ALL THE DIRECTORY ENTRIES
PASSND, TAD FILEC /CHECK IF WE'RE DONE
SZA
CMA /OR ALMOST DONE
SNA CLA
JMP ALLDUN /YES WE ARE
ISZ PFLAG /WHICH PASS?
JMP PRCPAS /A PRINTING PASS
DCA SKPCNT /DIVIDE THINGS UP
TAD FILEC
TAD ALNCNT
ISZ SKPCNT
SMA SZA
JMP .-3 /HOW MANY ROWS?
SNA /WHEN DO WE BREAK IT?
JMP .+3 /WE DON'T, IT CAME OUT EVEN
CMA /SINCE IT IS A PREINCREMENT
TAD ALNCNT
DCA COLCNT /CHANGE COUNT AT THIS COLUMN
TAD SKPCNT
CIA
DCA SKPCTB /BASE COLUMN CTR
TAD FILEC
CMA
DCA FILEC /FILE COUNTER
DCA ROWCNT /INIT THE ROW TO 0
PRCPAS, ISZ ROWCNT /SKIP THIS MANY AT FIRST
TAD ROWCNT
CIA
DCA SKPCTR /FOR FIRST ENTRY IN ROW
TAD COLCNT /REINIT THE COLUMN COUNT
DCA COLCTR
TAD SKPCTB
DCA SKPCNT /REINIT THE LENGTH ALSO
JMP REPROC /BACK FOR ANOTHER PASS!
SKPCNT= XR 1 /OFFSET BETWEEN TWO PASSES
SKPCTR= XR 2 /ACTIVE COUNTER FOR SKIPS
ROWCNT= XR 3 /INIT SKIP FOR EACH ROW
SKPCTB=.
DSK, 0 /DSK LOOKUP
DCA COLCTR
JMS I C200
12
5723
COLCTR, 0
COLCNT, 0
JMP IDBLVT
TAD COLCTR
JMP I DSK
DIRDAT, 0
DCA DSK
TAD DSK
RTL
RTL
JMS I (SETDAT
JMS MESAG
DIRMSG+40
TAD DSK
TAD (3662 /1970
JMS I (PRNUM
JMP I DIRDAT
DIRMSG, TEXT " DIRECTORY DATE: "
PAGE
/THE DATE ROUTINE NOW PRINTS EITHER ALPHANUMERIC DATES
/OR STRAIGHT NUMERIC ONES IF THE USER SPECIFIES "/N".
/MODIFIED BY JIM VAN ZEE, U/W DEPT. OF CHEM. 9/10/76.
/ADDED V3D CODE TO PRINT DATES AFTER 1977. 4/15/77.
PDATE, 0
CDF 10
SNA
JMP FDATE
DCA TEMP
TAD DATE
SNA CLA
JMP FDATE
DCA PRBLNK /SUPPRESS BLANKS
JMS CONVTP /THEN PRINT ONE!
TAD DAFLG
SZA CLA
JMP M0NTHS
M0NS, TAD TEMP
RTR
RAR
AND (37
JMS PRNUM
3
TAD DAFLG
SNA
JMP MONTHS
MONS, CMA CLL RAL /0 OR -2
TAD ("/
JMS I OSWTCH
TAD TEMP
JMS CKYEAR /COMPARE WITH CURRENT YEAR
DCA TEMP
TAD TEMP
JMS PRNUM
3
TAD PRBLNK-3 /'JMS CONVTP'
DCA PRBLNK
JMP I PDATE
FDATE, TAD LNCNT /SEE IF AT END OF LINE?
IAC /AC=0 NOW IF YES
SNA CLA /OUTPUT SPACES TO FILL DATE SLOT
JMP I PDATE /NO NEED FOR SPACES AT END OF LINE
TAD DAFLG /0 OR -1
TAD (12 /10 SPACES IS WHATS NEEDED
JMS BLANK
JMP I PDATE /LEAVE
M0NTHS, JMS MOONS
JMS PRNUM
3
TAD ("/
JMS I OSWTCH
JMP M0NS
MONTHS, TAD ("-
JMS I OSWTCH
JMS MOONS
TAD (-15
SPA CLA
JMS MOONS
CLL RAL
TAD (DATTAB+40
DCA PNTFLG
JMS MESAG
PNTFLG, 0
JMP MONS
PWRTEN, -1750;-144;-12;-1
DIGIT=.
MOONS, 0
TAD TEMP
CLL RAL
RTL
RTL
AND (37
JMP I MOONS
PRNUM, 0
CDF 10
DCA CNT
TAD I PRNUM /POSITION TO FORCE PRINTING
CIA
DCA XR /(OPTIONAL)
TAD (TAD PWRTEN
DCA DIVLPY
DCA PNTFLG
DCA DIGIT
DIVLPY, TAD PWRTEN
SNA
JMP I PRNUM
CLL
TAD CNT
SNL
JMP PRTDIG
DCA CNT
ISZ DIGIT
JMP DIVLPY
PRTDIG, STA STL /XX60
AND DIGIT
ISZ DIVLPY
ISZ PNTFLG
SZA
JMP .+3
ISZ XR
JMP PRBLNK
TAD PRTDIG
JMS CONVTP
CMA
JMP DIVLPY-2
PRBLNK, JMS CONVTP
JMP DIVLPY-2
VOLMES, TEXT " VOLUME-"
SYSMES, TEXT "SYSTEM TYPE"
PAGE
/THIS IS THE (BUBBLE) SORT ROUTINE. ORIGINALLY ADDED BY
/LARRY FOWLER, BCAC (4/22/75); REVISED BY JVZ (8/15/78).
SORT, 0
CDF 0
TAD (6 /4 FOR NAME, 1 FOR LEN & BLK
TAD INFWDS / PLUS ADDITIONAL INFO WORDS
DCA XR
TAD FCNT
DCA CNT1 /SET FILE COUNTER
TAD (4 /OFFSET FOR SYMBIONT
JMP SORTX /INITIALIZE POINTERS
NEXT1, TAD CNT1 /SET FILE SCAN COUNT
DCA CNT2
TAD PT1
TAD XR
JMP CHECK+1 /INITIALIZE SECOND POINTER
/THIS ROUTINE CHECKS IF THE FILES ARE IN THE RIGHT ORDER
CHECK, TAD PT2 /ADVANCE TO THE NEXT FILE
DCA PT2
TAD I PT1 /CHECK IF WE HAVE AN EMPTY
SZA CLA
JMP NOTMT /WE DON'T
TAD I PT2
SZA CLA
JMP MOVE+2 /MOVE EMPTIES TO THE END
CMA
TAD XR
JMS SETUP /KEEPING THE RIGHT SEQUENCE
TAD I CK1
STL CIA
TAD I CK2 /IF THERE ARE TWO IN A ROW.
JMP MOVE
NOTMT, TAD (4
JMS SETUP /SORTS BY DATE, NAME, OR EXTENSION
CDF 10
JMS CKDATE /CHECK THE DATE FIRST
JMS SWAP
IAC
AND SORTOP /THEN CHECK THE EXTENSION
SNA CLA
JMP CKNAME /X NOT SPECIFIED
TAD (3
JMS SETUP
TAD I CK1
STL CIA
TAD I CK2
JMS SWAP
IAC
CKNAME, TAD (-4 /NOW CHECK THE NAME
DCA CNT
JMS SETUP
NXTCHR, TAD I CK1
STL CIA
TAD I CK2
JMS SWAP
ISZ CK1 /EQUAL, KEEP CHECKING
ISZ CK2
ISZ CNT /DONE?
JMP NXTCHR /NOT YET
NOSWAP, TAD XR /IDENTICAL, OR PROPERLY ORDERED
ISZ CNT2 /WAS THE PREVIOUS FILE THE LAST
JMP CHECK /NO, CHECK THE NEXT ONE
TAD PT1 /ADVANCE TO THE NEXT POSITION
SORTX, DCA PT1
ISZ CNT1 /LAST FILE?
JMP NEXT1 /NO
CDF 10
JMP I SORT /YES
/THIS ROUTINE DOES THE ACTUAL SWAPPING
SWAP, 0
SNA CLA /ARE THEY THE SAME
JMP I SWAP /YES
TAD I PT2 /NO
SZA CLA /KEEP EMPTIES AT END
MOVE, SNL CLA /CHECK THE ORDER
JMP NOSWAP /RETURN TO THE LOOP
JMS SETUP
TAD XR /GET FILE ENTRY SIZE
CIA
DCA CNT /SET LOOP COUNTER
CONT, TAD I CK1
DCA TEMP
TAD I CK2
DCA I CK1
TAD TEMP
DCA I CK2
ISZ CK1
ISZ CK2
ISZ CNT
JMP CONT
JMP NOSWAP
SETUP, 0 /SET CHECK POINTERS
DCA TEMP
TAD TEMP /AC = OFFSET
TAD PT1
DCA CK1
TAD TEMP
TAD PT2
DCA CK2
JMP I SETUP
/MOVE AND COMPACT THE DIRECTORY BY MAKING ALL ENTRIES
/THE SAME LENGTH AND REMOVING EXTRANEOUS INFORMATION.
REFRMT, 0 /THIS IS ONLY DONE ONCE
TAD (4-1
DCA XR /FIRST ENTRY IS AT 4
DCA ACNT /CLEAR ACTIVE COUNTER
DCA BCNT /AND BLOCKS USED
DCA FCNT /ZERO NUMBER OF FILES
DCA ECNT /LIKEWISE THE EMPTY SPACE
MAINLP, TAD EPTR /SET UP CORE POINTER
DCA XR 1
TAD I EPTR /GET NO. OF ENTRIES
TAD FCNT /IN THIS SEGMENT
DCA FCNT /AND ADD TO THE TOTAL
TAD I XR 1
DCA FILEC /INITIALIZE THE BLOCK
TAD (4
TAD EPTR /POINT TO NEXT SEGMENT
DCA PTR
JMS XFORM /MOVE AND TRANSFORM
TAD I XR 1
SNA CLA /LAST SEGMENT?
JMP I REFRMT /YES DF=0
TAD (400
TAD EPTR /NO, ADVANCE ONE
DCA EPTR
JMP MAINLP
PT1= PTR
PT2= EPTR
CK1= MOIN
CK2= DAFLG
SORTOP= FILEC
CNT1= XR 1
CNT2= XR 2
ACNT= XR 4
BCNT= XR 5
ECNT= XR 6
FCNT= XR 7
PAGE
*4000
TYPE, 0
DCA GTSXBT
JMS CTYPE /^O
217
DCA ECHO
TAD ECHO
SNA CLA
JMP I TYPE
JMS CTYPE /^C
203
JMP SPURGE
JMS CTYPE /^P
220
JMP SPURGE+1
TAD GTSXBT
JMS TTY
JMP I TYPE
SPURGE, CMA
DCA ALTOPT
JMP ABORT
CTYPE, 0
TAD (200
KRS
CIA
TAD I CTYPE
SNA CLA
KSF
JMP IDLE
KCC
TAD ("^
JMS TTY
TAD I CTYPE
TAD (100
JMS TTY
TAD (215
JMS TTY
TAD (212
JMS TTY
SKP
IDLE, ISZ CTYPE
ISZ CTYPE
JMP I CTYPE
TTY, 0
TLS
TSF
JMP .-1
M100, SMA CLA
JMP I TTY
ECHO, 1
/THIS IS THE ERROR MESSAGE PRINTER
ERROR, 0
AC4000 /='TYPE'
DCA OSWTCH
ISZ ECHO
TAD M100
DCA CNT
CDF 10
PLOOP, TAD I ERROR
JMS GTSXBT
ISZ CNT
SNA
JMP .+3
JMS CONVTP
JMP PLOOP
JMS CRLF
JMP ABORT
BLANK, 0 /BLANKS ROUTINE
CIA
DCA CRLF
JMS CONVTP
ISZ CRLF
JMP .-2
JMP I BLANK
CONVTP, 0
SZA
TAD (240
AND (77
TAD (240
CDF 10
JMS I OSWTCH
JMP I CONVTP
GTSXBT, 0
CLL RAL
TAD CNT
CML RAR
DCA CRLF
TAD I CRLF
SNL
BSW
AND (77
JMP I GTSXBT
CRLF, 0
CLA
CDF 10
TAD (215
JMS I OSWTCH
TAD (212
JMS I OSWTCH
JMP I CRLF
MESAG, 0
TAD M100
DCA CNT
MSGLP, TAD I MESAG
JMS GTSXBT
ISZ CNT
SNA
JMP MSGND
JMS CONVTP
JMP MSGLP
MSGND, ISZ MESAG
JMP I MESAG
WRTERR, JMS ERROR
OUERR+40
CLOERR, JMS ERROR
CLERR+40
PAGE
VERNO, TEXT "DIRECT V50X"
ILLQ, TEXT "ILLEGAL ?"
ILLA, TEXT "ILLEGAL *"
EMPTYM, TEXT "<EMPTY> "
FRBLM, TEXT " FREE BLOCKS"
VERMES, TEXT " VERSION "
BIGEQ, TEXT "EQUALS OPTION BAD"
BADDIR, TEXT "BAD DIRECTORY"
OUERR, TEXT "ERROR WRITING FILE"
CLERR, TEXT "ERROR CLOSING FILE"
SPRBLM, TEXT "NO ROOM FOR OUTPUT"
BADIRD, TEXT "ERROR READING DIRECTORY"
NFLEIN, TEXT "NO DIR-DEVICE"
NOTTY, TEXT "NO TTY HANDLER"
FILESM, TEXT " FILES IN "
BLOCKM, TEXT " BLOCKS - "
HDRINI, TEXT "INITIALIZED: "
DATTAB, TEXT "BAD" /PROTECTION AGAINST BAD DATES
TEXT "JAN"
TEXT "FEB"
TEXT "MAR"
TEXT "APR"
TEXT "MAY"
TEXT "JUN"
TEXT "JUL"
TEXT "AUG"
TEXT "SEP"
TEXT "OCT"
TEXT "NOV"
TEXT "DEC"
CKDATE, 0 /ORGANIZE OUTPUT CHRONOLOGICALLY
TAD SORTOP /DF=10
AND (420 /CHECK D AND T
SZA CLA
TAD INFWDS /THERE MUST BE A SYSTEM DATE
CLLCIA, CLL CIA
AND DATE /AND ENOUGH INFORMATION WORDS
CDF 0
SNA CLA
JMP I CKDATE /OTHERWISE ITS **NO DEAL**
TAD SORTOP /CHECK /T
AND (20 /'CML' BIT
TAD CLLCIA
DCA TEST1
TAD I CK1 /GET THE FIRST DATE
JMS CKYEAR /TRANSFORM THE YEAR
DCA TEST2
TAD I CK2 /REPEAT
JMS CKYEAR
TEST1, CLL CIA /COMPARE YEARS
TAD TEST2
SZA
JMP I CKDATE /UNEQUAL
TAD TEST1
DCA TEST2 /EQUAL: CHECK MONTH, DAY
TAD I CK2
AND (7770
TEST2, CLL CIA
TAD I CK1
AND (7770 /REMOVE THE YEAR BITS
JMP I CKDATE
CKYEAR, 0 /EXTENDED DATE CHECK FOR OS/8-V3D
SNA /T FIX: LEAVE UNDATED FILES ALONE
JMP I CKYEAR / THANKS TO DON HARMER, GA. TECH.
CDF 0
AND (7
DCA TEMP
CDF 10
TAD DATE /COMPARE WITH THE SYSTEM DATE
AND (7
CIA
TAD TEMP
SMA SZA CLA
TAD (-10 /TOO BIG, DECREASE BY 8
TAD (106-144 /70-100
TAD EXTDAT
TAD TEMP
SPA SNA
TAD (144 /100
CDF 0
JMP I CKYEAR
SETDAT, 0
CLL RTR
RTR
AND (70 /GET EXTENDED DATE BITS
DCA EXTDAT
CDF 10
JMP I SETDAT
EXTDAT, 0
PRINT, 0
DCA XR
CDF 0
TAD I XR
SZA
TAD (-232
SNA
JMP I PRINT
TAD (232
CDF 10
JMS I OSWTCH
JMP PRINT+2
HEADER, 0
CDF 0
ISZ I (HDRFLG /6202
JMP I HEADER
CDF 10
TAD OPT1
AND (20 /CHECK THE HEADER OPTION
SZA CLA /WAS SNA CLA, FOR ALWAYS EXCEPT
JMS HEADPT
CDF 0
TAD I (HDRDID
SNA
JMP I HEADER
AND (70 /GET EXTENDED DATE BITS
DCA EXTDAT
JMP I HEADER
PAGE
FIELD 1
*4600
$$$$$$