PDP-10 Archive: 43,50520/forlib.cfc from decuslib10-10

Trailing-Edge - PDP-10 Archives - decuslib10-10 - 43,50520/forlib.cfc
There are 2 other files named forlib.cfc in the archive. Click here to see a list.
File 1)	DSKB:FORCNV.MAC[10,6]	created: 1541 10-JULY-1975
File 2)	TAPE:FORCNV.MAC	created: 0000 19-MAY-1976

1)1		TITLE	FORCNV	%4B(445)	CONVERSION ROUTINES
1)		SUBTTL	REVISION HISTORY
****
2)1		TITLE	FORCNV	%4C(476)	CONVERSION ROUTINES
2)		SUBTTL	REVISION HISTORY
**************
1)1		PRGEND
****
2)1	;465	17142	FIX NMLST% TO INPUT STRINGS INTO DOUBLE PRECISION AND
2)	;		COMPLEX VARIABLES CORRECTLY.
2)	;476	17725	FIX G FORMAT WHEN FIELD TOO SMALL UNLESS 4X REMOVED.
2)	;**************** END OF REVISION HISTORY
2)		PRGEND
**************
1)6		SOJA	W,GETNXT	;RETURN FOR NEXT CHAR.
1)	XCTTAB:	JRST	ILLCH		; (00) ILLEGAL CHAR
****
2)6	; GOTST+9	S.M. #485.6	RRB/ 12-16-75
2)	GETCH3:	SOJA	W,GETNXT	;RETURN FOR NEXT CHAR.
2)	XCTTAB:	JRST	ILLCH		; (00) ILLEGAL CHAR
**************
1)8		ERROR	(DAT,7,7,GETCH2);ILLEGAL CHARACTER IN INPUT
1)	ERROR1:	JSP	P1,IBYTE.	;GET NEXT CHAR
****
2)8	; ERROR0+3	S.M. #485.6	RRB/ 12-16-75
2)		ERROR	(DAT,7,7,GETCH3);ILLEGAL CHARACTER IN INPUT
2)	ERROR1:	JSP	P1,IBYTE.	;GET NEXT CHAR
**************
1)13		TITLE	FLOUT%	%4.(377) 	FLOATING POINT OUTPUT
1)		SUBTTL	D. NIXON AND T. W. EGGERS
1)		SUBTTL	D. TODD /DMN/DRT/HPW/MD		15-SEP-74
1)	;***COPYRIGHT 1972,1973,1974,1975 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.***
****
2)13		TITLE	FLOUT%	%4C.(476) 	FLOATING POINT OUTPUT
2)		SUBTTL	D. NIXON AND T. W. EGGERS
2)		SUBTTL	D. TODD /DMN/DRT/HPW/MD/JNG	22-NOV-75
2)	;***COPYRIGHT 1972,1973,1974,1975 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.***
**************
1)17		ADDI	C,3		;REMOVE 4 TRAILING SPACES
1)		JRST	TRYFIT		;AND TRY AGAIN
****
2)17	;**;[476] CHANGE TRYFI0+3L	JNG	22-NOV-75
2)		ADDI	C,4		;REMOVE 4 TRAILING SPACES
2)		JRST	TRYFIT		;AND TRY AGAIN
**************
1)22		SOJA	T3,INTI1	;YES, DO NOT ACCUMULATE THE SUM
1)	INTI1A:	ANDI	T0,17		;MAKE A BINARY NUMBER
****
2)22	; INTI1B+5	S.M. #485.6	RRB/ 12-16-75
2)	INTI1C:	SOJA	T3,INTI1	;YES, DO NOT ACCUMULATE THE SUM
2)	INTI1A:	ANDI	T0,17		;MAKE A BINARY NUMBER
**************
1)22		ERROR	(DAT,7,7,INTI1B);ILLEGAL CHARACTER IN INPUT
1)	INTI5:	TLNN	P3,IO.TTY	;IS THIS A TELETYPE
****
2)22	; INTI4+2	S.M. #485.6	RRB/ 12-16-75
File 1)	DSKB:FORCNV.MAC[10,6]	created: 1541 10-JULY-1975
File 2)	TAPE:FORCNV.MAC	created: 0000 19-MAY-1976

2)		ERROR	(DAT,7,7,INTI1C);ILLEGAL CHARACTER IN INPUT
2)	INTI5:	TLNN	P3,IO.TTY	;IS THIS A TELETYPE
**************
1)24	LINT2:	ERROR	(DAT,7,7,LINT0)	;ILLEGAL CHARACTER IN INPUT
1)	LINT3:	POPJ	P,	;RETURN
****
2)24	; LINT2		S.M. #485.6	RRB/ 12-16-75
2)	LINT2:	ERROR	(DAT,7,7,LINT1)	;ILLEGAL CHARACTER IN INPUT
2)	LINT3:	POPJ	P,	;RETURN
**************
1)25		SOJA	T3,OCTI1	;RETURN FOR NEXT CHARACTER
1)	OCTI2:	TLNE	P3,IO.EOL	;IS THIS THE END OF LINE
****
2)25	;OCTI1A+3	S.M. #485.6	RRB/ 12-16-75
2)	OCTI1C:	SOJA	T3,OCTI1	;RETURN FOR NEXT CHARACTER
2)	OCTI2:	TLNE	P3,IO.EOL	;IS THIS THE END OF LINE
**************
1)25		ERROR	(DAT,7,7,OCTI1B)	;ILLEGAL CHARACTER IN INPUT
1)	OCTI4:	TLNN	P3,IO.TTY	;IS THIS A TTY
****
2)25	; OCTI3+2	S.M. #485.6	RRB/ 12-16-75
2)		ERROR	(DAT,7,7,OCTI1C)	;ILLEGAL CHARACTER IN INPUT
2)	OCTI4:	TLNN	P3,IO.TTY	;IS THIS A TTY
**************
1)25		ADDI	T0,"0"		;CONVERT TO ASCII
1)		JSP	P1,OBYTE.	;OUTPUT A DIGIT
****
2)25	; OCTO2+4	S.M. #485.5	RRB/ 12-16-75
2)		JUMPL	T2,OCTO2A	;HAVE WE SEEN ANY DIGITS BEFORE?
2)		TLNE	T5,770000	;DON'T SUPPRESS THE WHOLE THING!
2)		CAIE	T0,0		;NO, IS THIS ONE?
2)		TLOA	T2,400000	;YES. MARK IT AND OUTPUT IT
2)		MOVNI	T0,20		;NO. LEADING BLANK
2)	OCTO2A:	ADDI	T0,"0"		;CONVERT TO ASCII
2)		JSP	P1,OBYTE.	;OUTPUT A DIGIT
**************
1)29	NLID:	TLO	P2,FT.PRC	;SET DOUBLE PRECISION
1)	NLIF:	PUSHJ	P,NLISCN	;FIND SOME DATA
1)		TLNE	P2,FT.NUL	;[366] NULL ITEM
****
2)29	;**;[465] CHANGE @ NLID JNG	11-NOV-75
2)	NLID:	TLOA	P2,FT.PRC	;[465] SET DOUBLE PRECISION
2)	NLIF:	TLZ	P2,FT.PRC	;[465] SET SINGLE PRECISION
2)		PUSHJ	P,NLISCN	;FIND SOME DATA
2)		TLNE	P2,FT.NUL	;[366] NULL ITEM
**************
1)29	NLIS0::MOVSI	T1,(POINT 7,(G1));ASCII BYTE POINTER
1)		MOVE	T0,[ASCII /     /];SET THE OUTPUT TO BLANKS FOR COMPARE
1)		MOVEM	T0,(G1)		;CLEAR THE OUTPUT WORD
1)	NLIS1:	JSP	P1,IBYTE.##	;GET A CHARACTER
1)		CAIE	T0,"'"		;CHECK FOR THE END OF STRING
1)		TLNE	P3,IO.EOL	;OR END OF LINE
1)		POPJ	P,		;RETURN END OF STRING
1)		IDPB	T0,T1		;NO, STORE THE CHARACTER
1)		TLNE	T1,760000	;END OF A WORD
1)		JRST	NLIS1		;NO CONTINUE
File 1)	DSKB:FORCNV.MAC[10,6]	created: 1541 10-JULY-1975
File 2)	TAPE:FORCNV.MAC	created: 0000 19-MAY-1976

1)		AOBJN	G1,NLIS0	;END OF ARRAY
****
2)29	;**;[465] CHANGE @ NLIS0	JNG	6-NOV-75
2)	NLIS0::MOVSI	T1,(POINT 7,)	;[465] ASCII BYTE POINTER
2)		HRRI	T1,(G1)		;[465] TO OUR OUTPUT DATA WORD
2)		MOVE	T0,[ASCII /     /];SET THE OUTPUT TO BLANKS FOR COMPARE
2)		MOVEM	T0,(G1)		;CLEAR THE OUTPUT WORD
2)		PUSH	P,[5]		;[465] SAVE CHAR COUNT TILL WORD FILLS
2)		JUMPSP	NLIS1		;[465] MORE FIXING NEEDED IF D.P.
2)		MOVEM	T0,1(G1)	;[465] CLEAR 2ND HALF WORD
2)		MOVEI	T0,^D10		;[465] RESET COUNT TO 10 CHARS
2)		MOVEM	T0,(P)		;[465] SO CAN INPUT D.P. STRING
2)		AOBJN	G1,.+1		;[465] ADVANCE G1 CORRECTLY FOR EXIT
2)	NLIS1:	JSP	P1,IBYTE.##	;GET A CHARACTER
2)		CAIE	T0,"'"		;CHECK FOR THE END OF STRING
2)		TLNE	P3,IO.EOL	;OR END OF LINE
2)	;**;[465] CHANGE @ NLIS1+3L	JNG	6-NOV-75
2)		JRST	[POP	P,(P)	;[465] REMOVE JUNK FORM STACK
2)			 POPJ	P,]	;[465] RETURN END OF STRING
2)		IDPB	T0,T1		;NO, STORE THE CHARACTER
2)		SOSLE	(P)		;[465] END OF VARIABLE?
2)		JRST	NLIS1		;NO CONTINUE
2)		POP	P,(P)		;[465] CLEAR JUNK FROM STACK
2)		AOBJN	G1,NLIS0	;END OF ARRAY
**************
1)29	NLINA2:	TRC	T0,140		;CONVERT THE ASCII
1)		TRNN	T0,140		;CHARACTER TO A SIXIT
1)		IORI	T0,40		;CHARACTER (CORRECT THE CASE)
1)		ANDI	T0,77		;SAVE ONLY 6 BITS
1)		LSH	T1,6		;STORE IT T1
1)		IOR	T1,T0		;INSET THE CHARACTER
1)		JUMPGE	T1,NLINA1	;CONTINUE FOR SIX CHARACTERS
****
2)29	; NLINA2+0[461]	S.M. #485.17	RRB/ 12-29-75
2)	NLINA2:	MOVE	T2,T0		;[461] USE T2, KEEP TO ASCII
2)		TRC	T2,140		;[461] CONVERT THE ASCII
2)		TRNN	T2,140		;[461] CHARACTER TO A SIXBIT
2)		IORI	T2,40		;[461] CHARACTER (CORRECT THE CASE)
2)		ANDI	T2,77		;[461] SAVE ONLY 6 BITS
2)		LSH	T1,6		;STORE IT T1
2)		IOR	T1,T2		;[461] INSERT THE CHARACTER
2)		JUMPGE	T1,NLINA1	;CONTINUE FOR SIX CHARACTERS
**************
1)29			JUMPL	G1,NLISCN	;ANYTHING LEFT
1)			SUB	P,[XWD 1,1]	;REDUDE THE STACK FOR THE RETURN
****
2)29	;**;[465] CHANGE @ LSDSCN+14L	JNG	6-NOV-75
2)			AOBJN	G1,NLISCN	;[465] ANYTHING LEFT
2)			SUB	P,[XWD 1,1]	;REDUDE THE STACK FOR THE RETURN
**************



File 1)	DSKB:FORDAR.MAC[10,6]	created: 1220 09-SEPT-1974
File 2)	TAPE:FORDAR.MAC	created: 0000 18-DEC-1975

