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

	TITLE STREAM I/O FOR FORTRAN/MACRO.
	SUBTTL PROGRAM BY MARTY SCHULTZ; V02: 4-05-72
	;	FLOATING I/O ROUTINES BY STUART SKALKA.
	;SYOSSET HIGH SCHOOL, N.Y.
;[DECUS]CONVERTED TO CURRENT FORTRAN CALLING CONVENTION 9 AUG 1980
;[DECUS]BY PAUL T. ROBINSON, WESLEYAN UNIV, DECUS CONVERSION PROGRAMMER
	LOC 137
	EXP 02		;VERSION 2 OF STREAM I/O
	RELOC

Q=16	;REFERENCE TO FORTRAN ARGUMENTS.
P=17	;USED FOR PUSH-DOWN OPERATIONS.
ACA=10	;BLOCK FOR LOOKUPS/ENTERS/OPENS
ACB=11
ACC=12
ACD=13
AC1=1	;GNL ACC. USED TO HOLD LOCATIONS.
AC2=2	;GNL ACC. USED TO HOLD POINTERS.
AC3=3	;GNL ACC. 
AC4=4	;GNL ACC. COUNTERS FOR LOOPS.
OFF=5	;OFFSET WHEN ADDRESSING BLOCK AREA.
GNL=6	;USED IN FORMING COMMANDS.
CNT=7	;USED IN COUNT OF INPUT STREAM.

	DEFINE GETUNT,
	<MOVE OFF,@(Q)
	MOVE AC3,OFF
	IMULI OFF,4>

	DEFINE W(WORD),
	<EXP WORD>

	DEFINE GETNCR,
	<JSR GETCHR
	JUMPE AC1,.-1>

	DEFINE BOUND (A1,A2),
	<CAIG AC1,A1
	CAIGE AC1,A2>

	DEFINE GETNBL,
	<GETNCR
	CAIN AC1," "
	JRST .-3>

	SUBTTL OUTFIL ROUTINE.

;CALL IS (IN FORTRAN PROGRAM):
;::= CALL OUTFIL(<UNIT>,<ASCIZ-DEVICE>,<MODE>,<FILENAME.EXT>,
;		<ASSIGNED-GOTO VARIABLE EOF;ERROR>,<PROTECTION>)
	ENTRY OUTFIL

OUTFIL:	JSR SETOPN		;CREATE OPEN COMMAND.
	MOVSI ACC,BUFFR(OFF)	;LOCATION OF BUFFER HEAD.
	MOVEM GNL,.+1		;ENTER CMMD.
	OPEN 0,0		;AN <OPEN>
	JRST IOFERR		;NO DEVICE FOR OUTPUT.
	MOVE GNL,[ENTER 0,ACA]	;CREATE ENTER
	DPB AC3,POINT1		;UNIT #
	JSR FILDO		;PUTS FILE.EXT INTO (10,11)
	MOVE ACC,@5(Q)		;PROTECTION
	ROT ACC,-9		;ADJUST FOR CORRECT POSITION.
	GETPPN ACD,		;ASSUME YOU.
	JFCL
	MOVEM GNL,.+1
	ENTER 0,0		;DO AN <ENTER>
	JRST IOFERR		;NO ROOM ON OUTPUT DEVICE.
	MOVE AC1,4(Q)		;LOCATION OF VARIABLE TO SET.
	MOVEM AC1,BUFFR+3(OFF)	;STORE HERE.
	POPJ	P,


	SUBTTL INFIL ROUTINE
	ENTRY INFIL
;CALL IS:
;::= CALL INFIL(<UNIT>,<ASCIZ-DEVICE>,<MODE>,<ASCIZ-FILE>
;		,<ASSIGNED-GOTO VARIABLE EOF;ERROF>,<P>,<PN>)

INFIL:	JSR SETOPN		;MAKE AN OPEN COMMAND
	MOVEI ACC,BUFFR(OFF)	;LOC OF BUFFER HEADER
	MOVEM GNL,.+1
	OPEN 0,0		;OPEN FILE FOR INPUT.
	JRST IOFERR		;NO SUCH INPUT DEVICE.

	MOVE GNL,[LOOKUP 0,ACA]	;CREATE A LOOKUP
	DPB AC3,POINT1		;ENTER UNIT NUMBER
	JSR FILDO		;PUTS FILENAME INTO ACA,ACB
	SETZ ACC,		;NOTHING GOES HERE.
	MOVE AC1,@5(Q)		;GET P[PN]
	JUMPN AC1,ISTHR		;IS IT ASSUMED (=0)?
	GETPPN ACD,		;YES. USE THIS ONE.
	JFCL
	JRST LKP		;DO A LOOKUP.
ISTHR:	HRL ACD,AC1		;IT IS THERE. P[PN]
	HRR ACD,@6(Q)		;[P]PN
