Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

TITLE EXCON - COMPACTION/EXPANSION PROGRAM FOR DECTAPES
SUBTTL DOT/TSC/PDC/J. SIGONA    5/19/71


	OPDEF CALL [PUSHJ 17,]
	OPDEF RETURN [POPJ 17,]


	DEFINE GETIT(L)
<IRP L<	SOSLE	IBUF+2
	JRST	.+2
	IN	1,
	JRST	.+4
	STATZ	1,740000
	JRST	ERR6
	JRST	FIN
	ILDB	L,IBUF+1>
>



	DEFINE OUTIT(L)
<IRP L<	SOSLE OBUF+2
	JRST	 .+4
	OUT	2,
	JRST	.+2
	JRST	ERR5
	MOVE	3,L
	IDPB	3,OBUF+1>
>


START:	CALLI	0			;GENERAL INITIALIZATION
	MOVE	17,[IOWD 10,PDL]
AGAIN:	TTCALL 3,[ASCIZ/
TYPE E OR C FOLLOWED BY CR: /]
	TTCALL 11,0
	TTCALL 0,0
	TTCALL 0,1
	CAIE	1,15
	JRST	AGAIN
	CAIN	0,"C"
	JRST	COMPAC
	CAIE	0,"E"
	JRST	AGAIN
	JRST	EXPAND

; ROUTINE TO DO FILE COMPACTION

COMPAC:	TTCALL 3,MSG1
	CALL OPNOUT			;SET UP OUTPUT DEVICE
	CALL GETNAM
	MOVE	0,INNAM
	MOVE	1,INNAM1
	MOVEI 	2,0
	CALL ENTER			;CALL OUTPUT FILE COMPAC.MAC
	CALL INITIN			;INIT INPUT DEVICE
	CALL GETDIR			;GET DECTAPE DIRECTORY
MORE:	CALL GETFL			;GET NEXT FILE NAME FROM DECTAPE
	SKIPN
	JRST FIN
	CALL LOOKUP			;LOOKUP FILE NAME ON DECTAPE
	CALL SETBFC			;SET UP FILE HEADER
	CALL DTAOUT			;MOVE FILE FROM DTA TO OUTPUT
	CALL SETEFC			;SET UP FILE TRAILER
	JRST MORE

; ROUTINE TO INIT INPUT DEVICE

INITIN:	INIT	1,13
	SIXBIT/INPUT/
	XWD	0,IBUF
	JRST	ERR1
	RETURN
ERR1:	TTCALL 3,[ASCIZ/INPUT DEVICE NOT ASSIGNED/]
	CALL DELFIL

; ROUTINE TO DO FILE EXPANSION

EXPAND:	CALL GETNAM			;GET COMPACTED FILE'S NAME
	CALL INITIN			;INIT. INPUT DEVICE
	CALL OPNOUT			;INIT. OUTPUT DEVICE
	MOVE	0,INNAM			;FILE NAME
	MOVE	1,INNAM1		;FILE EXT.
	CALL LOOKUP			;LOOKUP FILE ON INPUT DEVICE
EXP2:	SETZM	STFLAG
	GETIT<3,0,1,2>			;GET CODE,FILENAME,EXT,DATE
	CAME	3,BGNCOD		;COMPACTED?
	JRST	FIN			;NO OR DONE
	SETOM	STFLAG
	CALL ENTER			;ENTER FILE NAME
	CALL DTAOUT			;OUTPUT FILE
	CLOSE	2,			;CLOSE THIS FILE
	JRST	EXP2			;CHECK FOR MORE TO DO
STFLAG:	0

; ROUTINE TO GET FILE NAME

