DataMuseum.dk

top - metrics - download

    Length: 17416 (0x4408)
    Notes: pts_type(SC)
    Names: »WRITE.SC«

└─⟦2a21e4bb5⟧ Bits:30009691 Philips computer tape "600408"
    └─⟦this⟧ »BDKAPP/WRITE.SC« 
└─⟦71472ef1e⟧ Bits:30009661 Philips computer tape "600103"
    └─⟦this⟧ »BDKAPP/WRITE.SC« 

PTS(SC)

	IDENT  WRITE 	REL=7.2  DATE=77-09-09 
			UPDATE   #0   77-09-09 
* 
******************************************* 
* 
*   PHILIPS TERMINAL SYSTEM PTS 
* 
*   WRITE = WRITE FUNCTION
* 
* 
*   LEVEL     #2  77-09-09
* 
*   RELEASE   #7  77-09-09
* 
******************************************* 
* 
* 
*   THIS MODULE HANDLES THE EDITING OF DATA AT
*   I/O-REQUESTS
* 
* 
*   PICTURE CONTROLS THE EDITING OF NUMERIC DATA FROM 
*   BCD-ELEMENTS ONLY, AND CONSISTS OF A CHARACTER STRING.
* 
* 
* 
	EJECT
* 
* 
************
* ENTRIES: *
************
* 
	ENTRY	T:WRT,T:WRTZ 
	ENTRY	T:EDT,T:EDTZ 
* 
* 
**************
* EXTERNALS: *
**************
* 
	EXTRN	PICTAB 
	EXTRN	T:OPA
	EXTRN	M:OPA
	EXTRN	CTLTAB 
* 
BYTE	FORM	8,8 
* 
OVERLY	EQU	0
* 
**************
* WORK AREAS *
**************
* 
EDNOTZ	DATA	0	ZERO INDICATOR
EDSUPP	DATA	0	SUPPRESSOR INDICATOR
EDFCH	DATA	0	CHARACTER TO BE STORED IF F
EDEPOI	DATA	0	ELEMENT POINTER 
EDCNTE	DATA	0	INDEX FOR ELEMENT 
EDSIGN	DATA	0	SIGN FOR ELEMENT
EDPPOI	DATA	0	PICTURE POINTER 
EDCNTP	DATA	0	INDEX FOR PICTURE (2-COMPL.)
	EJECT
* 
* 
* 
TEDIT	LD	A10,8,A14	GET RETURN ADDRESS 
	LDR*	A9,A10	A9=DEVICE
	LD	A2,2,A10	A2=ADDRESS TO FORMAT 
	LDK	A1,4 
	ADS	A1,8,A14	STORE NEW RETURN ADDRESS
	STR	A11,A14	SAVE A11 ON STACK
	SUKL	A14,2	ADJUST STACK
	SUR	A11,A11	CLEAR A11
	SUR	A10,A10	CLEAR A10
WRIT10	LD	A7,2,A8	GET BUFFER ADDRESS
	CF	A14,EDITA	PERFORM EDIT
	LD	A4,2,A8	GET BUFFER START ADDRESS
	SUR	A7,A4	GET EFF. BUFFER LENGTH 
	ST	A7,4,A8	STORE REQUESTED LENGTH
	LDK	A4,0	CONTROL WORD=0
	SRC	A3,1	SHIFT CIRCULAR(D) 
	RF(NN)	WRIT20	JUMP IF NO CONTROL WORD
	LD	A4,CTLTAB,A1	GET CONTROL WORD FROM TABLE
WRIT20	ST	A4,10,A8	STORE CONTROL WORD 
	ECR	A7,A9
	ANK	A7,/FF	A7=W+R+ORDER
	SRC	A3,3	SHIFT EOR-MARK TO SIGN
	RF(NN)	WRIT30	JUMP IF END OF LIST
	ORK	A7,/80	INDICATE WAIT 
WRIT30	EQU	*
	STR	A9,A8	STORE FC IN ECB
	ADKL	A14,2	ADJUST STACK
	RTN	A14
	EJECT