LKP:	MOVEM GNL,.+1		;DO IT.
	LOOKUP 0,0		;WHAT IT WOULD BE.
	JRST IOFERR		;NO SUCH FILE
	MOVE AC1,4(Q)		;LOCATION OF VARIABLE TO SET.
	MOVEM AC1,BUFFR+3(OFF)	;STORE THERE.
	POPJ	P,


;SET-OPEN ROUTINE.
;THIS ROUTINE WILL FORM THE OPEN COMMAND, AND SET UP THE BUFFER
;HEADER LOCATION. INFO GOES ACA->ACD.
SETOPN:	Z
	GETUNT
	MOVE GNL,[OPEN 0,ACA]	;OPEN.
	DPB AC3,POINT1		;ENTER UNIT.
	MOVE ACA,@2(Q)		;MODE
	JSR ASCSIX		;CONVERT TO SIXBIT.
	JRST @SETOPN

ASCSIX:	Z			;ROUTINE TO CONVERT 7BIT-6BIT
	SETZ ACD,
	MOVE ACC,1(Q)
	MOVEM AC3,T1		;SAVE AC3.
	MOVE AC1,POINT5		;POINTER TO DEPOSIT CHARS
	MOVE AC2,POINT4		;POINTER TO LOAD UP CHARS.
	ILDB AC4,AC2
	SUBI AC4,40
	JUMPLE AC4,.+3
	IDPB AC4,AC1
	JRST .-4
	MOVE AC3,T1		;GET OLD VALUE
	MOVE ACB,ACD		;RETURN ANSWER HERE.
	JRST @ASCSIX

T1:	Z
T2:	MOVEI AC2,1(Q)		;THIS IS A RESETING INSTRUCTION.



FILDO:	Z			;ROUTINE TO TAKE FILE-NAME, ADJUST.
	MOVE ACC,3(Q)
	MOVE AC1,POINT4		;POINTER TO ASCIZ-NAME
	SETZB AC4,ACD
FILD3:	MOVE AC2,POINT5		;POINTER TO SIXBIT RESULT
FILD2:	ILDB AC3,AC1
	SUBI AC3,40		;AFTER GETTING CHAR, TURN TO SIXBIT.
	CAIN AC3,'.'		;AN EXTENSION STARTING?
	JRST FILEX		;YES. JUMP.
	CAIG AC3,' '		;GREATER THAN A SPACE- STILL NAME.
	JRST FILND
	IDPB AC3,AC2		;ENTER THE SIXBIT VALUE.
	JRST FILD2
FILND:	JUMPN AC4,FILED		;WAS THERE AN EXTENSION?
	MOVE ACA,ACD		;NO. BLANK EXTENSION.
	SETZB ACB,ACD
	JRST @FILDO
FILEX:	MOVE ACA,ACD
	SETO AC4,
	SETZ ACD,
	JRST FILD3
FILED:	MOVE ACB,ACD		;THERE WAS AN EXTENSION. FIX IT.
	SETZB ACD,AC4
	JRST @FILDO

IOFERR:	MOVE AC1,@4(Q)		;BRANCH TO @(LOC) ON ERROR.
	JRST (AC1)		;THIS CAME FROM AN ASSIGN.
	SUBTTL GETBYT ROUTINE
;CALL IS
;::=	CALL GETBYT(<UNIT>,<VARIABLE>[,<VARIABLE>,...])
;[DECUS]TOTALLY REWRITTEN TO AGREE WITH CURRENT FORTRAN CONVENTION 9 AUG 1980
	ENTRY GETBYT
GETBYT:	GETUNT			;UNIT PREPARATION
	HLLZ	AC2,-1(Q)	;GET ARG COUNT,,ZERO
GBTLUP:	AOBJN	AC2,.+2		;SKIP IF STILL NEGATIVE
	 POPJ	P,		;OTHERWISE RETURN
	JSR	GETCHR		;PICK UP A CHAR
	HRRZ	AC3,AC2		;GET OFFSET INTO BLOCK
	ADD	AC3,Q		;GET ADR OF CURRENT ARG
	MOVEM	AC1,@AC3	;STORE CHAR
	JRST	GBTLUP		;AND TRY FOR ANOTHER

;WHEN ANY TYPE OF ERROR CONDITION OCCURS, BRANCH TO THE VARIABLE
;STATED IN THE INFIL/OUTFIL CALL.  SHOULD BE SET THROUGH ASSIGNED GOTO.

INRR1:	MOVE AC1,@BUFFR+3(OFF)		;CONTAINS ADDRESS TO BRANCH
	JRST (AC1)			;ADDRESS TO GOTO.

	SUBTTL PUTBYT ROUTINE