1)1	IF1,<
****
2)1	;EDIT	SPR	WHAT
2)	;466	17152	FIX SNG.X FOR NEGATIVE NUMBERS NEAR POWERS OF TWO
2)	IF1,<
**************
1)3		JUMPG	X,.+3		;JUMP POSITIVE
1)		JUMPE	X+1,SNG2	;EXIT IF ZERO
1)		SUBI	X+1,1		;SPECIAL CASE FOR NUM=1B1
1)		TLNN	X+1,(1B1)	;ROUNDING NEEDED
1)		JRST	SNG2		;NO, RETURN
1)		CAME	X,[377777,,-1]	;YES, WILL NUMBER OVERFLOW
1)		AOSA	X		;NO, ROUND THE HIGH ORDER WORD
1)		FSC	X,1		;YES, FORCE A FLOATING OVERFLOW MESSAGE
1)		JUMPL	X,SNG2		;IS THE NUMBER POSITIVE
1)		TLO	X,400		;YES, FORCE MOST SIGNIFICANT FRACTION BIT ON
1)	>
****
2)3	;SNG.'X:	S.M. #485.17 SPR#17902[466]	RRB/ 12-18-75
2)		JUMPL	X,SNG3		;NEGATIVE ARGUMENT?
2)		TLNE	X+1,(1B1)	;POSITIVE. ROUND REQUIRED?
2)		TRON	X,1		;YES, TRY TO ROUND BY SETTING LSB
2)		JRST	SNG2		;WE WON,FINISHED
2)		MOVE	X+1,X		;COPY HIGH PART OF ARG
2)		AND	X,[777000,,1]	;MAKE UNNORMALIZED LSB, SAME EXPONENT
2)		FADR	X,X+1		;ROUND & RENORMALIZE
2)		GOODBY
2)	;HERE IF ARG IS NEGATIVE
2)	SNG3:	DMOVN	X,X		;MAKE POSITIVE
2)		TLNE	X+1,(1B1)	;NEED ROUNDING?
2)		TRON	X,1		;YES, TRY TO DO IT BY SETTING LSB
2)		JRST	SNG4		;DONE
2)		MOVN	X+1,X		;MAKE RE-NEGATED COPY OF HIGH PART
2)		ORCA	X,[777,,-1]	;GET UNNORM NEG LSB WITH SAME EXPONENT
2)		FADR	X,X+1		;ROUND AND NORMALIZE
2)		GOODBY
2)	SNG4:	MOVN	X,X		;RE-NEGATE
2)	>
**************



File 1)	DSKB:FORDBL.MAC[10,6]	created: 1218 09-SEPT-1974
File 2)	TAPE:FORDBL.MAC	created: 0000 11-JUNE-1976

1)14	TITLE	DATAN.	%4.(356) SINGLE ARGUMENT DOUBLE PRECISION ARC TANGENT
1)	SUBTTL	D. TODD /DRT/HPW/MD		12-AUG-74
1)	;***COPYRIGHT 1972,1973 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.***
1)	;THIS ROUTINE CALCULATES THE ACTANGENT OF A DOUBLE PRECISION
****
2)13	TITLE	DATAN.	%4C.(513) SINGLE ARGUMENT DOUBLE PRECISION ARC TANGENT
2)	SUBTTL	D. TODD /DRT/HPW/MD		15-DEC-75
2)	;***COPYRIGHT 1972,1973,1974,1975 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.***
2)	;THIS ROUTINE CALCULATES THE ACTANGENT OF A DOUBLE PRECISION
**************
1)14		;BIT34=1,ADD -PI/2 TO ANSWER
1)		;BIT0=1, NEGATE FINAL ANSWER
****
2)13		;BIT34=1, ADD 2*ATAN(1/2) TO ANSWER	;[513]
2)		;BIT17=1,ADD -PI/2 TO ANSWER		;[513]
2)		;BIT0=1, NEGATE FINAL ANSWER
**************
1)14		SKIPGE	A		;IS THE ARGUMENT POSITIVE?
****
2)13	;**;[513] INSERT @ DATAN.+7L	JNG	15-DEC-75
2)		TLZ	G,377777	;[513] ZAP ALL BUT SIGN FOR FLAGS
2)		SKIPGE	A		;IS THE ARGUMENT POSITIVE?
**************
1)14		TRO	G,2		;ADD -PI/2 TO FINAL ANSWER
1)		FLDIV	D,A
****
2)13	;**;[513] CHANGE @ DATAN.+17L	JNG	15-DEC-75
2)		TLO	G,1		;[513] ADD -PI/2 TO FINAL ANSWER
2)		FLDIV	D,A
**************
1)14		DMOVEM	A,DX
1)		TRO	G,1		;SET FLAG TO LATER ADD ATAN(1/2)
1)	DATAN1:	MOVM	D,A		;GET MOD(X)
****
2)13	;**;[513] REPLACE @ DATAN0+14L	JNG	15-DEC-75
2)		AOJA	G,DATAN0	;[513] TRY AGAIN IN CASE STILL TOO BIG
2)	DATAN1:	MOVM	D,A		;GET MOD(X)
**************
1)14	IFE CPU-KA10,<TRNN	G,1		;ADD ATAN(1/2)?
1)		JRST	DATAN4		;NO
1)	FLADD A,ATANH
1)	DATAN4:	TRNN	G,2		;ADD -PI/2?
1)		JRST	DATAN5		;NO
1)	FLADD A,MPIOT
1)	DATAN5: >
1)	IFE CPU-KI10,<TRNE	G,1
1)		DFAD	A,ATANH
1)		TRNE	G,2
1)		DFAD	A,MPIOT >
****
2)13	;**;[513] CHANGE @ DATAN3+1L	JNG	15-DEC-75
2)	IFE CPU-KA10,<TRNN	G,-1		;[513] ADD ATAN(1/2)?
2)		JRST	DATAN4		;[513] NO
2)	FLADD A,ATANH
2)		SOJA	G,DATAN3	;[513] TRY AGAIN IN CASE NEED TO ADD
2)					;[513] ATAN(1/2) TWICE?
File 1)	DSKB:FORDBL.MAC[10,6]	created: 1218 09-SEPT-1974
File 2)	TAPE:FORDBL.MAC	created: 0000 11-JUNE-1976

2)	DATAN4:	TRNN	G,1		;[513] ADD -PI/2?
2)		JRST	DATAN5		;NO
2)	FLADD A,MPIOT
2)	>
2)	DATAN5:
2)	IFE CPU-KI10,<TRNN	G,-1	;[513] NEED TO ADD ATAN(1/2)?
2)		JRST	DATAN7		;[513] NO, PROCEED
2)		DFAD	A,ATANH
2)		SOJA	G,DATAN5	;[513] MAKE SURE ALL DONE
2)	DATAN7:	TLNE	G,1		;[513] NEED TO ADD -PI/2?
2)		DFAD	A,MPIOT >
**************



File 1)	DSKB:FORDMP.MAC[10,6]	created: 1209 09-SEPT-1974
File 2)	TAPE:FORDMP.MAC	created: 0000 25-APR-1977

1)3		PUSH	P,L		;SAVE THE LINK OVER THE I/O CALLS
****
2)1		SUB	L,[XWD	1,0]	;SUB 1 FROM ARG COUNT
2)		PUSH	P,L		;SAVE THE LINK OVER THE I/O CALLS
**************
1)3		MOVEI	L,[XWD 3000,DEVICE
1)			XWD	0,0
1)			XWD	400006,MESS2]
1)		PUSHJ	P,OUT.##
1)		CLEARB	S, I		;AC0-AC7, SET INDICATOR TO ZERO
1)		MOVEI	L,[XWD 001000,S
1)			XWD	0,0]	;OUTPUT IT
1)		PUSHJ	P,IOLST.##
1)		CAIGE	S, 7		;WHICH CONTAINS 0,1,2,3,4,5,6,7
1)		AOJA	S, .-2		;LOOP BACK UNTIL DONE
1)		MOVEI	F, 1-N(P)	;GET CONTENTS OF AC0-AC7 OFF PD
1)		MOVEI	L,[XWD 001000,(F)
1)			XWD	0,0]	;OUTPUT IT
1)		PUSHJ	P,IOLST.##
1)		CAIGE	F, 1-N+7(P)	;LOOP FOR 8 ACCUMULATORS
1)		AOJA	F, .-2
1)		MOVEI	S, 10		;PRINT AC10 - AC17
1)		MOVEI	L,[XWD 001000,S
1)			XWD	0,0]	;OUTPUT IT
1)		PUSHJ	P,IOLST.##
1)		CAIGE	S, 17		;LOOP FOR 8 ACS
1)		AOJA	S, .-2
1)		MOVEI	S,-N(P)		;GET THE BLT ACC ADDR
****
2)1		MOVEI	L,[XWD	3000,DEVICE
2)			XWD	0,0
2)			XWD	400012,MESS2]
2)		PUSHJ	P,OUT.##
2)		CLEARB	S,I
2)		MOVEI	F, 1-N(P)	;GET CONTENTS OF AC0-AC7 OFF PD
2)		MOVEI	L,[XWD 001000,(F)
2)			XWD	0,0]	;OUTPUT IT
2)		PUSHJ	P,IOLST.##
2)		CAIGE	F, 1-N+7(P)	;LOOP FOR 8 ACCUMULATORS
2)		AOJA	F, .-2
2)		MOVEI	S,-N(P)		;GET THE BLT ACC ADDR
**************
1)4	SCHEK:	CAML	S, F		;ARE ARGUMENTS IN ORDER?
1)		EXCH	S, F		;NO, SWITCH THEM
****
2)1	SCHEK:	PUSH	P,S		;SAVE S
2)		PUSH	P,L		;SAVE THE LINK
2)		MOVEI	L,[XWD	3000,DEVICE
2)			XWD	0,0
2)			XWD	400006,MESS5]
2)		PUSHJ	P,OUT.##
2)		MOVEI	L,[XWD	1000,S
2)			XWD	0,0]
2)		MOVE	S,[ASCII "OCTALFLOATINTEGASCIIDOUBL"](C)
2)	;		GET FIRST PART OF MODE
2)		PUSHJ	P,IOLST.##	;OUTPUT IT
File 1)	DSKB:FORDMP.MAC[10,6]	created: 1209 09-SEPT-1974
File 2)	TAPE:FORDMP.MAC	created: 0000 25-APR-1977

2)		MOVE	S,[ASCII "     ING  ER        E PR."](C)
2)	;		GET SECOND PART OF MODE
2)		PUSHJ	P,IOLST.##	;OUTPUT IT
2)		PUSHJ	P,FIN.##
2)		POP	P,L		;RESTORE LINK
2)		POP	P,S		;RESTORE S
2)		CAML	S, F		;ARE ARGUMENTS IN ORDER?
2)		EXCH	S, F		;NO, SWITCH THEM
**************
1)7	MESS1:	ASCII	"(1H148X9HCORE DUMP/1H 7HOV FLAG17X9HCRY0"
1)		ASCII	" FLAG15X9HCRY1 FLAG15X14HPC CHANGE FLAG9"
1)		ASCII	"X8HBIS FLAG/1H 5(A9,15X))"
1)	MESS2:	ASCII	"(2(1H-8(9X3HAC O2)/7X8O14/))"
1)	MESS3:	ASCII	"(1H-)"
1)	MESS4:	ASCII	"(11H+LOCATIONS O6,9H THROUGH O6,9H CONTAIN /1H )"
1)8	;MORE FORMAT STATEMENTS AND SOME CONSTANTS, TOO
1)	OFRMT:	ASCII	"(1H0,O6,8O14)"
1)	EFRMT:	ASCII	"(1H0,O6,8G14.5)"
1)	IFRMT:	ASCII	"(1H0,O6,8I14)"
1)	AFRMT:	ASCII	"(1H0,O6,8A14)"
1)	DFRMT:	ASCII	"(1H0,O6,4G25.16)"
1)	OFRMT2:	ASCII   "(1H0,40X,O14)"
****
2)1	MESS1:	ASCII	"(1H148X9HCORE DUMP//'-OV FLAG - ',A3,11X"
2)		ASCII	"12HCRY0 FLAG - A3,9X,12HCRY1 FLAG - A3,9"
2)		ASCII	"X17HPC CHANGE FLAG - A3,4X11HBIS FLAG - A3)"
2)	MESS2:	ASCII	"('-AC0-AC7/  ',8(O14),/'-AC10-AC17/',8(O14))"
2)	MESS3:	ASCII	"(1H-)"
2)	MESS4:	ASCII	"(11H+LOCATIONS O6,9H THROUGH O6,9H CONTAIN /1H )"
2)	MESS5:	ASCII	"('-MODE = ',2A5)"
2)	;MORE FORMAT STATEMENTS AND SOME CONSTANTS, TOO
2)	OFRMT:	ASCII	"(1H0,O6,'/',8O14)"
2)	EFRMT:	ASCII	"(1H0,O6,'/',8G14.5)"
2)	IFRMT:	ASCII	"(1H0,O6,'/',8I14)"
2)	AFRMT:	ASCII	"(1H0,O6,'/',8A14)"
2)	DFRMT:	ASCII	"(1H0,O6,'/',4G25.16)"
2)	OFRMT2:	ASCII   "(1H0,40X,O14)"
**************