GETNAM:	TTCALL 3,[ASCIZ/
COMPACTED FILE NAME: /]
	TTCALL 11,0
	SETZM	2
	SETZM	0
	SETZM	1
	MOVE	3,[POINT 6,INNAM#]
	SETZM	4
NF4:	TTCALL 0,5
	CAIE	5,177
	JRST	NF1
	TTCALL 3,[ASCIZ/ XXX
/]
	JRST	GETNAM
NF1:	CAIE	5,"."
	JRST	NF2
	JUMPE	2,NF3
	JUMPN	4,NF3
	SETOM	4
	MOVE	3,[POINT 6,INNAM1#]
	SETZM	2
	JRST	NF4
NF3:	TTCALL 3,[ASCIZ/ ?
/]
	JRST	GETNAM
NF2:	CAIE	5,15
	JRST	NF7
	MOVEI	5,12
	TTCALL 1,5
	JUMPN	4,NF11
	RETURN
NF11:	JUMPE	2,NF3
	RETURN
NF7:	CAIGE	5,"0"
	JRST	NF3
	CAIG	5,"9"
	JRST	NF10
	CAIGE	5,"A"
	JRST	NF3
	CAIG	5,"["
	JRST	NF10
	JRST	NF3
NF10:	JUMPN	4,NF5
	CAIL	2,6
	JRST	NF3
	JRST	NF6
NF5:	CAIL	2,3
	JRST	NF3
NF6:	SUBI	5,40
	IDPB	5,3
	ADDI	2,1
	JRST	NF4

; ROUTINE TO GET DIRECTORY OF DECTAPE
; RETURNS IN DIRBUF THE 22 FILENAMES FOLLOWED BY THE 22 EXTS

GETDIR:	USETI	1,^D100		;READ DIRECTORY BLOCK
	IN	1,0
	JRST	.+2
	JRST	ERR3
EX:	MOVE	2,IBUF
	ANDI	2,777777	;CURRENT BUFFER ADR.
	ADDI	2,^D84		;ADR. OF 1ST FILENAME
	HRLZS	2		;SET UP BLT POINTER
	HRRI	2,DIRBUF
	BLT	2,DIRBUF+^D43	;MOVE FILENAMES  + EXTS TO DIRBUF
	RETURN
ERR3:	TTCALL 3,[ASCIZ/ERROR!! FILES TO BE COMPACTED MUST BE ON DECTAPE/]
	CALL DELFIL

; ROUTINE TO GET THE NEXT FILENAME + EXT + CREATION DATE
; RESULTS RETURNED IN REG. 0,1,2 RESP.

GETFL:	MOVE	3,DIRPTR
GETFL1:	MOVE	0,DIRBUF(3)		;GET FILENAME SLOT
	SKIPE				;IS IT NULL?
	JRST	NEXTFL			;NO-
	SOSL	3,DIRPTR			;YES- DIRECTORY DONE?
	JRST	GETFL1			;NO-LOOK FOR MORE NAMES
	RETURN
NEXTFL:	MOVE	1,DIRBUF+^D22(3)		;GET EXT
	MOVEM	1,2			;SAVE DATE
	AND	1,[XWD 777777,0]	;DEL DATE FROM EXT WORD
	ANDI 	2,777777		;DEL EXT FROM DATE
	SOS	DIRPTR			;DECR. SLOT POINTER
	RETURN

; ROUTINE TO PUT HEADER INFO IN OUTPUT BUFFER
; INFO IS: CODE,FILENAME,EXT,DATE IN REGS BGNCOD,0,1,2 RESP.

SETBFC:	OUTIT<BGNCOD,0,1,2>
	RETURN
BGNCOD:	OCT 101010101010
ERR5:	TTCALL 3,[ASCIZ/OUTPUT DISK ERROR/]
	CALL DELFIL

; ROUTINE TO DELETE PARTIALLY OUTPUTTED FILES UPON ERRORS

DELFIL:	MOVE	0,INNAM
	MOVE	1,INNAM1
	MOVEM	0,E
	MOVEM	1,E+1
	CLOSE	1,
	CLOSE	2,
	SKIPE	OUTFLG
	LOOKUP	2,E
	EXIT
	RENAME	2,ZERO
	EXIT
	EXIT
ZERO:	0
	0
	0
	0
E:	0
	0
	0
	0

; ROUTINE TO PUT TRAILER IN OUTPUT BUFFER

SETEFC:	MOVE	0,FLNAME
	HLLZ	1,FLEXT
	OUTIT<ENDFCC,0,1>
	RETURN
ENDFCC:	OCT 010101010101

; ROUTINE TO INIT OUTPUT DEVICE

OPNOUT:	INIT	2,13			;CHN 2, IMAGE BINARY
	SIXBIT/OUTPUT/			;LOGICAL NAME
	XWD	OBUF,0			;OUTPUT ONLY
	JRST	ERR4
	OUT	2,			;CLEAR OBUF HEADER BLOCK
	JRST	SOFLG
ERR4:	TTCALL 3,[ASCIZ/OUTPUT DEVICE NOT ASSIGNED/]
	EXIT
SOFLG:	SETOM	OUTFLG
	RETURN

; ROUTINE TO ENTER FILE NAME FOR OUTPUT DEVICE

ENTER:	MOVEM	0,OUTNAM
	MOVEM	1,OUTNAM+1
	MOVEM	2,OUTNAM+2
	ENTER	2,OUTNAM
	JRST	ERR4
	RETURN
OUTNAM:	BLOCK 3
	0

; ROUTINE TO READ FILE OFF INPUT DEV AND PUT ONTO OUTPUT DEVICE

DTAOUT:	SOSLE	IBUF+2
	JRST	GETOK
	IN	1,
	JRST	GETOK
	STATZ	1,740000
	JRST	ERR6
	JRST	EOF
GETOK:	ILDB	0,IBUF+1
	CAMN	0,ENDFCC
	JRST	CHKFLG
CONT:	OUTIT<0>
	JRST	DTAOUT
EOF:	RETURN
CHKFLG:	SKIPN	STFLAG
	JRST	CONT
	GETIT<1,2>
	CAMN	1,OUTNAM
	JRST	S1
S2:	OUTIT<0,1,2>
	JRST	DTAOUT
S1:	HRRI	2,0
	HRRM	2,OUTNAM+1
	CAME	2,OUTNAM+1
	JRST	S2
	RETURN
ERR6:	TTCALL 3,[ASCIZ/INPUT READ ERROR/]
	CALL DELFIL
; ROUTINE TO LOOKUP FILE ON INPUT DEVICE
; FILENAME + EXT IN REGS 0 & 1 RESP.

LOOKUP:	MOVEM	0,FLNAME		;SET UP LOOKUP BLOCK
	MOVEM	1,FLEXT
	LOOKUP	1,FLNAME		;DO LOOKUP
	JRST	ERR2			;LOOKUP ERROR
	RETURN
ERR2:	TTCALL	3,[ASCIZ/FILE NOT FOUND/]
	CALL DELFIL

FIN:	CLOSE	2,
	EXIT
MSG1:	ASCIZ/
WARNING: INPUT MUST BE ON DECTAPE FOR FILE COMPACTION!!
/
OUTFLG:	0
IBUF:	BLOCK	3
OBUF:	BLOCK	3
PDL:	BLOCK	10
DIRBUF:	BLOCK ^D44
DIRPTR:	^D21
FLNAME:	0
FLEXT:	0
	0
	0
	LIT
	END START
@*U*!@|