Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-02 - decus/20-0032/tapblk.mac
There are 2 other files named tapblk.mac in the archive. Click here to see a list.
	TITLE TAPBLK  PROGRAM TO BLOCK FILES FROM MTA.
; Modified by Paul T. Robinson, Wesleyan Univ.
; for DECUS conversion to DEC-20
	I=0
	O=1
	AC=1
	MLON
;	EXTERN JOBFF,JOBREL
	extern	.jbff,.jbrel	;redefine jobdat symbols
	LOC 124
	XWD 0,ST
	RELOC
ST:	SETZ 0,
	HRRZI 17,1
	BLT 17,17	;CLEAR ALL AC'S
	RESET
	MOVEI 0,13
	TTCALL 3,MESS1	;PARITY MESSAGE
	TTCALL 11,
	TTCALL 0,AC
	CAIN AC,105
	TRO 0, 1000	;SET EVEN PARITY
	TTCALL 3,MESS2
	TTCALL 11,
	TTCALL 0,AC
	CAIN AC,62
	TRO 0,200	;SET 200 BPI
	CAIN AC,65
	TRO 0,400	;SET 556 BPI
	CAIN AC,70
	TRO 0,600	;SET 800 BPI
	MOVEM 0,SPEC
	OPEN I,SPEC	;INIT TO PAR. & DENSITY SPECIFIED
	JRST ER1
	INIT O,13	;INIT TO SYSTEM STD,& 800 BPI
	SIXBIT/OUT/	;LOGICAL NAME OF OUT
	XWD OUTB,0
	JRST ER2
	OUTBUF O,2	;SET UP OUTPUT BUFFERS
	INBUF I,1	;SET UP 1 STD. INPUT BUFF
	JSR XPND	;MOVE INPUT BUFF TO END OF CORE SPACE
NAM:	TTCALL 3,MESS3
	TTCALL 11,
	TTCALL 0,AC
	CAIN AC,62
	JRST M
	CAIN AC,63
	JRST DONE
	MTAPE I,101	;IBM TAPES
M:	MOVEI 0,5
	MOVE 5,[POINT 3,3,20]
	MOVE 6,[POINT 6,E,5]
	ADDI 3,1	;NEW FILE NUMBER
AA:	ILDB AC,5
	ADDI AC,20	;CONVERT TO SIXBIT
	IDPB AC,6
	SOJG 0,AA
	ENTER O,E
	JRST ER3
GO:	IN I,		;READ IN 1ST REC.
	JRST COUNT-2
	STATZ 40000	;BLOCK TOO LG.?
	JRST LARGE
	STATZ 2000	;PHYSICAL EOT?
	JRST ER7
	STATZ 20000	;END OF FILE?
	JRST EOF
	STATZ 200000	;DATA OR TAPE ERROR?
	JRST ER5
	STATZ 100000	;BAD PARITY?
	JRST ER6
	STATZ 400000	;UNIT WRT-LCKED?
	JRST ER9
	JRST ER10
	MOVEI 4,1
	HRREI 2,-2	;SET EOF COUNTER
COUNT:	SOSGE INB+2
	JRST GO
	ILDB AC,INB+1	;GET A WORD
PUTNXT:	SOSGE OUTB+2
	JRST PUTBUF
	IDPB AC,OUTB+1	;PUT IT IN OUTPUT BUFF
	JRST COUNT
PUTBUF:	OUT O,		;OUTPUT TO DSK
	JRST PUTNXT
	JRST ER8
LARGE:	MTAPE I,7	;BACKSPACE 1 REC.
	MTAPE I,0	;WAIT
	JUMPE 4,FRST
	MTAPE I,7
	MTAPE I,0
	MTAPE I,6
	MTAPE I,0
FRST:	MOVE 0,.jbrel
	ADDI 0,2000
	CALLI 0,11	;GET MORE CORE
	JRST ER4
	JSR XPND
	JRST GO
XPND:	0
	MOVE 0,.jbrel
	SUB 0,.jbff
	ADDM 0,.jbff	;UPDATE .jbff TO END OF CORE SPACE
	MOVS 0,0
	ADDM 0,@INB	;EXPAND INPUT BUFF
	JRST @XPND