File 1)	DSKB:FORERR.MAC[10,6]	created: 1520 10-JULY-1975
File 2)	TAPE:FORERR.MAC	created: 0000 19-MAY-1976

1)1	;447	16733	FIX ER%DEV TO PUT END= AND ERR= ADDR'S IN USR.PC SO
1)	;		EOF TAKES AFFECT IMMEDIATELY AND NO IO VARIABLES GET
1)	;		CLEARED
1)	;450	-----	FIX EDIT 424 IN ER%DA1 TO CHECK P3 NOT P2 FOR IO.FMT
****
2)1	;450	-----	FIX EDIT 424 IN ER%DA1 TO CHECK P3 NOT P2 FOR IO.FMT
**************
1)11		MOVE	T5,DATTAB(T5)	;GET THE DISPATCH ENTRY
1)		TLNE	T5,ER.HDR	;TYPE A HEADER
****
2)11	; ER%DAT+5	S.M. #485.6	RRB/ 12-17-75
2)		CAIN	T5,7		;ILLEGAL CHARACTER?
2)		JRST	ER%DA2		;YES
2)	ER%DA0:	MOVE	T5,DATTAB(T5)	;GET THE DISPATCH ENTRY
2)		TLNE	T5,ER.HDR	;TYPE A HEADER
**************
1)11		TLNE	P2,IO.FMT	;[424] IS IT FORMATTED I/O
1)		OUTSTR	[ASCIZ /:  /]	;[424] SO RECORD NO. LOOKS NICE
1)		MOVE	T0,DD.LIM(P3)	;[330] GET RECORD NUMBER
1)		PUSHJ	P,TY%DEC	;[330] TYPE IT
1)		PJRST	TY%DDB		;[330] TYPE DDB INFO.
1)	DATTAB:
****
2)11	; ER%DA1+12	S.M. #485.17	RRB/ 12-17-75
2)		TLNE	P3,IO.FMT	;[424] IS IT FORMATTED I/O
2)		OUTSTR	[ASCIZ /:  /]	;[424] SO RECORD NO. LOOKS NICE
2)		MOVE	T0,DD.LIM(P3)	;[330] GET RECORD NUMBER
2)		PUSHJ	P,TY%DEC	;[330] TYPE IT
2)		PJRST	TY%DDB		;[330] TYPE DDB INFO.
2)	ER%DA2:	HLRZ	T1,ERR.PC(P4)	;USER GIVE ERR=?
2)		JUMPE	T1,ER%DA0	;NO. PROCEED NORMALLY
2)		JSP	P1,IBYTE.##	;GET A CHARACTER
2)		TLNN	P3,IO.EOL!IO.EOF ;AT END?
2)		JRST	.-2		;NO
2)		JRST	ERDEV4		;TREAT LIKE DEVICE ERROR
2)	DATTAB:
**************
1)12	DAT7E:	HRRZI	T3,1(T1)	;[414] [277]
1)					;NO, START PRINTING AT THE BEGINNING OF THE BUFFER
1)		TLNN	T3,-1		;[414] BYTE SIZE SET FROM POS.TB ?
1)		TLO	T3,(POINT 7,0,35);[414] NO - SET UP THE BYTE SIZE
1)		SETZ	T2,		;COUNT THE COLUMNS
1)	DAT7B:	ILDB	T0,T3		;GET A CHARACTER
1)		OUTCHR	T0		;TYPE IT
1)		CAME	T3,DD.HRI+1(P3)	;IS THIS THE CHARACTR
1)		JRST	DAT7C		;NO
1)		PUSH	P,T2		;SAVE THE POSITION
1)		MOVN	T2,DD.HRI+2(P3)	;GET THE REMAINING CHARACTER COUNT
1)		SUBI	T2,1		;[277] TO GET ALL CHARS IN CASE OF ENC/DEC
1)	DAT7C:	CAIE	T0,12		;IS THIS A LINE FEED
1)		AOJN	T2,DAT7B	;END OF BUFFER OR LINE FEED
****
2)12	; DATEG+10	S.M. #485.17	RRB/ 12-17-75
2)		 JRST	DAT7E		;NOT IN THIS BUFFER. START AT BEGINNING
2)		HRRZ	T4,DD.HRI+1(P3)	;GET ADR OF WORD WITH BAD CHARACTER
2)		CAILE	T4,(T3)		;IS IT GREATER THAT INITIAL POINTER?
File 1)	DSKB:FORERR.MAC[10,6]	created: 1520 10-JULY-1975
File 2)	TAPE:FORERR.MAC	created: 0000 19-MAY-1976

2)		 JRST	DAT7E1		;YES. ILDB WILL REACH CURRENT POINTER
2)		CAIN	T4,(T3)		;NO. IS IT EQUAL CURRENT POINTER?
2)		TLNN	T3,760000	;YES. IS INITIAL POINTER TO REAL ADDRESS?
2)		 JRST	DAT7E		;NO. ILDB WOULD BE PAST CURRENT POINTER
2)		CAMG	T3,DD.HRI+1(P3)	;YES. IS IT TO EARLIER BYTE THAN CURRENT?
2)	DAT7E:	MOVEI	T3,1(T1)	;[277]
2)					;NO, START PRINTING AT THE BEGINNING OF THE BUFFER
2)	DAT7E1:	TLNN	T3,-1		;[414] BYTE SIZE SET FROM POS.TB ?
2)		TLO	T3,(POINT 7,0,35);SET UP THE BYTE SIZE
2)	; DAT7B-1	S.M. #485.13	NDG/ 6-19-75
2)		SETZB	T1,T2		;COUNT THE COLUMNS, SET CHAR NOT REACHED
2)	DAT7B:	ILDB	T0,T3		;GET A CHARACTER
2)		OUTCHR	T0		;TYPE IT
2)		CAME	T3,DD.HRI+1(P3)	;IS THIS THE CHARACTR
2)		JRST	DAT7C		;NO
2)		PUSH	P,T2		;SAVE THE POSITION
2)		MOVN	T2,DD.HRI+2(P3)	;GET THE REMAINING CHARACTER COUNT
2)		SUBI	T2,1		;[277] TO GET ALL CHARS IN CASE OF ENC/DEC
2)	; DAT7C-1	S.M. #485.13	NDG/ 6-19-75
2)		SETO	T1,		;SET ILL CHAR REACHED
2)	DAT7C:	JUMPN	T1,DAT7C1	;IF ILL CHAR REACHED, LF TERMINATES
2)		CAIN	T0,12		;ELSE LF CLEARS POSITION COUNT
2)		SETO	T2,		;START AT MINUS ONE, SO AOJ GIVES ZERO
2)		AOJA	T2,DAT7B	;COUNT CHARACTER
2)	DAT7C1:	CAIE	T0,12		;IS THIS A LINE FEED
2)		AOJN	T2,DAT7B	;END OF BUFFER OR LINE FEED
**************
1)13	ERDEV4:	MOVEM	T1,USR.PC(P4)	;[225][447] CHANGE THE USR'S PC ADDRESS
1)		POPJ	P,		;[211] RETURN
****
2)13	ERDEV4:	MOVEM	T1,ALT.PC(P4)	;[225] CHANGE THE USR'S PC ADDRESS
2)		POPJ	P,		;[211] RETURN
**************
1)13		XWD	,[FIVBIT (Block too large or quota exceeded)]	;(3)
1)		XWD	,[FIVBIT (End of file)]				;(4)
****
2)13		XWD	,[FIVBIT (Block too large or quota exceeded or file structure full)]	;(3)
2)		XWD	,[FIVBIT (End of file)]				;(4)
**************



File 1)	DSKB:FORFUN.MAC[10,6]	created: 1545 10-JULY-1975
File 2)	TAPE:FORFUN.MAC	created: 0000 20-APR-1977

1)1		TITLE	FORFUN	%4.(446) - OVERLAY FUNCTION MODULE FOR FOROTS
1)		SUBTTL	H. P. WEISS/HPW/DMN/MD/DPL		7-JUL-75
1)	;***COPYRIGHT 1973,1974,1975, DIGITAL EQUIPMENT CORP., MAYNARD, MASS.***
1)	VERWHO==0	;EDITOR
1)	VERVER==4	;MAJOR VERSION NUMBER
1)	VERUPD==0	;MINOR VERSION NUMBER
1)	VEREDT==446	;EDIT NUMBER
1)	VERFUN==BYTE (3)VERWHO(9)VERVER(6)VERUPD(18)VEREDT
1)	PURGE	VERWHO,VERVER,VERUPD,VEREDT
1)2		SUBTTL	REVISION HISTORY
1)	;446	15993	FIX CBC FUNCTION SO IT WILL CUT BACK CORE PROPERLY
1)	;		FOR LINK OVERLAY'S
1)	;
****
2)1		TITLE	FORFUN	%4C.(477) - OVERLAY FUNCTION MODULE FOR FOROTS
2)		SUBTTL	H. P. WEISS/HPW/DMN/MD/DPL/JNG	22-NOV-75
2)	;***COPYRIGHT 1973,1974,1975, DIGITAL EQUIPMENT CORP., MAYNARD, MASS.***
2)	VERWHO==0	;EDITOR
2)	VERVER==4	;MAJOR VERSION NUMBER
2)	VERUPD==3	;MINOR VERSION NUMBER
2)	VEREDT==477	;EDIT NUMBER
2)	VERFUN==BYTE (3)VERWHO(9)VERVER(6)VERUPD(18)VEREDT
2)	PURGE	VERWHO,VERVER,VERUPD,VEREDT
2)2		SUBTTL	REVISION HISTORY
2)	;446	15993	FIX CBC FUNCTION SO IT WILL CUT BACK CORE PROPERLY
2)	;		FOR LINK OVERLAY'S
2)	;477	17759	ALWAYS REQUEST AT LEAST ONE WORD FROM GMEM%%
2)	;
**************
1)8		PUSHJ	P,GMEM%%##	;ALLOCATE CORE
****
2)8	;**;[477] INSERT @ FUNCR1+6L	JNG	22-NOV-75
2)		SKIPN	T0		;[477] USER REQUEST ONE WORD?
2)		MOVEI	T0,1		;[477] YES, GIVE HIM 2
2)		PUSHJ	P,GMEM%%##	;ALLOCATE CORE
**************
1)9		HRRZ	T1,.JBREL##	;LOAD LAST LEGAL ADR
****
2)9	;**;[477] INSERT @ FUNRA1+9L	JNG	22-NOV-75
2)		CAIN	P3,1		;[477] RETURNING 1 WORD?
2)		MOVEI	P3,2		;[477] YES, WE GAVE HIM 2
2)		HRRZ	T1,.JBREL##	;LOAD LAST LEGAL ADR
**************
1)9					;
1)	FUNRA4:	MOVE	P3,0(G1)	;RELOAD CORE SIZE
1)		HRLZM	P3,0(P2)	;BUILD FOROTS CONTROL WORD
****
2)9	FUNRA4:	MOVE	P3,0(G1)	;RELOAD CORE SIZE
2)	;**;[477] INSERT @ FUNRA4+1L	JNG	22-NOV-75
2)		CAIN	P3,1		;[477] GIVING BACK 1 WORD
2)		MOVEI	P3,2		;[477] YES, HE REALLY MEANT 2
2)		HRLZM	P3,0(P2)	;BUILD FOROTS CONTROL WORD
**************
1)16		MOVEI	P1,-1(T2)	;[311] LAST WORD WE NEED
1)		CORE	P1,		;[311]
1)		  JRST	FUNST0		;[311] NO CHANGE IF WE FAILED
File 1)	DSKB:FORFUN.MAC[10,6]	created: 1545 10-JULY-1975
File 2)	TAPE:FORFUN.MAC	created: 0000 20-APR-1977

