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

⟦b71f9cba0⟧ 

    Length: 17594 (0x44ba)
    Notes: pts_type(SC)
    Names: »PRT.SC«

Derivation

└─⟦b6546aa17⟧ Bits:30009689 Philips computer tape "600325"
    └─⟦this⟧ »DK3270/PRT.SC«

PTS(SC)

	IDENT PRT     	REL 2.1*800222NJ 870150540210 

			=1, ODD BUFFER ADDRESS 
			REL 2.1 79-05-23 
************************************************************************* 
* 
*   P R T  :  MODULE PRINTING MAIN FRAME MESSAGES ADDRESSED TO THE
*            GENERAL PRINTER. LOCAL HARDCOPY PRINTING IS ALSO 
*            CARRIED OUT IN THIS MODULE 
* 
**********************************************************************
* 
* [NDRINGER IFM DECENTRAL PRINT      800222 NJ
* LPGAE 48 = > 52 
* LPLIN                ADDED
* COPY111              FUBAR
*        EJECT


* 
* 
*	ENTRY PARAMETERS
* 
* 
	ENTRY	SNBUSY 
	ENTRY	PRINT
	ENTRY	ICREAD 
* 
* 
*	EXTERNAL PARAMETERS 
* 
* 
	EXTRN	UPDATE	UPDATE BUFFER CONTENTS
	EXTRN	RFMDUP	REPLACE FM & DUP CHARS
	EXTRN	GTRBUF 
	EXTRN	DCGETM 
	EXTRN	RELBUF 
	EXTRN	DC1INQ 
	EXTRN	DC2INQ 
	EXTRN	REQTIM 
* 
	EXTRN	I:EVA0	CREDIT EVALUATION ROUTINE 
* 
	EXTRN	EMULA	START
*        EJECT
* 
************************************************* 
* 
*   CONDITIONAL ASSEMBLY PARAMETERS 
* 
***************************************** 

OFLIN	EQU	1	OFFLINE HANDLING POSSIBLE IF ::= 1
DCLIN	EQU	1	NUMBER OF MAIN FRAMES 81-2) 
COPCMD	EQU	1	COPY COMMAND IF := 1 
* 
*	EQUATES 
* 
* 
* 
TIMDC	EQU	300	DC TIME OUT VALUE: 30 S 
ESC	EQU	/1B 
SBA	EQU	/11 
NULL	EQU	/7F	NULL CHARACTER 
NEWLIN	EQU	/7E	NEW LINE CHARACTER 
ENDMES	EQU	/7D	END MESSAGE CHAR 
FORMFD	EQU	/7C	FORMFEED CHAR. 
FMCH	EQU	/60
DUPCH	EQU	/7B 
*        EJECT
* 
* 
*     EQUATES 
* 
*	COMMON EQU FOR ECB HANDLING 
* 

ECBBA	EQU	2 
ECBRL	EQU	4 
ECBEL	EQU	6 
ECBRC	EQU	8 
ECBCW	EQU	10
* 
* 
*	CREDIT USED EQU 
* 
* 
*	ECB REL. ADDRESSES
* 
* 
DIS	EQU	20
* 
ECBDC	EQU	-DIS-14 
	IFT	DCLIN=2
ECBDC2	EQU	ECBDC-DIS
ECBICR	EQU	ECBDC2-DIS 
	XIF
	IFF	DCLIN=2
ECBICR	EQU	ECBDC-DIS
	XIF
	IFT	COPCMD=1 
ECBICW	EQU	ECBICR-DIS 
ECBPR	EQU	ECBICW-DIS
	XIF
	IFF	COPCMD=1 
ECBPR	EQU	ECBICR-DIS
	XIF
* 
* 
*	BASE ADDRESS FOR TCA AND ECB
* 
TCABAS	EQU	A11
CREBAS	EQU	A13	ECB
* 
*	CONFIG DATA 'CB1' REL ADDRESSES 
* 
NBRKBV	EQU	0	NUMBER OF KB/VDUS
NBRGTP	EQU	NBRKBV+2	NUMBER OF GTPS
* 
MF1KBV	EQU	NBRGTP+2	DV ADDRESSES KB/VDU MF #1 
MF1GTP	EQU	MF1KBV+16	DV ADDRESSES GTPS MF # 1 
	IFT	DCLIN=2
MF2KBV	EQU	MF1GTP+16
MF2GTP	EQU	MF2KBV+16
	XIF