;	CALL IS
;::=	CALL PUTBYT(<UNIT>,<VARIABLE>[,<VARIABLE>,...])
	ENTRY PUTBYT
;[DECUS]TOTALLY REWRITTEN FOR REVISED CALLING CONVENTION 9 AUG 80
PUTBYT:	GETUNT			;UNIT PREPARED
	HLLZ	AC2,-1(Q)	;GET -ARG COUNT,,ZERO
PBTLUP:	AOBJN	AC2,.+2		;SKIP IF STILL NEGATIVE
	 POPJ	P,		;OTHERWISE RETURN
	HRRZ	AC3,AC2		;GET ARG BLOCK OFFSET
	ADD	AC3,Q		;GET ADR OF ARG
	MOVE	AC1,@AC3	;GET ARG
	JSR	PUTCHR		;OUTPUT IT
	JRST	PBTLUP		;AND GO FOR MORE

;	ERROR CONDITION; EOF OR ERROR ON OUTPUT. <GOTO> ASSIGNED.
OUTRR1:	JRST INRR1


	SUBTTL GETCHR
;THIS ROUTINE WILL INPUT ONE CHARACTER FROM DEVICE INTO AC1.
GETCHR:	Z
	SOSL BUFFR+2(OFF)	;BUFFER EMPTYY?
	JRST GTBYT
	MOVE GNL,[IN 0,0]	;YES. CREATE AN 'IN'
	DPB AC3,POINT1		;ENTER UNIT
	MOVEM GNL,.+1
	IN 0,0			;INPUT FROM DEVICE.
	JRST  GETCHR+1		;NO ERROR. TRY AGAIN.
	JRST INRR1
GTBYT:	ILDB AC1,BUFFR+1(OFF)	;GET ONE ITEM.
	JRST @GETCHR

	SUBTTL PUTCHR
;THIS ROUTINE WILL OUTPUT ONE CHARACTER TO DEVICE FROM AC1.
PUTCHR:	Z
	SOSLE BUFFR+2(OFF)	;BUFFER FILLED UP?
	JRST PTBYT
	MOVE GNL,[OUT 0,0]	;YES. CREATE <OUT>
	DPB AC3,POINT1		;UNIT NUMBER.
	MOVEM GNL,.+1
	OUT 0,0			;OUTPUT TO DEVICE.
	JRST PUTCHR+1		;NO ERROR. TRY AGAIN
	JRST OUTRR1
PTBYT:	IDPB AC1,BUFFR+1(OFF)	;ENTER DATUM
	JRST @PUTCHR


	SUBTTL BRKOUT
;CALL IS:
;::=	CALL BRKOUT(<UNIT>)
;	THIS ROUTINE WILL IMMEDIATLEY EMPTY THE BUFFER.
;	USED FOR TTY COMMMUNICATIONS.
	ENTRY BRKOUT
BRKOUT:	MOVE AC3,@(Q)		;GET THE UNIT NUMBER.
	MOVE GNL,[OUT 0,0]	;DO A FORCED OUTPUT.
	DPB  AC3,POINT1		;ENTER THE UNIT NUMBER.
	MOVEM GNL,.+1
	OUT 0,0			;TYPE OF COMMAND.
	 POPJ	P,		;RETURN IF NO ERR
	JRST OUTRR1		;ERROR ROUTINE

	SUBTTL PUT ROUTINES.
	ENTRY PUT
;THE PUT ROUTINES ALLOW USER TO OUTPUT NUMBERS, CHARACTER STRINGS,
;AND HOLERITH CHARACTERS.  DUE TO THE FORTRAN COMPILER,
;TO OUTPUT CHARACTER STRINGS, (IN VARIABLES), THE VARIABLES MUST
;BE DECLARED COMPLEX.  IT WILL OUTPUT THE CHARACTERS UNTIL A NULL
;CHARACTER IS HIT.
;[DECUS]THIS ROUTINE HAS ALSO BEEN LARGELY REWRITTEN, VIZ. GETBYT.
PUT:	GETUNT			;SET UP UNIT
	MOVE	AC2,-1(Q)	;GET ARG COUNT WORD
PUTLUP:	AOBJN	AC2,.+2		;SKIP IF MORE ARGS
	 POPJ	P,		;OTHERWISE RETURN
	LDB	AC1,POINT6	;PICK UP ARG TYPE
	HRRZ	ACA,AC2		;GET ARG BLOCK OFFSET
	ADD	ACA,Q		;GET ARG ADR
	MOVE	ACA,@ACA	;GET VALUE TO OUTPUT
	JSR	@BRTAB1(AC1)	;BRANCH TO CORRECT ROUTINE
	JRST	PUTLUP		;AND GO FOR MORE