1)		CAMLE	T2,.JBREL##	;[311] INCASE WE GAVE IT ALL AWAY
1)		JRST	FUNCB1		;[311] JUST CLEAR PREVIOUS
****
2)16	IFN <KA10-CPU>,<		;IF NOT A KA10
2)		MOVE	T3,[XWD 4,T4]	;CHECK FOR EXISTENCE OF PAGE. UUO
2)		MOVEI	T4,1		;BY GETTING A WORD OF WORKING SET TABLE
2)		PAGE.	T3,		;DO CALL
2)		 JRST	FUNCB3		;DOES NOT EXIST. NOT PAGING SYSTEM
2)		MOVEI	P1,776(T2)	;GET FIRST UNWANTED PAGE
2)		LSH	P1,-^D9
2)		HRRZ	T3,.JBREL##	;GET LAST UNWANTED PAGE
2)		LSH	T3,-^D9
2)		TLO	P1,(1B0)	;SET DELETING PAGES BIT IN P1
2)	RETAGN:	MOVSI	T5,-17		;MAX PAGES TO DO AT ONE TIME
2)		HRRI	T5,PAG.TB(P4)	;WHERE TO STORE WORDS
2)		SETZM	PAG.TB(P4)	;START WITH ZERO PAGES
2)	RETMOR:	CAIGE	T3,(P1)		;FINISHED?
2)		 JRST	RETDON		;YES. DO FINAL PAGE. UUO
2)		MOVEM	P1,1(T5)	;NO. STORE THIS PAGE.  (SHOULD BE AT LEAST ONE)
2)		AOS	PAG.TB(P4)	;AND COUNT IT
2)		ADDI	P1,1		;STEP TO NEXT PAGE
2)		AOBJN	T5,RETMOR	;LOOP FOR MORE PAGES
2)	RETDON:	MOVEI	T5,PAG.TB(P4)	;SET UP UUO ARG
2)		HRLI	T5,1		;DELETE PAGES FUNCTION
2)		PAGE.	T5,		;DO IT
2)		  JFCL			;IGNORE IT. MAY CAUSE PROBS?
2)		CAIL	T3,(P1)		;WAS THAT THE END?
2)		JRST	RETAGN		;NO. DO MORE
2)		JRST	FUNCB4		;YES. DONE
2)	>	;END IFN <KA10-CPU>
2)	FUNCB3:	MOVEI	P1,-1(T2)	;[311] LAST WORD WE NEED
2)		CORE	P1,		;[311]
2)		  JRST	FUNST0		;[311] NO CHANGE IF WE FAILED
2)	FUNCB4:	CAMLE	T2,.JBREL##	;[311] INCASE WE GAVE IT ALL AWAY
2)		JRST	FUNCB1		;[311] JUST CLEAR PREVIOUS
**************



File 1)	DSKB:FORINI.MAC[10,6]	created: 1001 16-SEPT-1974
File 2)	TAPE:FORINI.MAC	created: 0000 26-MAY-1976

1)5		TLZN	P4,-1		;IF NON-ZERO, MUST GET FOROTS
****
2)5	; TRH 7-22-74
2)	IFN FTWMU,<
2)		JSP	P,INDVT.##	;INITIALIZE DEVTAB WORDS
2)	>
2)	; EOP
2)		TLZN	P4,-1		;IF NON-ZERO, MUST GET FOROTS
**************
1)5		SIXBIT	/FOROTS/
1)		EXP	0,0,0,0
****
2)5		SIXBIT	/FOR531/
2)		EXP	0,0,0,0
**************



File 1)	DSKB:FOROPN.MAC[10,6]	created: 1149 09-SEPT-1974
File 2)	TAPE:FOROPN.MAC	created: 0000 19-MAY-1976

1)1		TITLE FOROPN %4.(100) ROUTINES TO SIMULATE F40 SUBROUTINE CALLS
1)		SUBTTL	D. TODD /DRT/     08-DEC-1972
1)	;***COPYRIGHT 1972,1973,1974 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.***
1)		SEARCH FORPRM		;GET THE GLOBAL SYMBOLS
1)	;	ENTRY IFILE,OFILE,EOF1,EOFC,DEFINE,BUFFER,IBUFF,OBUFF,MAGDEN,RELEAS
1)		MLON
1)		SALL
1)2		SUBTTL COMMON STORAGE AND TABLES
1)	UNSAVE:	MOVSI	T5,SAVAC	;GET A RESTORE BLT POINTER
1)		BLT	T5,T5		;RESTORE THE AC'S
1)		POP	P,L		;RESTORE AC L
1)		GOODBY			;RETURN TO THE USER
1)	SAVE:	EXCH	L,(P)		;SAVE THE LINK POINTER
1)		PUSH	P,L		;SAVE THE SAVE CALL RETURN ADDRESS
1)		MOVEM	T5,SAVAC+T5	;SAVE AC T5
1)		MOVEI	T5,SAVAC	;GET A BLT POINTER TO THE SAVE AREA
1)		BLT	T5,SAVAC+T5		;SAVE THE AC'S
1)		MOVE	L,-1(P)		;RESTORE THE LINK REGISTER
1)		MOVE	T0,@(L)		;GET THE UNIT NUMBER
1)		HRRZM	T0,ARGBLK	;SAVE AS FIRST IN THE ARGBLK
1)	IFN F40LIB,<
****
2)1		TITLE FOROPN %4C.(504) ROUTINES TO SIMULATE F40 SUBROUTINE CALLS
2)		SUBTTL	D. TODD /DRT/     23-NOV-1975
2)	;***COPYRIGHT 1972,1973,1974,1975 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.***
2)		SEARCH FORPRM		;GET THE GLOBAL SYMBOLS
2)	;	ENTRY IFILE,OFILE,EOF1,EOFC,DEFINE,BUFFER,IBUFF,OBUFF,MAGDEN,RELEAS
2)		MLON
2)		SALL
2)	UNSAVE:	MOVSI	T5,SAVAC	;GET A RESTORE BLT POINTER
2)		BLT	T5,T5		;RESTORE THE AC'S
2)		POP	P,L		;RESTORE AC L
2)		GOODBY			;RETURN TO THE USER
2)	SAVE:	EXCH	L,(P)		;SAVE THE LINK POINTER
2)	;**;[504] REPLACE @ SAVE+2L	JNG	23-NOV-75
2)		PUSH	P,L		;SAVE THE SAVE CALL RETURN ADDRESS
2)		MOVEI	L,SAVAC		;[504] GET A BLT POINTER TO SAVE AREA
2)		BLT	L,SAVAC+T5	;[504] SAVE THE AC'S
2)		MOVE	L,-1(P)		;RESTORE THE LINK REGISTER
2)		MOVE	T0,@(L)		;GET THE UNIT NUMBER
2)		HRRZM	T0,ARGBLK	;SAVE AS FIRST IN THE ARGBLK
2)		SETZM	ARGBLK+1	;ZERO END=
2)		SETZM	ARGBLK+2	;ZERO ERR=
2)		MOVE	T3,[-4,,3]	;MIN ARGS AND ARGBLK INDEX
2)	IFN F40LIB,<
**************
1)2	ARGBLK:	BLOCK	^D20		;ARGBLK STORAGE
1)	SAVAC:	BLOCK	6	;SAVE ARE FOR ACS 0-6
1)3		SUBTTL THE FOLLOWING ROUTINE ARE PASSED ON TO FOROTS
1)		HELLO	(RELEAS)
1)		PUSHJ	P,SAVE		;SAVE THE WORDKING AC'S
1)		MOVSI	T1,1000
1)		HRLM	T1,ARGBLK
1)		MOVEI	L,ARGBLK	;GET THE ARGBLOK POINTER
1)		PUSHJ	P,RELEA.##	;RELEASE THE DEVICE
1)		JRST	UNSAVE		;RESTORE THE AC'S CONTINUE
File 1)	DSKB:FOROPN.MAC[10,6]	created: 1149 09-SEPT-1974
File 2)	TAPE:FOROPN.MAC	created: 0000 19-MAY-1976

1)		HELLO	(IFILE)
1)		PUSHJ	P,SAVE	;SAVE THE AC'S
1)		MOVE	T1,[XWD 2000!TP%LIT_5,[ASCIZ/SEQIN/]]
1)		JRST	OFILE1	;COMMON EXIT
1)		HELLO	(OFILE)
1)		PUSHJ	P,SAVE		;SAVE THE AC'S
1)		MOVE	T1,[XWD 2000!TP%LIT_5,[ASCIZ/SEQOUT/]]
1)	OFILE1:	MOVEM	T1,ARGBLK+1
1)		MOVE	T1,1(L)		;GET THE FILE NAME POINTER
1)		TLZ	T1,777000	;CLEAR THE OP CODE
1)		TLO	T1,6000		;SET THE FILE NAME POINTER
1)		MOVEM	T1,ARGBLK+2		;STORE IN THE ARGGBLK
1)		MOVSI	T1,3000			;SET THE ARGBLK COUNT
1)		IORM	T1,ARGBLK		;STORE IN THE ARGBLK
1)		JRST	OPENGO			;OPEN THE FILE
1)4		SUBTTL ROUTINE THAT ARE NOT IMPLEMENTED IN FOROTS 
1)		HELLO	(DEFINE)
1)		PUSHJ	P,SAVE		;SAVE THE ACS
1)		MOVEI	T3,3		;SET THE MIN ARG COUNT
1)		MOVE	T1,[XWD 2000!TP%LIT_5,[ASCIZ /RANDOM/]]
1)		MOVEM	T1,ARGBLK+1	;SAVE IN ARGBLK
1)		AOBJP	L,DEFGO		;EXIT IF END OF ARG LIST
1)		MOVE	T1,(L)		;GET THE RECORD SIZE
1)		TLZ	T1,777000	;CLEAR THE OP CODE
1)		TLO	T1,14000	;SET THE RECORD SIZE PARAMETER
1)		MOVEM	T1,ARGBLK+2	;SAVE IN ARGBLK
1)		AOBJP	L,DEFGO		;EXIT IF END OF ARG LIST
1)		MOVE	T1,(L)		;GET THE ASSOCIATE VARIABLE ADDRESS
1)		ADDI	T3,1		;COUNT IT
1)		TLZ	T1,777000	;CLEAR THE OP CODE
1)		TLO	T1,22000	;SET THE ASSOCIATE VARIABLE PARAMETER
1)		MOVEM	T1,ARGBLK+3	;SAVE IN THE ARGBLK
1)		AOBJP	L,DEFGO		;EXIT IF END OF ARG LIST
1)		MOVE	T1,(L)		;GET THE FILE NAME ARGUMENT
1)		ADDI	T3,1		;COUNT IT
1)		TLZ	T1,777000	;CLEAR THE OP CODE
1)		TLO	T1,6000		;SET THE FILE NAME POINTER
1)		MOVEM	T1,ARGBLK+4	;SAVE IN THE ARGBLK
1)		AOBJP	L,DEFGO		;EXIT IF END OF ARG LIST
1)		ADDI	T3,1		;COUNT IT
1)		HRLZ	T1,@(L)		;GET THE PROJECT NUMBER
1)		AOBJP	L,DEFGO		;EXIT IF END OF ARG LIST
1)		HRR	T1,@(L)		;GET THE PROGRAMMER NUMBER
1)		MOVEM	T1,ARGBLK+^D18	;STORE IN A TEMP
1)		SETZM	ARGBLK+^D19	;SET A TERM.
1)		MOVE	T1,[XWD 10000,ARGBLK+^D18]	;GET A DIRECTORY POINTE
1)		MOVEM	T1,ARGBLK+5	;STORE IN THE ARGBLK
1)	DEFGO:	LSH	T3,9	;POSITION THE ARG COUNT
1)		HRLM	T3,ARGBLK	;STORE IN THE ARGBLK
1)	OPENGO:	MOVEI	L,ARGBLK
1)		PUSHJ	P,OPEN.##
****
2)2	ARGCNT:	BLOCK	1		;COUNT OF ARGS, DO NOT SEPARATE FROM ARGBLK
2)	ARGBLK:	BLOCK	^D20		;ARGBLK STORAGE
2)	SAVAC:	BLOCK	6	;SAVE ARE FOR ACS 0-6
2)3		SUBTTL THE FOLLOWING ROUTINES ARE PASSED ON TO FOROTS
File 1)	DSKB:FOROPN.MAC[10,6]	created: 1149 09-SEPT-1974
File 2)	TAPE:FOROPN.MAC	created: 0000 19-MAY-1976