*        EJECT
* 
*	TCA REL. ADDRESSES
* 
TCT01	EQU	0 
PRINTER	EQU	TCT01+2 
BVDU	EQU	PRINTER+2	VDU SCREEN BUFFER
PCURS	EQU	BVDU+1920	CURSOR ADDRESS , BINARY 
ATTRIB	EQU	PCURS+2	LAST ATTRIBUTE CHAR
CURATT	EQU	ATTRIB+2 
WCC	EQU	CURATT+2	WCC/CCC CHARACTER
KBINH	EQU	WCC+2	KEYBOARD INHIBIT INDICATOR
LINCNT	EQU	KBINH+2	LINE COUNTER 
DCLENG	EQU	LINCNT+2	DC READ EFFECTIVE LENGTH
ICWORK	EQU	DCLENG+2	WORK FIELD INTERTASK COMM 
INTATT	EQU	ICWORK+2	INTENSITY ATTRIBUTE 
OFFFLG	EQU	INTATT+2	OFFLINE FLAG
COPNO	EQU	OFFFLG+2	HARDCOPY TASK ID 
CCC	EQU	COPNO+2	COPY COMMAND CHARACTER
MAIN	EQU	CCC+2	MAIN FRAME 
MODE	EQU	MAIN+2	INSERT MODE SWITCH
KEYS	EQU	MODE+2	KEY LOCK STATUS 
ECBDCC	EQU	KEYS+2	ECB ADDRESS LAST READ DC
ECBBLK	EQU	ECBDCC+2	ECBS FOR MULTIPLE WAIT &C 
RDMORE	EQU	ECBBLK+10	BRANCH ADDRESS NEXT READ KB
* 
PRBUSY	EQU	-2	PRINTER BUSY. OCCUPIES BOOLEAN VARAIBLE 
*        EJECT

* 
* 
LBVDU	EQU	1920	1920 CHARACTER DISPLAY 
LPAGE	EQU	52	LINES ON ONE PAGE
GTPLIN	EQU	112	LINELENGTH MAX 112 CHAR. 'NL' ORDER IN 
*			BUFFER DETERMINES PRINT LINE LENGTH 
LPLIN	EQU	132	LINELENGTH FOR LP 
* 


	EJECT
PRINT	EQU	* 
	CF	A14,I:EVA0
	LDR	TCABAS,A9	LOAD ASSEM TCA BASE
	LDR*	A4,TCABAS	REL TASK NO 
	AD	A4,6,CREBAS	'CB1' ADDRESS 

************************************************* 
* 
*   TRANSFER PARAMETER FOR MAIN-FRAME #1
* 
************************************************* 

	LC	A1,MF1GTP-1,A4
	ANK	A1,/FF 
	LDKL	A8,ECBDC
	CF	A14,EMULA 
	IFT	DCLIN=2
************************************************* 
* 
*   TRANSFER PARAMETER FOR MAIN-FRAME #2
* 
************************************************* 

	LC	A1,MF2GTP-1,A4
	ANK	A1,/FF 
	LDKL	A8,ECBDC2 
	CF	A14,EMULA	TRANSFER PARAMETER
	XIF
*        EJECT
* 
*	RELATIVE POS IN ECBBLK
ICR	EQU	2 
DC1	EQU	4 
DC2	EQU	6 
* 
	IFF	DCLIN=2
	LDK	A1,2 
	XIF
	IFT	DCLIN=2
	LDK	A1,3 
	XIF
	ST	A1,ECBBLK,TCABAS
PRI100	EQU	*
	CM	ICWORK,TCABAS 
	LD	A1,ECBBLK+DC1,TCABAS
	RF(NZ)	PRI110	PENDING
	CF	A14,DC1INQ	TEST IF ANY MESSAGE, NO WAIT 
PRI110	EQU	*
	IFT	DCLIN=2
	LD	A1,ECBBLK+DC2,TCABAS
	RF(NZ)	PRI120	PENDING
	CF	A14,DC2INQ	TEST IF ANY MESSAGE MF # 2, NO WAIT
	XIF
PRI120	EQU	*
	LD	A1,ECBBLK+ICR,TCABAS
	RF(NZ)	PRI150	PENDING
	LDKL	A6,LBVDU	REQ LENGTH 
	LDKL	A3,BVDU	BUFFER
	ADR	A3,TCABAS	  ADDRESS
	CF	A14,ICREAD	READ INTERTASK NO WAIT 
	ST	A8,ECBBLK+ICR,TCABAS
