Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

COMMENT * SIMULA specification;
OPTIONS(/E:CODE,tmpout);
BOOLEAN PROCEDURE tmpout(nam,txt);
NAME nam; TEXT nam,txt;
COMMENT Tries to use the TMPCOR UUO to write the core file NAM from TXT.
On failure, a file with name jjjnam.TMP is written instead (jjj is decimal
job number). If that also fails, FALSE is returned, otherwise TRUE.
No carriage return-line feed will be supplied - must be in TXT if needed.
;

!*;! MACRO-10 code !*;!

	TITLE	tmpout
	ENTRY	tmpout
	SUBTTL	SIMULA utility, Lars Enderin Oct 1976, modified version Sep 1977

;!*** Copyright 1977 by the Swedish Defence Research Institute. ***
;!*** Copying is allowed.					***


	sall
	search	simmac,simmcr,simrpa
	macinit

	;! Local definitions ;!

	.TCRWF==3	;! Write code
	result==ZBI%S
	nam==result+1
	txt==nam+2
	nm==XWAC1
	tx==XWAC1
	lng==XWAC5
	block==XWAC6

tmpout:	PROC
	LD	nm,nam(XCB)
	IF	;! No thunk
		JUMPGE	nm,FALSE
	THEN	;! Simple treatment
		ADDI	nm+1,(nm)
		LD	nm,(nm+1)
	ELSE	;! Full treatment
		LI	XWAC1,(XCB)
		HRLI	XWAC1,nam
		XEC	PHFV
		Z
	FI
	LF	X1,ZTVSP(,nm)
	IF	;! Non-zero offset
		JUMPE	X1,FALSE
	THEN	;! Modify
		IDIVI	X1,5
		ADDI	X2,(nm)
	ELSE	;! Standard byte pointer
		LF	X2,ZTVZTE(,nm)
	FI
	ADD	X2,bp(X1)
	LF	lng,ZTVLNG(,nm)
	CAILE	lng,3	;! Max 3 characters
	  LI	lng,3
	SETZ
	LOOP	;! Convert name to SIXBIT
		ILDB	X1,X2
		CAIL	X1,"a"
		SUBI	X1,40
		CAIG	X1,40
		LI	X1,40
		LSH	6
		ADDI	-40(X1)
	AS
		SOJG	lng,TRUE
	SA
	JUMPE	CSEP	;! Blank name, RETURN
	TRNN	77B23	;! Shift 1st non-blank into position
	LSH	6
	TRNN	77B23
	LSH	6
	HRLZM	block	;! XWD nm,0
	LD	tx,txt(XCB)
	LI	XTAC,tx
	XEC	TXST	;! tx:-tx.Strip
	LF	X2,ZTVSP(,tx)
	IF	;! txt not start of main text
		JUMPE	X2,FALSE
	THEN	;! Make Copy
		STACK	block
		XEC	TXCY
		Z
		UNSTK	block
		SETZ	X2,
	FI
	LI	block+1,1(tx)	;! addr(1st text word) - 1
	LF	X1,ZTVLNG(,tx)	;! Number of characters
	IDIVI	X1,5		;! = 5*<number of words>+<number of characters in last word>
	SKIPE	X2
	 ADDI	X1,1
	ADDI	tx,1(X1)	;! Address of last word
	L	tx+1,(tx)	;! Contents of last word
	IF	;! Not full
		JUMPE	X2,FALSE
	THEN	;! Make extra characters null temporarily
		AND	tx+1,nullmask-1(X2)
		EXCH	tx+1,(tx)
	FI
	MOVNI	X1,(X1)		;! -<number of words>
	HRLI	block+1,(X1)	;! IOWD <number of words>,<first text word>
	MOVSI	.TCRWF		;! Code for writing to TMPCOR
	HRRI	block
	TMPCOR
	 GOTO	tmpfil	;! Not enough space, make real file

L9():!	SETOM	result(XCB)
L8():!	EXCH	tx+1,(tx)	;! Restore last text word
	JSP	CSEP		;! RETURN

nullmask:
	BYTE	(7)177,0,0,0,0(1)0
	BYTE	(7)177,177,0,0,0(1)0
	BYTE	(7)177,177,177,0,0(1)0
	BYTE	(7)177,177,177,177,0(1)0

bp:	POINT	7,2
	POINT	7,2,6
	POINT	7,2,13
	POINT	7,2,20
	POINT	7,2,27

tmpfil:	;! Make a real file, output txt in dump mode
	LOWADR
	LI	X1,YIOCHT+17(XLOW)	;! Find a free channel
	LOOP
		SKIPN	(X1)
		 GOTO	L7
	AS
		CAILE	X1,YIOCHT(XLOW)
		 SOJA	X1,TRUE
	SA
	GOTO	L8	;! No free channel
L7():!	SUBI	X1,YIOCHT(XLOW)	;! Channel number
	LSH	X1,^D23		;! into AC position
	STACK	tx+1
	STACK	tx
	STACK	X1
	TLO	X1,(OPEN)	;! OPEN UUO in X1
	HRRI	X1,X3		;! OPEN block in X3-X5
	LI	X3,17		;! Dump mode
	MOVSI	X4,'DSK'	;! Device DSK
	SETZ	X5,		;! No buffers
	XCT	X1		;! OPEN
	 GOTO	[UNSTK X1
		GOTO L6		;! Failed
		]

	;! ENTER block for "jjjnam.TMP[,]" to X0-X3, UUO to X4
	PJOB	X1,		;! Job no (jjj)
	HLLZ	block		;! 'nam',,0
	IDIVI	X1,^D10		;! Form 'jjj' in front of 'nam'
	ADDI	'0'(X2)		;! last digit
	ROT	-6
	IDIVI	X1,^D10
	ADDI	'0'(X2)		;! tens digit
	ROT	-6
	ADDI	'0'(X1)		;! first digit
	ROT	-6		;! Now we have 'jjjnam' in SIXBIT
	MOVSI	X1,'TMP'	;! Extension
	SETZ	X2,		;! Rest of ENTER block
	GETPPN	X3,		;! UFD
	 CAI			;! In case of JACCT
	UNSTK	X4		;! Z channel,
	TLO	X4,(ENTER)	;! ENTER channel,X0
	XCT	X4
	 GOTO	errout

	;! Set up IOWD n,txt contents, followed by zero, for dump output
	;! block+1 already has the right IOWD
	SETZ	block,		;! End of io list
	EXCH	block,block+1	;! after swap
	TLZ	X4,(777B8)
	TLO	X4,(OUT)
	HRRI	X4,block
	XCT	X4		;! OUT channel,block
	 SETOM	result(XCB)	;! Ok result (TRUE)
	;! Close i/o channel
errout:	AND	X4,[777,,0]
	TLO	X4,(CLOSE)
	XCT	X4
L6():!	UNSTK	tx		;! Restore final text word
	UNSTK	(tx)
	JSP	CSEP		;! RETURN
	EPROC
	LIT
	END;