DataMuseum.dk

Presents historical artifacts from the history of:

Philips Data Systems

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Philips Data Systems

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - metrics - download

⟦635e0ce26⟧

    Length: 23776 (0x5ce0)
    Notes: pts_type(SC)
    Names: »DCBSC.SC«

Derivation

└─⟦7a1dcd5a9⟧ Bits:30009673 Philips computer tape "600134"
    └─⟦this⟧ »PT3272/DCBSC.SC« 

PTS(SC)

	IDENT DCBSC	REL 11.0 83-11-15 870150541100 

			DK1, DEV. STATUS AT CONNECT
			=2 TWO DC-LINES
			=1, CHARAC. ADDR.
			81-01-26 
****************************************************************
*                                                              *
*        MODULE       DCBSC                                    *
*                     MODULE HANDLING THE COMMUNICATION        *
*                     BETWEEN THE SLU AND CLUSTER CONTROLLER   *
*                     (EMULATION 3270 BSC)                * 
*                                                              *
****************************************************************
	EJECT
*********************************************************** 
*                                                         * 
*        ROUTINES                                         * 
*                                                         * 
*        DCINP    DC-INPUT MAIN ROUTINE                   * 
*        READW    READ WITH WAIT                          * 
*        DCWRIT   WRITE DC BUFFER                         * 
*        TSTMES   TEST MESSAGE                            * 
*        SETSTA   SET STATUS                              * 
*        TSTSTA   TEST STATUS                             * 
*        DCABOR   ABORT DC REQUEST                        * 
*        CHKSTA   CHACK DC STATUS                         * 
*        DCOFLN   INDICATE OFFLINE TO CLUSTER             * 
*        TRPA     TRANSMIT SHORT READ                     * 
*        TRPF     TRANSMIT READ MODIFIED                  * 
*                                                         * 
*********************************************************** 
	EJECT
****************************************************************
*                                                              *
*                     ENTRY POINTS                             *
*                                                              *
****************************************************************

	ENTRY	DCINP	DC-INPUT MAIN ROUTINE
	ENTRY	TSTSTA	TEST STATUS 
	ENTRY	SETSTA	SET STATUS
	ENTRY	OPEN	OPEN
	ENTRY	CONCT	CONNECT PASSIVE
	ENTRY	DISCON	DISCONNECT	=2 
	ENTRY	SETTYM	SET REQUEST TIMER 
	ENTRY	TSTMES	TEST MESSAGE. 
	ENTRY	DCABOR	ABORT DC REQUEST
	ENTRY	TRPA	TRANSMIT SHORT READ 
	ENTRY	TRPF	TRANSMIT READ MODIFIED
	ENTRY	DCOFLN	INDICATE OFFLINE TO CLUSTER 
	ENTRY	CHKSTA	CHECK DC STATUS 
	ENTRY	DCWRIT	WRITE DC BUFFER 
	ENTRY	READW	READ DC WITH WAIT
	ENTRY	RDSTAT	READ STATISTICS 

************************************************************* 
*                                                           * 
*                     EXTERNAL REFERENCES                   * 
*                                                           * 
************************************************************* 

	EXTRN	GETBUF	GET BUFFER (PAD)
	EXTRN	RELBUF	RELEASE BUFFER (PAD)
	EXTRN	PAID	STORE AID-CODE IN DC BUFFER (PAD) 
	EXTRN	SCRINF	GET SCREEN INFORMATION (VDU)
	EXTRN	BUFADR	STORE BUFFER ADDRESS IN DC BUFFER (PAD) 
	EXTRN	PACK	PACK MODIFIED FIELDS (PAD)
	EXTRN	LMP3OF	INHIBIT LAMP OFF (KEYB) 
	EXTRN	DISMOD	DISPLAY MODIFIED FIELDS (VDU) 
	EXTRN	UNPACK	UNPACK DC BUFFER (PAD)
	EXTRN	ERROR	INDICATE ERROR (KEYB)
	EXTRN	RESKB	RESET KEYBOARD BUFFER (KEYB) 
	EXTRN	LMP1ON	SYSTEM AVAILABLE	DK 
	EXTRN	LMP3ON	                   ON 
	EXTRN	LMP1OF	SYSTEM AVAILABLE	DK 
	EJECT
