Trailing-Edge
-
PDP-10 Archives
-
decuslib10-08
-
43,50471/dirsrt.mac
There are no other files named dirsrt.mac in the archive.
TITLE DIRSRT
SUBTTL SORT A DIRECTORY LISTING -- P. ALCIERE
SALL
VER==1
MIN==0
EDT==4
WHO==0
LOC 137
BYTE (3) WHO (9) VER (6) MIN (18) EDT
.IOASC==0
TWOSEG
; AC'S:
SW==0 ;SWITCHES, FLAGS
T1==1 ;TEMP
T2==2 ;TEMP
T3==3 ;TEMP
T4==4 ;TEMP
P1==5 ;WORD POINTER TO STRING1-1
P2==6 ;WORD POINTER TO STRING2-1
PRV==7 ;PREVIOUS CONTENTS OF P1
ST==13 ;START ADDRESS OF DATA STORAGE
STR1==14 ;BYTE POINTER TO ONE ASCIZ STRING
STR2==15 ;BYTE POINTER TO ANOTHER ASCIZ STRING
CHR==16 ;CHARACTER CURRENTLY BEING PROCESSED
P==17 ;PUSHDOWN POINTER
;SWITCHES:
BKSW==1B18 ;BREAK CHARACTER SEEN
BKPLOG==1B19 ;PROCESSING BACKUP.LOG DIRECTORY
; CHANNELS:
IN==1 ;INPUT FROM DSK
OUT==2 ;OUTPUT TO DSK
; MACROS
DEFINE ERROR (MSG)
<JRST [OUTSTR [ASCIZ/
? MSG
/]
EXIT]>
SUBTTL LOW SEGMENT
RELOC 0
LOWBEG==.
PDL: BLOCK 20 ;PUSH DOWN LIST
FILNAM: 0 ;FILE NAME
EXT: 0 ;EXTENSION
PROT: 0 ;PROTECTION, DATE-TIME
PPN: 0 ;PROJECT, PROGRAMMER NUMBER
STATUS: .IOASC ;OPEN BLOCK
DEV: SIXBIT /DSK/
BUFFS: XWD OBUF,IBUF
OBUF: BLOCK 3
IBUF: BLOCK 3
TBUFF: BLOCK ^D135/5 ;TEMPORARY BUFFER
LOWEND==.
;I/O BUFFERS -- NOT CLEARED AT INITIALIZATION:
OBUF1: 0
XWD 201,OBUF2+1
BLOCK 201
OBUF2: 0
XWD 201,OBUF1+1
BLOCK 201
IBUF1: 0
XWD 201,IBUF2+1
BLOCK 201
IBUF2: 0
XWD 201,IBUF1+1
BLOCK 201
SUBTTL INITIALIZATION
RELOC 400000
DIRSRT: JFCL
RESET
MOVE P,[XWD -20,PDL]
MOVE T1,[XWD LOWBEG,LOWBEG+1]
SETZB SW,LOWBEG
BLT T1,LOWEND
MOVSI T1,'DSK'
MOVEM T1,DEV
MOVE T1,[XWD OBUF,IBUF]
MOVEM T1,BUFFS
OUTSTR [ASCIZ/
FILNAME, EXTENSION: /]
MOVEI T1,9
SKIPA STR1,[POINT 6,FILNAM]
DOT: MOVE STR1,[POINT 6,EXT]
INCH: INCHWL CHR ;INPUT ONE CHARACTER FROM TTY
CAIN CHR,15 ;TEST FOR CARRIAGE RETURN
JRST CR
CAIN CHR,"." ;TEST FOR DOT
JRST DOT
CAIL CHR,140 ;TEST FOR LOWER CASE
SUBI CHR,40 ;IF SO, CONVERT TO UPPER CASE
SUBI CHR,40 ;IN ANY CASE, CONVERT TO SIXBIT
JUMPE CHR,INCH ;IGNORE NULL, BLANK, ETC.
IDPB CHR,STR1 ;STORE SIXBIT CHARACTER IN N1 OR N2
SOJG T1,INCH ;LOOP (MAX. 9 CHARS.)
CR: OPEN IN,STATUS
ERROR (? CANNOT OPEN DSK FOR INPUT.)
MOVE T1,[XWD 400000,IBUF1+1]
MOVEM T1,IBUF
MOVE T1,[POINT 7,0,35]
MOVEM T1,IBUF+1
LOOKUP IN,FILNAM
ERROR (? CANNOT FIND THAT FILE.)
OPEN OUT,STATUS
ERROR (? CANNOT OPEN DSK FOR OUTPUT.)
MOVE T1,[XWD 400000,OBUF1+1]
MOVEM T1,OBUF
MOVE T1,[POINT 7,0,35]
MOVEM T1,OBUF+1
MOVSI T1,'LST'
MOVEM T1,EXT
SETZM PROT
SETZM PPN
ENTER OUT,FILNAM
ERROR (? CANNOT OPEN OUTPUT FILE.)
SUBTTL PROCESS HEADING, IF ANY
LINE1: PUSHJ P,RDLIN ;READ A LINE FROM THE INPUT FILE
EOFERR: ERROR (END OF FILE TOO SOON)
LDB T1,[POINT 7,TBUFF,6]
CAIN T1,13 ;VT?
JRST LINE1 ;YES. IGNORE
MOVE STR1,[POINT 7,TBUFF]
MOVE STR2,[POINT 7,[ASCIZ/TAPE VERSION/]]
PUSHJ P,COMPAR
JUMPE T1,TAPHDR ;IF MATCH, "TAPE" DIRECTORY HEADER
MOVE T1,TBUFF ;DTA DIRECTORY HAS CR,LF IN 1ST LINE
CAME T1,[BYTE (7) 15,12,0,0,0]
JRST NOTDTA
PUSHJ P,RDLIN ;TRY THE NEXT LINE
JRST EOFERR
MOVE STR1,[POINT 7,TBUFF]
MOVE STR2,[POINT 7,[ASCIZ/TAPE ID:/]]
PUSHJ P,COMPAR
JUMPE T1,DTAHDR ;IF MATCH, DECTAPE HEADER
NOTDTA: MOVE STR1,[POINT 7,TBUFF]
MOVE STR2,[POINT 7,[ASCIZ/READ DENSITY:/]]
PUSHJ P,COMPAR
JUMPE T1,FSBUHD ;IF MATCH, FAILSAFE/BACKUP
MOVE STR1,[POINT 7,TBUFF]
MOVE STR2,[POINT 7,[ASCIZ/START OF/]]
PUSHJ P,COMPAR
JUMPE T1,BKUPLG ;BACKUP.LOG DIRECTORY
SUBTTL READ DATA TO BE SORTED
; READ EACH LINE INTO DATA AREA WITH A POINTER WORD IN FRONT OF IT.
; LEFT HALF POINTS BACK TO PRECEDING POINTER WORD. RIGHT HALF POINTS
; TO NEXT POINTER WORD, OR CONTAINS ZERO IF IT IS THE END OF THE CHAIN.
SORT:
HRRZ ST,.JBFF## ;SET UP START ADDRESS OF DATA STORAGE
HRRZ P1,ST
PUSHJ P,GETCOR ;GET CORE IF NECESSARY
MOVE STR1,[POINT 7,TBUFF] ;MOVE LINE TO DATA AREA
MOVE STR2,[POINT 7,1(P1)]
PUSHJ P,MOVSTR
MOVE P2,STR2
PUSHJ P,FIXMSG ;TEST FOR & FIX "PROTECTION FAILURE" MSG
MOVEI PRV,ST
FILL: HRRM P1,(PRV) ;STORE POINTER TO CURRENT RECORD
HRLZM PRV,(P1) ;STORE BACK POINTER TO PREVIOUS RECORD
HRRZ PRV,P1
MOVEI P1,@P2 ;MAKE POINTER TO NEXT LINE
AOJ P1,
PUSHJ P,GETCOR ;GET CORE IF NECESSARY
MOVE STR1,[POINT 7,1(P1)] ;SET UP POINTER TO NEXT DATA CHARACTER
PUSHJ P,READ
JRST FULL
MOVE P2,STR1
PUSHJ P,FIXMSG ;TEST FOR & FIX "PROTECTION FAILURE" MSG
MOVE T1,1(P1)
CAMN T1,[BYTE(7)15,12,0,0,0]
JRST FULL ;QUIT ON BLANK LINE
MOVE STR1,[POINT 7,1(P1)]
MOVE STR2,[POINT 7,[ASCIZ/TOTAL/]]
PUSHJ P,COMPAR
JUMPN T1,FILL
FULL:
MOVE STR1,[POINT 7,1(P1)] ;MOVE LAST LINE TO TBUFF
MOVE STR2,[POINT 7,TBUFF]
PUSHJ P,MOVSTR
SUBTTL WRITE LINES OUT IN ASCENDING SEQUENCE
LOOP1: HRRZ P1,ST
HRRZ P2,(P1)
JUMPE P2,LAST ;TEST FOR LAST LINE TO BE OUTPUT
LOOP2: MOVE STR1,[POINT 7,1(P1)] ;BYTE POINTER TO 1ST STRING
MOVE STR2,[POINT 7,1(P2)] ;BYTE POINTER TO NEXT STRING
PUSHJ P,COMPAR ;COMPARE TWO STRINGS
SKIPLE T1 ;RESULT IS IN T1
HRRZ P1,P2 ;STRING2 BECOMES NEW STRING1
HRRZ P2,(P2) ;GET NEXT LINK
JUMPN P2,LOOP2 ;IF THERE IS ONE. ELSE DUMP.
;END OF DATA (WORD POINTER=0). OUTPUT CHAMP AND REMOVE FROM CHAIN
DUMP: MOVE STR1,[POINT 7,1(P1)]
PUSHJ P,WRITE ;OUTPUT
HLRZ T1,(P1) ;PATCH CURRENT LINE OUT OF THE CHAIN
HRRZ T2,(P1)
SKIPE T1
HRRM T2,(T1)
SKIPE T2
HRLM T1,(T2)
JRST LOOP1
;DUMP THE LAST LINE
LAST: MOVE STR1,[POINT 7,1(P1)]
PUSHJ P,WRITE ;WRITE OUT THE LAST DATA LINE
HRL T1,.JBFF## ;CLEAR SORTING BUFFER
HRR T1,.JBFF##
AOJ T1,
SETZM @.JBFF##
BLT T1,@.JBREL##
; DUMP TRAILER LINES, IF ANY
TAIL: MOVE STR1,[POINT 7,TBUFF]
PUSHJ P,WRITE
PUSHJ P,RDLIN
EXIT
LDB CHR,[POINT 7,TBUFF,6]
TRNE SW,BKPLOG
JRST BKLEND
CAIN CHR," " ;COPY ALL LINES WITH SPACE OR <CR> IN 1ST POSITION
JRST TAIL
CAIN CHR,15
JRST TAIL
JRST SORT
BKLEND: CAIN CHR,15 ;FOR BACKUP.LOG, COPY UNTIL <CR>
JRST SORT
JRST TAIL
SUBTTL SUBROUTINES
; GET MORE CORE IF NECESSARY TO STORE ANOTHER LINE OF DATA
GETCOR: MOVEI T1,^D135/5+1(P1) ;ALLOW FOR ONE LINE
CAMG T1,.JBREL## ;SEE IF WE HAVE ENOUGH CORE
POPJ P, ;WE DO
CORE T1, ;NO. GET IT.
ERROR (COULD NOT GET ENOUGH CORE.)
POPJ P,
; READ A LINE INTO TBUFF
RDLIN: MOVE STR1,[POINT 7,TBUFF]
;READ A LINE INTO WHEREVER STR1 POINTS TO
READ: MOVEI T1,^D135
RDLIN1: PUSHJ P,RDCHR ;READ 1 CHARACTER FROM THE INPUT FILE
POPJ P, ;NON-SKIP RETURN ON END OF FILE
IDPB CHR,STR1 ;STORE IT IN THE LINE
TRNN SW,BKSW ;TEST FOR BREAK CHARACTER
SOJG T1,RDLIN1 ;ALSO LIMIT DATA TO 135 CHARACTERS
SETZ CHR,
IDPB CHR,STR1 ;STORE 0 TO FORCE ASCIZ
CPOPJ1: AOS (17) ;SKIP RETURN IF NOT END OF FILE
CPOPJ: POPJ P,
RDCHR: SOSGE IBUF+2 ;READ A CHARACTER
JRST GETBUF
ILDB CHR,IBUF+1
JUMPE CHR,RDCHR ;IGNORE NULLS ON INPUT
PUSHJ P,BKTEST ;TEST FOR BREAK CHARACTER
JRST CPOPJ1 ;SKIP RETURN IF NOT END OF FILE
GETBUF: IN IN, ;READ DATA INTO THE BUFFER
JRST RDCHR ;NORMAL RETURN
STATO IN,1B22 ;SKIP ON END OF FILE
ERROR (ERROR READING INPUT.)
POPJ P, ;NON-SKIP RETURN
;TEST FOR BREAK CHARACTER: LF, VT, FF, ESC
BKTEST: TRO SW,BKSW
CAIL CHR,12
CAILE CHR,14
TRZ SW,BKSW
CAIN CHR,176
TRO SW,BKSW
POPJ P,
; WRITE FROM TBUFF
WRLIN: MOVE STR1,[POINT 7,TBUFF]
PUSHJ P,WRITE
POPJ P,
;WRITE FROM WHERE STR1 POINTS TO
WRITE: MOVEI T1,^D135
WRITE1: ILDB CHR,STR1
JUMPE CHR,CPOPJ ;QUIT ON NULL (ASCIZ)
PUSHJ P,WRCHR
TRNN SW,BKSW
SOJG T1,WRITE1
POPJ P,
; WRITE ONE CHARACTER
WRCHR: JUMPE CHR,CPOPJ ;IGNORE NULLS
SOSG OBUF+2
PUSHJ P,PUTBUF
IDPB CHR,OBUF+1
PUSHJ P,BKTEST
POPJ P,
PUTBUF: OUT OUT, ;WRITE THE BUFFER
POPJ P,
OUTSTR [ASCIZ/
ERROR WRITING TO THE DISK
/]
POPJ P,
;COMPARE TWO ASCII STRINGS
COMPAR: ILDB CHR,STR2 ;GET ONE CHARACTER
JUMPE CHR,CPOPJ ;RETURN ON NULL. T1 CONTAINS RESULT OF LAST SUBTRACT
CAIL CHR,140 ;TEST FOR LOWER CASE
SUBI CHR,40 ;CONVERT TO UPPER CASE
CAIN CHR," " ;IGNORE SPACES
JRST COMPAR
CMPR1: ILDB T1,STR1 ;GET OTHER CHARACTER
JUMPE T1,CPOPJ ;RETURN ON NULL. T1 CONTAINS RESULT OF LAST SUBTRACT
CAIL T1,140 ;TEST FOR LOWER CASE
SUBI T1,40 ;CONVERT TO UPPER CASE
CAIN T1," "
JRST CMPR1
SUB T1,CHR ;THIS IS THE ACTUAL COMPARE
JUMPE T1,COMPAR ;CONTINUE IF NON-ZERO. RETURN IF ZERO
POPJ P,
;MOVE AN ASCIZ STRING
MOVSTR: ILDB CHR,STR1
IDPB CHR,STR2
JUMPN CHR,MOVSTR
POPJ P,
; PROCESS "TAPE" DIRECTORY HEADING
TAPHDR: PUSHJ P,WRLIN ;WRITE CURRENT LINE
PUSHJ P,RDLIN ;READ NEXT LINE
EXIT
MOVE STR1,[POINT 7,TBUFF]
MOVE STR2,[POINT 7,[ASCIZ/FILENAME/]]
PUSHJ P,COMPAR
JUMPN T1,TAPHDR ;CONTINUE UNTIL YOU FIND "FILENAME"
PUSHJ P,WRLIN ;WRITE "FILENAME" LINE
PUSHJ P,RDLIN ;READ BLANK LINE
EXIT
JRST SORT
; PROCESS DECTAPE DIRECTORY HEADER
DTAHDR: PUSHJ P,WRLIN ;WRITE "TAPE ID" LINE
PUSHJ P,RDLIN ;READ "FREE" LINE
EXIT
PUSHJ P,WRLIN ;WRITE "FREE" LINE
PUSHJ P,RDLIN
EXIT
JRST SORT
; PROCESS FAILSAFE/BACKUP DIRECTORY HEADER
FSBUHD: PUSHJ P,WRLIN ;WRITE "READ DENSITY" LINE
PUSHJ P,RDLIN
EXIT
MOVE STR1,[POINT 7,TBUFF]
MOVE STR2,[POINT 7,[ASCIZ/FAILSA/]];TEST FOR END OF FAILSAFE HEADER
PUSHJ P,COMPAR
JUMPE T1,PJPWRL
MOVE STR1,[POINT 7,TBUFF]
MOVE STR2,[POINT 7,[ASCIZ/UNDER/]];TEST FOR END OF BACKUP HEADER
PUSHJ P,COMPAR
JUMPN T1,FSBUHD ;COPY LOOP
PJPWRL: PUSHJ P,WRLIN
PUSHJ P,RDLIN
EXIT
JRST SORT
;PROCESS BACKUP.LOG DIRECTORY
BKUPLG: TRO SW,BKPLOG ;SET "BACKUP.LOG" SWITCH
PUSHJ P,WRLIN
SETZM TBUFF
PUSHJ P,RDLIN
EXIT
MOVE T1,TBUFF
CAME T1,[BYTE(7)15,12,0,0,0]
JRST BKUPLG
JRST PJPWRL
; TEST FOR & FIX "%DRTLKE PROTECTION FAILURE" MESSAGE
FIXMSG: LDB CHR,[POINT 7,1(P1),6]
CAIE CHR,"%"
POPJ P,
DMOVE T1,[ASCII/ /]
DMOVEM T1,TBUFF ;PRE-FILL TBUFF WITH SPACES
DMOVEM T1,TBUFF+2
MOVE STR1,[POINT 7,10(P1)]
MOVE STR2,[POINT 7,TBUFF]
NAME: ILDB CHR,STR1 ;MOVE FILE NAME TO TBUFF
CAIN CHR,15 ;TEST FOR <CR>
JRST ENDNAM
CAIN CHR,"." ;TEST FOR PERIOD
JRST [MOVE STR2,[POINT 7,TBUFF+1,20]
JRST NAME]
IDPB CHR,STR2 ;MOVE VALID CHARACTER TO TBUFF
JRST NAME
ENDNAM: MOVE STR1,[POINT 7,1(P1)]
MOVE STR2,[POINT 7,TBUFF+3,27]
PUSHJ P,MOVSTR ;MOVE MESSAGE TO TBUFF+2
MOVE STR1,[POINT 7,TBUFF]
MOVE STR2,[POINT 7,1(P1)]
PUSHJ P,MOVSTR ;MOVE TBUFF TO DATA AREA
MOVE P2,STR2 ;REMEMBER WHERE DATA ENDS
POPJ P,
END DIRSRT