PRI150	EQU	*
	LDKL	A7,ECBBLK 
	ADR	A7,TCABAS
	LKM
	DATA	7	MULTIPLE WAIT 
	CW	A8,ECBBLK+ICR,TCABAS
	RF(E)	ICRINP	INPUT FROM INTERTASK
	ST	A8,ECBDCC,TCABAS	SAVE ECB ADDRESS FOR CURRENT READ
	CF	A14,DCINP	INPUT FROM DC 
	RB	PRI100
*        EJECT
* 
*	READ INTERTASK, NOWAIT
* 
*	A3 = BUFFER ADDRESS 
*	A6 = REQ LENGTH 
* 
ICREAD	EQU	*
	LDKL	A8,ECBICR 
	ADR	A8,CREBAS
	LDKL	A1,-1 
	CF	A14,REQTIM
	ST	A6,ECBRL,A8	REQ LENGTH
	ST	A3,ECBBA,A8 
	LDK	A7,2	READ NOT ADDRESSED, NO WAIT 
	LKM
	DATA	1 
	RTN	A14
*        EJECT
****************************************************************
* 
*	INPUT FROM DC 
* 
****************************************************
* 
DCINP	EQU	* 
	CF	A14,ICABOR	ABORT INTERTASK READ 
	LDR	A7,A7
	RF(Z)	DCIN10	NOT COMPLETED 
	IM	ICWORK,TCABAS	SET FLAG
	RF	ICRINP	TAKE CARE OF INTERTASK INPUT 
			OR BUFFER WILL BE DESTROYED IN 'UPDATE'
DCIN10	EQU	*
	CF	A14,GTRBUF	GET RECEIVE BUFFER 
	LD	A8,ECBDCC,TCABAS
	CF	A14,DCGETM	READ MESSAGE 
	IFF	DCLIN=2
	CM	ECBBLK+DC1,TCABAS 
	XIF
	IFT	DCLIN=2
	CW	A8,ECBBLK+DC2,TCABAS
	RF(E)	DCIN20	MF # 2
	CM	ECBBLK+DC1,TCABAS 
	RF	DCIN30
DCIN20	EQU	*
	CM	ECBBLK+DC2,TCABAS 
	XIF
DCIN30	EQU	*
	LD	A1,ECBEL,A8	EFFECTIVE LENGTH
	ST	A1,DCLENG,TCABAS	SAVE IT IN SAVE AREA 

	CF	A14,UPDATE	MOVE FROM DC TO PRINTER BUFFER;
	IFT	COPCMD=1 
	LD	A1,ICWORK,TCABAS
	RF(NZ)	DCIN90	COPY COMMAND 
	XIF
	LD	A1,WCC,TCABAS	WRITE CONTROL CHARACTER 
	ST	A1,CCC,TCABAS	COPY IT 
	CF	A14,COPY	COPY ON PRINTER
DCIN90	EQU	*
	CF	A14,SNBUSY
	RTN	A14
*        EJECT
* 
*	ABORT INTERTASK READ
* 
ICABOR	EQU	*
	LDK	A7,0 
	CM	ECBBLK+ICR,TCABAS 
	LDKL	A8,ECBICR 
	ADR	A8,CREBAS
	LKM
	DATA	10
	RTN	A14
*        EJECT
* 
*	INPUT FROM INTERTASK
* 
ICRINP	EQU	*
	CM	ECBBLK+ICR,TCABAS 

	LDK	A1,X'38'	PRINT BIT, 80 CHAR./LINE
	ST	A1,CCC,TCABAS	SAVE AS COPY CONTROL CHARACTER
	CF	A14,COPY	PRINT ON HARDCOPY DEVICE 
	LD	A1,ICWORK,TCABAS
	RB(NZ)	DCIN10	TAKE CARE OF DC INPUT
	RB	PRI100
*        EJECT
* 
* 
*	PRINT THE CONTENTS OF THE PRINTER BUFFER
* 
* 
LINLEN	DATA	/0028,/4050	LINE LENGTHS /40, 64 AND 80 CHARS 
* 
* 
COPY	LDKL	A8,ECBPR
	ADR	A8,CREBAS	PRINTER ECB
	LD	A7,ECBBA,A8 
	SUR	A3,A3		=1
	SC	A3,0,A7		=1 
	SC	A3,1,A7		=1 
	ADK	A7,2	PRINt BUFFER ADDRESS
	SUR	A9,A9	RESET BUFFER INDEX 
	LDKL	A4,BVDU 
	ADR	A4,TCABAS
	LD	A2,CCC,TCABAS	GET CCC/CCC 
	ANK	A2,/08 
	RF(NZ)	COP100	START PRINTER BIT SET
