File: DIR40.PA of Tape: Various/Tests/Blank-Tape-Unit1
(Source file text)
/ OS/8 DIRECT V40A FOR KBM V40
/
/
/
/
/
/
/COPYRIGHT (C) 1974 BY DIGITAL EQUIPMENT CORPORATION
/ AND 1979 BY DATAPLAN GMBH
/
/
/
/
/
/
/
/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 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
/
/W VAN DER MARK ADDED SOME NICE GERMAN MESSAGES
/26-JUN-79
/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
/JUNE 26, 1979 ALTERNATE GERMAN TEXT WVDM
GERMAN=1
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>
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, 3600
1
JMP INDERR
CDF 0
TAD I DIRTY /CODE TO CHECK FOR
CMA CLL
TAD I (3602 /A LEGAL DIRECTORY
SNL
TAD D7700
SZL CLA
JMP BIDIR /DIRECTORY IS BAD
TAD DIRTY /POINT TO FIRST SEGMENT
DCA EPTR
TAD I (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
TAD DATE
JMS PDATE /PRINT THE CURRENT DATE
JMS CRLF
JMS CRLF
TAD OPT1
AND (20 /CHECK THE HEADER OPTION
SZA CLA
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
WRTERR, JMS ERROR
OUERR+40
CLOERR, JMS ERROR
CLERR+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 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
HEADER, 0
CDF 0
ISZ I (6202
JMP I HEADER
TAD I (6304
DCA TEMP
DCA I (6304
TAD (6300-1
JMS PRINT
CDF 10
JMS MESAG
VOLMES+40
TAD TEMP
JMS PRNUM
JMS CRLF
TAD (6400-1
JMS PRINT
TAD (6304
DCA XR 1
CLL
TAD I XR 1 /CHECK RANGE OF SYSTEM I.D.
TAD (10 /EIGHT IS THE MAXIMUM
SZL /SHOULD HAVE SET THE LINK...
ISZ I (6207 /DOES THE DEVICE HAVE A SYSTEM?
JMP HDEND /NOPE
TAD (POINT-7
DCA PTR
JMS CRLF
TAD I PTR
DCA .+2
JMS MESAG
0
JMS MESAG
SYSMES+40
CDF 0
TAD I XR 1
JMS PRNUM
CDF 0
TAD I XR 1
JMS CONVTP
JMS CRLF
HDEND, JMS CRLF
JMP I HEADER
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
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
FILESM,
IFNDEF GERMAN < TEXT " FILES IN ">
IFDEF GERMAN < TEXT " DATEIEN IN ">
BLOCKM,
IFNDEF GERMAN < TEXT " BLOCKS - ">
IFDEF GERMAN < TEXT " BLOECKEN, ">
/SYSTEM TABLE - FIRST 3 ARE NON-STANDARD
BRANDX+40
MULTI8+40
ETOS+40
OS78+40
DS8+40
OS12+40
OS8+40
POINT, PS8+40
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 I DIGIT-1 /=7777
AND (600 /GET EXTENDED DATE BITS
CLL RTR
RTR
TAD TEMP
JMS PRNUM
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,
IFNDEF GERMAN < TEXT " VOLUME--">
IFDEF GERMAN < TEXT " BAND --">
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 ROTR6
TAD I ROTR6
SNL
JMS ROTR6
AND (77
JMP I GTSXBT
ROTR6, 0
RTR
RTR
RTR
JMP I ROTR6
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
PAGE
VERNO, TEXT "DIRECT V40B"
PS8, TEXT "PS/8"
OS8, TEXT "OS/8"
OS12, TEXT "OS/12"
OS78, TEXT "OS/78"
ETOS, TEXT "E*T*O*S"
MULTI8, TEXT "MULTI-8"
BRANDX, TEXT "BRAND X"
DS8, TEXT "DECSYSTEM-8"
ILLQ,
IFNDEF GERMAN < TEXT "ILLEGAL ?">
IFDEF GERMAN < TEXT "FALSCHES ?">
ILLA,
IFNDEF GERMAN < TEXT "ILLEGAL *">
IFDEF GERMAN < TEXT "FALSCHER *">
EMPTYM,
IFNDEF GERMAN < TEXT "<EMPTY> ">
IFDEF GERMAN < TEXT "<FREI> ">
FRBLM,
IFNDEF GERMAN < TEXT " FREE BLOCKS">
IFDEF GERMAN < TEXT " FREIE BLOECKE">
SYSMES, TEXT " SYSTEM VERSION"
BIGEQ,
IFNDEF GERMAN < TEXT "EQUALS OPTION BAD">
IFDEF GERMAN < TEXT "= AUSWAHL FA PLATZ FUER DATEI">
BADIRD,
IFNDEF GERMAN < TEXT "ERROR READING INPUT DIRECTORY">
IFDEF GERMAN < TEXT "VERZEICHNIS LESE-FEHLER">
NFLEIN,
IFNDEF GERMAN < TEXT "DEVICE DOES NOT HAVE DIRECTORY">
IFDEF GERMAN < TEXT "GERAET HAT KEIN VERZEICHNIS">
NOTTY,
IFNDEF GERMAN <TEXT "THERE IS NO HOPE-THERE IS NO TTY HANDLER IN YOUR SYSTEM">
IFDEF GERMAN <TEXT "EIN RECHNER OHNE TTY-GERAET IST MEISTENS NUTZLOS!">
IFNDEF GERMAN <
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"
>
IFDEF GERMAN <
DATTAB, TEXT "???" /PROTECTION AGAINST BAD DATES
TEXT "JAN"
TEXT "FEB"
TEXT "MAR"
TEXT "APR"
TEXT "MAI"
TEXT "JUN"
TEXT "JUL"
TEXT "AUG"
TEXT "SEP"
TEXT "OKT"
TEXT "NOV"
TEXT "DEZ"
>
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 10
AND (7
DCA TEMP
TAD DATE /COMPARE WITH THE SYSTEM DATE
AND (7
CIA
TAD TEMP
SMA SZA CLA
TAD (-10 /TOO BIG, DECREASE BY 8
TAD (106 /1970
TAD TEMP
CDF 0
JMP I CKYEAR
PAGE
FIELD 1
*4600
$$$$$$