2)		HELLO	(RELEAS)
2)		PUSH	P,L		;SAVE LINK
2)		HRRZ	T0,@(L)		;GET THE FLU
2)		MOVEM	T0,ARGBLK
2)		HRROS	ARGCNT		;COUNT OF -1
2)		MOVEI	L,ARGBLK	;GET THE ARGBLOCK POINTER
2)		PUSHJ	P,RELEA.##	;RELEASE THE DEVICE
2)		POP	P,L		;RESTORE LINK
2)		GOODBY
2)		HELLO	(IFILE)
2)		PUSHJ	P,SAVE		;SAVE THE AC'S
2)		MOVE	T1,[XWD 2000!TP%LIT_5,[ASCIZ/SEQIN/]]
2)		MOVEM	T1,ARGBLK(T3)	;STORE ACCESS TYPE
2)		JRST	DEFILE
2)		HELLO	(OFILE)
2)		PUSHJ	P,SAVE		;SAVE THE AC'S
2)		MOVE	T1,[XWD 2000!TP%LIT_5,[ASCIZ/SEQOUT/]]
2)		MOVEM	T1,ARGBLK(T3)	;STORE ACCESS TYPE
2)		JRST	DEFILE		;CHECK FOR PPN
2)4		HELLO	(DEFINE)
2)		PUSHJ	P,SAVE		;SAVE THE ACS
2)		MOVE	T1,[XWD 2000!TP%LIT_5,[ASCIZ /RANDOM/]]
2)		MOVEM	T1,ARGBLK(T3)	;SAVE IN ARGBLK
2)		AOBJP	L,DEFGO		;EXIT IF END OF ARG LIST
2)		SKIPN	@(L)		;DO WE REALLY WANT SEQUENCIAL?
2)		HRRI	T1,[ASCIZ /SEQINOUT/]	;YES
2)		MOVEM	T1,ARGBLK(T3)
2)		SUBI	T3,-1		;COUNT IT
2)		MOVE	T1,(L)		;GET THE RECORD SIZE
2)		TLZ	T1,777000	;CLEAR THE OP CODE
2)		TLO	T1,14000	;SET THE RECORD SIZE PARAMETER
2)		MOVEM	T1,ARGBLK(T3)	;SAVE IN ARGBLK
2)		AOBJP	L,DEFGO		;EXIT IF END OF ARG LIST
2)		SUBI	T3,-1		;COUNT IT
2)		MOVE	T1,(L)		;GET THE ASSOCIATE VARIABLE ADDRESS
2)		TLZ	T1,777000	;CLEAR THE OP CODE
2)		TLO	T1,22000	;SET THE ASSOCIATE VARIABLE PARAMETER
2)		MOVEM	T1,ARGBLK(T3)	;SAVE IN THE ARGBLK
2)	DEFILE:	AOBJP	L,DEFGO		;EXIT IF END OF ARG LIST
2)		SUBI	T3,-1		;COUNT IT
2)		MOVE	T1,(L)		;GET THE FILE NAME ARGUMENT
2)		TLZ	T1,777000	;CLEAR THE OP CODE
2)		TLO	T1,6000		;SET THE FILE NAME POINTER
2)		MOVEM	T1,ARGBLK(T3)	;SAVE IN THE ARGBLK
2)		AOBJP	L,DEFGO		;EXIT IF END OF ARG LIST
2)		HRLZ	T1,@(L)		;GET THE PROJECT NUMBER
2)		AOBJP	L,DEFGO		;EXIT IF END OF ARG LIST
2)		SUBI	T3,-1		;COUNT IT NOW
2)		HRR	T1,@(L)		;GET THE PROGRAMMER NUMBER
2)		MOVEM	T1,ARGBLK+^D18	;STORE IN A TEMP
2)		SETZM	ARGBLK+^D19	;SET A TERM.
2)		MOVE	T1,[XWD 10000,ARGBLK+^D18]	;GET A DIRECTORY POINTE
2)		MOVEM	T1,ARGBLK(T3)	;STORE IN THE ARGBLK
2)		AOBJP	L,DEFGO		;JUMP IF NO PROTECTION
2)		SUBI	T3,-1		;COUNT IT
2)		MOVE	T1,(L)		;GET ADDRESS
File 1)	DSKB:FOROPN.MAC[10,6]	created: 1149 09-SEPT-1974
File 2)	TAPE:FOROPN.MAC	created: 0000 19-MAY-1976

2)		TLZ	T1,777000	;CLEAR OPCODE
2)		TLO	T1,7000		;PROTECTION ARG
2)		MOVEM	T1,ARGBLK(T3)
2)	DEFGO:	HLLZM	T3,ARGCNT	;SET THE COUNT
2)		MOVEI	L,ARGBLK
2)		PUSHJ	P,OPEN.##
**************



File 1)	DSKB:FOROTS.MAC[10,6]	created: 0000 13-AUG-1975
File 2)	DSKC:FOROTS.MAC[10,6]	created: 1038 12-OCT-1977

1)1		TITLE FOROTS %4B.(460) - FORTRAN OBJECT TIME SYSTEM
1)		SUBTTL	D. TODD/DRT/HPW/MD/NEA/DPL		 13-AUG-75
1)	;***COPYRIGHT 1972,1973,1974,1975 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.***
1)		MLON
****
2)1		TITLE FOROTS %5C.(531) - FORTRAN OBJECT TIME SYSTEM
2)		SUBTTL	D. TODD/DRT/HPW/MD/NEA/DPL/JNG/CLRH	 5-APR-76
2)	;***COPYRIGHT 1972,1973,1974,1975,1976 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.***
2)		MLON
**************
1)1	VEDIT==460		;MAJOR EDIT NUMBER
1)	VMINOR==02		;MINOR EDIT NUMBER
1)	VWHO==0			;WHO EDITED LAST
1)	VEROTS==BYTE (3)VWHO(9)VERNO(6)VMINOR(18)VEDIT
****
2)1	VEDIT==532		;MAJOR EDIT NUMBER
2)	VMINOR==02		;MINOR EDIT NUMBER
2)	VWHO==4			;WHO EDITED LAST
2)	VEROTS==BYTE (3)VWHO(9)VERNO(6)VMINOR(18)VEDIT
**************
1)1	;447	16733	FIX IN FOROTS AND FORERR EOF PROCESSING SO IO LIST
1)	;		VARIABLES DO NOT GET CLEARED
****
2)1	;446	16733	FIX IN FOROTS AND FORERR EOF PROCESSING SO IO LIST
2)	;		VARIABLES DO NOT GET CLEARED
**************
1)1	;	DEFINE THE LOADING
****
2)1	;465	17142	READ STRINGS INTO D.P. VARIABLES CORRECTLY.
2)	;466	17152	FIX SNG.X WHEN ARG IS NEGATIVE AND CLOSE TO A POWER OF 2
2)	;473	17572	CLEAR CH.SAV IN FIN%% SO DECODE WILL WORK.
2)	;474	17648	DON'T STOP PRINTING BAD RECORD ON LF IN FORERR.
2)	;476	17725	FIX G FORMAT WHEN FIELD IS TOO SMALL, BUT OK W.O. 4X.
2)	;477	17759	ALWAYS ALLOCATE AT LEAST 2 WORDS OF CORE IN FURFUN.
2)	;500	17818	RESET ELIST/SLIST FLAGS WHEN STARTING NEW LIST.
2)	;501	17900	CLEAR IO.EOL AT CPYSTR SO SOME DATA WILL ALWAYS MOVE.
2)	;502	17899	MAKE TTY BUFFER 132 CHARS FOR REASONABLE REREAD.
2)	;503	17871	CLEAR CH.SAV ON T FORMAT IN CASE FREE FORMAT PRECEDED.
2)	;504	18010	CORRECT SAVE IN FOROPN TO SAVE T5, AS IT TRIES TO
2)	;505	18011	STORE BLOCKS (NOT WORDS) IN .RBEST ON FILESIZE= IN OPEN.
2)	;513	15636	FIX INCORRECT RESULTS FOR DATAN(X), WHERE
2)	;		(5*SQRT(5)-2)/11 < ABS(X) < (5*SQRT(5)+2)/11, I.I.
2)	;		IF .8346 < ABS(X) < 1.198
2)	;531	18074	INSERT MISSING PORTALS IN FORTRP FOR CONCEALED MODE
2)	;**************** END OF REVISION HISTORY
2)	;	DEFINE THE LOADING
**************
1)3		HRRI	T2,ACC.SV+21(P4);BUILD A BLT POINTER TO CLEAR THE LOW
1)		HRLI	T2,ACC.SV+20(P4); SEGMENT FROM THE SAVE AREA
1)		SETZM	ACC.SV+20(P4)	;CLEAR THE FIRST WORD
1)		BLT	T2,@.JBREL	; TOP OF THE DYNAMIC AREA
1)		MOVE	T1,ACC.SV+0(P4)	;[320]
****
2)3	IFE FTWMU,<		;RRB/ 12-17-75
2)		HRRI	T2,ACC.SV+21(P4);BUILD A BLT POINTER TO CLEAR THE LOW
2)		HRLI	T2,ACC.SV+20(P4); SEGMENT FROM THE SAVE AREA
File 1)	DSKB:FOROTS.MAC[10,6]	created: 0000 13-AUG-1975
File 2)	DSKC:FOROTS.MAC[10,6]	created: 1038 12-OCT-1977