* 
T:EDTZ	ADKL	A8,1	INDICATE "NO CTL-BYTES"
* 
T:EDT	CF	A14,TEDIT
EDTRTN	EQU	*
	LD	A11,-4,A14	RESTORE A11
	ANKL	A8,/FFFE	CLEAR "NO CTL-BYTES"-INDICATION
	IFT	OVERLY=1 
	DATA	/C0FF 
	XIF
	IFT	OVERLY=0 
	RTN	A14
	XIF
* 
T:WRTZ	ADKL	A8,1	INDICATE "NO CTL-BYTES"
* 
T:WRT	CF	A14,TEDIT
********* 
* WRITE * 
********* 
	LDR	A1,A8	SAVE ORIGIN A8 
	ANKL	A8,/FFFE
	LKM
	DATA	1 
	LDR	A8,A1	RESTORE ORIGIN A8
	LDR	A3,A3
	RB(NN)	EDTRTN	JUMP IF END OF LIST
	SUKL	A14,6	MODIFY STACK POINTER
	RB	WRIT10	CONTINUE 
	EJECT
EDITA	EQU	* 
	LDK	A3,1	LOAD MASK 
	TM	A8,A3 
	RF(Z)	EDIT	JUMP IF CTL-BYTES 
	LDK	A3,0 
	SCR	A3,A7	CLEAR 1:ST BYTE
	ADK	A7,1	INCREMENT POINTER 
	SCR	A3,A7	CLEAR SECOND BYTE
	ADK	A7,1	INCREMENT POINTER 
EDIT	ADK	A2,1 
	ANKL	A2,/FFFE	WORD LIMIT 
	LDK	A6,0 
	LDR*	A1,A2	GET WORD TO A1
	ADK	A2,2	INCR. FORMAT POINTER
	LDR	A5,A1	COPY A1
	ECR	A4,A1	CHANGE BYTES TO A4 
	ANK	A1,/FF	A1=CHAR 
	ANK	A4,/FF	A4=Z+D
	LDR	A3,A4	A3=Z+D 
	SRL	A4,4	A4=Z
	SUK	A4,8 
	RF(NN)	EDPICT	JUMP IF PICTURE
	LC	A6,TABZON+8,A4	GET DISPLACEMENT 
BASIS	EQU	*+2	TABLE BASE
EDJMP	ADR	P,A6	JUMP TO RESPECTIVE ROUTINE 
* 
RETURN	EQU	*-BASIS
	RTN	A14
	EJECT
********
* TEXT *
********
EDTXT	EQU	*-BASIS 
	ANK	A3,/F	MASK OUT DATA PART 
	LC	A6,TABLE,A3	GET DISPLACEMENT
	RB	EDJMP	JUMP TO RESPECTIVE ROUTINE
******************************
* SUBFORMAT OR SWITCH FORMAT *
******************************
AFORM	EQU	*-BASIS 
	SUKL	A5,/6800
	ANKL	A5,/FFFE	MASK OUT INDICATION BIT
	ADK	A5,2 
	ANK	A1,1 
	RF(Z)	SWITCH	JUMP IF SWITCH FORMAT 
	LDR	A10,A10
	RF(NZ)	AFORM1	JUMP IF OCCUPIED 
	LDR	A10,A2	GET RETURN ADDRESS TO A10 
	RF	SWITCH
AFORM1	LDR	A11,A2	GET RETURN ADDRESS TO A11 
SWITCH	SUR	A2,A5	GET ALTERNATIVE FORMAT TO A2 
RETUR	EQU	*-BASIS 
	RB	EDIT
********************
* END OF SUBFORMAT *
********************
ENDSUB	EQU	*-BASIS
	LDR	A11,A11
	RF(Z)	ENDS10	JUMP IF 0 
	LDR	A2,A11	GET RETURN ADDRESS FROM A11 
	SUR	A11,A11	CLEAR A11
	RB	EDIT
ENDS10	LDR	A10,A10
	RB(Z)	EDIT	JUMP IF NO SUB CALL 
	LDR	A2,A10	GET RETURN ADDRESS FROM A10 
	SUR	A10,A10	CLEAR A10
ENDS50	EQU	*
	RB	EDIT
