Directory of image this file is from
This file as a plain text file

/ASSIGN TAPE USER DEVICE NAMES FROM INTERNAL LABELS

/THIS VERSION IS INDEPENDENT OF THE DEVICE
/NUMBERS ASSOCIATED WITH TAPES. HENCE
/IT WILL RUN WITH PS/8 SYSTEM WITH "BUILD".

/MODIFIED 7/19/73
/TO USE BLOCK 6 AS PARAMETER BLOCK IF PRESENT.

/ASSEMBLY INFORMATION:
/	.CO DTA /L
/	*=12000(89)$
/	.SA SYS AUTOAS
/NOTE THIS PROGRAM MAY BE RUN ON NON-DECSYSTEM-8 SYSTEMS
/VIA JUST  .R AUTOAS

/FOR LINCTAPES DEFINE LTA
/DEFAULT IS DECTAPE

	IFNDEF LTA <LTA=0;DTA=1>
	IFNDEF DTA <LTA=1;DTA=0>

	USR=200

	FIELD 1
	*2000

	CLA CLL
	JMS I (7700	/USRIN
	  10
ZDTLP,	CLA CLL 	/WE WISH TO DELETE THE USER DEVICE
	JMS I (USR	/NAMES. SO INQUIRE DEVICE NUMBERS
	  12		/AND BUILD "UNITABLE".

ZDEVN,
IFNZRO LTA <DEVICE LTA0>
IFNZRO DTA <DEVICE DTA0> /DEVICE NAME;DEVICE NUMBER
	  0
	JMP LOOP	/HAVE GONE THROUGH ALL AVAILABLE UNITS.
	TAD ZDEVN+1	/PICK UP DEVICE NUMBER
	DCA I ZDTPTR	/AND SAVE IN TABLE
	ISZ ZDTPTR	/POINT TO NEXT
	TAD ZDEVN+1	/NOW CALC ADDRESS OF USER DEV. NAME TABLE
	TAD (7740	/IS 7740+DEV#
	DCA ZDTCT
	DCA I ZDTCT	/NOW CLEAR OUT OLD ENTRY
	TAD DTAX	/NOW RESTORE DEVICE NAME
	DCA ZDEVN	/FIRST WORD
	TAD DTAX+1	/SECOND WORD (NO NUMBER)
	TAD ZDTPTR	/AND PUT IN UNIT NUMBER
	TAD (60-UNITABLE
	DCA ZDEVN+1
	JMP ZDTLP	/AND LOOP FOR NEXT UNIT.

LOOP,	CLA CLL
	ISZ UNIT
	TAD I UNIT	/PICK UP DEV. NUMBER
	SNA CLA 	/ZEROS END LIST
	JMP EXIT
	TAD UNIT
	TAD (-UNITABLE	/TO CALC UNIT NUMBER
	JMS ONLINE	/IS THIS UNIT ONLINE
	JMP LOOP	/NO
	JMS CRLF
	JMS DOLABL
	JMP LOOP
ZDTPTR, UNITABLE
ZDTCT,	0
UNIT,	UNITABLE-1

ONLINE, 0
	IFNZRO LTA <
	CLL RAR 	/THIS GETS UNIT (EVEN - ODD) IN LINK
	TAD (10 	/WE NOW HAVE NO PAUSE + EX UNIT IN AC
	6141		/GO TO LINC MODE
	0001		/AC TO XOB
	0452		/SKIP IF LINK ZERO
	.+4&1777+6000	/JMP .+4
	0703		/MOVE
	0000
	.+3&1777+6000	/JUMP AROUND THE ONE FOR NO LINK
	0713
	0000
	0002
	CLA CLL
	TAD (5000	/GET
	6151
	CLA CLL
	6154
	RTR
	SNL CLA 	/SKIP IF TAPE OK
	JMP ONLIN1	/NOT ONLINE = NO NEED TO WAIT
	6141		/GO TO LINK MODE
	0416		/IN ORDER TO WAIT UNTIL
	.-1&1777+6000	/TAPE FINISHED
	0002		/BACK TO 8 MODE
	ISZ ONLINE	/RETURN TO CALL +2: TAPE O.K.
ONLIN1, CLA CLL
	TAD (20
	6141		/LINC MODE
	0004		/I/O PRESET
	0002		/8 MODE
	JMP I ONLINE

DTAX,	TEXT /LTA/
	>

	IFNZRO DTA <
	CLL RTR; RTR
	TAD (700	/START MOTION IN REVERSE
	6762		/CLEAR STATUS REG A
	6764		/LOAD  STATUS REG A
	6771		/WAIT FOR SOMETHING TO HAPPEN
	JMP .-1
	6772		/READ  STATUS REG B
	AND (400	/LOOK AT SEL ERR BIT
	SNA CLA 	/BIT IS SET, UNIT NOT ON LINE
	ISZ ONLINE	/UNIT ONLINE, RETURN TO CALL +2
	JMP I ONLINE

DTAX,	TEXT /DTA/
	>

EXIT,	CLA CLL
	CIF CDF 0
	JMP I (7600

PRTEXT, 0
	DCA PRTIP
	TAD I PRTIP
	SNA
	JMP I PRTEXT
	RTR
	RTR
	RTR
	JMS PR6BIT
	TAD I PRTIP
	JMS PR6BIT
	ISZ PRTIP
	JMP PRTEXT+2
PRTIP,	0
PR6BIT, 0
	AND (77
	SNA
	JMP I PRTEXT
	TAD (-40
	SPA
	TAD (100
	TAD (240
	JMS OPUTC
	JMP I PR6BIT
OPUTC,	0
	TLS
	TSF
	JMP .-1
	CLA CLL
	JMP I OPUTC

	PAGE

DOLABL, 0
	CLA CLL
	TAD (4001
	DCA HANENT
	TAD UNIT
	DCA UNIT2	/COPY POINTER TO THIS PAGE
	TAD I UNIT2	/PICK UP DEVICE NUMBER
	JMS I (USR
	1		/FETCH ITS HANDLER
HANENT, 0
	HLT
	CIF 0
	JMS I HANENT	/READ
IFNZRO LTA<0110 	/1 PAGE (128 WDS) TO FIELD 1>
IFNZRO DTA<0111 	/DECTAPES START FORWARD>
	4000		/AT LOC 4000-4177
	0		/BLOCK ZERO OF TAPE
	HLT
	CIF 0
	JMS I HANENT	/READ
	0111		/1 PAGE
	4200		/BEHIND BLOCK 0
	6		/PARAMETER BLOCK
	HLT

	CLA CLL
	TAD (DTAX
	JMS PRTEXT
	TAD UNIT2
	TAD (260-UNITABLE	/MAKES ASCII UNIT NUMBER
	JMS OPUTC
	DCA LABEL
	DCA LABEL+1	/CLEAR FROM PREVIOUS
	DCA LABEL+2

	ISZ I (4202	/SKIP IF PARAM BLOCK
	JMP BLK0	/NO: TRY BLOCK 0
	TAD I (4300	/GET LABLE CHARS
	JMS RTL6	/OVER TO HIGH ORDER
	DCA LABEL	/FOR LABEL CHECK.
	TAD I (4301	/NEXT
	AND (77
	TAD LABEL	/FINISH UP 1ST TWO
	DCA LABEL
	TAD I (4302	/3RD CHAR
	JMS RTL6	/OVER TO HIGH ORDER
	DCA LABEL+1
	TAD I (4303	/LAST CHAR
	AND (77
	TAD LABEL+1
	DCA LABEL+1
	TAD I (4277	/INTERNAL LABLE
	DCA INTLBL	/STASH
	JMP LFINISH	/GO FINISH UP

BLK0,	TAD I (4000
	TAD (-6260
	SZA CLA
	JMP UNLAB
	TAD I (4001
	TAD (-0714
	SZA CLA
	JMP UNLAB
	TAD I (4005	/WE ARE WORKING ON LABEL
	AND (7400
	CLL RTR
	DCA LABEL
	TAD I (4004
	AND (1400
	CLL RTL
	TAD LABEL
	DCA LABEL
	TAD I (4006
	AND (77
	TAD LABEL
	DCA LABEL
	TAD LABEL
	DCA INTLBL
LFINIS, TAD (PRLABL
	JMS PRTEXT
	TAD (LABEL
	JMS CHKDUP
	JMP DUPLAB	/WE ALREADY HAVE DEVICE BY THAT NAME
	CLA CLL
	TAD (7740	/CALCULATE
	TAD I UNIT2	/INDEX INTO TABLE
	DCA ASGIND
	TAD INTLBL	/GET INTERNAL LABEL
	DCA I ASGIND	/ENTER IT
	JMP I DOLABL

INTLBL, 0
UNIT2,	0
ASGIND, 0
PRLABL, 4040
LABEL,	0;0;0

UNLAB,	TAD (PRUNL
	JMS PRTEXT
	JMP I DOLABL
DUPLAB, CLA CLL
	TAD (DUPMSG
	JMP UNLAB+1

	PAGE
DUPMSG, TEXT / IS DUP NAME, NOT ASSIGNED/
PRUNL,	TEXT /	UNLABELED/

CHKDUP, 0
	DCA CHKD
	TAD I CHKD
	DCA CHKA1
	ISZ CHKD
	TAD I CHKD
	DCA CHKA1+1
	JMS I (USR
	12		/INQUIRE
CHKA1,	0;0;0
	ISZ CHKDUP	/NO DEVICE BY THIS NAME ALREADY EXISTS, GOOD
	JMP I CHKDUP	/IF WE CAME BACK TO HERE, TAKE ER RET FROM HERE

CHKD,	0


CRLF,	0
	CLA CLL
	TAD (215
	JMS OPUTC
	TAD (212
	JMS OPUTC
	JMP I CRLF

RTL6,	0
	AND (77
	CLL RTL;RTL;RTL
	JMP I RTL6

UNITABLE,ZBLOCK 11

	$