********************************************************* 
*                                                       * 
*        CONDITIONAL ASSEMBLY PARAMETERS                * 
*                                                       * 
********************************************************* 
X:C	EQU	0	OFFLINE HANDLING IF :=1 
OFLIN	EQU	0 
X:D	EQU	1	NUMBER OF LINES (1-2) 
NBRLIN	EQU	2
X:E	EQU	300	REQUEST TIMEOUT IN 100 MS 
REQTIM	EQU	00300
X:L	EQU	1000	MAX BUFFER SIZE IN WORDS 
BUFFL	EQU	1150
X:O	EQU	0	TEST INCLUDED IF:=1 
TEST	EQU	0
	EJECT
*************************************************************** 
*                                                             * 
*	DECLARATIONS OF DATA AND EQUATES
*                                                             * 
*************************************************************** 

* 
*       EQUATES FOR ECB HANDLING
* 
ECBBA	EQU	2	BUFFER ADDRESS
ECBRL	EQU	4	REQUESTED LENGTH
ECBEL	EQU	6	EFFECTIVE LENGTH
ECBRC	EQU	8	RETURN CODE 
ECBCW1	EQU	10	CONTROL WORD 1
ECBCW2	EQU	12	CONTROL WORD 2
* 
*	RELATIVE POS. IN ECBBLK 
* 
DC	EQU	4
	EJECT
* 
*	RELATIVE ADDRESSES IN 
*	TERMINAL WORKBLOCK
* 
WCC	EQU	1952	WCC CHAR.
KBINH	EQU	WCC+2	KB INHIBIT INDICATOR
DCLENG	EQU	KBINH+4	DC READ EFFECTIVE LENGTH 
MAIN	EQU	DCLENG+12	MAIN FRAME FLAG
ECBBLK	EQU	MAIN+6	ECB:S FOR MULTIPLE WAIT 
BUFPNT	EQU	ECBBLK+14	BUFFER TO RELEASE
REGI	EQU	BUFPNT+2	SAVE AREA 
ECBDC1	EQU	REGI+46	ECB DC LINE 1
ECBDC2	EQU	ECBDC1+2	ECB DC LINE 2 
* 
*	RELATIVE ADDRESSES IN 
*	COMMON WORKBLOCK
* 
MF1CU	EQU	0	SYMBOLIC ADDRESS
MF2CU	EQU	MF1CU+2	SYMBOLIC ADDRESS	 
	EJECT
************************************************************
*                                                          *
*        DCINP       DC INPUT MAIN ROUTINE                 *
*                                                          *
************************************************************
*		REGISTERS
* 
*	A11= CREDIT WORK AREA 
*	A13= RESERVED 
* 
********************************************
DCINP	EQU	* 
	CF	A14,GETBUF	GET BUFFER 
	LDR	A3,A8
	CF	A14,READW	READ ONE BUFFER 
	ANK	A1,8	OK? 
	RF(Z)	DCIN10	YES 
	LDR	A8,A12 
	CF	A14,RELBUF	RELEASE BUFFER 
	RF	DCIN15
DCIN10	EQU	*
	LD	A1,ECBEL,A8 
	ST	A1,DCLENG,A11	SAVE LENGTH 
	ST	A12,BUFPNT,A11
	CF	A14,UNPACK	UNPACK THE BUFFER
	CF	A14,DISMOD	DISPLAY THE NEWS 
DCIN15	EQU	*
	LD	A1,KBINH,A11
	LDR	A2,A1
	ANK	A1,1	KEYBOARD TOTALLY INHIBIT? 
	RF(Z)	DCIN20	NO
	ANK	A2,/E	KEYBOARD NOT TOTALLY INHIBIT 
	LD	A1,WCC,A11
	ANK	A1,2	RESTORE KEYBOARD? 
	RF(Z)	DCIN30	NO