2)		SETZM	ACC.SV+20(P4)	;CLEAR THE FIRST WORD
2)		BLT	T2,@.JBREL	; TOP OF THE DYNAMIC AREA
2)	>
2)		MOVE	T1,ACC.SV+0(P4)	;[320]
**************
1)3		MOVE	G1,[XWD 2,23]	;GET THE BUF SIZE AND COUNT
1)		MOVSI	T1,(20B12)	;SET TTY ON PSEUDO CHANNEL 0
****
2)3	;**;[502] CHANGE @ INIT%+62L	JNG	23-NOV-75
2)		MOVE	G1,[XWD 2,36]	;[502] GET THE BUF SIZE AND COUNT
2)		MOVSI	T1,(20B12)	;SET TTY ON PSEUDO CHANNEL 0
**************
1)13		MOVEM	T1,DD.NAM(P2)	;SAVE THE FILE NAME
****
2)13		CAME	T1,DD.NAM(P2)	;CHECK THE FILE NAME
2)		TLO	P2,OP.SAC	;SOME ARGUMENT CHANGED
2)		MOVEM	T1,DD.NAM(P2)	;SAVE THE FILE NAME
**************
1)13	OPNEXT:	HLLM	T1,DD.EXT(P2)	;[416][453] SAVE THE EXTENSION
1)		POPJ	P,		;RETURN TO THE SWITCH SCANNER
1)	OPNDLM:	TLZE	P2,40000	;[416] ALREADY IN DIALOG MODE?
1)		JRST	OPNEXT		;[416] YES, GO BACK AND TRY AGAIN
1)		SETZB	T1,T1		;[416] SET ILLEGAL DELIMITER
1)		SETZB	G3,G3		;[416] SET SWITCH ERROR FOUND
1)		TLO	P2,OP.ERR	;[416] SET ERROR FOUND FLAG(ARGUMENT)
1)		ERROR	(OPN,11,7,.+1)	;[416] TELL ABOUT OPEN ARG ERROR
1)		EXCH	P2,P3		;[416] SET UP TO TYPE THE DDB
1)		PUSHJ	P,TY%DDB	;[416] SHOW WHAT WE GOT SO FAR
1)		EXCH	P3,P2		;[416] RESTORE THE I/O REGS
1)		POPJ	P,		;[416] RETURN TAKES US TO DIALOG MODE
1)	OPNPPN:
1)		TLNN	P2,OP.OPN!OP.DIA	;DIALOG MODE
****
2)13	OPNEXT:	HRR	T1,DD.EXT(P2)	;GET RH OF WORD
2)		CAME	T1,DD.EXT(P2)	;ANY CHANGE?
2)		TLO	P2,OP.SAC	;SOME ARGUMENT CHANGED
2)		HLLM	T1,DD.EXT(P2)	;[416][453] SAVE THE EXTENSION
2)		POPJ	P,		;RETURN TO THE SWITCH SCANNER
2)	OPNDLM:	TLZE	P2,40000	;[416] ALREADY IN DIALOG MODE?
2)		JRST	OPNEXT		;[416] YES, GO BACK AND TRY AGAIN
2)		SETZB	T1,G3		;[416] SET ILLEGAL DELIMITER
2)					;[416] SET SWITCH ERROR FOUND
2)		TLO	P2,OP.ERR	;[416] SET ERROR FOUND FLAG(ARGUMENT)
2)		ERROR	(OPN,11,7,.+1)	;[416] TELL ABOUT OPEN ARG ERROR
2)		EXCH	P2,P3		;[416] SET UP TO TYPE THE DDB
2)		PUSHJ	P,TY%DDB	;[416] SHOW WHAT WE GOT SO FAR
2)		EXCH	P3,P2		;[416] RESTORE THE I/O REGS
2)		POPJ	P,		;[416] RETURN TAKES US TO DIALOG MODE
2)	OPNPPN:	TLO	P2,OP.SAC	;SOME ARGUMENT CHANGED
2)		TLNN	P2,OP.OPN!OP.DIA	;DIALOG MODE
**************
1)13		DPB	T1,[POINT 9,DD.PRV(P2),8]	;[322] SAVE PROTECTION CODE
1)		TRZ	T2,1B'>'	;CHECK THE TERMINATOR
1)		POPJ	P,		;JUST RETURN
1)	OPNEST:
1)		MOVEM	T1,DD.EST(P2)	;SAVE ESTIMATED FILE SIZE
File 1)	DSKB:FOROTS.MAC[10,6]	created: 0000 13-AUG-1975
File 2)	DSKC:FOROTS.MAC[10,6]	created: 1038 12-OCT-1977

1)		POPJ	P,		;RETURN
1)	OPNREC:
1)		MOVNM	T1,DD.LOG(P2)	;SAVE THE LOGICAL RECORD LENGTH
1)					;SET NEGATIVE DON'T KNOW (CHAR/WORD)
1)		POPJ	P,		;RETURN
1)	OPNVER:
1)		MOVEM	T1,DD.VER(P2)	;[343] STORE VERSION NUMBER
****
2)13		PUSH	P,T2
2)		LDB	T2,[POINT 9,DD.PRV(P2),8]	;GET OLD PROTECTION
2)		DPB	T1,[POINT 9,DD.PRV(P2),8]	;[322] SAVE PROTECTION CODE
2)		CAME	T1,T2		;DID IT CHANGE?
2)		TLO	P2,OP.SAC	;SOME ARGUMENT CHANGED
2)		POP	P,T2		;RESTORE REGISTER
2)		TRZ	T2,1B'>'	;CHECK THE TERMINATOR
2)		POPJ	P,		;JUST RETURN
2)	OPNEST:
2)	;**;[505] INSERT @ OPNEST+1L	JNG	23-NOV-75
2)		ADDI	T1,177		;[505] ROUND UP TO BLOCK BOUN
2)		LSH	T1,-7		;[505] CONVERT TO BLOCKS FOR FILSER
2)		CAME	T1,DD.EXT(P2)	;CHANGE IN ESTIMATED SIZE?
2)		TLO	P2,OP.SAC	;SOME ARGUMENT CHANGED
2)		MOVEM	T1,DD.EST(P2)	;SAVE ESTIMATED FILE SIZE
2)		POPJ	P,		;RETURN
2)	OPNREC:
2)		MOVNM	T1,DD.LOG(P2)	;SAVE THE LOGICAL RECORD LENGTH
2)					;SET NEGATIVE DON'T KNOW (CHAR/WORD)
2)		POPJ	P,		;RETURN
2)	OPNVER:
2)		CAME	T1,DD.VER(P2)	;ANY CHANGE TO VERSION
2)		TLO	P2,OP.SAC	;SOME ARGUMENT CHANGED
2)		MOVEM	T1,DD.VER(P2)	;[343] STORE VERSION NUMBER
**************
1)18		JUMPGE	T1,.+2		;JUMP IF A +FLU
1)		SKIPA	T2,DEVTB.(T1)	;NO GET THE DEVICE NAME FOR A FILE NAME
1)		JSP	P1,FLUSIX	;CONVERT TO SIXBIT
****
2)18	;TRH 9-25-74
2)	IFN FTWMU,<
2)		JUMPGE	T1,.+3		;JUMP IF A +FLU
2)		ADD	T1,DEV.TB(P4)
2)		SKIPA	T2,(T1)		;NO GET THE DEVICE NAME FOR A FILE NAME
2)	>
2)	IFE FTWMU,<
2)		JUMPGE	T1,.+2		;JUMP IF A +FLU
2)		SKIPA	T2,DEVTB.(T1)	;NO GET THE DEVICE NAME FOR A FILE NAME
2)	>
2)	;EOP
2)		JSP	P1,FLUSIX	;CONVERT TO SIXBIT
**************
1)19	GETDV1:	CAIG	T3,DEV.SZ	;IS THE FLU IN THE TABLE RANGE
1)		SKIPN	G1,DEVTB.(T3)	;GET THE DEVICE NAME
1)		MOVSI	G1,(SIXBIT /DSK/)	;NOT IN RANGE OR ZERO ENTRY
****
2)19	;TRH 9-25-74
2)	GETDV1:
File 1)	DSKB:FOROTS.MAC[10,6]	created: 0000 13-AUG-1975
File 2)	DSKC:FOROTS.MAC[10,6]	created: 1038 12-OCT-1977

2)	IFN FTWMU,<
2)		MOVE	T2,DEV.TB(P4)	;GET DEVICE TABLE ADDRESS
2)		ADDI	T2,(T3)		;ADDRESS OF ENTRY WE WANT
2)		CAMG	T3,DEV.SZ(P4)	;IS THE FLU IN THE TABLE RANGE?
2)		SKIPN	G1,(T2)		;YES, GET DEVICE NAME
2)	>
2)	IFE FTWMU,<
2)		CAIG	T3,DEV.SZ	;IS THE FLU IN THE TABLE RANGE
2)		SKIPN	G1,DEVTB.(T3)	;GET THE DEVICE NAME
2)	>
2)	;EOP
2)		MOVSI	G1,(SIXBIT /DSK/)	;NOT IN RANGE OR ZERO ENTRY
**************
1)21	IPEEK.:	TLNE	P3,IO.EOF	;[431] EOF ALREADY
1)		JRST	IBYTE2		;[431] YES, NO SENSE CONTINUING
1)		SKIPG	DD.HRI+2(P3)	;PEEK AT NEXT CHARACTER ANY LEFT
1)		PUSHJ	P,IBLOK.	;NO, GET NEXT BLOCK
****
2)21	; IPEEK.+0	S.M. #490.19	RRB/ 6-FEB-76
2)	; DELETED PATCH[431](2 LINES
2)	IPEEK.:	SKIPG	DD.HRI+2(P3)	;PEEK AT NEXT CHARACTER ANY LEFT
2)		PUSHJ	P,IBLOK.	;NO, GET NEXT BLOCK
**************
1)21		AOS	DD.BLK(P3)	;COUNT THIS BLOCK
1)	IBLOK0:	HLLZ	T0,DD.UNT(P3)	;GET THE CHANNEL NUMBER
1)		TLO	T0,(IN)		;SETUP AN INPUT UUO
1)		TLZE	P3,IO.RNG	;CHANGING RINGS
1)		HRR	T0,DD.HRI(P3)	;GET THE NEW RING ADDRESS
1)		XCT	T0		;EXECUTE THE UUO
1)		POPJ	P,		;GET THE NEXT CHARACTER FROM THE BLOCK
1)		ERROR	(DEV,0,5,IBLOK1);DO THE ERROR PROCESSING
1)	IBLOK1:	TLO	P3,IO.EOL!IO.EOF;SET END OF LINE
****
2)21	; IBLOK.+4	S.M. #490.20	RRB/ 16-JUL-76
2)		TLNN	P3,IO.EOF	;EOF ALREADY?
2)		JRST	IBLOK7		;NO
2)		TLNE	G3,DV.DTA!DV.DSK!DV.TTA		;DID FORERR CALL CLOSE
2)		JRST	IBLOKZ		;NO	
2)		TLZ	P3,IO.EOF	;CLEAR EOF FLAG
2)	IBLOK7:
2)	;EOP
2)		AOS	DD.BLK(P3)	;COUNT THIS BLOCK
2)	IBLOK0:	HLLZ	T0,DD.UNT(P3)	;GET THE CHANNEL NUMBER
2)		TLO	T0,(IN)		;SETUP AN INPUT UUO
2)		TLZE	P3,IO.RNG	;CHANGING RINGS
2)		HRR	T0,DD.HRI(P3)	;GET THE NEW RING ADDRESS
2)		XCT	T0		;EXECUTE THE UUO
2)		POPJ	P,		;GET THE NEXT CHARACTER FROM THE BLOCK
2)	; IBLOK0+6	S.M. #490.19	RRB/ 6-FEB-76
2)	IBLOKZ:	ERROR	(DEV,0,5,IBLOK1);DO THE ERROR PROCESSING
2)	;EOP
2)	IBLOK1:	TLO	P3,IO.EOL!IO.EOF;SET END OF LINE
**************
1)21		MOVSI	T2,-<<23-3>*5-1>;[177] CLEAR THE BYTE COUNT
1)		INCHWL	T0		;WAIT FOR A CHARACTER
1)		JRST	IBLOK4		;GO A CHARACTER
File 1)	DSKB:FOROTS.MAC[10,6]	created: 0000 13-AUG-1975
File 2)	DSKC:FOROTS.MAC[10,6]	created: 1038 12-OCT-1977