******************
* IMMEDIATE TEXT *
******************
IMTXT	EQU	*-BASIS	IMMEDIATE TEXT
EDT100	SUK	A1,1	DECREMENT CHAR
	RB(N)	EDIT	JUMP IF ALL DONE
	LCR	A6,A2	GET CHARACTER
	ADK	A2,1	STEP POINTER
	SCR	A6,A7	STORE BYTE IN BUFFER 
	ADK	A7,1	INCREMENT POINTER 
	RB	EDT100	JUMP TO CONTINUE 
************************
* SPECIAL TEXT ELEMENT *
************************
STXTEL	EQU	*-BASIS
	LDR	A3,A7	SAVE A7
	LDR	A7,A1	LOAD CHAR IN A7
	ST	A13,SVA13	SAVE A13
	LD	A13,-2,A13	GET NEW BASE 
	IFT	OVERLY=0 
	CF	A14,T:OPA	GET ELEMENT PARAMETERS
	XIF
	IFT	OVERLY=1 
	CF	A14,M:OPA	GET ELEMENT ADDRESS 
	XIF
	LDKL	A13,0 
SVA13	EQU	*-2 
	RF	EDT205
****************
* TEXT ELEMENT *
****************
TXTEL	EQU	*-BASIS	TEXT ELEMENT
EDT200	LDR	A3,A7	SAVE A7
	LDR	A7,A1	LOAD EL.IDENTIFICATOR IN A7
	IFT	OVERLY=0 
	CF	A14,T:OPA	GET ELEMENT PARAMETERS
	XIF
	IFT	OVERLY=1 
	CF	A14,M:OPA	GET ELEMENT PARAMETERS
	XIF
EDT205	EQU	*
	LDR	A7,A3	RESTORE A7 
	ADR	A6,A1	ADD 2-COMPL. LENGTH
	ADK	A6,1	GET ELEMENT ADDRESS 
EDT210	ADK	A1,1	INCREMENT COUNT 
	RB(P)	EDIT	JUMP IF FINISHED
	LCR	A5,A6	GET ASCII-CHARACTER
	ADK	A6,1	INCREMENT ELEMENT POINTER 
	ANK	A5,/FF 
	RB(Z)	EDT210	JUMP IF 00
	SCR	A5,A7	STORE BYTE IN BUFFER 
	ADK	A7,1	INCREMENT BUFFER POINTER
	RB	EDT210
**********
* FILLER *
**********
EDFILL	EQU	*-BASIS
EDF100	SUK	A1,1	STEP DOWN "CHAR"
	RB(N)	EDIT	JUMP IF FINISHED
	SCR	A3,A7	STORE BYTE IN BUFFER 
	ADK	A7,1	INCREMENT POINTER 
	RB	EDF100	CONTINUE TO LOOP 
**********************
* CONDITIONAL FORMAT *
**********************
COND	EQU	*-BASIS
	LDR	A3,A7	SAVE A7
	LDR	A7,A1	GET ELEMENT ADDRESS TO A7
	IFT	OVERLY=0 
	CF	A14,T:OPA	GET ELEMENT PARAMETERS
	XIF
	IFT	OVERLY=1 
	CF	A14,M:OPA	GET ELEMENT PARAMETERS
	XIF
	LDR	A7,A3	RESTORE A7 
	LCR	A1,A6	GET SIGN 
	ANK	A1,/F	MASK OUT SIGN
	SUK	A1,/D
	RB(NZ)	EDIT	JUMP IF POSITIVE 
	ADK	A2,2	JUMP TO NEXT WORD IN FORMAT 
	RB	EDIT
	EJECT
