Directory of image this file is from
This file as a plain text file

/ OS/8 FORTRAN II CHARACTER STRING SUBROUTINES
/ 22. MAERZ 1974		W.HOUBEN
/ AUFRUF :
/		I = LGET (STRING,N)
/
/ STRING  =  ZEICHENKETTE  (REAL ODER INTEGER)
/ N	  =  ZEICHENINDEX  (INTEGER)
/
/		CALL LSET (STRING,N,K)
/ K	  =  ZEICHEN (INTEGER 0-63)
/

	OPDEF BSW 7002

	ENTRY LGET
	ENTRY LSET
	DUMMY S1
	DUMMY N
	DUMMY K
	DUMMY LOCA

N,	BLOCK 2
K,	BLOCK 2

ERR2,	5407; 0524	/ LGET ERROR
LGET,	BLOCK 2
	TAD I LGET
	INC LGET#
	DCA S1
	TAD I LGET
	INC LGET#
	DCA S1#
	TAD I LGET
	INC LGET#
	DCA N
	TAD I LGET
	INC LGET#
	DCA N#

	TAD I N		/ ZEICHENINDEX HOLEN
	SPA SNA
	JMP GETERR
	IAC
	DCA N
	TAD N
	CLL RAR
	DCA INDEX	/ WORTINDEX
	JMS GETW
	TAD N
	CLL RAR
	CLA
	TAD WORD
	SNL
	BSW		/ LINK NULL (LINKES BYTE)
	AND (77
	RETRN LGET

LOCA,	BLOCK 2
GETW,	0
	CALL 2,SUBSC
	ARG INDEX
S1,	ARG 0		/ STRINGADRESSE
	LOCA
	TAD I LOCA
	DCA WORD
	JMP I GETW
WORD,	0
ERR1,	5423; 0524	/ LSET ERROR
LSET,	BLOCK 2
	TAD I LSET
	INC LSET#
	DCA S1
	TAD I LSET
	INC LSET#
	DCA S1#
	TAD I LSET
	INC LSET#
	DCA N
	TAD I LSET
	INC LSET#
	DCA N#
	TAD I N
	SPA SNA
	JMP SETERR
	IAC
	DCA N
	TAD N
	CLL RAR
	DCA INDEX
	JMS GETW
	TAD I LSET
	INC LSET#
	DCA K
	TAD I LSET
	INC LSET#
	DCA K#
	TAD I K
	AND (7700
	SZA		/ ZEICHEN <= 63 ?
	JMP SETERR	/ NEIN !!
	TAD N
	CLL RAR
	CLA
	SNL
	JMP LSET1
	TAD WORD
	AND (7700
	TAD I K
LSET2,	DCA I LOCA
	RETRN LSET
LSET1,	TAD WORD
	AND (77
	DCA WORD
	TAD I K
	BSW
	TAD WORD
	JMP LSET2
SETERR,	CLA CLL
	CALL 1,ERROR
	ARG ERR1
	RETRN LSET
INDEX,	0
GETERR,	CLA CLL
	CALL 1,ERROR
	ARG ERR2
	RETRN LGET
	END
~