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

⟦26c45978c⟧ 

    Length: 7556 (0x1d84)
    Notes: pts_type(SC)
    Names: »DATDIV.SC«

Derivation

└─⟦fce1dcf99⟧ Bits:30009704 Philips computer tape "KMD15"
    └─⟦this⟧ »IBM3270/DATDIV.SC«

PTS(SC)

	IDENT DATDIV 	REL 1.2 78-09-15  870150540120 

************************************************************************
* 
*   D A T D I V  :  DATA DIVISION FOR IBM-3270 EMULATION PACKAGE. 
*                   THIS MODULE ALSO CONTAINS THE CREDIT CODED
*                   START-UP ROUTINES.
* 
********************************************************************

	EJECT
	DDIV 
* 
* 
*	DATA DIVISION 
* 
* 
* 
*	KBAN TERMINAL 
* 
* 
	TERM	K0
* 
	UWB	UB1
	CWB	CB1
* 
	START	KBGO 
* 
DSDC	DSET	FC=61 
DSDCT	DSET	FC=61
DSVDU	DSET	FC=50,DEV=DY,BUFL=162
DSKBAN	DSET	FC=20,DEV=KA,BUFL=2 
DSKBSD	DSET	FC=40,DEV=KI,BUFL=2 
	EJECT
* 
* 
*	VDU TERMINAL
* 
* 
	TERM	V0
* 
	UWB	UB1
	CWB	CB1
* 
	START	VDUGO
* 
	EJECT
* 
* 
*	GTP TERMINAL
* 
* 
	TERM	G0
* 
	UWB	UB2
	CWB	CB1
* 
	START	GTPGO
* 
DSDC	DSET	FC=61 
DSDCT	DSET	FC=61
DSGTP	DSET	FC=30,DEV=GP,BUFL=162
	EJECT
* 
* 
*	DCTASK
* 
* 
	TERM	DC
* 
	UWB	UB1	DUMMY
	START	DCGO 
	EJECT
* 
* 
*      WORK AREA FOR KEYBOARD AND DISPLAY TASKS 
* 
* 
UB1	BLK 
* 
TCT01	STRG	4X'0'	TID AND STACKBASE
PRINTER	STRG	4X'0'	KEYBARD/VDU/PRINTER
BVDU	STRG	3840X'0'	VDU SCREEN BUFF
PCURS	STRG	4X'0'	CURSOR ADDR. BINARY
ATTRIB	STRG	4X'0'	LAST ATTRIBUTE CHARACTER
CURATT	STRG	4X'0'	CURSOR ATTRIBUTE
WCC	STRG	4X'0'	WCC/CCC CHARACTER
KBINH	STRG	4X'0'	KEYBOARD INHIBIT INDIC.
LINCNT	STRG	4X'0'	
DCLENG	STRG	4X'0'	DC READ EFFECTIVE LENGTH
DCADDR	STRG	4X'0'	DC SUBTERMINAL ADDR.
TCTGPL	STRG	4X'0'	
INTATT	STRG	4X'0'	INTENSITY ATTRIBUTE 
OFFFLG	STRG	4X'0'	OFFLINE FLAG
COPL	STRG	4X'0'	COPY LOCK 
VDUBSY	STRG	20X'0'	VDUBSY,COPNO,CRE,VDUT.A,CCC
	EJECT

* 
* 
*	GTP TERMINAL AREA 
* 
* 
UB2	BLK 
* 
A1	STRG	4X'0'	TID AND STACKBASE 
A2	STRG	4X'0001'	PRINTER DEF. 
A3	STRG	3840X'0'	VDU SCREEN BUFFER
A4	STRG	4X'0'	PCURS 
A5	STRG	4X'0'	LAST ATTRIBUTE CHAR 
A6	STRG	4X'0'	CURSOR ATTRIBUTE
A7	STRG	4X'0'	WCC/CCC CHARACTER 
A8	STRG	4X'0'	KEYBOARD INHIBIT
A9	STRG	4X'0'	
AA	STRG	4X'0'	DC READ EFFECTIVE LENGTH
AB	STRG	4X'0'	DC SUBTERMINAL ADDRESS
AC	STRG	4X'0' 
AD	STRG	4X'0'	INTENSITY ATTRIBUTE 
AE	STRG	4X'0'	OFFLINE FLAG
AF	STRG	4X'0'	COPY LOCK 
AG	STRG	20X'0'	VDUBSY,COPNO,CRE,VDUT.A,CCC
	EJECT

**************
* 
*   COMMON WORK BLOCK FOR ALL TASKS 
* 
***************************************** 

CB1	BLK 
BINTID	BIN	W'0' 
BCDTID	BCD	'+001' 
STRTID	STRG	4X'0' 
	PDIV 
* 
* 
* 
	ENTRY	KBGO 
	ENTRY	VDUGO
	ENTRY	GTPGO
	ENTRY	DCGO 
	EXT	VDUKB
	EXT	VDTASK 
	EXT	PRINT
	EXT	DCTASK 
	EXT	GETTID	GET TASK IDENTITY 
*	EXT	CREDIT	CREDIT APPLICATION START ADDRESS 
* 
* 
* 


	EJECT
	DSC0	DSDC,2	DUMMY REFERENCE T:IO 

****************************************
* 
*   START ADDRESS FOR KEYBOARD TASK 
* 
****************************************

KBGO	PERF	TIDNR	GET TASK IDENTITY NUMBER
	USE	UB1,BINTID	ASSIGN A WORK BLOCK 
	SUB	BINTID,=W'1' 
	CALL	VDUKB,TCT01,BINTID	BRANCH TO ASSEMBLY CODE
*	PERF	CREDIT	BRANCH TO CREDIT CODE 
*	SB	KBGO	RETURN TO IBM-3270 EMULATION

	EJECT

********************************************
* 
*   START ADDRESS FOR DISPLAY TASK
* 
****************************************

VDUGO	PERF	TIDNR	GET TASK IDENTITY NUMBER 
	USE	UB1,BINTID	ASSIGN A WORK BLOCK 
	SUB	BINTID,=W'1' 
	CALL	VDTASK,TCT01,BINTID	BRANCH TO IBM-3270 EMULATION


	EJECT


********************************************* 
* 
*   START ADDRESS FOR GENERAL PRINTER TASK
* 
********************************************* 

GTPGO	PERF	TIDNR	GET TASK IDENTITY NUMBER 
	USE	UB2,BINTID	ASSIGN A WORK BLOCK 
	SUB	BINTID,=W'1' 
	CALL	PRINT,TCT01,BINTID	START IBM-3270 EMULATION 

	EJECT


*********************************************** 
* 
*   START ADDRESS FOR DC-TASK 
* 
********************************* 

DCGO	CALL	DCTASK	START IBM-3270 EMULATION 


	EJECT

*************************************************** 
* 
*   T I D N R :   GET TASK IDENTITY NUMBER
* 
************************************************

TIDNR	PROC
	CALL	GETTID,STRTID	GET TASK IDENTITY 
	MOVE	BCDTID,STRTID	SAVE TASK NUMBER
	MOVE	BINTID,BCDTID	CONVERT TO BINARY 
	ADD	BINTID,=W'1' 
	RET
	PEND 
	END

Full view