*********** 
* PICTURE * 
*********** 
EDPICT	ANK	A3,/7F	MASK OUT PICTURE NUMBER 
	SLL	A3,2	PICTURE NUMBER * 4
	LD	A4,PICTAB+2,A3	GET STRING ADDRESS 
	LD	A3,PICTAB,A3	GET CONTROL WORD 
	ST	A3,EDEPOI	SAVE A3 
	ANK	A3,/FF 
	ST	A4,EDPPOI	STORE PICTURE POINTER 
	NGR	A3,A3	NEGATE REGISTER
	ST	A3,EDCNTP	STORE LENGTH I  COUNTER 
	LDR	A3,A7	SAVE A7
	LDR	A7,A1	GET EL. INDICATOR TO A7
	IFT	OVERLY=0 
	CF	A14,T:OPA	GET ELEMENT PARAMETERS
	XIF
	IFT	OVERLY=1 
	CF	A14,M:OPA 
	XIF
	LDR	A7,A3	RESTORE A7 
	LCR	A4,A6	SIGN 
	ANK	A4,/F	MASK OUT SIGN
	SUK	A4,/D	SUBTRACT WITH MINUS SIGN 
	ST	A4,EDSIGN	STORE IN SIGN INDICATOR 
	NGR	A1,A1	GET POSITIVE LENGTH IN BYTES 
	SUR	A6,A1
	ADK	A6,1	GET ELEMENT START ADDRESS 
	SLL	A1,1	LENGTH IN BCD INCL. SIGN
	SUK	A1,1	LENGTH IN BCD EXCL. SIGN
	LC	A3,EDEPOI	GET SAVED A3
	ANK	A3,/FF	GET NUMBER OF DIGITS TO FETCH 
	SUR	A1,A3	L-N
	ST	A1,EDCNTE	STORE ELEMENT INDEX 
	RF(NP)	EDP050
	SRL	A1,1	DIVIDE WITH 2 
	ADR	A6,A1
EDP050	ST	A6,EDEPOI	STORE ELEMENT POINTER 
	CM	EDNOTZ	CLEAR ZEROMARK 
	CM	EDFCH	CLEAR EDFCH 
	CM	EDSUPP	CLEAR SUPPR. INDICATOR 
	LDK	A6,0	CLEAR A6
EDP100	IM	EDCNTP	INCREMENT COUNT
	RB(P)	ENDS50	JUMP IF ALL DONE
	LC*	A4,EDPPOI	GET PICTURE CODE 
	ANK	A4,/FF 
	IM	EDPPOI	INCREMENT POINTER
	LDK	A1,/80	LOAD TO MASK
	TM	A1,A4	TEST ON LEFTMOST BIT IN CODE
	RF(Z)	EDP120	JUMP IF BIT=0 
	LDR	A6,A4	A6=ASCII-CODE
	ANK	A6,/7F 
EDP110	SCR	A6,A7	STORE BYTE IN BUFFER 
	ADK	A7,1	INCREMENT POINTER 
	RB	EDP100	CONTINUE 
EDP120	LDKL	A1,-17	LOAD START INDEX 
EDP130	CC	A4,TABPIC+17,A1 
	RF(E)	EDP150	JUMP IF CODE IN TABLE 
	ADK	A1,1	INCREMENT INDEX 
	RB(N)	EDP130	JUMP IF NOT END OF TABLE
	RB	EDP100	JUMP IF ILLEGAL CODE 
EDP150	EQU	*
	LC	A6,CODTAB+17,A1	GET DISPLACEMENT
BASE	EQU	*+2
	ADR	P,A6	JUMP TO ROUTINE 
	EJECT
**************
* * ASTERISK *
**************
LAST	EQU	*-BASE 
EDP600	LDK	A5,'*'	LOAD * IN A5
********
* T    *
********
LT	EQU	*-BASE 
EDP610	IM	EDSUPP	EDSUPP NOT=0 
	CF	A14,EDGETN	GET CHR FROM ELEMENT 
	LD	A1,EDNOTZ	LOAD ZERO INDICATOR 
	RF(NZ)	EDP670	JUMP IF NOT LEADING ZEROES 
	CWK	A6,/30	COMP WITH ZERO
	RF(E)	EDP680	JUMP IF ZERO
	RF	EDP660
*********** 
*  Z      * 
*********** 
LZ	EQU	*-BASE 
EDP650	LDK	A5,' '	LOAD SPACE
	RB	EDP610
	EJECT
************************************* 
* MARK NOT ZERO AND STORE CHARACTER * 
************************************* 
EDP660	IM	EDNOTZ	INCREMENT ZERO INDICATOR 
	LDR	A1,A6	A1=CHR FROM ELEMENT
	LD	A6,EDFCH	A6=EDFCH 
	RF(Z)	EDP665	JUMP IF NOT F 
	CM	EDFCH	CLEAR EDFCH 
	SCR	A6,A7	STORE EDFCH IN BUFFER
	ADK	A7,1	INCREMENT POINTER 