DCIN20	EQU	*
	CF	A14,LMP3OF	TUR OFF INHIBIT LAMP 
	ANK	A2,4	RESTORE KEYBOARD
DCIN30	EQU	*
	ST	A2,KBINH,A11
	LDK	A1,0 
	CF	A14,SETSTA	SET DEVICE END 
	RTN	A14
	EJECT
**************************************************************
*                                                            *
*	OPEN	OPEN 
*                                                            *
**************************************************************
*		REGISTERS
* 
*	A8= DC ECB
*	A11= CREDIT WORK AREA 
*	A13= RESERVED 
* 
**************************************************************
OPEN	EQU	*
	LD	A8,ECBDC1,A11	GET ECB ADDRESS 
	LDK	A4,0	RESET INDICATOR 
	LD	A3,6,A13	GET BASE 
	LD	A2,MF1CU,A3	ADDRESS	=1
OPEN10	EQU	*
	ST	A2,ECBCW2,A8	.	=1 
	LDK	A7,/A1	OPEN
	LKM
	DATA	1 
	LD	A1,ECBRC,A8 
	RF(N)	OPEN20 
	IFT	NBRLIN=2 
	LDR	A4,A4	ANOTHER LINE TO OPEN 
	RF(NZ)	OPEN20	NO 
	LD	A8,ECBDC2,A11	GET LINE 2
	LD	A2,MF2CU,A3	GET SECOND SYMB. ADD	DK 
	LDK	A4,1 
	RB	OPEN10
	XIF
OPEN20	EQU	*
	RTN	A14
	EJECT
********************************************************* 
*                                                       * 
*	CONCT	CONNECT PASSIVE 
*                                                       * 
********************************************************* 
*		REGISTERS
* 
*	A4= DEVICE STATUS 
*	A8= DC ECB
*	A11= CREDIT WORK AREA 
*	A13= RESERVED 
* 
**************************************************
CONCT	EQU	* 
	CF	A14,GETBUF	GET BUFFER 
	LD	A8,ECBDC1,A11	GET LINE 1
	LD	A3,6,A13	GET BASE	=2
			.	=2 
	IFT	NBRLIN=2	.	=2
	LD	A1,MAIN,A11	SECOND LINE?	=2 
	RF(Z)	CONC10	NO!	=2
	LD	A8,ECBDC2,A11	YES!	=2 
	ADK	A3,2	SECOND CU	=2
	XIF		.	=2
CONC10	EQU	*
	ST	A12,ECBBA,A8
	LDR*	A1,A11	GET TASKID 
	ANK	A1,/FF 
	SC	A1,+1,A12	SAVE ADDRESS IN BUFFER
	LDK	A1,2	LENGTH
	ST	A1,ECBRL,A8 
	ST	A4,ECBCW1,A8	SET DEVICE STATUS	DK1
			.	=2 
	LD	A1,MF1CU,A3 
	ST	A1,ECBCW2,A8	.	=1 
	LDK	A7,/A7	CONNECT PASSIVE 
	LKM
	DATA	1 
	LD	A1,REGI,A11	GET TABLE TO SAVE PHYS. ADDRESS 
	LD	A2,ECBCW2,A8	GET ADDRESS
	SC	A2,+2,A1	SAVE IT FOR COPY COMMAND 
			.	=2 
	LDR	A8,A12 
	CF	A14,RELBUF	RELEASE BUFFER 
	RTN	A14
	EJECT		.	=2
**************************************************************
* 
*	DISCON     -     DISCONNECT 
* 
**************************************************************
* 
*	INPUT: A11 = CREDIT WORK AREA 
* 
*	USED*  A1,A7,A8 
* 
*************************************************************** 
* 
DISCON	EQU	*	.	=2 
	CF	A14,DCABOR	ABORT TEST MESSAGE	=2
	LDK	A7,/AF	DISCONNECT	=2 
	LKM		.	=2
	DATA	1	.	=2
	RTN	A14	.	=2 
	EJECT