COPRTN	RTN	A14
COP100	EQU	*
	LD	A2,CCC,TCABAS 
	ANK	A2,/30 
	ABL(Z)	COP111	NL DETERMINES LINE LENGTH
	SRL	A2,4 
	LDK	A6,0 
	LC	A6,LINLEN,A2	GET LINE LENGTH
COP110	CWR	A9,A6
	RF(L)	COP120 
COP115	CF	A14,PRLINE	LINE FULL: PRINT IT
	RB	COP110
COP120	CWK	A3,LBVDU 
	ABL(NL)	COP300	PRINT LAST LINE 
	LCR	A2,A4
	ANK	A2,/7F	RESET DISPLAY BIT 
	SCR	A2,A4
	CWK	A2,/20 
	RF(NL)	COP130
COP123	EQU	*
	ANK	A2,6 
	XRK	A2,6 
	RF(Z)	COP150 
COP125	LDK	A2,/20	REPLACE ATTR BY SPACE 
	RF	COP140
COP130	CWK	A2,NULL
	RB(E)	COP125	REPLACE NULL BY SPACE 
COP140	EQU	*
	CWK	A2,/7D 
	RF(NE)	COP141
	LDK	A2,/39 
COP141	CWK	A2,/7E 
	RF(NE)	COP142
	LDK	A2,/35 
COP142	EQU	*
	CF	A14,RFMDUP	FM OR DUP ?
COP143	CWK	A2,/61	LOWER CASE CHARACTER ?? 
	RF(L)	COP144	NO!!
	SUK	A2,/20 
COP144	SCR	A2,A7
	ADK	A3,1 
	ADK	A4,1 
	ADK	A7,1 
	ADKL	A9,1
	RB	COP110
COP150	LDK	A2,/20	SPACE INSTEAD OF TEXT 
	SCR	A2,A7
	ADK	A3,1 
	ADK	A4,1 
	ADK	A7,1 
	ADKL	A9,1
	CWR	A9,A6
	RF(L)	COP160 
	CF	A14,PRLINE	LINE FULL : PRINT IT 
COP160	LCR	A2,A4
	ANK	A2,/7F 
	CWK	A2,/20 
	RB(L)	COP123	ATTRIBUTE 
	RB	COP150	STILL IN PROTECTED FIELD 
* 
* 
*	LINE LENGTH AS DEFINED BY NL CHARACTER
* 
* 
* THE FIRST INSTR. ORIGINALLY HAD LABEL 'COP200'. 
* 
* 
COP111	EQU	*
	LC	A2,COPNO,TCABAS LP/GP ? 
	CW	A2,/47
	RF(E)	COP202 
	CWK	A9,LPLIN 
	RF	COP203
COP202	EQU	*
	CWK	A9,GTPLIN
COP203	EQU	*
	RF(L)	COP220	BUFFER NOT FULL 
COP210	CF	A14,PRLINE	PRINT LINE 
	ABL	COP111 
COP220	CWK	A3,LBVDU 
	RF(NL)	COP300	PRINT LAST LINE
	LCR	A2,A4
	ANK	A2,/7F 
	SCR	A2,A4	RESET DISPLAY BIT
	CWK	A2,/20 
	RF(NL)	COP230
COP223	ANK	A2,/6	ATTRIBUTE CHARACTER
	XRK	A2,6 
	RF(Z)	COP250	PROTECTED FIELD 
COP225	LDK	A2,/20	REPLACE ATTRIBUTE BY SPACE
	RF	COP240
COP230	CWK	A2,NULL
	RB(E)	COP225	NULL IS REPLACED BY SPACE 
COP240	EQU	*
	CWK	A2,/7B 
	RF(NE)	COP241
	LDK	A2,/2A 
COP241	SCR	A2,A7
	ADK	A3,1 
	ADK	A4,1 
	ADK	A7,1 
	CWK	A2,NEWLIN
	RB(E)	COP210	NL CHAR: PRINT LINE 
	CWK	A2,ENDMES
	RF(E)	COP300	UND MESSAGE: PRINT LAST LINE
	ADKL	A9,1
	ABL	COP111 
