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.
	LOC 137
	EXP 02		;VERSION 2 OF STREAM I/O
	RELOC

Q=16	;REFERENCE TO F40 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.

		EXTERN MAIN.
STREAM:	JRST MAIN.
	DEFINE GETUNT,
	<MOVE OFF,@(Q)
	MOVE AC3,OFF
	IMULI OFF,4>
	DEFINE RESTOR,
	<MOVE AC2,T2
	MOVEM AC2,.+1>
	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 F40 PROGRAM):
;::= CALL OUTFIL(<UNIT>,<ASCIZ-DEVICE>,<MODE>,<FILENAME.EXT>,
;		<ASSIGNED-GOTO VARIABLE EOF;ERROR>,<PROTECTION>)
	ENTRY OUTFIL

OUTFIL:	Z
	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.
	JRA Q,5(Q)


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

INFIL:	Z
	JSR SETOPN		;MAKE AN OPEN COMMAND
	MOVEI ACC,BUFFR(OFF)	;LOC OF BUFFER HEADER
	MOEM 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.
	JRA Q,6(Q)		;RETURN & RESTORE.


;SET-OPEN ROUTINE.
;THIS ROUTINE WILL FORM THE OPEN COMMAND, AND SET UP THE BUFFER
;HEADER LOCATION. INFO GOES ACA->ACD.
	ENTRY SETOPN
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

	ENTRY ASCSIX
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.



	ENTRY FILDO
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>,...])
	ENTRY GETBYT


GETBYT:	Z
	GETUNT			;UNIT PREPARARION.
	RESTOR			;RESETS NEXT INSTRUCTION.
GETA:	MOVEI AC2,1(Q)		;LOACTION FOR RETURN, NEXT ARG.
GETB:	JFCL @(AC2)		;LOCATION FOR RETURN.
	LDB AC1,POINT2		;INSTRUCTION.
	CAIE AC1,320		;IS IT F40'S <ARG> PSEUDO-OP?
	JRA Q,@GETA		;NO RETURN
	JSR GETCHR		;YES. GET A CHAR.
	MOVEM AC1,@GETB		;LOAD IT UP.
	AOS GETA
	JRST GETA		;DO IT AGAIN.

;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

PUTBYT:	Z
	GETUNT			;UNIT PREPARED
	RESTOR			;RESETS NEXT INSTRUCTION.
PUTA:	MOVEI AC2,1(Q)		;LOCATION FOR RETURN.
PUTB:	JFCL @(AC2)		;LOCATION FOR ARGS.
	LDB AC1,POINT2		;INSTRUCTION OF LOCATION.
	CAIE AC1,320		;IS THIS AN ARG
	JRA Q,@PUTA		;NO. RETURN TO F40 PROGRAM.
	MOVE AC1,@PUTB		;YES. VALUE TO OUTPUT.
	JSR PUTCHR		;OUTPUT IT.
	AOS PUTA
	JRST PUTA		;DO IT AGAIN.

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


	SUBTTL GETCHR
	ENTRY 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
	ENTRY 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:	Z
	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.
	JRA Q,(Q)		;RETURN.
	JRST OUTRR1

	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.
PUT:	Z
	GETUNT			;SET UP THE UNIT AREA.
	RESTOR			;RESTORE THE NEXT INSTRUCTION.
