Google
 

Trailing-Edge - PDP-10 Archives - BB-4157E-BM - fortran-ots-debugger/fordum.mac
There are 15 other files named fordum.mac in the archive. Click here to see a list.
	SEARCH	FORPRM
	TV	FORDUM	DUMMY FORERR FOR STAND-ALONE FORLIB ROUTINES,6(2031)

;COPYRIGHT (C) 1981  BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.


COMMENT \

***** Begin Revision History *****

1100	CKS	12-Apr-80
	New

***** End Revision History *****

\

	TWOSEG	400000
	FSRCH
	ENTRY	FORER.

IF10,<
	OPDEF TMSG [OUTSTR]
	OPDEF TCHR [OUTCHR]
>

IF20,<
 DEFINE TMSG (E) <
	HRROI	T1,E
	PSOUT%
 >
 DEFINE TCHR (E) <
  IFN <E-T1>,<
	MOVE	T1,E
  >
	PBOUT%
>>

	SIXBIT	/FORER./
FORER.:	MOVEM	P1,SAVE1	;SAVE P1
	POP	P,ARGBLK	;GET ARG BLOCK POINTER
	POP	P,P1		;GET ARG COUNT
	JUMPLE	P1,ENDARG	;IF AT END OF ARGS, SKIP
	POP	P,(P)		;DISCARD AN ARG
	SOJG	P1,.-1		;DISCARD THEM ALL
ENDARG:	MOVE	P1,ARGBLK	;GET ARG BLOCK POINTER
	PUSH	P,T1		;SAVE T1
	LDB	T1,[POINT 7,(P1),6] ;GET INITIAL CHAR (? OR %)
	TCHR	T1		;TYPE IT
	TMSG	2(P1)		;TYPE ERROR MESSAGE
	TMSG	[ASCIZ /
/]
	HRRZ	T1,1(P1)	;GET CONTINUE ADDRESS
	CAIE	T1,0		;IF PRESENT,
	  MOVEM	T1,-1(P)	;  OVERWRITE RETURN ADDRESS

	MOVE	P1,SAVE1	;RESTORE P1
	POP	P,T1		;RESTORE T1
	POPJ	P,		;RETURN

	RELOC			;DATA
SAVE1:	BLOCK	1
ARGBLK:	BLOCK	1
	RELOC			;END OF DATA

	END