COP250	LDK	A2,/20	REPLACE TEXT BY SPACE 
	SCR	A2,A7
	ADK	A3,1 
	ADK	A4,1 
	ADK	A7,1 
	ADKL	A9,1
	CWR	A9,A6
	RF(L)	COP260 
	CF	A14,PRLINE	LINE FULL : PRINT IT 
COP260	LCR	A2,A4
	ANK	A2,/7F 
	CWK	A2,/20 
	RB(L)	COP223	ATTRIBUTE FOUND 
	RB	COP250	STILL IN PROTECTED FIELD 
COP300	LDR	A9,A9
	ABL(Z)	COPRTN	ALL PRINTED
	CF	A14,PRLINE	PRINT LAST LINE
	ABL	COPRTN 
*        EJECT
* 
* 
*	PRINT ONE LINE ON PRINTER 
* 
*	A9=NUMBER OF CHAR IN PRINT BUFFER 
* 
* 
PRLINE	IM	LINCNT,TCABAS	COUNT NBR OF PRINTLINES 
	RF(N)	PRL100	NOT END OF PAGE 
	LDK	A7,LPAGE	END OF PAGE 
	NGR	A7,A7
	ST	A7,LINCNT,TCABAS	RESET LINE COUNTER 
PRL100	LD	A7,ECBBA,A8 
********************* LP 400 SUPPORT ********* DK 
	LC	A2,COPNO,TCABAS	1. CHAR FROM RUNNING TASK	DK
	CW	A2,/47	GTP ? 	DK
	RF(E)	PRL105	YES, NORMAL PRINT	DK
	LC	A2,2,A7	GET FORMCONTROL CHAR	DK 
	ANK	A2,/7F	REMOVE PARITY BIT	DK
	CWK	A2,FORMFD		DK
	RF(NE)	PRL106	NO, NORMAL PRINT	DK
	LDK	A2,/31		DK 
	SC	A2,1,A7	CHANGE TO FORMFEED	DK 
	LDK	A7,2		DK 
	ST	A7,ECBRL,A8	REQ LENGTH = 2	DK 
	LDK	A7,/86	STD WRITE 
	LKM
	DATA	1		DK 
	LD	A7,ECBBA,A8	DK	DK 
	LDK	A2,/2B	NO-SPACE	DK 
	SC	A2,1,A7		DK 
	LDK	A7,LPAGE		DK 
	NGR	A7,A7		DK
	ST	A7,LINCNT,TCABAS	RESET LINE COUNTER	DK
	RF	PRL200
PRL105	EQU	*		DK
******************** END LP400 SUPPORT DK 
	LC	A2,2,A7	GET FIRST CHAR IN BUFFER
	ANK	A2,/7F 
PRL106	EQU	*		DK
	CWK	A2,FORMFD
	RF(NE)	PRL200	NOT FORM FEED
	LDK	A2,/20 
	SC	A2,2,A7	REPLACE LF BY SPACE 

PRL110	EQU	*
	LD	A1,LINCNT,TCABAS	FORM FEED
	LDK	A7,2 
	ST	A7,ECBRL,A8	SET REQ LENGTH TO 2 FOR NEW LINE
PRL120	LDK	A7,/86	STD WRITE 
	LKM
	DATA	1 
	ADK	A1,1	COUNT LINES 
	RB(N)	PRL120 
	LDK	A7,LPAGE 
	NGR	A7,A7
	ST	A7,LINCNT,TCABAS	RESET LINE COUNTER 
PRL200	ADKL	A9,2	ADJUST LENGTH FOR BUFFER CW
	ST	A9,ECBRL,A8	REQ LENGTH
PRL210	EQU	*		DK
	LDK	A7,/86	STD WRITE 
	LKM
	DATA	1 
	LDK	A7,0 
	LD	A7,ECBBA,A8 
	SUR	A9,A9		=1
	SCR	A9,A7		=1
	SC	A9,1,A7		=1 
	ADK	A7,2	RESTORE BUFFER ADDRESS
	RTN	A14
*        EJECT
* 
* 
*	SET STATUS NOT BUSY FOR DC
* 
* 
SNBUSY	EQU	*
	LD	A8,ECBDCC,TCABAS
	CM	ECBCW,A8
	LDK	A7,/B8	SET STATUS ORDER
	LKM
	DATA	1 
	RTN	A14
* 
* 
         END

Full view