***************************************************************** 
* 
*	SETTYM	SET REQUEST TIMEOUT
* 
***************************************************************** 
*              REGISTERS
* 
* 
***************************************************************** 
SETTYM	EQU	*
	LD	A8,ECBDC1,A11	GET ECB 
	LDK	A4,0	RESET INDICATOR 
	LDKL	A1,REQTIM	GET TIMEOUT VALUE 
SETT10	EQU	*
	ST	A1,ECBCW1,A8
	LDK	A7,/B9	SET TIMEOUT 
	LKM
	DATA	1 
	IFT	NBRLIN=2 
	LDR	A4,A4	MORE TO TIME?
	RF(NZ)	SETT20	NO 
	LD	A8,ECBDC2,A11	GET LINE 2
	LDK	A4,1	NO MORE 
	RB	SETT10
SETT20	EQU	*
	XIF	 
	RTN	A14
	EJECT
********************************************************* 
*                                                       * 
*	READW	RECEIVE 
*                                                       * 
********************************************************* 
*		REGISTERS
* 
*	A3= BUFFER ADDRESS
*	A8= DC ECB
*	A11= CREDIT WORK AREA 
*	A13= RESERVED 
* 
********************************************************* 
READW	EQU	* 
	LD	A8,ECBDC1,A11	LINE 1
	IFT	NBRLIN=2 
	LD	A1,MAIN,A11	MORE LINES
	RF(Z)	REDW10	NO
	LD	A8,ECBDC2,A11	LINE 2
REDW10	EQU	*
	XIF
	LDKL	A1,BUFFL+BUFFL	GET LENGTH 
	ST	A1,ECBRL,A8 
	ST	A3,ECBBA,A8 
	LDK	A7,/82	RECEIVE 
	LKM
	DATA	1 
	LD	A1,ECBRC,A8 
	ANK	A1,/5B	OK? 
	RF(Z)	REDW20	YES 
	CF	A14,CHKSTA	CHECK STATUS 
	LDK	A1,8	INDICATE ERROR
	RF	REDW30
REDW20	EQU	*
	LDK	A1,2 
REDW30	EQU	*
	RTN	A14
	EJECT
********************************************************* 
*                                                       * 
*	DCWRIT	SEND 
*                                                       * 
********************************************************* 
*		REGISTERS
* 
*	A1= AT ENTRY CHAIN INDICATOR, RETURN CODE 
*	A8= DC ECB
*	A9= DC BUFFER LENGTH
*	A11= CREDIT WORK AREA 
*	A13= RESERVED 
* 
***************************************************** 
DCWRIT	EQU	*
	LD	A8,ECBDC1,A11	LINE
	IFT	NBRLIN=2 
	LD	A1,MAIN,A11	LINE 2? 
	RF(Z)	DCWR10	NO
	LD	A8,ECBDC2,A11	LINE 2
DCWR10	EQU	*
	XIF
	LDK	A2,2	KEYBOARD INHIBIT BUT RESETABLE
	ORS	A2,KBINH,A11 
	LDK	A7,/86	WRITE ORDER 
	ST	A12,ECBBA,A8	BUFFER ADDRESS 
	ST	A9,ECBRL,A8 
	LKM
	DATA	1 
	LD	A1,ECBRC,A8	ANY ERROR?
	ANK	A1,/5B 
	RF(Z)	DCWR90	NO
	CF	A14,ERROR 
	CF	A14,CHKSTA	CHECK DC STATUS
	LD	A1,KBINH,A11
	ANK	A1,/D	RESET KEYBOARD PARTLY
	ST	A1,KBINH,A11
	CF	A14,LMP3OF	INHIBIT LAMP OFF 
	CF	A14,RESKB	RESET KB BUFFER 
	LDK	A1,1	RETURN CODE 
