Google
 

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