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

⟦49547b292⟧ 

    Length: 17252 (0x4364)
    Notes: pts_type(SC)
    Names: »PRT.SC«

Derivation

└─⟦985af0f82⟧ Bits:30009681 Philips computer tape "600231"
    └─⟦this⟧ »D3270:92/PRT.SC«

PTS(SC)

	IDENT PRT     	2.1DK 4 800930   870150540210 

			=1, ODD BUFFER ADDRESS 
			REL 2.1 79-05-23 
			DK4 - SUPPRESS SPACES
			DK3 - CHECK PRINTER
			DK2 - DC TIMEOUT 
			DK1 - LP400, DEC. PRINT
************************************************************************* 
* 
*   P R T  :  MODULE PRINTING MAIN FRAME MESSAGES ADDRESSED TO THE
*            GENERAL PRINTER. LOCAL HARDCOPY PRINTING IS ALSO 
*            CARRIED OUT IN THIS MODULE 
* 
**********************************************************************
* 
* 


* 
* 
*	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
* 
* 
************************************************* 
* 
*   CONDITIONAL ASSEMBLY PARAMETERS 
* 
***************************************** 

OFLIN	EQU	1	OFFLINE HANDLING POSSIBLE IF ::= 1
DCLIN	EQU	1	NUMBER OF MAIN FRAMES (1-2) 
COPCMD	EQU	1	COPY COMMAND IF := 1 
* 
*	SUPPRESSION OF TRAILING SPACES		DK4 
*	ONLY RELEVANT FOR LP100		DK4
SUSPA	EQU	1		DK4
* 
*	EQUATES 
* 
* 
* 
TIMDC	EQU	600	DC TIME OUT: 60 S	DK2 
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 
TRCH	EQU	/F0		DK1 
* 
* 
* 
*     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
* 
* 
*	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 
* 

* 
* 
LBVDU	EQU	1920	1920 CHARACTER DISPLAY 
LPAGE	EQU	48	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 
* 


	 
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
* 
* 
*	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
* 
* 
*	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
* 
****************************************************************
* 
*	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
* 
* 
*	ABORT INTERTASK READ
* 
ICABOR	EQU	*
	LDK	A7,0 
	CM	ECBBLK+ICR,TCABAS 
	LDKL	A8,ECBICR 
	ADR	A8,CREBAS
	LKM
	DATA	10
	RTN	A14
* 
* 
*	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
* 
* 
* 
*	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	*
	CWK	A9,LPLIN		DK3
	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,FORMFD		DK1 
	RB(E)	COP210		DK1
	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 
* 
* 
* 
*	PRINT ONE LINE ON PRINTER 
* 
*	A9=NUMBER OF CHAR IN PRINT BUFFER 
* 
* 
PRLINE	EQU	*
	IFT	SUSPA=1		DK4 
	CF	A14,SKIPSP		DK4 
	XIF			DK4
	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,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 
	CF	A14,PRLKM		DK3
	LDK	A7,LPAGE		DK 
	NGR	A7,A7		DK
	ST	A7,LINCNT,TCABAS	RESET LINE COUNTER	DK
	RF	PRL220
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	EQU	*
	CF	A14,PRLKM		DK3
	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
	CF	A14,PRLKM		DK3
PRL220	EQU	*		DK
	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
* 
* 
* 
* 
PRLKM	EQU	*		DK3
	LDK	A7,/86		DK3
	LKM			DK3
	DATA	1		DK3
	LD	A7,ECBRC,A8	GET RETURN CODE	DK3 
	ANKL	A7,/2005	BIT 2,3,15?	DK3
	RB(NZ)	PRLKM	NO, TRY AGAIN	DK3 
	RTN	A14		DK3 
* 
* 
	IFT	SUSPA=1		DK4B
* 
* 
*    SKIPSP = SUBROTINE TO SKIP SPACES
*             IN END OF ECB-BUFFER. 
*             REQUESTED LENGTH IN A9 IS UPDATED.
*             A1,A2 - WORK REG
* 
SKIPSP	EQU	*
	ADKL	A9,2
	LD	A1,2,A8	GET BUFFER ADDRESS (BA) 
	ADR	A1,A9	GET ADD END OF BUFFER
SKIP05	CWK	A9,2 
	RF(NG)	SKIP30	RL < 3 
	SUK	A1,1	DECR. BA
	LCR	A2,A1	GET CHAR 
	CCK	A2,/2020	SPACE ? 
	RF(NE)	SKIP20	NO 
SKIP07	SUKL	A9,1	DECR RL
	RB	SKIP05	GET NEXT 
SKIP20	CWK	A9,4 
	RF(NG)	SKIP30	RL < 5 
	LC	A2,-2,A1	GET CHAR 
	CCK	A2,/1111	TABULATION CHAR ? 
	RF(NE)	SKIP30	NO 
	SUK	A1,2	DECR BA 
	SUKL	A9,2	DECR RL
	RB	SKIP07	GET NEXT 
* 
SKIP30	EQU	*
	SUKL	A9,2
	RTN	A14
	XIF			DK4E 
* 
         END

Full view