PUTINT:	Z			;INTEGER OUTPUT ROUTINE.
	PUSHJ P,DECOUT		;OUTPUT INTEGER.
	MOVEI AC1," "		;PREPARE TO OUTPUT A SPACE.
	JSR PUTCHR		;OUTPUT IT.
	JRST @PUTINT		;RETURN

PUTLOG:	Z			;LOGICAL OUTPUT ROUTINE.
	MOVE AC2,POINT8		;POINTER TO OUTPUT T-F
	JUMPGE ACA,.+3		;WAS IT TRUE?
	HRRI AC2,TRUEV		;YES TAKE IT FROM TRUE.
	JRST .+2
	HRRI AC2,FALSV		;NO TAKE IT FROM FALSE.
	ILDB AC1,AC2		;GET CHARACTER.
	JSR PUTCHR		;OUTPUT IT.
	JUMPN AC1,.-2		;IF NOT END, OUTPUT MORE.
	JRST @PUTLOG

TRUEV:	ASCIZ/TRUE  /
FALSV:	ASCIZ/FALSE /

PUTHOL:	Z			;OUTPUTS HOLERITH CHARACTERS.
	MOVE AC4,(AC2)		;LOCATION OF ARG.
	MOVE ACA,POINT7		;POINTER FOR CHARS.
	ILDB AC1,ACA		;GET CHARACTER.
	JSR PUTCHR		;OUTPUT IT.
	JUMPN AC1,.-2		;KEEP GOING UNTILL END.
	MOVEI	AC1,033		;ENTER ALTMODE
	JSR PUTCHR
	JRST @PUTHOL		;RETURN.

PUTCOM:	Z			;HOLERITH OUTPUT ROUTINE:VARIABLES
	MOVE AC4,(AC2)		;LOCATION OF PARAMETERS.
	MOVE ACA,POINT7		;POINTER FOR CHARS.
	MOVEI ACB,^D10		;OUTPUT TEN CHARS MAX.
PUTCM1:	ILDB AC1,ACA		;GET A CHAR.
	JUMPE AC1,PUTCM2	;EXIT ROUTINE AFTER NULL.
	JSR PUTCHR		;OUTPUT CHAR.
	SOJG ACB,PUTCM1		;LOOP UNTIL ALL TEN CHARS.
PUTCM2:	MOVEI AC1,175		;INSERT A $ WHEN DONE.
	JSR PUTCHR
	JRST @PUTCOM		;RETURN TO MAIN PROGRAM.

PUTNON:	Z			;OUTPUT ILLEGAL TYPE.
	MOVE AC2,POINT8		;POINTER TO NON-OUT
	HRRI AC2,NONEV		;ADDRESS TO OUTPUT.
	ILDB AC1,AC2
	JSR PUTCHR
	JUMPN AC1,.-2		;END YET?
	JRST @PUTNON		;YES. RETURN.