EDP665	LDR	A6,A1	A6=CHR FROM ELEMENT
******************* 
* STORE CHARACTER * 
******************* 
EDP670	SCR	A6,A7	STORE BYTE IN BUFFER 
	ADK	A7,1	INCREMENT POINTER 
EDP725	RB	EDP100	CONTINUE 
********************* 
* EDNOTZ=0, CHR=/30 * 
********************* 
EDP680	SUK	A4,/54 
	RB(Z)	EDP100	JUMP IF T 
***************** 
* STORE FROM A5 * 
***************** 
EDP700	LDR	A6,A5	LOAD CHARACTER TO A6 
	RB	EDP670	JUMP TO STORE
	EJECT
**********************
* . (POINT ROOMLESS) *
**********************
L.	EQU	*-BASE 
EDP710	LDK	A6,'.'+/80	LOAD ROOMLESS POINT 
EDP720	LD	A1,EDSUPP 
	RB(Z)	EDP670	JUMP IF NOT SUPPRESSED
	LD	A1,EDNOTZ 
	RB(NZ)	EDP670	JUMP IF NOT LEADING ZERO 
	CWK	A6,'.'+/80	COMP WITH ROOMLESS POINT
	RB(E)	EDP100	JUMP IF ROOMLESS POINT
	RF	EDP780
************* 
* , (COMMA) * 
************* 
LCOMMA	EQU	*-BASE 
EDP730	LDK	A6,','	LOAD COMMA
	RB	EDP720
*************************** 
* V (POINT, NOT ROOMLESS) * 
*************************** 
LV	EQU	*-BASE 
EDP740	LDK	A6,'.'	LOAD POINT
	RB	EDP720
************
* 0 (ZERO) *
************
L0	EQU	*-BASE 
EDP750	LDK	A6,'0'	LOAD ZERO 
	RB	EDP660	JUMP TO IM EDNOTZ AND STORE
**********
*  P     *
**********
LP	EQU	*-BASE 
EDP760	CF	A14,EDGETN	GET CHR FROM ELEMENT 
	RB	EDP100	JUMP BACK
************* 
* 9 (DIGIT) * 
************* 
L9	EQU	*-BASE 
EDP770	CF	A14,EDGETN	GET CHR FROM ELEMENT 
	RB	EDP660	JUMP TO IM EDNOTZ AND STORE
	EJECT
************* 
* B (SPACE) * 
************* 
LB	EQU	*-BASE 
EDP780	LDK	A6,' '	LOAD SPACE
	RB	EDP670	JUMP TO STORE
********************
* A (IGNORE SPACE) *
********************
LA	EQU	*-BASE 
EDP790	CF	A14,EDGETA	GET CHR FROM ELEMENT IN ASCII
	CCK	A6,'  '	COMP WITH SPACE
	RB(E)	EDP725	IGNORE IF SPACE 
	RB	EDP660	JUMP TO IM EDNOTZ AND STORE
********************************************
* F (NEXT CHR IS STORED AFTER SUPPRESSION) *
********************************************
LF	EQU	*-BASE 
EDP800	LC*	A4,EDPPOI	GET PICTURE CODE 
	IM	EDPPOI	INCREMENT POINTER
	ST	A4,EDFCH	STORE CHARACTER IN EDFCH 
	IM	EDCNTP
EDP805	RB	EDP725	JUMP BACK
	EJECT
************
* + (PLUS) *
************
LPLUS	EQU	*-BASE
EDP810	LD	A1,EDSIGN	GET SIGN
	RF(NZ)	EDP830	JUMP IF POSITIVE 
EDP820	LDK	A6,'-'	LOAD MINUS
	RB	EDP670	STORE SIGN IN BUFF 
EDP830	LDK	A6,'+'	 LOAD PLUS
	RB	EDP670
************* 
* - (MINUS) * 
************* 
LMINUS	EQU	*-BASE 
EDP840	LD	A1,EDSIGN	GET SIGN
	RB(Z)	EDP820	STORE MINUS 
	RB	EDP780	STORE SPACE
