Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-05 - 43,50337/23/tmpin.mac
There is 1 other file named tmpin.mac in the archive. Click here to see a list.
00010	COMMENT * SIMULA specification;
00020	OPTIONS(/E:CODE,tmpin);
00030	TEXT PROCEDURE tmpin(nam,delete);
00040	VALUE nam; TEXT nam; BOOLEAN delete;
00050	COMMENT Uses the TMPCOR UUO to read the core file NAM into a new text object.
00060	If a TMPCOR file is not found, a real file named "jjjnam.TMP" is looked up
00070	and read instead.
00080	If DELETE is TRUE, the file is deleted.
00090	Returns NOTEXT if the file was not found, Blanks(1) if found but empty.
00100	In the latter case Pos=2 also, otherwise 1.
00110	;
00120	
00130	!*;! MACRO-10 code !*;!
00140	
00150		TITLE	tmpin
00160		ENTRY	tmpin
00170		SUBTTL	SIMULA utility, Lars Enderin Oct 1976, modified Feb 1977
00180	
00190	;!*** Copyright 1976 by the Swedish Defence Research Institute. ***
00200	;!*** Copying is allowed.					***
00210	
00220	
00230		sall
00240		search	simmac,simmcr,simrpa
00250		macinit
00260	
00270		;! Local definitions ;!
00280	
00290		.TCRRF==1	;! Read code
00300		.TCRDF==2	;! Read and delete code
00310		result==2
00320		nam==result+2
00330		delete==nam+2
00340		lng==XWAC5
00350		attempt==XWAC6
00360		cnt==XWAC7
00370		block==XWAC10
00380		buflen==^D120/5
00390	
00400	tmpin:	PROC
00410		LF	lng,ZTVLNG(XCB,nam)
00420		JUMPE	lng,L9
00430		LI	attempt,1
00440		LI	XWAC1,buflen*5	;! Allocate  text as buffer
00450	L1():!	EXEC	TXBL
00460		XWD	0,0
00470		LF	X1,ZTVSP(XCB,nam)
00480		SUBI	attempt,1
00490		IF	;! Non-zero offset
00500			JUMPE	X1,FALSE
00510		THEN	;! Modify
00520			IDIVI	X1,5
00530			ADD	X2,nam(XCB)
00540		ELSE	;! Standard byte pointer
00550			LF	X2,ZTVZTE(XCB,nam)
00560		FI
00570		HRRZS	X2
00580		ADD	X2,bp(X1)
00590		CAILE	lng,3
00600		LI	lng,3
00610		SETZ
00620		LOOP	;! Convert name to SIXBIT
00630			ILDB	X1,X2
00640			CAIL	X1,"a"
00650			SUBI	X1,40
00660			CAIG	X1,40
00670			LI	X1,40
00680			LSH	6
00690			ADDI	-40(X1)
00700		AS
00710			SOJG	lng,TRUE
00720		SA
00730		JUMPE	L9	;! Blank name
00740		TRNN	77B23
00750		LSH	6
00760		TRNN	77B23
00770		LSH	6
00780		HRLZM	block
00790		LF	block+1,ZTELEN(XWAC1)
00800		MOVNI	-2(block+1)
00810		HRLM	block+1
00820		HRRI	block+1,1(XWAC1)	;! IOWD buflen,buffer
00830		MOVSI	.TCRRF
00840		HRRI	block
00850		TMPCOR
00860		GOTO	tmpfil	;! Not found, look for real file
00870		IMULI	5
00880		IF	;! Zero length file
00890			JUMPN	FALSE
00900		THEN	;! Return Blanks(1) only
00910	L2():!		MOVSI	(" "B6)
00920			ST	2(XWAC1)
00930			SETZM	result+1(XCB)
00940			MOVSI	XWAC2,1
00950			HRRI	XWAC2,1	;! Pos=2
00960			GOTO	L3
00970		FI
00980		LF	lng,ZTECLN(XWAC1)
00990		IF	;! Buffer was too small
01000			CAIG	(lng)
01010			GOTO	FALSE
01020		THEN	;! Make a new text
01030			JUMPL	attempt,L9	;! Just two attempts possible
01040			ST	XWAC1
01050			GOTO	L1
01060		FI
01070		ST	lng
01080	L5():!	;! Now clean up the text
01090		L	X1,[POINT 7,2(XWAC1)]
01100		L	X2,X1
01110		SETZ	cnt,
01120		LOOP
01130			ILDB	X1
01140			IF	;! Non-zero byte
01150				JUMPE	FALSE
01160			THEN	;! Count and store it
01170				AOS	cnt
01180				IDPB	X2
01190			FI
01200		AS
01210			SOJG	lng,TRUE
01220		SA
01230		JUMPE	cnt,L2
01240		HRLZ	XWAC2,cnt
01250	L3():!	ST	XWAC1,result(XCB)
01260		EXCH	XWAC2,result+1(XCB)
01270		IF	;! delete
01280			SKIPN	delete(XCB)
01290			GOTO	FALSE
01300		THEN	;! Do another TMPCOR or RENAME (to delete)
01310			IF	;! it was a TMPCOR file
01320				JUMPE	block+1,FALSE
01330			THEN	;! Use TMPCOR to delete
01340				SETZM	block+1
01350				MOVSI	.TCRDF
01360				HRRI	block
01370				TMPCOR
01380				NOP	;! Ignore error
01390			ELSE	;! Real file, use RENAME
01400				AND	X4,[777,,0]
01410				TLO	X4,(RENAME)
01420				SETZB	X1
01430				SETZB	X2,X3
01440				XCT	X4
01450				NOP	;! Ignore error
01460			FI
01470		ELSE	;! Close the file if any
01480			JUMPE	block+1,L6
01490		FI
01500	L9():!	BRANCH	CSEP
01510	
01520	bp:	POINT	7,2
01530		POINT	7,2,6
01540		POINT	7,2,13
01550		POINT	7,2,20
01560		POINT	7,2,27
01570	
01580	tmpfil:	;! Look up and read "jjjnam.TMP"
01590		LI	X1,YIOCHT+17(XLOW)	;! Find a free channel
01600		LOOP
01610			SKIPN	(X1)
01620			GOTO	L7
01630		AS
01640			CAILE	X1,YIOCHT(XLOW)
01650			SOJA	X1,TRUE
01660		SA
01670		GOTO	L9	;! No free channel
01680	L7():!	SUBI	X1,YIOCHT(XLOW)	;! Channel number
01690		LSH	X1,^D23		;! into AC position
01700		ST	X1,result+1(XCB);! Save channel in correct position
01710		TLO	X1,(OPEN)	;! OPEN UUO in X1
01720		ST	XWAC1,result(XCB) ;! Save XWAC1
01730		HRRI	X1,X3		;! OPEN block in X3-X5
01740		LI	X3,17		;! Dump mode
01750		MOVSI	X4,'DSK'	;! Device DSK
01760		SETZ	X5,		;! No buffers
01770		XCT	X1		;! OPEN
01780		GOTO	[SETZM	result(XCB)
01790			GOTO	L9()]		;! Failed
01800	
01810		;! LOOKUP block for "jjjnam.TMP[,]" in X0-X3, UUO in X4
01820		PJOB	X1,		;! Job no (jjj)
01830		HLLZ	block		;! 'nam',,0
01840		IDIVI	X1,^D10		;! Form 'jjj' in front of 'nam'
01850		ADDI	'0'(X2)		;! last digit
01860		ROT	-6
01870		IDIVI	X1,^D10
01880		ADDI	'0'(X2)		;! tens digit
01890		ROT	-6
01900		ADDI	'0'(X1)		;! first digit
01910		ROT	-6		;! Now we have 'jjjnam' in SIXBIT
01920		MOVSI	X1,'TMP'	;! Extension
01930		SETZ	X2,		;! Rest of LOOKUP block
01932		GETPPN	X3,		;! UFD = [,]
01934		 CAI			;! In case of JACCT
01940		L	X4,result+1(XCB);! Z channel,
01950		TLO	X4,(LOOKUP)	;! LOOKUP channel,X0
01960		XCT	X4
01970		GOTO	errout
01980	
01990		HRR	X3,block+1	;! Same right half for comparison
02000		;! Set up IOWD n,txt contents, followed by zero, for dump input
02010		IF	;! File is bigger (-words,,xxx in X3 now) than text
02020			CAML	X3,block+1
02030			GOTO	FALSE
02040		THEN	;! Reallocate text
02050			HRRM	X3,block+1
02060			HLRES	X3
02070			MOVN	XWAC1,X3
02080			IMULI	XWAC1,5
02090			EXEC	TXBL
02100			Z
02110			HRRI	block+1,1(XWAC1)
02120			ST	XWAC1,result(XCB)
02130		FI
02140		SETZ	block,		;! End of io list
02150		EXCH	block,block+1	;! after swap
02160		L	X4,result+1(XCB)
02170		TLO	X4,(IN)
02180		HRRI	X4,block
02190		XCT	X4		;! IN channel,block
02200		GOTO	okin
02210	errout:	SETZM	result(XCB)
02220		SETZM	result+1(XCB)
02230		GOTO	L6
02240	okin:	L	XWAC1,result(XCB)
02250		LF	lng,ZTECLN(XWAC1)
02260		GOTO	L5	;! Go clean up the text
02270	L6():!	AND	X4,[777,,0]
02280		TLO	X4,(CLOSE)
02290		XCT	X4
02300		GOTO	L9
02310		EPROC
02320		LIT
02330		END;