DCWR90	EQU	*
	RTN	A14
	EJECT
********************************************************* 
*                                                       * 
*        TSTMES       TEST IF ANY MESSAGE, NO WAIT      * 
*                                                       * 
********************************************************* 
*		REGISTERS
* 
*	A1= RETURN CODE 
*	A11= ADDRESS TO CREDIT WORK AREA
*	A13= ADDRESS TO ECB AREA
* 
********************************************************* 
TSTMES	EQU	*
	LD	A8,ECBDC1,A11	LINE 1
	IFT	NBRLIN=2 
	LD	A1,MAIN,A11	LINE 2
	RF(Z)	TSTM10	NO
	LD	A8,ECBDC2,A11	LINE 2
TSTM10	EQU	*
	XIF
	LDK	A2,1 
	ST	A2,ECBCW1,A8	INDICATE TEST MESSAGE
	LDK	A7,0	TEST MESS., NO WAIT 
	LKM
	DATA	1 
	RTN	A14
	EJECT
************************************************************* 
*                                                           * 
*        SETSTA       SET STATUS                            * 
*                                                           * 
************************************************************* 
*		REGISTERS
* 
*	A1= AT ENTRY STATUS 
*	A8= DC ECB
*	A11= RESERVED 
*	A13= ADDRESS TO ECB AREA
* 
************************************************************
SETSTA	EQU	*
	LD	A8,ECBDC1,A11 
	IFT	NBRLIN=2 
	LD	A2,MAIN,A11 
	RF(Z)	SETS10 
	LD	A8,ECBDC2,A11 
SETS10	EQU	*
	XIF
	LDK	A7,/B8 
	ST	A1,ECBCW1,A8
	LKM
	DATA	1 
	RTN	A14
	EJECT
******************************************************
*                                                    *
*        TSTSTA       TEST STATUS                    *
*                                                    *
******************************************************
*		REGISTERS
* 
*	A1= RETURN CODE 
*	A8= DC ECB
*	A11= RESERVED 
*	A13= ADDRESS TO ECB AREA
* 
***************************************************** 
TSTSTA	EQU	*
	LD	A8,ECBDC1,A11	LINE 1
	IFT	NBRLIN=2 
	LD	A1,MAIN,A11	LINE 2? 
	RF(Z)	TSTS10	NO
	LD	A8,ECBDC2,A11	LINE 2
TSTS10	EQU	*
	XIF
	CM	ECBCW1,A8	INDICATE TEST STATUS
	LDK	A7,/80 
	LKM
	DATA	1 
	LD	A1,ECBCW1,A8
	RTN	A14
	EJECT
********************************************************************* 
* 
*	RDSTAT	READ STATISTICS
* 
**********************************************************************
*         REGISTERS 
* 
* 
********************************************************************* 
RDSTAT	EQU	*
	IFT	TEST=1 
	LD	A8,ECBDC1,A11 
	IFT	NBRLIN=2 
	LD	A1,MAIN,A11	THE OTHER LINE
	RF(Z)	RDST10	NO
	LD	A8,ECBDC2,A11 
RDST10	EQU	*
	XIF
	IFT	TEST=1 
	ST	A12,ECBBA,A8
	LDKL	A1,BUFFL+BUFFL
	ST	A1,ECBRL,A8 
	CM	ECBCW1,A8	NO RESET AFTERWARDS 
	LDK	A7,/AD 
	LKM
	DATA	1 
	RTN	A14
	XIF
	EJECT
**********************************************************
*                                                        *
*        DCABOR       ABORT TEST MESSAGE REQUEST         *
*                                                        *
**********************************************************
*		REGISTERS
* 
*	A8= DC ECB
*	A11= ADDRESS TO CREDIT WORK  AREA 
*	A13= ADDRESS TO ECB AREA
* 
********************************************************* 
DCABOR	EQU	*
	LD	A8,ECBDC1,A11	LINE 1
	IFT	NBRLIN=2 
	LD	A1,MAIN,A11	LINE 2? 
	RF(Z)	DCAB10	NO
	LD	A8,ECBDC2,A11	LINE 2