PUTN1:	MOVEI AC2,1(Q)		;LOCATION FOR RETURN.
PUTN2:	JFCL @(AC2)		;LOCATION FOR ARGUMENTS.
	LDB AC1,POINT2		;INSTRUCTION VALUE.
	CAIE AC1,320		;IS IT A JUMP NO-OP?
	JRA Q,@PUTN1		;NO RETURN.
	LDB AC1,POINT6		;GET THE DATA TYPE.
	MOVE ACA,@PUTN2		;VALUE TO OUTPUT.
	JSR @BRTAB1(AC1)	;BRANCH OUT ACCORDINGLY.
	AOS PUTN1
	JRST PUTN1		;REPEAT PROCESS.

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

	ENTRY PUTLOG
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 /

	ENTRY PUTHOL
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,175		;ENTER AN ALTMODE.
	JSR PUTCHR
	JRST @PUTHOL		;RETURN.

	ENTRY PUTCOM
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.

	ENTRY PUTNON
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/*** /

	ENTRY PUTFLT
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:	Z			;DIGITS ROUTINE.
	MOVE AC1,@(Q)		;GET THE AMOUNT.
	ADDI AC1,1
	MOVEM AC1,NUMDIG	;TELL IT.
	JRA Q,(Q)		;RETURN.

	ENTRY DECOUT
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.
GET:	Z			;GET ROUTINES.
	GETUNT			;SET UP THE BUFFER ADDRESS.
	SETZ CNT,		;CLEAR LIST COUNT.
	RESTOR			;RESET NEXT INSTRUCTION.
GETN1:	MOVEI AC2,1(Q)		;LOCATION FOR RETURN.
GETN2:	JFCL @(AC2)
	AOS CNT			;INCREMENT LIST COUNT.
	SETZ ACB,		;CLEAR ERROR FLAG.
	LDB AC1,POINT2		;GET THE INSTRUCTION.
	CAIE AC1,320		;IS IT A JUMP?
	JRA Q,@GETN1		;NO, RESTORE & RETURN.
	LDB AC1,POINT6		;GET THE TYPE OF VARIABLE.
	JSR @BRTAB2(AC1)	;BRANCH OUT.
	JUMPL ACB,GETER1	;IF ERROR, GOTO GETER1.
	AOS GETN1
	JRST GETN1		;REPEAT PROCEDURE.

GETER1:	OUTSTR [ASCIZ/
IE=/]				;SIGNIFY INPUT ERROR.
	MOVE ACA,AC3		;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 GETN2		;TRY AGAIN.
	ENTRY GETINT
GETINT:	Z			;INTEGER INPUT ROUTINE.
	SETZ ACA,		;RESET VALUE.
	GETNBL			;GET FIRST NON-BLANK CHAR.
	JRST .+2		;SKIP OVER NEXT INSTRUCTION.
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
	MOVEM ACA,@GETN2	;LEGAL. LOAD IT IN.
	JRST @GETINT

	ENTRY GETLOG
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.
	MOVEM ACA,@GETN2	;ENTER VALUE.
	JRST @GETLOG

	ENTRY GETCOM
GETCOM:	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 @GETCOM		;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 @GETCOM


	ENTRY GETNON
GETNON:	Z			;ROUTINE TO THROW OUT VALUE.
	SETZM @GETN2		;SET IT TO ZERO.
GETNN1:	GETNCR			;GET NON-BLANK.
	JSR TYPCHR		;FIND OUT TYPE.
	JUMPE AC1,GETNN1	;IF NOT BREAK, GET AGAIN.
	JRST @GETNON


	ENTRY GETFLT
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.
	MOVEM AC1,@GETN2	;STORE IT AWAY.
	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


	ENTRY DECT
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,

	ENTRY TYPCHR

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:	Z
	MOVE AC3,@(Q)		;THIS IS THE LOC IN CHAIN.
	JSA Q,BRKOUT		;DO A DEFUALT BRKOUT.
	JUMP AC3		;CONTAINS UNIT NUMBER.
	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.
	JRA Q,(Q)		;RESTORE AC, 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

BRTAB1:	W PUTINT		;INTEGER OUTPUT.
	W PUTNON		;ILLEGAL
	W PUTFLT		;FLOATING.
	W PUTLOG		;LOGICAL
	W PUTNON		;ILLEGAL.
	W PUTHOL		;HOLERITH
	W PUTNON		;ILLEGAL.
	W PUTCOM		;COMPLEX=HOLERITH.


BRTAB2:	W GETINT		;INTEGER INPUT.
	W GETNON		;ILLEGAL
	W GETFLT		;FLOATING.
	W GETLOG		;LOGICAL
	W GETNON		;ILLEGAL
	W GETNON		;ILLEGAL
	W GETNON		;ILLEGAL
	W GETCOM		;COMPLEX=HOLERITH



	END STREAM
*U*