DataMuseum.dk

top - metrics - download

    Length: 10826 (0x2a4a)
    Notes: pts_type(SC)
    Names: »LOGINP.SC«

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

PTS(SC)

	IDENT LOGINP	REL 1.1 78-04-21  870150140110
* 
* 
*	TASK FOR LINE INPUT 
* 
* 
	ENTRY	LOGINP 
* 
* 
*	EXTERNAL REFERENCES 
* 
* 
	EXTRN	MOL	OWN LINE MESSAGES
	EXTRN	MBL	BEGIN OF LINE MESSAGES 
	EXTRN	TAB1	CHAR TABLE 1
	EXTRN	TAB2	CHAR TABLE 2
	EXTRN	PRPOOL	PRINTER OCCUPIED BUFFER ADDRESSS
	EXTRN	EBASC
* 
* 
* 
*	RELATIVE ECB EQUATES
* 
* 
ECBBA	EQU	2 
ECBRL	EQU	4 
ECBEL	EQU	6 
ECBRC	EQU	8 
ECBCW	EQU	/A
* 
	RES	20	A14 STACK 
STB	EQU	*-2 
PROCCA	DATA	0	ADDRESS TO PRINTER OCCUPIED BUFFER
	EJECT
* 
* 
*	INITIALIZE SYSTEM 
* 
*	A9=BUFFER POINTER 
*	A10=CHARACTER COUNTER 
* 
* 
LOGINP	LDKL	A14,STB	LOAD STACK BASE 
	SUR	A10,A10	RESET CHARACTER COUNTER
	LDK	A1,2 
	ST	A1,PRECBL	EMPTY PRINTER BUFFER
	LDK	A1,1 
	ST	A1,XSPACE	SET SPACE INDICATOR 
	EJECT
* 
* 
*	EDIT CHARACTERS FROM LINE 
* 
* 
EDIT	CF	A14,GETCH	GET CHARACTER 
ED100	EQU	* 
	RF(P)	ED600	COMMENT
	RF(N)	ED700	COUNTER
	CWK	A7,/FF 
	RF(E)	ED500	MARK HOLD PRINT LINE 
	LD	A2,EBASC
	RF(Z)	ED200	EBCDIC-CODE
	CF	A14,STAB2	SEARCH FOR ASCII
	RF(Z)	ED400	FOUND
	RF	ED300 
ED200	EQU	* 
	CF	A14,STAB1	SEARCH FOR EBCDIC 
	RF(Z)	ED400	FOUND
ED300	EQU	* 
	CF	A14,EDHEX	EDIT IN HEXADECIMAL 
ED400	EQU	* 
	LDK	A2,100 
	CW	A2,PRECBL 
	RB(G)	EDIT	LINE NOT FULL 
ED500	EQU	* 
	CF	A14,PRLINE	PRINT ONE LINE 
	CF	A14,CRLF
	RB	EDIT
	EJECT
ED600	EQU	* 
	CF	A14,CRLF	COMMENT FOUND
	CF	A14,PRTEXT
	RB	EDIT
ED700	EQU	* 
	CF	A14,EDDEC	CONVERT COUNTER TO DECIMAL
	CF	A14,PRLINE	PRINT COUNTER
	RB	EDIT
	EJECT
* 
* 
*	PRINT TEXT ON PRINTER 
* 
*	A7 CONTAINS CONTROL CHARACTER 
* 
* 
PRTEXT	LDR	A6,A7	SAVE CHARACTER 
	CF	A14,PRLINE	RELEASE PRINT BUFFER 
	ADR	A6,A6	DOUBLE FOR INDEXING
	ANK	A6,/FF 
	LDR	A2,A6
	ANK	A2,/7F 
	LD	A3,MOL,A2	GET TEXT ADDRESS
	CWR	A2,A6
	RF(NE)	PRT100	OWN LINE TEXT
	LD	A3,MBL,A2	BEGINNING OF LINE 
PRT100	LDR*	A4,A3	GET TEXT LENGTH 
	CWK	A1,100 
	RF(G)	PRT130	INVALID LENGTH: SKIP TEXT 
	ADK	A3,2	SKIP LENGTH 