DCAB10	EQU	*	.	=2 
	XIF
	LDK	A7,0 
	LKM
	DATA	10
	LDR	A7,A7	OK?
	RF(NZ)	DCAB20	NO, ALREADY COMPLETED	=2 
	CM	ECBBLK+DC,A11 
DCAB20	EQU	*	.	=2 
	RTN	A14
	EJECT
* 
* 
* 
*	DC RETURN CODE

* 
* 
* 
*   BIT        0 REQUEST ERROR
*              1 RESERVED 
*              2 RESERVED 
* 
*              9 REQUEST TIMEOUT
*             11 SEQUENCE ERROR 
*             12 INCORRECT LENGTH 
*             13 RESERVED 
*             14 TRANSMISSION ERROR 
*             15 NO CONNECTION
* 
* 
* 
	EJECT
******************************************************
*                                                    *
*        CHKSTA       CHECK DC STATUS                *
*                                                    *
******************************************************
*		REGISTERS
* 
*	A1= AT ENTRY DC RETURN CODE, RETURN CODE
*	A11= CREDIT WORK AREA 
*	A13= RESERVED 
* 
******************************************************* 
CHKSTA	EQU	*
	CF	A14,TSTSTA	TEST STATUS
	ANKL	A1,/2211	LINE OK? 
	XRKL	A1,/2211
	RF(NZ)	CHKS10	NO 
	CF	A14,LMP1ON	SYSTEM AVAIL.
	RF	CHKS20
CHKS10	EQU	*
*     LAMP ONE OFF DELETED P & T    * 
CHKS20	EQU	*
	RTN	A14
	EJECT
********************************************************* 
*                                                       * 
*        DCOFLN       INDICATE OFFLINE TO CLUSTER       * 
*                                                       * 
********************************************************* 
*		REGISTERS
* 
*	A11= CREDIT WORK AREA 
*	A13= RESERVED 
* 
**************************************************
DCOFLN	EQU	*
	IFT	OFLIN=1
	CF	A14,DCABOR
	XIF
	RTN	A14
	EJECT
***************************************************** 
*                                                   * 
*        TRPA       TRANSMIT SHORT READ AT PA-KEY   * 
*                                                   * 
***************************************************** 
*		REGISTERS
* 
*	A2= AID CODE
*	A11= CREDIT WORK AREA 
*	A13= RESERVED 
* 
***************************************************** 
TRPA	EQU	*
	CF	A14,GETBUF	GET TRANSMIT BUFFER
	CF	A14,PAID	STORE AID IN BUFFER
	CF	A14,DCWRIT	TRANSMIT 
	LDR	A8,A12	BUFFER TO RELEASE 
	CF	A14,RELBUF	RELEASE BUFFER 
	RTN	A14
	EJECT
******************************************************
*                                                    *
*        TRPF       TRANSMIT MODIFIED READ AT PF-KEY *
*                                                    *
******************************************************
*		REGISTERS
* 
*	A2= AID CODE
*	A4= REL CURSOR POS. 
*	A5= RESERVED
*	A6= RESERVED
*	A11= CREDIT WORK AREA 
*	A13= RESERVED 
* 
******************************************************
TRPF	EQU	*
	CF	A14,GETBUF	GET TRANSMIT BUFFER
	CF	A14,PAID	SAVE AID-CODE
	CF	A14,SCRINF	GET SCREEN INFORMATION 
	LDR	A1,A4	CURSOR ADDRESS 
	CF	A14,BUFADR	STORE CURSOR ADDRESS IN BUFFER 
	CF	A14,PACK	PACK BUFFER WITH MODIFIED FIELDS AND TRANSMIT
	RTN	A14

	END

Full view