Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-05 - 43,50337/23/tmpout.mac
There are 2 other files named tmpout.mac in the archive. Click here to see a list.
00010	COMMENT * SIMULA specification;
00020	OPTIONS(/E:CODE,tmpout);
00030	BOOLEAN PROCEDURE tmpout(nam,txt);
00040	NAME nam; TEXT nam,txt;
00050	COMMENT Tries to use the TMPCOR UUO to write the core file NAM from TXT.
00060	On failure, a file with name jjjnam.TMP is written instead (jjj is decimal
00070	job number). If that also fails, FALSE is returned, otherwise TRUE.
00080	No carriage return-line feed will be supplied - must be in TXT if needed.
00090	;
00100	
00110	!*;! MACRO-10 code !*;!
00120	
00130		TITLE	tmpout
00140		ENTRY	tmpout
00150		SUBTTL	SIMULA utility, Lars Enderin Oct 1976, modified version Sep 1977
00160	
00170	;!*** Copyright 1977 by the Swedish Defence Research Institute. ***
00180	;!*** Copying is allowed.					***
00190	
00200	
00210		sall
00220		search	simmac,simmcr,simrpa
00230		macinit
00240	
00250		;! Local definitions ;!
00260	
00270		.TCRWF==3	;! Write code
00280		result==ZBI%S
00290		nam==result+1
00300		txt==nam+2
00310		nm==XWAC1
00320		tx==XWAC1
00330		lng==XWAC5
00340		block==XWAC6
00350	
00360	tmpout:	PROC
00370		LD	nm,nam(XCB)
00380		IF	;! No thunk
00390			JUMPGE	nm,FALSE
00400		THEN	;! Simple treatment
00410			ADDI	nm+1,(nm)
00420			LD	nm,(nm+1)
00430		ELSE	;! Full treatment
00440			LI	XWAC1,(XCB)
00450			HRLI	XWAC1,nam
00460			XEC	PHFV
00470			Z
00480		FI
00490		LF	X1,ZTVSP(,nm)
00500		IF	;! Non-zero offset
00510			JUMPE	X1,FALSE
00520		THEN	;! Modify
00530			IDIVI	X1,5
00540			ADDI	X2,(nm)
00550		ELSE	;! Standard byte pointer
00560			LF	X2,ZTVZTE(,nm)
00570		FI
00580		ADD	X2,bp(X1)
00590		LF	lng,ZTVLNG(,nm)
00600		CAILE	lng,3	;! Max 3 characters
00610		  LI	lng,3
00620		SETZ
00630		LOOP	;! Convert name to SIXBIT
00640			ILDB	X1,X2
00650			CAIL	X1,"a"
00660			SUBI	X1,40
00670			CAIG	X1,40
00680			LI	X1,40
00690			LSH	6
00700			ADDI	-40(X1)
00710		AS
00720			SOJG	lng,TRUE
00730		SA
00740		JUMPE	CSEP	;! Blank name, RETURN
00750		TRNN	77B23	;! Shift 1st non-blank into position
00760		LSH	6
00770		TRNN	77B23
00780		LSH	6
00790		HRLZM	block	;! XWD nm,0
00800		LD	tx,txt(XCB)
00810		LI	XTAC,tx
00820		XEC	TXST	;! tx:-tx.Strip
00830		LF	X2,ZTVSP(,tx)
00840		IF	;! txt not start of main text
00850			JUMPE	X2,FALSE
00860		THEN	;! Make Copy
00870			STACK	block
00880			XEC	TXCY
00890			Z
00900			UNSTK	block
00910			SETZ	X2,
00920		FI
00930		LI	block+1,1(tx)	;! addr(1st text word) - 1
00940		LF	X1,ZTVLNG(,tx)	;! Number of characters
00950		IDIVI	X1,5		;! = 5*<number of words>+<number of characters in last word>
00960		SKIPE	X2
00970		 ADDI	X1,1
00980		ADDI	tx,1(X1)	;! Address of last word
00990		L	tx+1,(tx)	;! Contents of last word
01000		IF	;! Not full
01010			JUMPE	X2,FALSE
01020		THEN	;! Make extra characters null temporarily
01030			AND	tx+1,nullmask-1(X2)
01040			EXCH	tx+1,(tx)
01050		FI
01060		MOVNI	X1,(X1)		;! -<number of words>
01070		HRLI	block+1,(X1)	;! IOWD <number of words>,<first text word>
01080		MOVSI	.TCRWF		;! Code for writing to TMPCOR
01090		HRRI	block
01100		TMPCOR
01110		 GOTO	tmpfil	;! Not enough space, make real file
01120	
01130	L9():!	SETOM	result(XCB)
01140	L8():!	EXCH	tx+1,(tx)	;! Restore last text word
01150		JSP	CSEP		;! RETURN
01160	
01170	nullmask:
01180		BYTE	(7)177,0,0,0,0(1)0
01190		BYTE	(7)177,177,0,0,0(1)0
01200		BYTE	(7)177,177,177,0,0(1)0
01210		BYTE	(7)177,177,177,177,0(1)0
01220	
01230	bp:	POINT	7,2
01240		POINT	7,2,6
01250		POINT	7,2,13
01260		POINT	7,2,20
01270		POINT	7,2,27
01280	
01290	tmpfil:	;! Make a real file, output txt in dump mode
01300		LOWADR
01310		LI	X1,YIOCHT+17(XLOW)	;! Find a free channel
01320		LOOP
01330			SKIPN	(X1)
01340			 GOTO	L7
01350		AS
01360			CAILE	X1,YIOCHT(XLOW)
01370			 SOJA	X1,TRUE
01380		SA
01390		GOTO	L8	;! No free channel
01400	L7():!	SUBI	X1,YIOCHT(XLOW)	;! Channel number
01410		LSH	X1,^D23		;! into AC position
01420		STACK	tx+1
01430		STACK	tx
01440		STACK	X1
01450		TLO	X1,(OPEN)	;! OPEN UUO in X1
01460		HRRI	X1,X3		;! OPEN block in X3-X5
01470		LI	X3,17		;! Dump mode
01480		MOVSI	X4,'DSK'	;! Device DSK
01490		SETZ	X5,		;! No buffers
01500		XCT	X1		;! OPEN
01510		 GOTO	[UNSTK X1
01520			GOTO L6]	;! Failed
01530	
01540		;! ENTER block for "jjjnam.TMP[,]" to X0-X3, UUO to X4
01550		PJOB	X1,		;! Job no (jjj)
01560		HLLZ	block		;! 'nam',,0
01570		IDIVI	X1,^D10		;! Form 'jjj' in front of 'nam'
01580		ADDI	'0'(X2)		;! last digit
01590		ROT	-6
01600		IDIVI	X1,^D10
01610		ADDI	'0'(X2)		;! tens digit
01620		ROT	-6
01630		ADDI	'0'(X1)		;! first digit
01640		ROT	-6		;! Now we have 'jjjnam' in SIXBIT
01650		MOVSI	X1,'TMP'	;! Extension
01660		SETZ	X2,		;! Rest of ENTER block
01665		GETPPN	X3,		;! UFD
01667		 CAI			;! In case of JACCT
01670		UNSTK	X4		;! Z channel,
01680		TLO	X4,(ENTER)	;! ENTER channel,X0
01690		XCT	X4
01700		 GOTO	errout
01710	
01720		;! Set up IOWD n,txt contents, followed by zero, for dump output
01730		;! block+1 already has the right IOWD
01740		SETZ	block,		;! End of io list
01750		EXCH	block,block+1	;! after swap
01760		TLZ	X4,(777B8)
01770		TLO	X4,(OUT)
01780		HRRI	X4,block
01790		XCT	X4		;! OUT channel,block
01800		 SETOM	result(XCB)	;! Ok result (TRUE)
01810		;! Close i/o channel
01820	errout:	AND	X4,[777,,0]
01830		TLO	X4,(CLOSE)
01840		XCT	X4
01850	L6():!	UNSTK	tx		;! Restore final text word
01860		UNSTK	(tx)
01870		JSP	CSEP		;! RETURN
01880		EPROC
01890		LIT
01900		END;