************************************
* S (LEADING ZERO REPLACED BY SIGN)*
************************************
LS	EQU	*-BASE 
EDP850	IM	EDSUPP	MARK SUPPRESSION 
	CF	A14,EDGETN	GET CHR FROM ELEMENT 
	LD	A1,EDNOTZ	LOAD ZERO INDICATOR 
	RB(NZ)	EDP670	STORE CHR IF NOT ZERO
	CWK	A6,/30	COMP WITH ZERO
	RB(E)	EDP810	JUMP IF EQUAL 
	RB	EDP660	IM EDNOTZ AND STORE CHR
	EJECT
************************* 
* C:CONDITIONAL PICTURE * 
************************* 
LC	EQU	*-BASE 
EDP900	LD	A4,EDSIGN	LOAD SIGN 
	RB(NZ)	EDP725	JUMP BACK IF POSITIVE
	LD	A4,EDPPOI	LOAD PICTURE POINTER
	SU	A4,EDCNTP	SUB. WITH NEG.NUMBER=;
	ST	A4,EDPPOI	STORE NEW POINTER 
	RB	EDP725	JUMP BACK
* 
* 
************************
* PRINT SPACE IF BLANK *
************************
LD	EQU	*-BASE 
	IM	EDSUPP	INDICATE SUPPRESSION CODE
	CF	A14,EDGETA	GET DIGIT IN ASCII TO A6 
	CWK	A6,/20 
	RB(E)	EDP670	JUMP IF SPACE 
	RB	EDP660	STORE AND INDICATE NOT LEADING ZERO
	EJECT
TABPIC	EQU	*
	DATA	'ABCDFP'
	DATA	'STVZ09'
	DATA	'.,+-*' 
* 
CODTAB	EQU	*
	BYTE	LA,LB 
	BYTE	LC,LD 
	BYTE	LF,LP 
	BYTE	LS,LT 
	BYTE	LV,LZ 
	BYTE	L0,L9 
	BYTE	L.,LCOMMA 
	BYTE	LPLUS,LMINUS
	BYTE	LAST,0
* 
TABLE	EQU	* 
	BYTE	TXTEL,IMTXT	D=0,1 
	BYTE	STXTEL,RETUR	  2,3
	BYTE	RETUR,RETUR	  4,5 
	BYTE	RETUR,ENDSUB	  6,7
	BYTE	RETUR,RETUR	8,9 
	BYTE	RETUR,RETUR	A,B 
	BYTE	RETUR,RETUR	C,D 
	BYTE	RETUR,COND	E,F
* 
TABZON	EQU	*
	BYTE	RETURN,EDTXT	Z=0,1
	BYTE	EDFILL,EDFILL	  2,3 
	BYTE	RETUR,RETUR	  4,5 
	BYTE	AFORM,RETUR	  6,7 
	EJECT
*************************************** 
* GET CHARACTER FROM ELEMENT, NUMERIC * 
*************************************** 
EDGETN	CF	A14,EDGETA	GET CHR IN ASCII 
	ANK	A6,/F	MASK OUT ZONE PART 
	ORK	A6,/30	MAKE ASCII DIGIT
	RTN	A14
************************************* 
* GET CHARACTER FROM ELEMENT, ASCII * 
************************************* 
EDGETA	LD	A1,EDCNTE	LOAD INDEX
	RF(N)	GETBLK	JUMP IF NEGATIVE
	LC*	A6,EDEPOI	GET CHARACTER
	IM	EDEPOI	INCREMENT POINTER
GETBCD	SRC	A1,1	SHIFT CIRCULAR
	RF(N)	GETRGT	JUMP IF ODD INDEX 
	LDKL	A3,-1 
	ADS	A3,EDEPOI	STEP DOWN ELEMENT POINTER
	SRL	A6,4	A6=LEFT DIGIT 
GETB10	SUK	A6,/F
	RF(Z)	GETBLK	JUMP IF BLANK 
	ADK	A6,/3F	MAKE ASCII DIGIT
	RF	GETRTN
GETRGT	ANK	A6,/F	A6=RIGHT DIGIT 
	RB	GETB10
GETRTN	IM	EDCNTE	INCREMENT INDEX
	RTN	A14
GETBLK	LDK	A6,/20	A6=SPACE
	RB	GETRTN
	END