/
	.TITLE	'IBM 360 DATA LINK CONTROL'
/  THIS PROGRAM IS A PACKAGE FOR HANDLING THE DATA LINK TO THE IBM
/  360.  USERS MUST SUPPLY SUBROUTINES FOR HANDLING ALL EXPECTED
/  CHANNEL COMMANDS.
/
/  THE SUBROUTINES ARE CONNECTED TO THIS PACKAGE BY MEANS OF THE CALL
/
/	LAW	-NUM	NUM=NUMBER OF COMMANDS
/	JMS*	L.JOIN
/	.DSA	XXX	8 BIT COMMAND
/	.DSA	ADDRESS	SUBROUTINE ADDRESS
/
/  THE LAST TWO ENTRIES ARE REPEATED NUM TIMES.
/  THE MAX. PERMISSIBLE COMMAND IS N WHERE :
N=47	/ SET FOR X'27', MAX. COMMAND FOR IBM 2250
/
/  TO ALLOW HIGHER OR LOWER LIMITS FOR MAXIMUM PERMISSIBLE COMMAND
/  CHANGE ABOVE STATEMENT AND RECOMPILE.
/
/  AFTER THE INDICATED SUBROUTINES HAVE BEEN CONNECTED
/  TO THE PACKAGE, THE DATA LINK IS INITIALIZED, AND ALL
/  FUTURE INTERRUPTS FROM THE IBM 360 WILL BE ACCEPTED.
/
/  IF A COMMAND  IS RECEIVED FROM THE IBM 360 GREATER THAN N,
/  OR FOR WHICH A SUBROUTINE ADDRESS WAS NOT SUPPLIED, EXECUTION
/  WILL BE TERMINATED.
/
/  THE SUBROUTINES FOR DATA TRANSFER COMMANDS MUST STORE (-WORD
/  COUNT) IN LOCATION WC, AND (DATA ADDRESS - 1) IN LOCATION CA,
/  AND THEN FOR PDP-9 READ OPERATIONS
/
/	LAC	(X*PF+READF
/	JMS*	L.INOUT
/
/  AND FOR PDP-9 WRITE OPERATIONS
/
/	LAC	(X*PF+WRITEF
/	JMS*	L.INOUT
/
/  IN THE ABOVE X INDICATES THE PACKING FACTOR (0,1,2,3) FOR
/  1,2,3 OR4 IBM 360 BYTES PER PDP-9 WORD.
/
/  AFTER DATA TRANSFER IS COMPLETE CONTROL WILL BE RETURNED TO THE
/  INSTRUCTION FOLLOWING THE JMS*.  THE CONTENTS OF CA AND WC
/  CONTAIN THE RESULTS AT THE END OF DATA TRANSFER.  THE CONTENTS
/  OF STATUS REGISTER B IS IN LOCATION L.STATUS.	THIS MAY BE
/  CHECKED FOR PARITY ERRORS AND EXTRA BYTES.  AFTER PERFORMING ANY
/  NECESSARY OPERATIONS THE SUBROUTINE RELEASES CONTROL WITH
/
/	JMP*	L.DONE
/
	.EJECT
/  THE SUBROUTINES FOR COMMANDS THAT DO NOT TRANSFER DATA SHOULD
/  PERFORM THE NECESSARY FUNCTION AND THEN RELEASE CONTROL WITH
/
/	JMP*	L.CNTRL
/
/  TO DISABLE THE INTERRUPTS (IGNORE THE 360)
/  ISSUE
/
/	DZM*	L.STOP
/
/  IT SHOULD BE NOTED THAT IF THE IBM 360 REQUESTS SERVICE, AND
/  THE PDP-9 IGNORES THE INTERRUPTS, THEN THE PROGRAM ON THE IBM
/  360 WILL TERMINATE RUDELY.
/
/  CONSTANTS AND GLOBAL VARIABLES REQUIRED BY THIS PACKAGE AND
/  THE COMMAND SERVICE SUBROUTINES ARE:
/
PF=2000			/ PACK FACTOR BIT LOCATION
READF=1000			/ PDP-9 READ - IBM 360 WRITE
WRITEF=0			/ THE REVERSE
WC=36			/ WORD COUNT ADDRESS
CA=37			/ CHANNEL ADDRESS
/
	.GLOBL	L.STOP,L.INOUT,L.CNTRL,L.SENSE,L.CHECK,TR.NFR
	.GLOBL	L.JOIN,L.STATUS,L.DONE,L.ERROR,L.BUFFER
/
/  DEFINITIONS OF BIT STRINGS, IOT, ETC. REQUIRED BY THE PACKAGE
/  FOLLOW.
/
SEN=400000		/ STATUS A, ENABLE THE LINK
ENI=200000		/ STATUS A, ALLOW INTERRUPTS
RQIN=100000		/ STATUS A, REQUEST 360 INTERRUPT
ES=40000			/ STATUS A, INDICATE OPERATION END
/
ENDSTA=14 		/CHANNEL END,DEVICE END
OKSTAT=0			/ STATUS O.K.
/
ISD=400000			/ INITIAL SELECTION DONE FLAG
DTD=200000			/ DATA TRANSFER DONE FLAG
ESD=100000			/ END SEQUENCE DONE FLAG
TIO=040000			/ TEST I/O FLAG
DSC=020000			/ DISCONNECT FLAG
PAR=010000			/ PARITY ERROR FLAG
HIO=000040			/ HALT I/O FLAG
BITS=ISD!DTD!ESD!TIO!DSC!PAR!HIO
DT=400				/ DATA TRANSFER REQUEST
/
SSTB=702361			/ SKIP ON STATUS B REGISTER
/
	.EJECT
/  TEST SECTION. NOT COMPILED IN NORMAL PROGRAM.
/
	.IFDEF	OFFLIN
	.GLOBL	T.LSTA,T.RSTB,T.RCDR,T.LSTB,INT360
	.DEFIN	LSTA
	JMS*	T.LSTA
	.ENDM
	.DEFIN	RSTB
	JMS*	T.RSTB
	.ENDM
	.DEFIN	RCDR
	JMS*	T.RCDR
	.ENDM
	.DEFIN	LSTB
	JMS*	T.LSTB
	.ENDM
	.ENDC
/
/  END OF TEST SECTION
/
	.IFUND	OFFLIN
LSTA=702344			/LOAD STATUS A REGISTER
RSTB=702372			/ READ STATUS REGISTER B
RCDR=702352			/ READ COMMAND REGISTER
LSTB=702364			/LOAD STATUS REGISTER B
	.ENDC
/
API=61			/ API CHANNEL NUMBER
.SCOM=100
LEVEL5=402000
/
/  TO DISCONNECT THE LINK, SET L.STOP TO ZERO
/
L.STOP	-1
/
	.EJECT
/  ROUTINE TO CONNECT IN COMMAND HANDLING ROUTINES.
/  WILL REJECT ALL COMMANDS GREATER THAN N OR LESS THAN 0
/
/				INTERRUPT FOR ERROR ROUT.
L.JOIN	XX
	DAC	ITEMS
PRINTB	LAC	(JMP SHORT	/ENTER ONLY ONCE
	DAC	.-2
	LAW	-1
	DAC	L.STOP
	LAC	(.DSA SMASH
	DAC*	(.SCOM+13 /ALLOW LEVEL 5 SOFTWARE
/				   INTERRUPT FOR ERROR ROUT.
	LAC	(IOPSER
	DAC*	(24	/CATCH IOPS ERRORS TO PREVENT
	LAC	(JMP* 24	/MAJOR DISASTER ON 360/75 WHEN
	DAC*	(326	/IOPS ERROR OCCURS
JOINS	CLL!CML
	LAW	-N	/ CHECK IF COMMAND
	TAD*	L.JOIN	/ GREATER THAN N
	SNL!SZA		/ LESS THAN ZERO
	JMP	GOOF	/ IT WAS
	TAD	(DAC TABLE+N	/CALC. TABLE
	DAC	POINTR	/ ADDRESS
	SAD	(DAC TABLE+4	/DO NOT ALLOW X'04' THE
	JMP	GOOF		/SENSE COMMAND TO BE CHANGED
	ISZ	L.JOIN
	LAC*	L.JOIN	/ LOAD ADDRESS
POINTR	DAC	TABLE	/ INSERT ADDRESS IN TABLE
	ISZ	L.JOIN
	ISZ	ITEMS	/ ALL ENTRIES USED?
	JMP	JOINS	/ NO
	LAC	(JMP* TABLE+N
	CMA	
	TAD	(1
	DAC	TESTS	/BUILD A CONSTANT
	LAC	(ESD
	DAC	SEQNCE	/ SET UP TO ALLOW ISD
	CAL	API	/ TIE TO API CHANNEL, LEVEL 3
	16
	SSTB
	INT360		/INTERRUPT ADDRESS
	DBK		/.SETUP DOES NOT DEBREAK ON RETURN
	LAC	(SEN!ENI!RQIN!ENDSTA
	LSTA
ONWAIT	LAC	ONLINE
	SNA
JOINED	JMP*	L.JOIN
	ISZ	TIMR1
	JMP	ONWAIT
	ISZ	TIMR2
	JMP	ONWAIT
	LSTA+10		/ PDP-9 IS OFF LINE
	JMS	TELL
	.DSA	ERROR7+400000
	JMP	.
ERROR7	.ASCII	' 07 0'
/
/
TIMR1	0
TIMR2	LAW	-15
ONLINE	LAW	-1
/
ITEMS	XX
/
	.EJECT
GOOF	LAC*	L.JOIN	/ GET INVALID COMMAND
SMASHS	JMS	TELL	/ ISSUE LINK ERROR 1
	.DSA	ERROR1
	.EXIT		/ GO AWAY MAD!!
ERROR1	.ASCII	' 01 0'
SHORT	ISZ	L.JOIN
	ISZ	L.JOIN
	TAD	(1
	SPA	
	JMP	SHORT
	JMP*	L.JOIN
/
/  SET UP ERROR PRINT OUT
/
TELL	XX
	DAC*	PRINTL	/  MESSAGE DATA
	ISZ	PRINTL
	LAC*	TELL	/  MESSAGE ADDRESS
	SPA		/ IF DISASTER, CLEAR LINK
	DZM	L.STOP
	DAC*	PRINTL
	ISZ	PRINTL
	LAC	PRINTL
	SAD	(ENDLIST	/  CIRCULAR BUFFER
	LAC	(PRINTB
	DAC	PRINTL
	ISZ	TELL	/STEP PAST ARGUMENT
	LAC	(LEVEL5
	ISA		/  REQUEST SOFTWARE INTERRUPT
	JMP*	TELL
ENDLIST=JOINED-PRINTB/2*2+PRINTB
PRINTL	.DSA	PRINTB
PRINTX	.DSA	PRINTB
/
	.EJECT
/  THIS ROUTINE ISSUES ERROR MESSAGES. AFTER ISSUING DISASTER
/  MESSAGE WAIT FOR USER INTERVENTION: EXIT, DUMP, RESTART
/
SMASH	XX
	DAC	ITEMS	/ SAVE AC
	LAC	SMCHK
	SZA
	JMP	LEAVER
	ISZ	SMCHK
	LACQ
	DAC	GOOF	/ SAVE MQ
	LACS
	DAC	SCSAVE#	/ SAVE STEP COUNTER
SLOOP	LAC	PRINTX
	SAD	PRINTL
	JMP	PEXIT	/ BUFFER IS EMPTY
	LAC	SMASH
	DAC	SMASH2
	LAC	ITEMS
	DAC	ACTEMP
	DBK
	LAC*	PRINTX
	LMQ		/ PUT 6 DIGIT OCTAL NUMBER IN MQ
	ISZ	PRINTX
	LAC*	PRINTX
	DAC	SMASHS	/ ADDRESS OF ERROR NUMBER
	.WAIT	-3
	LAC*	SMASHS
	DAC	LIST	/ FIRST WORD OF ERROR CODE
	ISZ	SMASHS	/ POINT AT SECOND WORD
	LLS	3+1000	/ CLEAR AC, THEN SHIFT 3 TO
	CLL!RAL		/ PUT OCTAL CHAR. IN AC
	XOR*	SMASHS	/ ADD IT TO ERROR OCTAL CODE WORD
	DAC	LIST+1	/ AND STORE IN OCTAL OUTPUT LIST
/
	LAC	(6	/ PUT 2.5 OCTAL DIGITS
	JMS	SLIDE	/ FROM MQ INTO OUTPUT
	JMS	SLIDE	/ LIST
	DAC	LIST+2
	JMS	SLIDE	/ PUT ANOTHER 2.5 OCTAL
	JMS	SLIDE	/ DIGITS FROM MQ INTO
	LLS	4	/ OUTPUT LIST
	DAC	LIST+3
/
	.EJECT
	.INIT	-3,1,QUITIT
	.WRITE	-3,2,ERRORS,0
	LAC*	PRINTX
	SPA
	JMP	.	/ WAIT FOR @P, @S, @Q
	ISZ	PRINTX
	LAC	PRINTX
	SAD	(ENDLIST	
	LAC	(PRINTB
	DAC	PRINTX
	LAC	(400004
	ISA
	LAC	ACTEMP
	DAC	ITEMS
	LAC	SMASH2
	DAC	SMASH
	JMP	SLOOP
ACTEMP	XX
SMASH2	XX
SMCHK	0
/  RESET STEP COUNTER
PEXIT	LAC	SCSAVE
	XOR	(77
	TAD	(640402
	AND	(640477
	DAC	.+1
	XX
	LAC	GOOF
	LMQ
	DZM	SMCHK
LEAVER	LAC	ITEMS
	DBR
	XCT	(JMP* SMASH
/
QUITIT	.EXIT		/ QUIT IF @P
/
SLIDE	XX
	LLS	3	/ MOVE OCTAL NUMBER INTO AC
	ALS	4
	XOR	(6	/ INSERT LEADING 4 BITS FOR NEXT DIGIT
	JMP*	SLIDE
/
	.EJECT
ERRORS	.DSA	ERREND-.*400	/ WORD PAIR COUNT
	.DSA	0
	.ASCII	'LINK ERROR'
LIST	.BLOCK	4
	.ASCII	 ' > '<007><175>	 /RING BELL, ALT MODE
ERREND=.
/
/  ENTER HERE WHEN DATA CHANNEL INTERRUPT OCCURS. READ STATUS
/  REGISTER B AND SEE WHAT THE IBM 360 THINKS IT IS DOING
/
INT360	XX
	DAC	ACSAVE	/ SAVE AC
	RSTB		/ READ STATUS B
	DAC	STATSB	/ SAVE IT
	AND	SEQNCE	/ CHECK AGAINST EXPECTED
	SAD	(ISD	/ INTERRUPT SEQUENCE
	JMP	INITAL	/ INITIAL SELECTION
	SAD	 (DTD
	JMP*	L.INOUT	/ DATA TRANSFER DONE
	SAD	(ESD
	JMP	END-1
/
/  EITHER OUT OF SEQUENCE, OR NON-STANDARD REQUEST
/
	LAC	(TIO
	AND	STATSB
	SZA
	JMP	TEST	/ TEST I/O COMMAND
	LAC	(DSC
	AND	STATSB
	SZA
	JMP	DISCON	/ DISCONNECT CONDITION
	LAC	(HIO
	AND	STATSB
	SZA!CLL
	JMP	HALT	 / HALT I/O COMMAND
/
/  OUT OF SEQUENCE COMMAND. QUIT IN DISGUST. THE LINK HARDWARE
/  IS FUBAR. FIRST HOWEVER, TRY TO SAVE IBM 360 FROM CHANNEL
/  HANG-UP.
	JMS	TELL1
	.DSA	QUIT+400000
/
	.EJECT
DOLT	LAC	STATSB	/ GET BIT TO RESET
	CMA		/ STATUS-B REGISTER
	AND	(BITS
	LSTB
	LAC	(ESD
	DAC	SEQNCE
/
	LAC	(100000	/ SET SENSE BITS AS
	DAC	L.SENSE	/ AN ERROR -COMMAND REJECT
	LAC	(SEN!ENI!ES+2  / UNIT CHECK
	JMP	TIEUP2
QUIT	.ASCII	' 02 0'
/
/ WHEN TEST I/O ISSUED BY IBM 360 WE WILL SAY WE ARE HAPPY AND
/  IGNORE IT.
/
TEST	LAC	(BITS\TIO
	LSTB		/ TURN OFF INTERRUPT
	LAC	(SEN!ENI+OKSTAT
	JMP	TIEUP2
/
/  INITIAL SELECTION.  GO TO APPROPRIATE COMMAND SUBROUTINE AFTER
/  CHECKING IF LEGAL.
/
INITAL	LAC	(DTD
	DAC	SEQNCE	/SET UP NEXT GATE
/
	LAC	STATSB
	AND	(PAR
	SZA
	JMP	PARERR	/ PARITY ERROR IN COMMAND
/
/  READ THE COMMAND BYTE AND GO TO SUBROUTINE
/
	RCDR		/ GET COMMAND
	TAD	(JMP* TABLE
	DAC	SPOT
	TAD	TESTS	/(TESTS)=-(JMP* TABLE+N)
	SPA		/ TEST IF ILLEGAL (TOO BIG)
SPOT	XX		/ GO CORRECT ROUTINE
/
/  ENTER HERE FOR AN INVALID COMMAND.  AC CONTAINS (COMMAND 
/ BYTE - N)
/
INVALD	TAD	(N	/RECOVER COMMAND BYTE
	JMS	TELL
	.DSA	 ERROR3+400000
	JMP	DOLT
ERROR3	.ASCII	' 03 0'
/
	.EJECT
/  INVALID PARITY IN COMMAND
/
PARERR	RCDR		/ GET COMMAND
	JMS	TELL
	.DSA	ERROR4+400000
	JMP	DOLT
ERROR4	.ASCII	' 04 0'	/ ISSUE LINK ERROR 4
/
/  IOPS ERROR HAS OCCURRED.  ATTEMPT TO BAIL OUT THE 360/75
/
IOPSER	LAW	-10
	DAC	L.JOIN
	DBK		/RELEASE ALL API LEVELS
	ISZ	L.JOIN
	JMP	.-2
	LAC	(400000	/TURN API BACK ON
	ISA
	ION		/TURN PI BACK ON
	JMS*	TR.NFR	/ATTEMPT TO TERMINATE POLITELY
	SKP
	XX
	JMP	.	/WAIT FOR THE OPERATOR'S BLESSING
TR.NFR	.-2		/MAY BE CHANGED BY USER. I.E. 'CHAT1'
/
/ TABLE FOR DECODING IBM 360 CHANNEL COMMANDS.  SIZE IS SET FOR
/  SYSTEM MAX. ALLOWABLE COMMAND (N).
/
/  MUST GENERATE TABLE HARD WAY DUE TO STUPID RESTRICTIONS
/  PLACED ON .REPT
/
	.DEFIN	GEN,A
	.IFPOZ	M-A
M=M-A
	.REPT	A
	.DSA	INVALD
	.ENDC
	.ENDM
/
	.EJECT
M=N
TABLE	.DSA	INVALD	/ ILLEGAL COMMAND EXIT
	GEN	200
	GEN	100
	GEN	40
	.EJECT
	GEN	20
	GEN	10
	GEN	4
	GEN	2
	GEN	1
/
BOOBOO=.
	.LOC	TABLE+4
	.DSA	SENSE
	.LOC	BOOBOO
/
	.EJECT
TESTS	XX		/-JMP* TABLE+N
/
/  ROUTINES TO INITIATE I/O.	THESE ARE THE RETURN POINTS FROM THE
/  USERS COMMAND HANDLING ROUTINES
/
L.CNTRL	LAC	(BITS\ISD
CONTROL	LSTB		/ TURN OFF INTERRUPTS
	LAC	 (ESD	 / SET UP TO EXPECT
	DAC	SEQNCE	/ END SEQUENCE NEXT
/
	LAC	(SEN!ENI!ES+ENDSTA
TIEUP2	LSTA		/ START END SEQUENCE
	JMP	TIEUP	/ AND EXIT
/
L.INOUT	XX
	DAC	CHKBOX
	XOR	(BITS\ISD!DT	/ TURN OFF INTERRUPT AND
TIEUP4	LSTB		/ SET UP DATA TRANSFER BITS
TIEUP	LAC	ACSAVE
	DBR
	XCT	(JMP*  INT360	/EXIT TO MAIN LINE
ACSAVE	XX
/
/ AFTER RECEIVING CONTROL FOLLOWING END-OF-DATA INTERRUPT USERS
/  SUBROUTINE RETURNS CONTROL TO THE FOLLOWING INSTRUCTION.
/
L.DONE	LAC	STATSB	/ TURN OF DTD AND
	AND	(PAR	/ POSSIBLY PAR BIT
	XOR	(BITS\DTD
	JMP	CONTROL
/
/  INTERRUPT INDICATED END OF ENDING SEQUENCE
/
/
/  TURN OFF INTERRUPTS AND LOAD STATUS REGISTER FOR NEXT TIME
/
	DZM	ONLINE
END	LAC	(BITS\ESD
TIEUP3	LSTB		/ TURN OFF INTERRUPT
	LAC	(ISD
	DAC	SEQNCE	/ ALLOW NEW SEQUENCE
	LAC	(SEN!ENI+OKSTAT	/ LOAD STATUS A
	AND	L.STOP		/DISABLE LINK IF REQUIRED
	JMP	TIEUP2
/
	.EJECT
/  WHEN DISCONNECT OCCURS, TELL USER AND RE-INITIALIZE
/
DISCON	JMS	TELL1
	.DSA	QUIT
	LAC	(BITS\DSC
	JMP	TIEUP3
/
/  WHEN HALT I/O OCCURS, PRESENT CHANNEL END
/  IF NECESSARY, AND TELL USER.
/
HALT	JMS	TELL1
	.DSA	QUIT
	LAC	 SEQNCE
	SAD	(ISD
	JMP	TIEUP
	LAC	(ESD
	DAC	SEQNCE
	LAC	(SEN!ENI!RQIN!ES+ENDSTA
	LSTA
	LAC	(BITS\HIO
	JMP	TIEUP4
STATSB	XX
SEQNCE	XX
L.STATUS=STATSB
L.ERROR=TELL
/
TELL1	XX
	LAC	TELL1
	DAC	TELL
	CLL
	LAC	SEQNCE
	RTL
	RTL
	XOR	STATSB	/BITS 15, 16, 17, EXPECTED STATUS
	JMP	TELL+1
/
	.EJECT
/
/
/  DEVICE DEPENDENT SECTION. WE ARE PRETENDING PDP-9 IS
/  A IBM 2250. MUST HANDLE SENSE COMMAND IN MANNER THAT
/  IBM 360 EXPECTS.
/
SENSE	LAW	-3	/ TRANSFER 2 WORDS
	DAC*	(.DSA WC
	LAC	(.DSA L.SENSE-1
	DAC*	(.DSA CA
	LAC	(1*PF+WRITEF	/ 2 BYTES/WORD
	JMS	L.INOUT
	DZM	L.SENSE
	JMS	CHECK	/ CHECKS THAT FULL TRANSFER OCCURRED
	JMP	L.DONE
CHECK	XX
	LAC*	(.DSA WC	/ CHECK IF WORD COUNT IS ZERO
	SZA
	JMP	WOOPS
CHECK2	LAC	STATSB
	AND	(3*PF+PAR / IS IT EXTRA BYTE OR PARITY ?
	DAC	CHKBIN
	LAC	CHKBOX
	AND	(3*PF
	SAD	CHKBIN
	JMP*	CHECK
	RAR
	RTR
	XOR	CHKBIN
	JMS	TELL
	.DSA	PARITY
	JMP*	CHECK
WOOPS	JMS	TELL
	.DSA	WCOUNT
	JMP	CHECK2
PARITY	.ASCII	' 05 0'	/ EXTRA BYTE OR PARITY
WCOUNT	.ASCII	' 06 0'	/ WORD COUNT WRONG!
L.CHECK=CHECK
/
L.SENSE	.DSA	0
L.BUFFER	.DSA	0
CHKBOX	XX
CHKBIN	XX
/
	.EJECT
	.END