EOF:	TTCALL 3,[ASCIZ/
EOF ON INPUT TAPE
/]
	AOSGE 2
	JRST .+2
	TTCALL 3,[ASCIZ/
REACHED LOGICAL END OF TAPE (2 EOF'S TOGETHER)
/]
	CLOSE I,
	CLOSE O,
	JRST NAM
ER1:	TTCALL 3,[ASCIZ/
INIT FAILURE FOR INPUT DEVICE, TRY "AS MTA- INN", THEN TYPE "REENTER"
/]
	JRST DONE
ER2:	TTCALL 3,[ASCIZ/
INIT FAILURE FOR OUTPUT DEVICE DSK, TYPE "AS DSK OUT" THEN "REENTER" TO RESTART
/]
	JRST DONE
ER3:	TTCALL 3,[ASCIZ/
ENTER FAILURE FOR OUTPUT FILE ON DSK, TRY A "REENTER" TO RESTART
/]
	JRST DONE
ER4:	TTCALL 3,[ASCIZ/
ATTEMPT TO EXPAND CORE FAILED, TRY A "CORE"
COMMAND, AND THEN RENAME T000XX, SO YOU WILL 
NOT LOSE THE FIRST PART OF IT, THEN
RESTART THE PROGRAM.
/]
	JRST DONE
ER5:	TTCALL 3,[ASCIZ/
DATA ERROR, TAPE BAD OR DEVICE HUNG, WILL TRY TO CONTINUE XMISSION.
/]
	JRST COUNT-2
ER6:	TTCALL 3,[ASCIZ/
BAD PARITY DETECTED, SUGGEST RESTARTING PROGRAM BUT
CHANGE RESPONSE TO 1ST OR 2ND QUESTION
/]
	JRST DONE
ER7:	TTCALL 3,[ASCIZ/
REACHED PHYSICAL END OF TAPE, REWINDING./]
	MTAPE I,1
	MTAPE I,0
	TTCALL 3,[ASCIZ/
REWIND DONE.  MOUNT NEXT TAPE, THEN TYPE
CARRIAGE RETURN TO CONTINUE, OR
TYPE 3 TO CLOSE FILES AND EXIT.
/]
	TTCALL 11,
	TTCALL 0,AC
	CAIN AC,63
	JRST DONE
	JRST GO
ER8:	TTCALL 3,[ASCIZ/
ERROR DURING BUFFERED OUTPUT, SUGGEST REWINDING TAPE AND RESTARTING
AT THE BEGINNING OF THE CURRENT FILE.
(RENAME ANY OTHER T000XX FILES FIRST)
/]
	JRST DONE
ER9:	TTCALL 3,[ASCIZ/
IS TAPE UNIT OK? START OVER.
/]
	JRST DONE
ER10:	TTCALL 3,[ASCIZ/
HELP!! UNIDENTIFIED INPUT ERROR, YOU SHOULD
NEVER REACH THIS MESSAGE. CHECK TAPE AND RESTART.
/]
DONE:	RELEAS I,
	RELEAS O,
	EXIT
	LIT
MESS1:	ASCIZ/
TYPE "E" FOR EVEN PARITY ON INPUT TAPE.
(DEFAULT VALUE IS ODD)
/
MESS2:	ASCIZ/
TYPE 2,5,OR 8 FOR 200,556,OR 800 BPI INPUT.
(DEFAULT VALUE IS THE SYSTEM STANDARD)
/
MESS3:	ASCIZ/
TYPE 1 FOR 9 TRACK INDUSTRY STANDARD MODE.
	(I.E. IBM TAPES)
TYPE 2 FOR DEC 7 OR 9 TRACK (NON-STANDARD), OR
TYPE 3 TO CLOSE FILES AND EXIT
(DEFAULT VALUE IS 1)
/
SPEC:	0
	SIXBIT/INN/
	XWD 0,INB
E:	SIXBIT/T00000/
	0
	EXP<157>B8
	0
INB:	BLOCK 3
OUTB:	BLOCK 3
	END ST