1)	IBLOK3:	INCHSL	T0		;GET ANOTHER CHARACTER
1)		JRST	IBLOK5		;NONE LEFT
1)	IBLOK4:	CAIN	T0,32		;^Z FOR EOF
****
2)21	;**;[502] CHANGE @ IBLOCK6+10L	JNG	23-NOV-75
2)		MOVSI	T2,-<<36-3>*5-1>;[502] CLEAR THE BYTE COUNT
2)	IBLOK3:	INCHWL	T0		;[502] WAIT FOR A CHARACTER
2)	IBLOK4:	CAIN	T0,32		;^Z FOR EOF
**************
1)21		CAIG	T0,14		;CHECK FOR A TERMINATOR
****
2)21		CAIN	T0,33		;CHECK FOR ALTMODE TERMINATOR(SINCE 512
2)		JRST	IBLOK5		;BROKE DIALOG WHICH EXPECTS ALTMODE)
2)		CAIG	T0,14		;CHECK FOR A TERMINATOR
**************
1)22		TSOA	T0,DD.LOG(P3)	;GET THE LOGCIAL RECORD SIZE
****
2)22	; NXTLNO+24.	S.M. #485.21	NDG/ 6-9-76
2)		TLZ	P3,IO.EOL	;WE REALLY ARE AT THE BEGINNING OF A NEW
2)					;RECORD (NOT END OF CURRENT)
2)		TSOA	T0,DD.LOG(P3)	;GET THE LOGCIAL RECORD SIZE
**************
1)23		MOVEI	T0,<23-3>*5-1  ;GET BUFFER SIZE IN CHARACTERS
1)		MOVEM	T0,DD.HRO+2(P3)	;SAVE IN RING HEADER
****
2)23	;**;[502] CHANGE @ OBLOK2+5L	JNG	23-NOV-75
2)		MOVEI	T0,<36-3>*5-1  ;[502] GET BUFFER SIZE IN CHARACTERS
2)		MOVEM	T0,DD.HRO+2(P3)	;SAVE IN RING HEADER
**************
1)24		SUBI	T0,"*"		;RELOCATE CONTROL CHARACTER FOR INDEXING
1)		JUMPL	T0,OUTCC2	;CHARACTER IS NOT IN RANGE
1)		CAILE	T0,"3"-"*"	;CHECK THE HIGH END
1)		JRST	OUTCC2		;NOT IN RANGE USE THE PREVIOUS CCC
1)		ADDI	T0,CCC.TB	;POINT TO THE TABLE
1)		MOVE	T0,@T0		;GET THE CONTROL CHARACTERS
1)		ROT	T0,5		;GET THE LOW ORDER 4 BITS
1)		TLNN	P3,IO.TTA	;IS THIS THE USER'S TTY
1)		JRST	OUTCC0		;NO,CONTINUE NORMAL
****
2)24	; OUTCCC+4	S.M. 485.17	;RRB/ 12-23-75
2)		CAIE	T0," "		;SPACE?
2)		JRST	OUTCC8		;NO
2)		MOVEI	T0,12		;YES, SINGLE LINEFEED
2)		JRST	OUTCC9
2)	OUTCC8:	SUBI	T0,"*"		;RELOCATE CONTROL CHARACTER FOR INDEXING
2)		JUMPL	T0,OUTCC2	;CHARACTER IS NOT IN RANGE
2)		CAILE	T0,"3"-"*"	;CHECK THE HIGH END
2)		JRST	OUTCC2		;NOT IN RANGE USE THE PREVIOUS CCC
2)		ADDI	T0,CCC.TB	;POINT TO THE TABLE
2)		MOVE	T0,@T0		;GET THE CONTROL CHARACTERS
2)		ROT	T0,5		;GET THE LOW ORDER 4 BITS
2)	OUTCC9:	TLNN	P3,IO.TTA	;IS THIS THE USER'S TTY
2)		JRST	OUTCC0		;NO,CONTINUE NORMAL
**************
1)25		JSP	P1,IBYTE.	;GET AN INPUT CHARACTER
1)		TLZE	P3,IO.EOL!IO.EOF;END OF LINE
File 1)	DSKB:FOROTS.MAC[10,6]	created: 0000 13-AUG-1975
File 2)	DSKC:FOROTS.MAC[10,6]	created: 1038 12-OCT-1977

1)		POPJ	P,		;YES, STOP THE COPY
1)		TLC	P3,IO.STR	;SET STRING FOR OUTPUT
1)		JSP	P1,OBYTE.	;OUTPUT
1)		TLC	P3,IO.STR	;COMPLEMENT
1)		JRST	CPYSTR		;CONTINUE
1)26		SUBTTL FIND RANDOM ACCESS POSITIONING ROUTINES
****
2)25	;**;[501] INSERT @ CPYSTR	JNG	23-NOV-75
2)		TLZ	P3,IO.EOL	;[501] GET DATA FROM IBYTE.
2)	CPYST1:	JSP	P1,IBYTE.	;[501] GET AN INPUT CHARACTER
2)		TLZE	P3,IO.EOL!IO.EOF;END OF LINE
2)		POPJ	P,		;YES, STOP THE COPY
2)		TLC	P3,IO.STR	;SET STRING FOR OUTPUT
2)		JSP	P1,OBYTE.	;OUTPUT
2)		TLC	P3,IO.STR	;COMPLEMENT
2)	;**;[501] CHANGE @ CPYSTR+7L	JNG	23-NOV-75
2)		JRST	CPYST1		;[501] CONTINUE
2)26		SUBTTL FIND RANDOM ACCESS POSITIONING ROUTINES
**************
1)26		TLNE	P3,IO.EOF	;[447] DID RBLOK. CAUSE EOF
1)		JRST	[POP	P,	;[447] YES-SET UP RETURN TO USER
1)			JRST	FIN%%]	;[447] CLEAN UP FILE JUNK
1)		SETZB	T2,T2		;[424] CLEAR AC FOR TEST
****
2)26		SETZB	T2,T2		;[424] CLEAR AC FOR TEST
**************
1)26		CAMGE	T5,1(T1)	;[427][447] REQUESTED OFFSET WITHIN BUF SIZE
1)		ERROR	(DAT,2,7,)	;[427] YES-- RECORD NEVER WRITTEN
1)		HLLZ	T0,DD.UNT(P3)	;[447] GET CHANNEL NUMBER
1)		IOR	[SETSTS 0,20000]	;[447] SET UP EOF FOR FORER%
1)		XCT	T0		;[447] DO IT
1)		TLO	P3,IO.EOL!IO.EOF	;[447] MAY NOT BE NECESSARY
1)		POP	P,		;[447] SET UP TO RETURN TO USER
1)		ERROR	(DEV,0,5,FIN%%)	;[447] GIVE ERROR MSG IF NECESSARY
1)	RBLOK.:			;GET THE NEXT RANDOM BLOCK IN CORE
****
2)26		CAML	T5,1(T1)	;[427] REQUESTED OFFSET WITHIN BUF SIZE
2)		POPJ	P,		;[427] NO--EOF GETS HANDLED ELSEWHERE
2)		ERROR	(DAT,2,7,)	;[427] YES-- RECORD NEVER WRITTEN
2)	RBLOK.:			;GET THE NEXT RANDOM BLOCK IN CORE
**************
1)37		CAIGE	G2,IOL.MX	;CHECK FOR AN IMPLIED FIN CALL
****
2)37	;**;[500] INSERT @ IOLST1+5L	JNG	22-NOV-75
2)		TLZ	P2,FT.SLT!FT.ELT!FT.EXT	;[500] NEW LIST...NEW FLAGS
2)		CAIGE	G2,IOL.MX	;CHECK FOR AN IMPLIED FIN CALL
**************
1)39		JRST	FINXI1		;EXIT ON ENCODE/DECODE
1)	FINF1:	PUSHJ	P,ENDLN.	;FINISH UP THIS LINE
****
2)39	; FIN%%+12	S.M. #485.15	RRB/ 12-17-75
2)		JRST	[SETZM	CH.SAV(P4)	;CLEAR SAVED CHARACTER
2)			JRST	FINXI1]		;EXIT ON ENCODE/DECODE
2)	FINF1:	PUSHJ	P,ENDLN.	;FINISH UP THIS LINE
**************
1)39		SETZM	ALT.PC(P4)	;[225] CLEAR ALT RETURN PC
File 1)	DSKB:FOROTS.MAC[10,6]	created: 0000 13-AUG-1975
File 2)	DSKC:FOROTS.MAC[10,6]	created: 1038 12-OCT-1977

1)		POPJ	P,		;RETURN TO THE USER
****
2)39		SKIPE	T1,ALT.PC(P4)	;[225] END OR ERR RETURN
2)		MOVEM	T1,USR.PC(P4)	;[225] YES - SET ALTERNATE RETURN
2)		SETZM	ALT.PC(P4)	;[225] CLEAR ALT RETURN PC
2)	; FINXI1+2	SPR#17718[473]	RRB/ 12-17-75
2)		SETZM	CH.SAV(P4)	;[473] CLEAR SAVED CHR AT END OF RECORD
2)		POPJ	P,		;RETURN TO THE USER
**************
1)45		JUMPE	T1,FSXEE1	;PAREN STACK NOT DEFINED
1)		HLRZ	T2,-1(T1)	;GET THE SIZE OF THE PAREN STACK
1)		LSH	G3,1		;TWO WORDS/PAREN DEPTH
1)		CAIG	G3,-4(T2)	;MUST THE STACK BE EXPANDED
****
2)45	; FSXEE+3[464]	S.M. #485.17	RRB/ 12-29-75
2)		LSH	G3,1		;[464] TWO WORDS/PAREN DEPTH
2)		JUMPE	T1,FSXEE1	;PAREN STACK NOT DEFINED
2)		HLRZ	T2,-1(T1)	;GET THE SIZE OF THE PAREN STACK
2)		CAIG	G3,-4(T2)	;MUST THE STACK BE EXPANDED
**************
1)48		MOVEI	G3,DD.HRI(P3)	;INPUT HEADER
****
2)48	;**;[503] INSERT @ FSXT+1L	JNG	23-NOV-75
2)		SETZM	CH.SAV(P4)		;[503] ZAP SAVED CHARACTER
2)		MOVEI	G3,DD.HRI(P3)	;INPUT HEADER
**************
1)54		TLNN	G3,DV.DSK!DV.DTA;[204] DISK OR DECTAPE?
****
2)54		TLNE	P2,OP.SAC	;DID USER RESET ANY ARGS?
2)		TLNN	G3,DV.DSK!DV.DTA;[204] DISK OR DECTAPE?
**************
1)55		MOVS	T1,DD.PPN(P3)	;PPN
1)		TRNN	T1,-1		;IS THERE AN SFD
1)		JUMPN	T1,.+3		;OR NULL
1)		MOVSM	T1,Q.FDIR(P2)	;STORE THE PPN
1)		JRST	.+3		;SKIP THE SFD STUFF
1)		HRRI	T1,Q.FDIR(P2)	;YES, SET UP A BLT POINTER
1)		BLT	T1,Q.FDIR+6(P2)	;MOVE THE DIRECTORY PATH
1)		MOVE	T1,DD.NAM(P3)	;GET THE FILE NAME
****
2)55		; REPLACE 7 LINES @ CLOS.Q+43(8) CCOA 6-FEB-75
2)		SKIPE	T1,DD.PPN(P3)	;IS THERE A PPN OR PATH SPECIFIED?
2)		TLNE	T1,-1		;YES--IS IT A PATH?
2)		JRST	[MOVEM	T1,Q.FDIR(P2)	;NO--JUST PUT AWAY PPN
2)			 JRST	CLOSQ1]		;AND SKIP AROUND
2)		HRLI	T1,2(T1)	;YES--GET ADR OF PPN IN PATH
2)		HRRI	T1,Q.FDIR(P2)	;GET PATH ADR IN QUEUE BLOCK
2)		BLT	T1,Q.FDIR+5(P2)	;AND STORE PPN AND SFD PATH
2)	CLOSQ1:
2)	; END OF REPLACEMENT @ CLOS.Q+43(8)
2)		MOVE	T1,DD.NAM(P3)	;GET THE FILE NAME
**************
1)55		PUSH	P,.JBHRL##	;[346] SAVE HIGH SEGMENT LENGTH
1)		PUSHJ	P,FORQU%##	;CALL QMANGR VIA FORQUE
1)		POP	P,.JBHRL	;[346] RESTORE
1)		PUSHJ	P,PMEM%%	;[240] RETURN THE ARG BLOCK TO THE HEAP
File 1)	DSKB:FOROTS.MAC[10,6]	created: 0000 13-AUG-1975
File 2)	DSKC:FOROTS.MAC[10,6]	created: 1038 12-OCT-1977