PRT110	SUK	A4,1 
	RF(N)	PRT120	ALL MOVED 
	LCR	A1,A3
	ADK	A3,1 
	CF	A14,STORE 
	RB	PRT110
PRT120	ANK	A6,/80 
	RF(Z)	PRT130	BEGINNING OF LINE 
	CF	A14,PRLINE	PRINT OWN LINE 
PRT130	RTN	A14
	EJECT
* 
* 
*	PRINT ONE LINE ON PRINTER 
* 
* 
PRLINE	LDK	A1,2 
	CW	A1,PRECBL 
	RF(E)	PRLI10	NOTHING IN BUFFER 
	LDK	A7,1 
	LKM
	DATA	-7,PRPOOL	OCCUPIE PRINTER 
	ST	A8,PROCCA	SAVE BUFFER ADDRESS 
	LDK	A7,/86	STD WRITE AND WAIT
	LDKL	A8,PRECB
	LKM
	DATA	1 
	LD	A8,PROCCA	RESTORE BUFFER ADDRESS
	RF(Z)	PRLI05	NO BUFFER 
	LKM	 
	DATA	-8,PRPOOL	RELEASE PRINTER 
	CM	PROCCA
PRLI05	EQU	*
	ST	A1,PRECBL	RESET LENGTH
	LDK	A1,1 
	ST	A1,XSPACE	SET SPACE INDICATOR 
PRLI10	RTN	A14
PRECB	DATA	/31,PRBUF,2,0,0,0
PRECBL	EQU	PRECB+4	REQUESTED LENGTH 
PRBUF	DATA	0	CONTROL WORD 
	RES	60 
	EJECT
* 
* 
*	GET ONE CHARACTER FROM LINE TO A7 
*	CR=0 IF NORMAL CHARACTER
*	CR=1 IF COMMENT CHARACTER 
* 
* 
GETCH	SUKL	A10,1
	RF(NN)	GETCH1	FETCH FROM BUFFER
	LDK	A7,/81	READ NEW BUFFER 
	LDKL	A8,LGECB
	LKM
	DATA	1 
	LD	A10,ECBEL,A8	GET EFFECTIVE LENGTH 
	SUKL	A10,1 
	LD	A9,ECBBA,A8	GET BUFFER ADDRESS
GETCH1	LCR	A7,A9	LOAD CHARACTER 
	ADKL	A9,1	INCREMENT POINTER
	LC	A1,ECBRC,A8 
	ADKL	A14,4	SKIP STACK FOR RETURN 
	ANK	A1,/20 
	RF(NZ)	GETCH2	COMMENT OR COUNTER 
	ABR*	A14 
	EJECT
GETCH2	LDK	A1,/80 
	TM	A1,A7 
	RF(Z)	GETCH3	COMMENT 
	ANK	A7,/7F	COUNTER 
	SLL	A7,8 
	LCR	A7,A9	GET NEXT DIGIT 
	SUR	A10,A10
	LDK	A1,0 
GETCH3	SUK	A1,1	SET CR
	ABR*	A14 
* 
LGECB	DATA	/60,LGBUF,20,0,0,0 
LGBUF	RES	20
	EJECT
* 
* 
*	EDIT	CHAR FROM A7 IN HEXADECIMAL FORM 
* 
* 
EDHEX	CF	A14,SPACE
	LDK	A1,'/' 
	CF	A14,STORE 
	LDR	A1,A7
	SRL	A1,4 
	ANK	A1,/F
	LC	A1,HEXTAB,A1
	CF	A14,STORE	1ST CHAR
	LDR	A1,A7
	ANK	A1,/F
	LC	A1,HEXTAB,A1
	CF	A14,STORE	2ND CHAR
	CF	A14,SPACE	SPACE 
	RTN	A14
HEXTAB	DATA	'0123456789ABCDEF'
	EJECT
* 
* 
*	STORE CHAR FROM A1 IN PRINT BUFFER
* 
* 
STORE	LD	A2,PRECBL
	SC	A1,PRBUF,A2 
	IM	PRECBL
	LDK	A1,0 
	ST	A1,XSPACE 
	RTN	A14
	EJECT