NONEV:	ASCIZ/*** /

PUTFLT:	Z			;FLOATING POUTPUT ROUTINE.
	MOVE ACC,ACA		;ROUTINE BY STUART SKALKA.
	JUMPE ACA,PUTFZR	;IF ZERO, DONT CONVERT.
	SETZB ACA,ACB		;EXPONENT, FLAGS.
	JUMPGE ACC,PUTFCK	;JUMP IF NOT NEG.
	FMPR ACC,[-1.0]		;POSITIVIZE.
	TRO ACB,1		;SET NEG BIT.

PUTFCK:	CAML ACC,ONE		;IS NUM>=1 ?
	JRST PUTFDV
	CAMLE ACC,PTONE		;IS NUM<=.1
	JRST PUTFOT
	FMPR ACC,TEN		;YES. MULTIPLY.
	SOJA ACA,PUTFCK		;RETEST IT.
PUTFDV:	FDVR ACC,TEN		;DEVIDE FOR NEW VALUE
	AOJA ACA,PUTFCK		;CHECK AGAIN.
PUTFOT:	MOVE ACD,[377B8]	;BITS TO SAVE EXPONENT.
	AND ACD,ACC		;ACD HAS EXPONENT.
	SUB ACC,ACD		;KILL EXPONENT FROM NUMBER.
	ROT ACD,9		;BRING AROUND TO START.
	SUBI ACD,^D125		;SUB 128 FOR CONVERT TO 2S COMPLEMENT.
				;ADD 3 EXPONENT BETWEEN 0 -> -3
	LSH ACC,(ACD)		;SHIFT NUMBER BY EXPONENT.
	TRNN ACB,1		;WAS THE NEGATIVE BIT ON?
	JRST .+3		;NO. DONT PRINT.
	MOVEI AC1,"-"		;OUTPUT A MINUS SIGN.
	JSR PUTCHR
PUTFZZ:	MOVE ACB,NUMDIG		;CLEAR FLAG, INSERT AMOUNT OF DIGITS.
	MOVEI AC1,"."		;OUTPUT A DECIMAL POINT.
	JSR PUTCHR
	SETZ AC1,
PUTFLP:	IMULI ACC,^D10		;MULTIPLY NUMBER BY 10.
	IDIV ACC,THIRTY
	IMULI AC1,^D10		;INCREASE VALUE.
	ADD AC1,ACC
	MOVE ACC,ACD		;GET NEW NUMBER.
	SOJG ACB,PUTFLP		;LOOP UNTIL ALL PRECSION DONE.
	MOVE ACC,ACA
	MOVE ACA,AC1
	ADDI ACA,5
	PUSHJ P,DECOUT
	MOVE ACA,ACC
PUTFEX:	MOVEI AC1,"E"
	JSR PUTCHR		;PRINT 'E'
	MOVEI AC1,"+"		;ASSUME POSITIVE.
	SKIPGE ACA
	MOVEI AC1,"-"		;OUTPUT A MINUS SIGN.
	JSR PUTCHR
PUTFTX:	MOVMS ACA		;MAKE EXPONENT POSITIVE.
	PUSHJ P,DECOUT		;OUTPUT EXPONENT.
	MOVEI AC1," "		;PRINT A TRIALING SPACE.
	JSR PUTCHR
	JRST @PUTFLT		;RETURN.
PUTFZR:	SETZB ACA,ACC
	JRST PUTFZZ

THIRTY:	^D1073741824
ONE:	1.0
PTONE:	0.1
TEN:	10.0

	SUBTTL DIGITS ROUTINE.
	ENTRY DIGITS
;CALL IS:
;::= CALL DIGITS(<AMOUNT>)
;THIS ROUTINE ENABLES USER TO VARY HOW MUCH PRECISION ON OUTPUT
;SHOULD BE GIVEN.  STANDARD OUTPUT IS SEVEN DIGITS.
DIGITS:	MOVE AC1,@(Q)		;GET THE AMOUNT.
	ADDI AC1,1
	MOVEM AC1,NUMDIG	;TELL IT.
	POPJ	P,

DECOUT:	IDIVI ACA,^D10		;DIVIDE BY BASE.
	HRLM ACB,(P)		;STORE IT.
	SKIPE ACA		;END OF NUMBER?
	PUSHJ P,DECOUT		;NO, TRY AGAIN.
	HLRZ AC1,(P)		;GET TOP ELEMENT.
	ADDI AC1,60		;CONVERT TO ASCIZ.
	JSR PUTCHR		;OUTPUT IT.
	POPJ P,			;RETURN.



	SUBTTL GET ROUTINES.
	ENTRY GET
;THE GET ROUTINES ALLOW THE USER TO INPUT NUMBERS,CHARACTER STRINGS,
;AND LOGICAL VALUES.  DUE TO THE FORTRAN COMPILER, TO INPUT CHAR-
;ACTER STRINGS, THE VARIABLE IN THE GET CALL MUST BE COMPLEX.
;[DECUS]MODIFIED AGAIN AS PER GETBYT.
GET:	GETUNT			;PICK UP UNIT
	SETZ	CNT,		;CLEAR LIST COUNT
	HLLZ	AC2,-1(Q)	;GET -ARG COUNT,,ZERO
GETLUP:	AOBJN	AC2,.+2		;SKIP IF STILL MORE TO GO
	 POPJ	P,		;OTHERWISE RETURN
	AOS	CNT		;INCREMENT COUNTER
	SETZ	ACB,		;CLEAR ERROR FLAG
	LDB	AC1,POINT6	;PICK UP ARG TYPE
	JSR	@BRTAB2(AC1)	;GO TO IT
	JUMPL	ACB,GETER1	;TAKE CARE OF ERRORS
	JRST	GETLUP		;GO FOR ANOTHER ONE


GETER1:	OUTSTR [ASCIZ/
IE=/]				;SIGNIFY INPUT ERROR.
	MOVE ACA,@(Q)		;GET THE UNIT NUMBER.
	PUSHJ P,DECT		;OUTPUT UNIT #.
	OUTCHR [","]
	MOVE ACA,CNT		;OUTPUT DATA NUMBER IN LIST.
	PUSHJ P,DECT
	SOS CNT			;SUBTRACT ONE FROM LIST COUNT.
	SETZM BUFFR+2(OFF)	;CLEAR BUFFER.
	OUTSTR [ASCIZ/
/]
	JRST GETLUP		;TRY AGAIN.

GETINT:	Z			;INTEGER INPUT ROUTINE.
	SETZ ACA,		;RESET VALUE.
	GETNBL			;GET FIRST NON-BLANK CHAR.
	CAIA			;SKIP NEXT INSTR
GETI1:	GETNCR			;GET NON-ZERO CHARACTER.
	BOUND "9","0"		;LEGAL DECIMAL DIGIT?
	JRST GETI2		;NO CHECK.
	SUBI AC1,60		;CONVERT TO DECIMAL.
	IMULI ACA,^D10
	ADD ACA,AC1
	JRST GETI1

GETI2:	JSR TYPCHR		;FIND OUT WHAT TYPE IT IS.
	JUMPN AC1,.+3		;IS IT LEGAL?
	SETO ACB,		;NO. SIGNAL ERROR.
	JRST @GETINT
	HRRZ	AC1,AC2		;GET OFFSET INTO AGR BLOCK
	ADD	AC1,Q		;ADD ADR OF BLOCK FOR ARG LOC
	MOVEM	ACA,@AC1	;RETURN VALUE
	JRST @GETINT

GETLOG:	Z			;LOGICAL INPUT ROUTINE.
	GETNBL			;GET NON-BLANK CHARACTER.
	CAIE AC1,"T"		;IS IT TRUE?
	JRST .+3
	SETO ACA,		;YES NEGATIVE.
	JRST  GETL1		;SCRAP REST.
	CAIN AC1,"F"		;THEN IS IT FALSE?
	JRST GETL2		;YES. BRANCH.
	SETO ACB,		;NO. ERROR.
	JRST @GETLOG
GETL2:	SETZ ACA,		;FALSE=0
GETL1:	GETNCR			;GET NON-ZERO CHAR
	JSR TYPCHR		;WHAT TYPE?
	JUMPE AC1,GETL1		;IGNORE IF NOT BREAK.
	HRRZ	AC1,AC2		;GET OFFSET INTO ARG BLOCK
	ADD	AC1,Q		;ADD ARG BLOCK ADR
	MOVEM	ACA,@AC1	;RETURN VALUE
	JRST @GETLOG

GETHOL:	Z			;HOLERITH(COMPLEX) INPUT ROUTINE.
	MOVE AC4,(AC2)		;LOCATION OF ARG.
	MOVE ACA,POINT7		;POINTER FOR CHARS.
	MOVEI ACB,^D10		;LOOP FOR INPUT.
GETC2:	GETNCR			;GET NON-NULL IN AC1.
	CAIN AC1,175		;AN ALTMODE?
	JRST GETC1		;YES.
	IDPB AC1,ACA		;NO.DEPOSIT CHAR.
	SOJG ACB,GETC2		;LOOP FOR THE TEN CHARACTERS.
GETC3:	GETNCR			;GET GARBAGE.
	CAIE AC1,175		;END JUNK.
	JRST GETC3		;NO. KEEP GOING.
	SETZ ACB,		;CLEAR ERROR FLAG.
	JRST @GETHOL		;RETURN.
GETC1:	SETZ AC1,		;ENTER NULLS
	IDPB AC1,ACA		;DEPOSIT IT.
	SOJG ACB,.-1		;KEEP REPEATING UNTIL ALL IN.
	SETZ ACB,		;CLEAR ERROR FLAG.
	JRST @GETHOL


GETNON:	Z			;ROUTINE TO THROW OUT VALUE.
	HRRZ	AC1,AC2		;GET OFFSET INTO ARG BLOCK
	ADD	AC1,Q		;ADD ADR OF ARG BLOCK
	SETZM	@AC1		;SET ARG TO 0
GETNN1:	GETNCR			;GET NON-BLANK.
	JSR TYPCHR		;FIND OUT TYPE.
	JUMPE AC1,GETNN1	;IF NOT BREAK, GET AGAIN.
	JRST @GETNON


GETFLT:	Z			;ROUTINE GETFLT BY STUART SKALKA.
	PUSH P,AC2		;KEEP THE INDEX TO RETURN TO.
	MOVE ACD,GETFMS		;INPUTS A FLOATING POINT NUMBER.
	SUBI ACD,1		;ACD HAS BITS 9 TO 35 SET.
	SETZB AC2,ACC		;FRACTION, EXPONENT.
	SETZB AC4,ACB		;COUNT, FLAGS.
GETF1:	GETNCR			;GET A NON-BLANK CHARACETER.
	MOVEM AC1,T1		;SAVE THIS TYPECHAR.
	JSR TYPCHR		;FIND OUT CHAR TYPE IN AC1.
	JUMPN AC1,GETFDN+3	;BREAK CHAR.  GOTO GETFDN.
	MOVE AC1,T1		;NORMAL TYPE CHARACTER.
	CAIN AC1,"E"		;EXPONENT YET?
	JRST GETF2		;YES. GET IT.
	CAIE AC1,"."		;HIT DECIMAL POINT YET?
	JRST .+5		;NO.
	TRNE ACB,1B34		;POINT BIT SET?
	JRST GETFBD		;BAD DIGIT.
	TRO ACB,^B1001B34	;SET POINT AND DIGITS BIT.
	JRST GETF1		;GET NEXT CHAR
	TRNE ACB,1B31		;DIGITS YET?
	JRST GETCD		;YES PROCESS.
	CAIE AC1,"+"		;HIT A +?
	JRST .+3		;NOPE, SKIP IT.
	TRO ACB,1B31		;SET DIGITS BIT.
	JRST GETF1		;GET MORE.
	CAIE AC1,"-"		;MINUS?
	JRST GETCD		;NO CHECK DIGIT.
	TRO ACB,^B101B33	;SET - AND DIGITS BIT
	JRST GETF1
GETCD:	BOUND "9","0"
	JRST GETFBD		;NOT A DIGIT. ILLEGAL.
	TRNE ACB,1B34		;DECIMAL POINT DIGIT?
	SUBI AC4,1		;ANOTHER 10^-1 TO MULT BY.
	IMULI AC2,^D10		;MULTIPLY FRAC BY 10
	SUBI AC1,60		;MAKE INTO DECIMAL.
	ADD AC2,AC1		;ADD TO FRACTION
	CAMLE AC2,ACD		;TOO MANY DIGITS?
	JRST GETFBD		;YES. ERROR
	JRST GETF1
GETF2:	GETNCR			;GET NON-NULL CHAR.
	MOVEM AC1,T1		;SAVE CHARACTER.
	JSR TYPCHR		;IS IT A BREAKCHAR?
	JUMPN AC1,GETFDN
	MOVE AC1,T1		;NO IT WASN'T.
	TRNE ACB,1B30		;DIGITS YET?
	JRST GETFDG		;YES. GET THEM.
	CAIE AC1,"+"
	JRST .+3
	TRO ACB,1B30		;SET DIGITS.
	JRST GETF2		;RETURN.
	CAIE AC1,"-"
	JRST GETFDG		;NO. SEE IF DIGIT.
	TRO ACB,^B101B32	;SET - DIGIT FLAGS.
	JRST GETF2
GETFDG:	BOUND "9","0"
	JRST GETFBD		;NOT A DIGIT.
	SUBI AC1,60		;CONVERT TO DECIMAL.
	IMULI ACC,^D10
	ADD ACC,AC1
	TRO ACB,1B30		;SET DIGITS FLAG.
	JRST GETF2
GETFDN:	TRNE ACB,1B32		;NEGATIVE?
	MOVNS ACC		;NEGATE IT.
	ADD AC4,ACC		;POWER OF TEN.
	FSC AC2,233		;FLOAT FRACTION.
	JUMPE AC4,GETFIN-2	;IF EXPONENT=0, PRINT.
	MOVE ACD,[1.0]		;WILL HAVE FLOATED EXPONENT.
	SETZ ACC,
	JUMPL AC4,GETFDV	;IF EXP<0, THEN DIVIDE.
GETFML:	ADDI ACC,1		;INCREMENT COUNTER.
	FMPR ACD,[10.0]		;MULTIPLY.
	JFOV GETFVR
	CAME ACC,AC4		;ENOUGH?
	JRST GETFML		;NO.
	JRST GETFIN-4		;YES. MULTIPLY FRACTION BY EXPONENT.
GETFDV:	SUBI ACC,1		;DECREMENT COUNTER.
	FDVR ACD,[10.0]		;DIVIDE.
	JFOV GETFUN
	CAME ACC,AC4		;ENOUGH?
	JRST GETFDV		;NOPE.
	FMPR AC2,ACD		;MULTIPLY FRACTION BY EXPONENT.
	JFOV GETFWH
GETFFN:	TRNE ACB,1B33		;NEGATIVE NUMBER?
	FMPR AC2,[-1.0]		;NEGATE IT.
GETFIN:	MOVE AC1,AC2		;SWITCH VALUES.
	POP P,AC2		;GET THE OLD VALUE BACK.
	HRRZ	ACA,AC2		;GET OFFSET INTO ARG BLOCK
	ADD	ACA,Q		;ADD ADR OF ARG BLOCK
	MOVEM	AC1,@ACA	;RETURN VALUE
	JRST @GETFLT
GETFBD:	SETO ACB,		;AN ERROR
	POP P,AC2		;GET THE OLD VALUE AWAY.
	JRST @GETFLT

GETFMS:	1B8
GETFWH:	JUMPL AC4,GETFUN	;IF EXP<0,...
GETFVR:	SETO AC2,
	LSH AC2,-1		;MAXIMUN FLOATING NUMBER.
	JRST GETFFN		;NEGATE IF NEEDED.
GETFUN:	SETZ AC2,		;SMALLEST FLOATING NUMBER.
	JRST GETFIN


DECT:	IDIVI ACA,^D10		;ERROR DECIMAL PRINTOUT REOUTINE.
	HRLM ACB,(P)
	SKIPE ACA
	PUSHJ P,DECT
	HLRZ ACA,(P)
	ADDI ACA,60
	OUTCHR ACA
	POPJ P,

TYPCHR:	Z			;RETURNS TYPE OF CHARACTER.
	CAIE AC1,15		;IS IT A <CR>
	JRST .+6
	SETZ CNT,		;YES. RESET LIST COUNT.
	GETNCR			;SCRAP LINE-FEED.
	MOVEI AC1,1		;1=<CR>
	JRST @TYPCHR		;RETURN.
	CAIE AC1,33		;AN ALTMODE ($)
	JRST .+3
	MOVEI AC1,2		;2=<ALTMODE>
	JRST @TYPCHR		;RETURN.
	CAIE AC1," "		;A SPACE.
	JRST .+3
	MOVEI AC1,3		;3=<SPACE>
	JRST @TYPCHR
	CAIE AC1,","		;A COMMA?
	JRST .+3
	MOVEI AC1,4		;4=<COMMA>
	JRST @TYPCHR
	SETZ AC1,		;0=<ANY OTHER CHAR>
	JRST @TYPCHR

	SUBTTL CLSFIL ROUTINE
;ROUTINE TO CLOSE FILE, DISASSOCIATE CHANNEL NUMBER. CALL:
;::= CALL CLSFIL(<UNIT>)
	ENTRY CLSFIL
CLSFIL:	MOVE AC3,@(Q)		;THIS IS THE LOC IN CHAIN.
	MOVEI	Q,[EXP AC3]
	PUSHJ	P,BRKOUT	;DO A DEFAULT BRKOUT
	MOVE GNL,[CLOSE 0,0]	;CREATE THE CLOSE COMMAND.
	DPB AC3,POINT1		;ENTER UNIT
	MOVEM GNL,.+1
	CLOSE 0,0		;CLOSE THE FILE.
	MOVE GNL,[RELEAS 0,0]	;CREATE THE RELEASE COMMAND.
	DPB AC3,POINT1		;ENTER THE UNIT NUMBER.
	MOVEM GNL,.+1
	RELEAS 0,0		;RELEASE THE DEVICE.
	POPJ	P,		;RETURN

BUFFR:	BLOCK ^D4*^D16		;ALLOW FOR 16 DEVICES: 3 HEADER, 1 LOC

POINT1:	POINT 4,GNL,12
POINT2:	POINT 9,(AC2),8
POINT3:	POINT 7,@(Q)
POINT4:	POINT 7,(ACC)
POINT5:	POINT 6,ACD
POINT6:	POINT 3,(AC2),12
POINT7:	POINT 7,(AC4)
POINT8:	POINT 7,0

NUMDIG:	7

;[DECUS]THE TWO BRANCH TABLES WERE REWRITTEN TO ACCOMMODATE THE CHANGED 
;[DECUS]ARGUMENT TYPE CODES.
BRTAB1:	W PUTINT		;(0)INTEGER OUTPUT.
	W PUTLOG		;(1)LOGICAL
	W PUTINT		;(2)ALSO INTEGER
	W PUTNON		;(3)ILLEGAL
	W PUTFLT		;(4)FLOATING.
	W PUTNON		;(5)ILLEGAL
	W PUTNON		;(6)ILLEGAL.
	W PUTNON		;(7)ILLEGAL
	W PUTHOL		;(10)DOUBLE-PRECISION (HOLERITH)
	W PUTNON		;(11)ILLEGAL.
	W PUTNON		;(12)ILLEGAL
	W PUTNON		;(13)ILLEGAL
	W PUTHOL		;(14)COMPLEX(HOLLERITH)
	W PUTNON		;(15)ILLEGAL
	W PUTNON		;(16)ILLEGAL
	W PUTHOL		;(17)ASCIZ STRING (HOLLERITH)


BRTAB2:	W GETINT		;(0)INTEGER INPUT.
	W GETLOG		;(1)LOGICAL
	W GETINT		;(2)INTEGER
	W GETNON		;(3)ILLEGAL
	W GETFLT		;(4)FLOATING POINT
	W GETNON		;(5)ILLEGAL
	W GETNON		;(6)ILLEGAL
	W GETNON		;(7)ILLEGAL
	W GETHOL		;(10)DOUBLE-PRECISION (HOLLERITH)
	W GETNON		;(11)ILLEGAL
	W GETNON		;(12)ILLEGAL
	W GETNON		;(13)ILLEGAL
	W GETHOL		;(14)COMPLEX=HOLERITH
	W GETNON		;(15)ILLEGAL
	W GETNON		;(16)ILLEGAL
	W GETHOL		;(17)ASCIZ STRING (HOLLERITH)


	END