1)		PJRST	UPDCHN		;[240] UPDATE CHANNEL TABLE
1)	QUE.TB:				;TABLE OF QUEUE CODES
****
2)55	; CLOS.Q+	S.M. #485.25	NDG/ 10-12-77
2)		TLO	T1,40000	;TELL QMANGR NOT TO DO ANY CORE SHRINKING
2)		PUSH	P,.JBHRL##	;[346] SAVE HIGH SEGMENT LENGTH
2)		PUSHJ	P,FORQU%##	;CALL QMANGR VIA FORQUE
2)		POP	P,.JBHRL	;[346] RESTORE
2)		PUSHJ	P,PMEM%%	;[240] RETURN THE ARG BLOCK TO THE HEAP
2)		PUSHJ	P,UPDCHN	;[240] UPDATE CHANNEL TABLE
2)		HRRZ	T2,.JBFF	;GET WHERE WE THINK CORE ENDS
2)		CAML	T2,.JBREL	;QMANGR CHANGE?
2)		 POPJ	P,		;NO. OK
2)	IFN <KA10-CPU>,<		;IF NOT A KA10
2)		MOVE	T3,[XWD 4,T4]	;CHECK FOR EXISTENCE OF PAGE. UUO
2)		MOVEI	T4,1		;BY GETTING A WORD OF WORKING SET TABLE
2)		PAGE.	T3,		;DO CALL
2)		 JRST	QUECB3		;DOES NOT EXIST. NOT PAGING SYSTEM
2)		MOVEI	P1,776(T2)	;GET FIRST UNWANTED PAGE
2)		LSH	P1,-^D9
2)		HRRZ	T3,.JBREL##	;GET LAST UNWANTED PAGE
2)		LSH	T3,-^D9
2)		TLO	P1,(1B0)	;SET DELETING PAGES BIT IN P1
2)	RETAGN:	MOVSI	T5,-17		;MAX PAGES TO DO AT ONE TIME
2)		HRRI	T5,PAG.TB(P4)	;WHERE TO STORE WORDS
2)		SETZM	PAG.TB(P4)	;START WITH ZERO PAGES
2)	RETMOR:	CAIGE	T3,(P1)		;FINISHED?
2)		 JRST	RETDON		;YES. DO FINAL PAGE. UUO
2)		MOVEM	P1,1(T5)	;NO. STORE THIS PAGE.  (SHOULD BE AT LEAST ONE)
2)		AOS	PAG.TB(P4)	;AND COUNT IT
2)		ADDI	P1,1		;STEP TO NEXT PAGE
2)		AOBJN	T5,RETMOR	;LOOP FOR MORE PAGES
2)	RETDON:	MOVEI	T5,PAG.TB(P4)	;SET UP UUO ARG
2)		HRLI	T5,1		;DELETE PAGES FUNCTION
2)		PAGE.	T5,		;DO IT
2)		  JFCL			;IGNORE IT. MAY CAUSE PROBS?
2)		CAIL	T3,(P1)		;WAS THAT THE END?
2)		JRST	RETAGN		;NO. DO MORE
2)		POPJ	P,		;YES. DONE
2)	>	;END IFN <KA10-CPU>
2)	QUECB3:	MOVEI	P1,-1(T2)	;WHERE TO SHRINK BY CORE UUO
2)		CORE	P1,		;DO IT
2)		 JFCL			;CAN'T FAIL
2)		POPJ	P,		;RETURN
2)	QUE.TB:				;TABLE OF QUEUE CODES
**************
1)59		ERROR	(SYS,1,0,0)	;EXIT VIA FORERR FOR MESSAGE
1)60	SUBTTL GMEM%% PMEM%% SMEM%% MEMORY MANAGEMENT ROUTINES
****
2)59	; EXIT.2+3	S.M. #485.6	NDG/ 1-2-75
2)	IFN F40LIB,<
2)		TLNN	L,-20		;F40 CALL?
2)		 JRST	EXITF4		;NO
2)		HLRZ	T1,(L)		;YES. GET NEXT WORD.
2)		TRZ	T1,777		;JUST OP CODE
2)		CAIE	T1,(JUMP)	;IS IT AN ARG?
File 1)	DSKB:FOROTS.MAC[10,6]	created: 0000 13-AUG-1975
File 2)	DSKC:FOROTS.MAC[10,6]	created: 1038 12-OCT-1977

2)		 JRST	EXIT%M		;NO
2)		JRST	EXIT%0		;YES
2)	EXITF4:>
2)		HLRE	T1,-1(L)	;F10 CALL. SEE IF ARGUMENTS
2)	; EXITF4+1	S.M. #485.11	NDG/ 4-4-75
2)		JUMPGE	T1,EXIT%M	;IF NO ARGS, DO NORMAL EXIT
2)	EXIT%0:	MOVE	T1,@0(L)	;GET ARG
2)		CAIN	T1,0		; CALL EXIT(0)
2)		EXIT			;YES.
2)		CAIE	T1,1		;CALL EXIT(1)
2)		 JRST	EXIT%M		;NO. GIVE MESSAGE AND EXIT
2)		EXIT	1,		;GIVE EXIT WITH JUST DOT
2)		JRST	.-1		;REPEAT
2)	EXIT%M:	ERROR	(SYS,1,0,0)	;EXIT VIA FORERR FOR MESSAGE
2)60	SUBTTL GMEM%% PMEM%% SMEM%% MEMORY MANAGEMENT ROUTINES
**************
1)62		SUBTTL DEVTB. DEFAULT DEVICE TABLE FOR FORTRAN IV
****
2)62	IFE FTWMU,<
2)		SUBTTL DEVTB. DEFAULT DEVICE TABLE FOR FORTRAN IV
**************
1)62		SIXBIT	.DEV5.		;29;
1)	DEV.SZ==.-DEVTB.-1
1)		END
****
2)62		SIXBIT	.CDP.		;29;
2)		SIXBIT	.TTY.		;30;
2)	DEV.SZ==.-DEVTB.-1
2)	>
2)		END
**************



File 1)	DSKB:FORPLT.MAC[10,6]	created: 1016 16-SEPT-1974
File 2)	TAPE:FORPLT.MAC	created: 0000 19-MAY-1976

1)2		740,,[201224020100]
1)		200,,THETA
****
2)2		740,,[ASCII /(X10  )/]	;[BYU-106]
2)		200,,THETA
**************



File 1)	DSKB:FORPRM.KI[10,6]	created: 0942 10-APR-1975
File 2)	TAPE:FORPRM.MAC	created: 0000 20-APR-1977

1)2		SUBTTL	REVISION HISTORY
****
2)1	IFNDEF	FTWMU,<FTWMU==-1>	;0 IF DON'T WANT DEVTB. IN LOWSEG
2)					;STANDARD FOROTS HAS IT IN HIGHSEG.
2)	;NOTE THAT THE ROUTINES IN FORWMU WHICH NORMALLY ACCEPT UNIT NUMBERS
2)	;	WILL ONLY ACCEPT DEVICE NAMES IF THIS IS ZERO, AND THAT
2)	;	DEVCHG WILL NOT WORK AT ALL.
2)2		SUBTTL	REVISION HISTORY
**************
1)12	;FLAGS DEFINE IN THE LEFT HALF OF P2 DURING FORMAT PROCESSING
****
2)12	;40000	IS USED AS TEMPORAY DIALOGUE FLAG BY OPNARG
2)	OP.SAC==20000	;OPNARG SET SOME RENAME ARGUMENT TO NEW VALUE
2)	;FLAGS DEFINE IN THE LEFT HALF OF P2 DURING FORMAT PROCESSING
**************
1)13	STATIC(FLU.TB,FLU.SZ)	;The FORTRAN logical unit number table.
1)	LOW.SZ==ZZ.		;SIZE OF THE STATIC LOW SEGMENT
****
2)13	IFN FTWMU,<
2)	;	S.M. #485.5	RRB/ 12-16-75
2)	STATIC(DEV.TB,1)	;ADDRESS OF DEVTAB
2)	STATIC(DEV.SZ,1)	;POSITIVE SIZE OF DEVTAB
2)	>
2)	STATIC(FLU.TB,FLU.SZ)	;The FORTRAN logical unit number table.
2)	STATIC(PAG.TB,20)	;WORDS FOR FORFUN TO DO PAGE. UUOS
2)	LOW.SZ==ZZ.		;SIZE OF THE STATIC LOW SEGMENT
**************



File 1)	DSKB:FORTRP.MAC[10,6]	created: 1147 09-SEPT-1974
File 2)	TAPE:FORTRP.MAC	created: 0000 20-MAY-1976

1)1	TITLE FORTRP %4.(152) OVER/UNDERFLOW TRAP ROUTINE
1)		SUBTTL	D. TODD /DRT/     08-MAR-1972 T. EGGERS/DMN/TWE/DRT
1)	;***COPYRIGHT 1972,1973,1974 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.***
****
2)1	TITLE FORTRP %4C.(531) OVER/UNDERFLOW TRAP ROUTINE
2)		SUBTTL	D. TODD/T. EGGERS/DRT/TWE/DMN/JNG/CLRH	5-APR-76
2)	;***COPYRIGHT 1972,1973,1974 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.***
**************
1)2	OVTRAP:	PUSH P,T		;SAVE AC T AS "TSAVE"
1)		N=1
****
2)2	;**;[531] CHANGE @ OVTRAP	CLRH	5-APR-76
2)	OVTRAP:				;[531]
2)		IFN CPU-KA10,<		;[531]
2)		JRST	1,.+1		;[531] PORTAL FOR EXECUTE ONLY
2)	>;END IFN CPU-KA10	;[531]
2)		PUSH P,T		;SAVE AC T AS "TSAVE"
2)		N=1
**************
1)4		MOVSI T,(Z 17,)		;GET ONES IN AC FIELD
1)		AND T,@.JBTPC		;EXTRACT AC FIELD FROM FAULTING D.P. INST
1)		IOR T,[DMOVE 0,[EXP <377777,,777777>,<377777,,777777>]]
1)		SKIPGE ACDATA-N(P)	;WAS OVERFLOW RESULT POSITIVE?
****
2)4	;**; [531] CHANGE @ ACDOUN + 1L	CLRH	5-APR-76
2)		SETO	T,		;[531] GET -1 TO MAKE INFINITIES
2)		MOVMM	T,TSAVE-N+1(P)	;[531] PUT TWO WORDS ON THE STACK
2)		MOVMM	T,TSAVE-N+2(P)	;[531] FOR THE DMOVE TO USE
2)					;[531] THIS ASSUMES THAT ACDATA IS AT
2)					;[531] LEAST 3 SINCE WE ARE MAKING PLUS
2)					;[531] STACK ENTRIES.  THESE SHOULD BE
2)					;[531] SETOM'S AND MOVM'S IF ACFLD OR
2)					;[531] INST ARE NEEDED LATER
2)		MOVSI T,(Z 17,)		;GET ONES IN AC FIELD
2)		AND T,@.JBTPC		;EXTRACT AC FIELD FROM FAULTING D.P. INST
2)		IOR T,[DMOVE 0,TSAVE-N+1(P)] ;[531] SET UP DMOVE
2)		SKIPGE ACDATA-N(P)	;WAS OVERFLOW RESULT POSITIVE?
**************
1)4	IFE CPU-KA10,<LDB T,[POINT 4,@.JBTPC,12]	;GET AC FIELD
1)		DPB T,[POINT 4,T,12]	;COPY INTO AC FIELD
1)		ADDI T,1		;CHANGE AC TO AC+1
1)		TRZ T,20		;MASK TO 4 BITS
1)		TLO T,(SETZB) >		;CHANGE TO "SETZB AC,AC+1"
1)	IFE CPU-KI10,<MOVSI T,(Z 17,)	;GET ONES IN AC FIELD
1)		AND T,@.JBTPC		;EXTRACT AC FIELD FROM FAULTING INST
1)		IOR T,[DMOVE 0,[EXP 0,0]] >	;SET UP A DMOVE TO CLEAR 2 AC'S
1)		JRST UAC2
1)	UFSC:	MOVE	T,.JBTPC	;GET THE TRAP ADDRESS
****
2)4	;**; [531] CHANGE @ UACLNG + 1L CLRH	5-APR-76
2)		LDB T,[POINT 4,@.JBTPC,12]	;[531] GET AC FIELD
2)		DPB T,[POINT 4,T,12]	;COPY INTO AC FIELD
2)		ADDI T,1		;CHANGE AC TO AC+1
2)		TRZ T,20		;MASK TO 4 BITS
2)		TLO T,(SETZB)		;[531] CHANGE TO "SETZB AC,AC+1"
2)	;**; [531] DELETE CPU-KI10 COND @ UACLNG	CLRH	5-APR-76
File 1)	DSKB:FORTRP.MAC[10,6]	created: 1147 09-SEPT-1974
File 2)	TAPE:FORTRP.MAC	created: 0000 20-MAY-1976

2)		JRST	UAC2
2)	UFSC:	MOVE	T,.JBTPC	;GET THE TRAP ADDRESS
**************
1)4	TJFCL:	N=1
****
2)4	;**; [531] INSERT @ UAC2 + 2L	CLRH	5-APR-76
2)	IFN	CPU-KA10,<		;[531]
2)		JRST	1,.+1		;[531] KI AND KL PORTAL
2)	>;END IFN CPU-KA10		;[531]
2)	TJFCL:	N=1
**************