* 
* 
*	EDIT CHARACTER DECIMAL FROM A7
* 
* 
EDDEC	LDK	A4,0	RESET INDEX
	LDK	A5,0 
EDD100	LDK	A1,'0'	ASCII ZERO AT START 
EDD110	CW	A7,DECADE,A4
	RF(L)	EDD200	NO MORE SUBTRACTIONS
	SU	A7,DECADE,A4	SUBTRACT AND INCREMENT 
	ADK	A1,1 
	RB	EDD110
EDD200	EQU	*
	CWK	A1,'0' 
	RF(NZ)	EDD250	NOT ASCII ZERO 
	LDR	A5,A5
	RF(Z)	EDD300	LEADING ZERO
EDD250	EQU	*
	ADK	A5,1 
	CF	A14,STORE	STORE DIGIT 
EDD300	EQU	*
	ADK	A4,2 
	CWK	A4,10
	RB(NE)	EDD100	NEXT DIGIT 
	RTN	A14	CONVERSION DONE
DECADE	DATA	10000,1000,100,10,1 
	EJECT
* 
* 
*	SEARCH FOR A7 CHAR IN TABLE 1 
* 
*	CR=1 IF NOT FOUND 
*	CR=0 IF FOUND AND CORRESPONDING TEXT IN BUFFER
* 
* 
STAB1	EQU	* 
	LDK	A5,0 
	RF	STAB20
	EJECT
* 
* 
*	SEARCH FRO A7 CHAR IN TABLE 2 
* 
*	CR=1 IF NOT FOUND 
*	CR=0 IF FOUND AND CORRESPONDING TEXT IN BUFFER
* 
* 
STAB2	EQU	* 
	LDK	A5,1 
STAB20	EQU	*
	LDK	A4,3 
	LDK	A1,1	CR IF NOT FOUND 
STAB40	LDR	A5,A5
	RF(Z)	STAB41 
	CW	A4,TAB2 
	RF(G)	STAB80	END OF TABLE
	CC	A7,TAB2,A4
	RF(E)	STAB50	FOUND 
	RF	STAB42
STAB41	CW	A4,TAB1 
	RF(G)	STAB80	END OF TABLE
	CC	A7,TAB1,A4
	RF(E)	STAB50	FOUND 
STAB42	EQU	*
	ADK	A4,4 
	RB	STAB40	NEXT CHAR
STAB50	CF	A14,SPACE 
	LDR	A5,A5
	RF(NZ)	STAB51
	LD	A3,TAB1+1,A4	GET STRING ADDRESS 
	RF	STAB52
STAB51	EQU	*
	LD	A3,TAB2+1,A4	GET STRING ADDRESS 
STAB52	EQU	*
	LDR*	A4,A3	GET LENGTH
	ADK	A3,2 
STAB60	SUK	A4,1 
	RF(N)	STAB70 
	LCR	A1,A3	MOVE TEXT
	ADK	A3,1 
	CF	A14,STORE 
	RB	STAB60
STAB70	CF	A14,SPACE	SPACE 
	LDK	A1,0 
STAB80	EQU	*
	LC	A2,2,A14	SET CR FOR RETURN
	ANK	A2,/FC 
	ANK	A1,3 
	ADR	A1,A2
	SC	A1,2,A14
	RTN	A14
	EJECT
* 
* 
*	PUT SPACE IN BUFFER 
* 
* 
SPACE	LD	A1,XSPACE
	RF(NZ)	SPA100
	LDK	A1,/20 
	CF	A14,STORE 
	IM	XSPACE
SPA100	RTN	A14
XSPACE	DATA	0	SPACE INDICATOR 
* 
* 
*    CRLF IN BUFFER 
* 
* 
CRLF	EQU	*
	CF	A14,SPACE 
	LDK	A1,/0D 
	CF	A14,STORE 
	LDK	A1,/0A 
	CF	A14,SPACE 
	RTN	A14
**
* 
	END