TITLE ABACUS - ADVANCED BOWDOIN ARITHMETIC CALCULATOR UTILITY SYSTEM
SUBTTL DECLARATIONS


;WRITTEN BY WILLIAM E. SEVERANCE, JR. '74
;WITH SPECIAL CREDIT TO PAUL P. VAGNOZZI '75 FOR ASSISTANCE IN
;DEVELOPING THE PNS CONVERSION AND FUNCTION CALLING TECHNIQUES
;WITHOUT WHICH ABACUS WOULD BE IMPOSSIBLE


;DEVELOPMENT OF ABACUS BEGAN IN THE SPRING OF 1972 AS A FUTURE
;SUBSTITUTE FOR THE SYSTEM PROGRAM "AID".


;*********INSTRUCTIONS FOR LOADING AND SAVING ABACUS***********

;THE ABACUS SYSTEM IS SUPPLIED WITH THE FOLLOWING FILES:
;	ABACUS.MAC   --   SOURCE CODE IN MACRO-10
;	ABACUS.SHR   --   SHARABLE OBJECT CODE  WITH STANDARD ASSEMBLY PARAMETERS
;	ABACUS.HLP   --   ASCII HELP FILE TO BE PLACED ON DEVICE SYS:
;	ABACUS.STO   --   SAMPLE STORAGE FILE PRODUCED BY ABACUS
;			  CONTAINING MANY USEFUL FUNCTION DEFINITIONS

;TO LOAD YOUR OWN ABACUS SYSTEM THE FOLLOWING IS TYPED:
;	.LOAD ABACUS.MAC

;TO MAKE A SHARABLE VERSION OF ABACUS SIMPLY TYPE:
;	.SSAVE SYS:

;*******************************************************************

	IFNDEF PURE,<PURE=1>	;TWO SEGMENT IF PURE=1
	IFN PURE,<TWOSEG>
	IFN PURE,<RELOC 400000>


;ACCUMULATOR ASSIGNMENTS

	FLAGS=0			;SEE HOW THEY WAVE BELOW
	A=1			;GENERAL PURPOSE
	B=2
	C=3
	D=4
	N=5			;FOR NUMBERS
	N1=N+1			;NEXT TO N THERE'S N1
	CNT=7			;ALL PURPOSE COUNTER
	FIND=10			;FUNCTION INDEX
	PIND=11			;PNS INDEX
	SYMBOL=12		;FOR LABLES, ETC.
	WD=13			;FOR WORDS
	CHR=14			;FOR CHARACTERS (XWD FLAG,SIXBIT CHARACTER)
	BPT=15			;A BYTE POINTER
	STACK=16		;STACK PUSH DOWN POINTER
	PDP=17			;REGULAR PUSH DOWN POINTER

;FLAGS IN RIGHT HALF OF 'FLAGS'

	F.LPAR=1		;LAST ELEMENT WAS "("
	F.LVAR=2		;LAST ELEMENT WAS NUMBER OR LABLE
	F.LOPP=4		;LAST ELEMENT WAS AN OPERATOR
	F.PASS=10		;A DEFINITION IS BEING PASSED
	F.DEFN=20		;A FUNCTION IS BEING DEFINED
	F.DTA=40		;DEVICE IS A DTA
	F.MINI=200		;ON IF MINUS DO INCREMENT
	F.DEG=400		;ON IF TRIG FUNCTIONS WORK IN DEGREES
	F.MINV=1000		;IT'S A MINUS VALUE
	F.UNDR=2000		;UNDERFLOW HAS OCCURED
	F.OVER=4000		;OVERFLOW HAS OCCURRED
	F.FCHR=10000		;ON IF OUTPUTING TO A FILE
	F.ALF=20000		;ON IF COMMAND ARG 'ALLFUN' SEEN
	F.ALV=40000		;ON IF COMMAND ARG 'ALLVAR' SEEN
	F.VARS=100000		;ON IF  A VARIABLE SEEN IN INPUT FILE
	F.FUNS=200000		;ON IF A FUNCTION SEEN IN INPUT FILE

;FLAGS IN LEFT HALF OF 'FLAGS'

	F.NUM=1			;A DIGIT HAS BEEN SEEN
	F.MINN=2		;IT'S A MINUS QUANTITY
	F.DOT=4			;A DOT HAS BEEN SEEN

;CHARACTER FLAGS IN LEFT HALF OF AC "CHR"

	C.OTHR=0		;NOT HANDLED WITH FLAGS
	C.ILEG=1		;ILLEGAL CHARACTER
	C.LETT=2		;A LETTER
	C.LOWC=4		;LOWER CASE
	C.DIGI=10		;A DIGIT
	C.DOT=20		;A DECIMAL POINT
	C.COLN=40		;A COLON
	C.CR=100		;CARRIAGE RETURN
	C.LTR=200		;THE LESS THAN RELATION <
	C.GTR=400		;THE GREATER THAN RELATION >
	C.SPAC=1000		;A SPACE
	C.COMA=2000		;A COMMA
	C.SEMI=4000		;A SEMI COLON
	C.OPR=10000		;AN OPERATOR
	C.EQAL=20000		;THE EQUAL SIGN
	C.LPAR=40000		;LEFT PARENTHESIS
	C.RPAR=100000		;RIGHT PARENTHESIS
	C.LBRK=200000		;A LEFT BRACKET
	C.RBRK=400000		;A RIGHT BRACKET
	C.LETL=C.LETT+C.LOWC	;LOWER CASE LETTER
	C.TERM=C.SEMI+C.CR	;EXPRESSION TERMINATOR


;DEVCHR CALLI BIT FLAGS -- IN AC "A" AFTER DEVCHK ROUTINE

	DV.DSK=200000		;DEVICE IS DSK
	DV.LPT=40000		;DEVICE IS LPT
	DV.DTA=100		;DEVICE IS DECTAPE
	DV.AVL=40		;DEVICE IS AVAILABLE TO JOB
	DV.TTY=10		;DEVICE IS A TTY
	DV.DIR=4		;DEVICE IS A DIRECTORY DEVICE (DSK OR DTA)
	DV.IN=2			;DEVICE CAN DO INPUT
	DV.OUT=1		;DEVICE CAN DO OUTPUT

;MISC. DEFINITIONS

	PNSLEN=^D256		;PNS MAXIMUM LENGTH
	STKLEN=^D150		;STACK MAXIMUM PDL DEPTH
	PDLLEN=^D32		;REGULAR PDL MAXIMUM DEPTH
	.JBVER=137		;VERSION NUMBER LOCATION
	LTLEN=^D128		;MAXIMUM LENGTH OF LABTAB (EACH ENTRY IS 2 WORDS)
	MAXARG=^D10		;MAXIMUN NUMBER OF FUNCTION ARGS
	OPFLD=10		;OPCODE FIELD FOR UUO'S
	STDPRO=157000		;STANDARD OUTPUT FILE PROTECTION
	MODE=14			;BINARY MODE FOR FILE INPUT/OUTPUT
	ASCMOD=0		;ASCII MODE
	FILCOD=234500		;FILE FORMAT CODE

;ASCII CHARACTER CODES

	TAB=11			;TAB
	LF=12			;LINE FEED
	CR=15			;CARRIAGE RETURN
	SPACE=40		;SPACE

;I/O CHANNEL ASSIGNMENTS

	CHANI=1			;INPUT FROM FILE
	CHANO=2			;OUTPUT TO FILE


;CONDITIONAL ASSEMBLY SWITCHES

	IFNDEF HEADER,<HEADER=1>		;PRINT GREATING IF 1
	IFNDEF DEBUG,<DEBUG=0>			;DEBUG FEATURES IF 1
	IFNDEF FILCAP,<FILCAP=1>		;FILE CAPABILITIES IF 1
	IFNDEF BYER,<BYER=1>			;ALLOW LOGOUTS IF 1



;EXTERNAL DECLARATIONS

	EXTERN .JBSA,.JBFF,.JBREL,.JBTPC,.JBAPR,.JBUUO,.JB41,.JBDDT,.JBREN

;UUO OPCODE DEFINITIONS -- SEE ROUTINE UUOH FOR DETAILS

	OPDEF SPEAK [1B8]
	OPDEF ERR [2B8]
	OPDEF ERRF [3B8]


LOC	.JBVER			;SET UP VERSION NUMBER
XWD	1,4
RELOC
SUBTTL MAIN PROGRAM

ABACUS:	CALLI	0			;RESET ALL I/O
	SETZ	FLAGS,			;ZERO ALL FLAGS
	MOVE	A,[LOWBEG,,LOWBEG+1]	;SET UP BLT WORD TO CLEAR
	SETZM	LOWBEG			;ALL OF THE LOW SEGMENT
	BLT	A,LOWEND-1
	SETZ	A,			;SAVE RUN TIME THUS FAR
	CALLI	A,27
	MOVEM	A,INRNTM
	CALLI	A,23			;SAVE STARTING TIME
	MOVEM	A,INCNTM
	HRLZI	A,CNT			;SET UP FUNCTION POINTER
	HRR	A,.JBFF
	MOVEM	A,FNSTPT
	HRRZM	A,FUNNXT		;SET UP ADR FOR NEXT FUNCTION
	MOVEI	A,FIND			;SET UP SECOND FUNCTION POINTER
	HRLZM	A,FUNPNT
	MOVE	A,.JBREL		;SET UP MAX ADR OF LOW SEG
	HRRZM	A,FUNMAX
	MOVEI	A,PIND			;SET UP PNS POINTER
	HRLZM	A,PNSLOC
	MOVE	A,[FSC N,0]		;SET UP CONSTANT LOCS IN LOW SEG
	MOVEM	A,EX1
	MOVEI	A,2			;2 VARIABLES ARE PRE-DEFINED
	MOVEM	A,LABTOT
	MOVE	A,[SIXBIT /RESLT/]
	MOVEM	A,LABTAB
	MOVE	A,[SIXBIT /TOT/]
	MOVEM	A,LABTAB+2
	MOVE	A,[PUSHJ PDP,UUOH]	;GET READY FOR UUO TRAPPING
	MOVEM	A,.JB41
	MOVEI	A,TRAPIT		;SET UP PROCESSOR TRAPPING
	HRRZM	A,.JBAPR		;FOR REPETATIVE ENABLE
	MOVEI	A,600110		;OF PDL OVERFLOW AND
	CALLI	A,16			;ARITH. OVER/UNDERFLOW
	MOVE	PDP,PDLPNT		;INIT REGULAR PUSH DOWN LIST
	MOVEI	A,RENTER		;SET UP REENTER LOCATION
	MOVEM	A,.JBREN
	IFN	FILCAP,<
	PUSHJ	PDP,DTAFIL		;SET UP A TMP FILENAME
	>
	PUSHJ	PDP,CRLF		;FANCY IT UP

	IFN HEADER, <

	SPEAK	HDMSG			;PRINT GREATING
	HLRZ	N,.JBVER		;PUT OUT VERSION NUMBER
	PUSHJ	PDP,OCTPNT
	PUSHJ	PDP,PERIOD
	HRRZ	N,.JBVER
	PUSHJ	PDP,OCTPNT
	PUSHJ	PDP,TABOUT
	PUSHJ	PDP,DATE		;ALONG WITH DATE AND TIME
	PUSHJ	PDP,TABOUT
	PUSHJ	PDP,TIME
	PUSHJ	PDP,CRLF
	>				;END OF COND. ON HEADER


BEGINC:	PUSHJ	PDP,CRLF


;THIS IS THE TOP LEVEL OF ABACUS!!!!!

BEGIN:	TLNN	CHR,C.SEMI		;SEMICOLON WAS TERMINATIOR?
RENTER:	PUSHJ	PDP,PROMPT		;PUT OUT A "#"
	MOVSI	PIND,-PNSLEN		;SET UP PNS LENGTH CONTROL
	SETZ	FLAGS,			;CLEAR ALL FLAGS
	SETZM	VARNAM			;VARIABLE NAME ON AN EQUAL
	MOVE	STACK,STKST		;INIT STACK AS A DELIMITER LIST
	PUSHJ	PDP,SSPACE		;INPUT SKIPING SPACES
	TLNE	CHR,C.TERM		;ANYTHING TYPED?
	JRST	BEGIN			;HOW SAD. . .
	TLNE	CHR,C.LETT		;ALPHA?
	JRST	BEGINA
	TLNE	CHR,C.DIGI+C.DOT	;NUMERIC?
	JRST	BEGINN
	PUSHJ	PDP,POLC3		;START SCAN WITH SOMETHING ELSE

CHAIN:	MOVE	STACK,STKST		;COME HERE WHEN CHAINING
	PUSH	STACK,RESLT		;PUSH PREVIOUS RESLT ONTO STACK
	PUSHJ	PDP,PNSVAL		;EVALUATE PNS
	MOVE	N,RESLT			;UPDATE THE BACKUP RESLT
	MOVEM	N,BRESLT
	POP	STACK,RESLT		;AND STORE THE RESULT
	JRST	BEGIN			;START FRESH

BEGINA:	MOVEI	CNT,6			;HERE ON FIRST ALPHA
	PUSHJ	PDP,LABIN		;BRING IN LABLE OR COMMAND
	JRST	LABLON			;TOO MANY CHARACTERS
	PUSHJ	PDP,COMCHK
	JRST	@COMTAB+1(A)		;GO TO THE COMMAND ROUTINE
BEGIN1:	TLNE	CHR,C.LETT+C.DIGI+C.DOT
	ERR	NOCOMD			;COMMAND IS BAD
	CAIGE	CNT,1			;HERE IF NOT LEGAL COMMAND
	JRST	LABLON			;TOO LONG A VARIABLE
	TLNE	CHR,C.EQAL		;AN EQUAL SIGN?
	JRST	TYPE1			;YES, TREAT AS IMPLICIT TYPE
	PUSH	STACK,.PLUS		;PLACE PLUS CODE INTO DL
	PUSHJ	PDP,POLC4		;TREAT AS A LABLE TO START PNS CONVERSION
	JRST	CHAIN			;THEN CHAIN

BEGINN:	PUSH	STACK,.PLUS		;HERE IF NUMBER
	PUSHJ	PDP,POLC2		;START SCAN WITH NUMBER
	JRST	CHAIN			;AND LIKEWISE CHAIN



SUBTTL COMMAND HANDLING ROUTINES

;THE FOLLOWING ROUTINES HANDLE THE MAJORITY OF ABACUS
;COMMANDS AND ARE DISPATCHED TO VIA THE COMMAND TABLE COMTAB


;THE TYPE COMMAND

;THE FORMAT IS AS FOLLOWS:

;	TYPE NUMERICAL EXPRESSION

TYPE:	TLNN	CHR,C.LETT		;LETTER?
	JRST	TYPE2
	MOVEI	CNT,5
	PUSHJ	PDP,LABIN		;GET IN THE LABLE
	JRST	LABLON
	TLNE	CHR,C.EQAL		;EQUAL SIGN?
TYPE1:	MOVEM	SYMBOL,VARNAM		;SAVE THE NAME
	PUSHJ	PDP,POLC4		;START PNS CONVERSION
	JRST	TYPO			;TYPE OUT THE RESULTS

TYPE2:	TRO	FLAGS,F.LPAR		;ALLOW NEGATION
	PUSHJ	PDP,POLC1		;START PNS CONVERSION

TYPO:	MOVE	STACK,STKST		;INITIALIZE THE STACK
	PUSHJ	PDP,PNSVAL		;EVALUATE THE PNS
	MOVE	SYMBOL,VARNAM		;GET VARIABLE NAME ON EQUAL
	POP	STACK,N			;GET FINAL RESULT FROM STACK
	PUSHJ	PDP,TABOUT		;PRINT TAB
	PUSHJ	PDP,SIXOUT		;PRINT LABLE (IF ANY)
	PUSHJ	PDP,EQOUT		;PRINT EQUAL SIGN
	PUSHJ	PDP,FLOCON		;PRINT THE NUMERIC VALUE
	PUSHJ	PDP,CRLF2
	JRST	BEGIN



;THE FOR COMMAND

;THE FORMAT IS AS FOLLOWS:

;	FOR VALUE=START,END,INCREMENT DO NUMERICAL EXPRESSION

FOR:	TRZ	FLAGS,F.MINI		;CLEAR NEG. INCREMENT FLAG
	TLNE	CHR,C.TERM		;ANYTHING TYPED?
	ERR	FORLET			;MUST BEGIN WITH A LETTER?
	TLNN	CHR,C.LETT		;LETTER?
	ERR	FORLET
	MOVEI	CNT,5			;5 CHR MAX
	PUSHJ	PDP,LABIN		;GET THE LABLE
	JRST	LABLON			;TOO MANY CHARACTERS
	MOVEM	SYMBOL,FORVAR		;SAVE IT
	TLNN	CHR,C.EQAL		;EQUAL SIGN?
	ERR	FOREQ			;NO
	PUSHJ	PDP,GETVAL		;GET START VALUE
	MOVEM	N,DOREG1		;AND SAVE IT
	TLNN	CHR,C.COMA		;COMMA NEXT?
	ERR	BADST			;NO
	PUSHJ	PDP,GETVAL		;GET END VALUE
	MOVEM	N,DOREG2		;AND SAVE IT
	MOVE	N,ONE			;DEFAULT INCREMENT
	TLNN	CHR,C.COMA		;COMMA IF INCREMENT FOLLOWS
	JRST	FOR1			;DEFAULT OF 1.0
	PUSHJ	PDP,GETVAL
FOR1:	MOVEM	N,DOREG3		;AND SAVE IT
	JUMPN	N,.+2			;ZERO INCREMENT BAD
	ERR	ZERINC
	MOVE	N1,DOREG1		;GET START AGAIN
	JUMPL	N,.+4			;NEG. INCREMENT?
	CAMLE	N1,DOREG2		;NO
	ERR	ENDLST
	JRST	.+4
	TRO	FLAGS,F.MINI		;NOTE THE NEG. INCREMENT
	CAMGE	N1,DOREG2
	ERR	STLEND
	MOVEI	CNT,2			;2 CHRS IN 'DO'
	TLNE	CHR,C.LETT
	PUSHJ	PDP,LABIN		;PICK UP 'DO'
	ERR	NODO
	CAME	SYMBOL,[SIXBIT /DO/]	;'DO' MUST FOLLOW
	ERR	NODO
	TRO	FLAGS,F.LPAR		;SET TO ALLOW NEGATION
	PUSHJ	PDP,POLCON+1		;FULL SCAN
	MOVE	SYMBOL,FORVAR
	LSH	SYMBOL,-6		;MAKE OPCODE OPDC
	IOR	SYMBOL,.OPDC
	SETZ	PIND,
	MOVE	A,.DONE			;DONE SCAN WHEN .DONE IS SEEN
	MOVE	B,.DOCAL		;WHAT WE SUBSTITUTE FOR OPDC'S
FOR2:	CAMN	A,PNS(PIND)		;SEARCH AND ALTER PNS
	JRST	FOR3			;DONE
	CAME	SYMBOL,PNS(PIND)
	AOJA	PIND,FOR2		;NOT THIS ONE
	MOVEM	B,PNS(PIND)		;SUBSTITUTE DOCALL
	AOJA	PIND,FOR2		;LOOP THROUGH

FOR3:	PUSHJ	PDP,CRLF
	PUSHJ	PDP,TABOUT
	MOVE	SYMBOL,FORVAR		;GET FOR VARIABLE
	PUSHJ	PDP,SIXOUT		;AND PRINT IT
	PUSHJ	PDP,TABOUT
	SPEAK	[ASCIZ /VALUE/]
	PUSHJ	PDP,CRLF2

FOR4:	MOVE	STACK,STKST		;SET UP STACK
	PUSHJ	PDP,PNSVAL		;EVALUATE PNS
	MOVE	N,DOREG1		;GET CURRENT VALUE
	PUSHJ	PDP,TABOUT
	PUSHJ	PDP,FLOCON		;PRINT IT
	PUSHJ	PDP,TABOUT
	POP	STACK,N			;GET RESULT OF CALCULATION
	PUSHJ	PDP,FLOCON		;PRINT IT
	PUSHJ	PDP,CRLF
	MOVE	N,DOREG1		;GET COUNT
	FADR	N,DOREG3		;ADD ON INCREMENT
	CAMN	N,DOREG1		;ANY CHANGE?
	ERR	NOCNG
	MOVEM	N,DOREG1		;SAVE THE UPDATE
	TRNN	FLAGS,F.MINI		;MINUS INCREMENT
	JRST	.+4			;YES
	CAMGE	N,DOREG2		;CHECK FOR END
	JRST	BEGINC
	JRST	FOR4
	CAMLE	N,DOREG2
	JRST	BEGINC
	JRST	FOR4


;THE DAYTIM COMMAND -- PRINTS THE DATE AND TIME

DAYTIM:	TLNN	CHR,C.TERM
	ERR	SINGLE
	PUSHJ	PDP,DATIM
	JRST	BEGINC


;THE RUNTIM COMMAND -- PRINTS USER'S RUNTIME IN SECONDS

RNTIM:	TLNN	CHR,C.TERM
	ERR	SINGLE
	PUSHJ	PDP,RNTIME
	PUSHJ	PDP,CRLF
	JRST	BEGINC


;THE CONTIM COMMAND -- PRINTS ELAPSED TIME SINCE STARTUP OF ABACUS

CONTIM:	TLNN	CHR,C.TERM
	ERR	SINGLE
	PUSHJ	PDP,CNTIME
	PUSHJ	PDP,CRLF
	JRST	BEGINC


;THE PJOB COMMAND -- PRINTS USER'S JOB NUMBER

PJOBER:	TLNN	CHR,C.TERM
	ERR	SINGLE
	CALLI	N,30
	SPEAK	JOBMSG
	JRST	BEGINC


;THE DISPLY OR DIS COMMAND -- DISPLAYS RESULT OF CHAIN CALCULATION

DISPLY:	TLNN	CHR,C.TERM		;MUST BE TERMINATED
	ERR	SINGLE
	MOVE	N,RESLT
	SPEAK	DISMSG
	JRST	BEGINC


;THE SUBTOT OR S COMMAND -- TAKES A SUBTOTAL

SUBTOT:	TLNN	CHR,C.TERM		;MUST BE TERMINATED
	ERR	SINGLE
	MOVE	N1,TOT
	MOVE	N,RESLT
	FADRM	N,TOT			;ADD ONTO COMBINED TOTAL IN 'TOT'
	TRZE	FLAGS,F.UNDR		;MUST CHECK UNDER/OVER FLOWS
	ERR	SUBUND
	TRZE	FLAGS,F.OVER
	ERR	SUBOVR
	MOVEM	N1,BTOT			;UPDATE BACKUP TOTAL
	SETZM	RESLT			;CLEAR 'RESLT'
	SPEAK	SUBMSG
	JRST	BEGINC


;THE TOTAL OR T COMMAND -- DOES A TOTAL

TOTAL:	TLNN	CHR,C.TERM
	ERR	SINGLE
	MOVE	N,RESLT
	FADR	N,TOT			;FORCE A SUBTOTAL FIRST
	TRZE	FLAGS,F.UNDR		;CHECK FOR UNDER/OVER FLOWS
	ERR	SUBUND
	TRZE	FLAGS,F.OVER
	ERR	SUBOVR
	SETZM	RESLT			;CLEAR 'RESLT' AND 'TOT'
	SETZM	TOT
	SPEAK	TOTMSG
	JRST	BEGINC



;THE CLRTOT COMMAND -- CLEARS 'TOT'

CLRTOT:	TLNN	CHR,C.TERM
	ERR	SINGLE
	SETZM	TOT
	SPEAK	CLRTMG
	JRST	BEGINC


;THE CLRSUB COMMAND -- CLEARS 'RESLT'

CLRSUB:	TLNN	CHR,C.TERM
	ERR	SINGLE
	SETZM	RESLT
	SPEAK	CLRSMG
	JRST	BEGINC


;THE BACKUP OR BK COMMAND -- BACKUPS OVER LAST LINE IN CHAIN
;CALCULATIONS

BACKUP:	TLNN	CHR,C.TERM
	ERR	SINGLE
	MOVE	N,BRESLT		;GET BACKUP RESULT INTO 'RESLT'
	MOVEM	N,RESLT
	MOVE	N,BTOT			;GET BACKUP TOTAL INTO 'TOT'
	MOVEM	N,TOT
	SPEAK	BAKMSG
	JRST	BEGINC


;THE CNGSGN OR CS COMMAND -- CHANGES SIGN OF 'RESLT'

CNGSGN:	TLNN	CHR,C.TERM
	ERR	SINGLE
	MOVNS	RESLT			;NEGATE 'RESLT'
	SPEAK	CNGMSG
	JRST	BEGINC

;THE STOP COMMAND -- EXITS TO MONITOR

STOP:	TLNN	CHR,C.TERM
	ERR	SINGLE
	TTCALL	11,			;CLEAR INPUT BUFFER
	CALLI	1,12			;EXIT, BUT DON'T PRINT "EXIT"
	SPEAK	NOCONT			;DON'T LET THEM CONTINUE
	JRST	STOP


;THE BYE COMMAND -- PERFORMS A K/F LOGOUT

	IFN BYER,<

BYE:	TLNN	CHR,C.TERM
	ERR	SINGLE
	TTCALL	11,
	MOVE	A,[XWD 17,11]		;GET THE STATES WORD
	CALLI	A,41
	JRST	.+1
	TLNN	A,(1B2)			;IS IT A LOGIN SYSTEM?
	ERR	NOLOGO
	MOVSI	A,(SIXBIT /SYS/)	;SETUP RUNBLOCK BEGINNING AT FILNAM
	MOVEM	A,FILNAM
	MOVE	A,[SIXBIT /LOGOUT/]
	MOVEM	A,FILNAM+1
	SETZM	FILNAM+2
	SETZM	FILNAM+3
	SETZM	FILNAM+4
	SETZM	FILNAM+5
	MOVSI	A,1			;OFFSET FOR STARTING LOC
	HRRI	A,FILNAM		;ADR OF RUN DATA BLOCK
	CALLI	A,35			;THE RUN UUO
	SPEAK	NOLOGO			;CAN'T LOG OUT
	JRST	STOP			;PERFORM REGULAR STOP
	>


;THE DEFINE OR DEF COMMAND

;THE FORMAT IS:

;	DEFINE NAME(ARG1,ARG2,. . .,ARGN)=NUMERICAL EXPRESSION

DEFINF:	TLNN	CHR,C.LETT		;MUST BEGIN WITH A LETTER
	ERR	BADFLT
	MOVEI	CNT,5			;ONLY 5 CHRS IN NAME
	PUSHJ	PDP,LABIN		;GET THE LABLE
	JRST	LABLON
	SETZ	FIND,			;ZERO INDEX TO FUNCTION TABLE
	MOVEM	SYMBOL,@FUNNXT		;STORE FUNCTION NAME
	TRO	FLAGS,F.DEFN		;TURN ON DEFINE FLAG
	AOS	A,FUNNXT		;SET FUNNXT TO HEADER+1
	HRRM	A,FUNPNT		;SET UP BASE ADR OF FUNPNT
	PUSHJ	PDP,CHKCOR		;CHECK CORE AVAILABLE
	MOVE	C,SRCPNT		;USE AC 'C' AS BPT TO SOURCE
	SETZ	WD,			;FOR EACH WORD OF SOURCE
	SETZM	NARGS			;NUMBER OF ARGUMENTS
	PUSHJ	PDP,STOSRC		;STORE NEXT CHR BEYOND NAME
	TLNN	CHR,C.LPAR
	ERR	BADDUM
	HRLZI	B,-MAXARG		;SET UP MAXIMUM ARGS CONTROL
DEFIN1:	PUSHJ	PDP,SSPACE		;GET NEXT NON-BLANK CHARACTER
	TLNN	CHR,C.LETT
	ERR	BADDLT
	MOVEI	CNT,5			;GET AN ARGUMENT
	PUSHJ	PDP,LABIN
	JRST	LABLON
	MOVEM	SYMBOL,DUMARG(B)	;MAKE A TABLE OF DUMMY ARGS
	AOBJN	B,.+3
	MOVEI	N,MAXARG		;GET MAXIMUM NUMBER ALLOWED
	ERR	TOOMAG			;TOO MANY ARGUMENTS SUPPLIED
	TLNE	CHR,C.COMA		;ARGUMENTS ARE DELIMITED BY COMMAS
	JRST	DEFIN1
	TLNN	CHR,C.RPAR		;MUST END WITH A ")" OR ELSE
	ERR	BADARG			;BAD ARGUMENT DELIMITER
	PUSHJ	PDP,SSPACE		;GET NEXT NON-BLANK CHARACTER
	TLNN	CHR,C.EQAL		;MUST BE AN "=" OR ELSE
	ERR	BADFEQ			;MISPLACED EQUAL SIGN
	HRRZM	B,NARGS
	TRO	FLAGS,F.LPAR
	PUSHJ	PDP,POLCON
	JUMPE	WD,.+4			;LAST WORD OF SOURCE TO STORE?
	AOBJN	FIND,.+2
	PUSHJ	PDP,CHKCOR
	MOVEM	WD,@FUNPNT		;STORE IT IF THERE IS
	HRLZM	FIND,@FUNNXT		;NUMBER OF SOURCE WORDS
	MOVE	A,NARGS			;NUMBER OF ARGUMENTS
	DPB	A,[POINT 6,@FUNNXT,5]
	AOJ	PIND,			;ADVANCE INDEX VALUE TO PNS
	HRRM	PIND,@FUNNXT		;NBER OF PNS WORDS
	ADDI	PIND,(FIND)		;SUM OF THE TWO
	AOJ	FIND,
	MOVEI	A,@FUNPNT		;ADR OF 1 WORD BEYOND SOURCE
	HRLI	A,PNS			;ADR OF PNS
	MOVE	FIND,PIND
	PUSHJ	PDP,CHKCOR		;ROOM FOR THE PNS?
	BLT	A,@FUNPNT		;BLT PNS INTO FUNCTION DEF
	AOBJN	FIND,.+2
	PUSHJ	PDP,CHKCOR
	MOVEI	B,@FUNPNT		;ADR OF NEXT FUNCTION
	PUSH	PDP,B			;SAVE AC 'B'
	TRZ	FLAGS,F.DEFN		;TURN OFF THE DEFINE FLAG
	SOS	FUNNXT			;SET TO POINT BACK TO NAME
DEFIN2:	MOVE	SYMBOL,@FUNNXT		;GET THE NAME AGAIN
	PUSHJ	PDP,RESCHK		;CHECKRFOR RESERVED WORDS
	JRST	DEFIN3			;OH-OH!
	POP	PDP,FUNNXT		;FINALLY UPDATE FUNNXT
	SPEAK	DEFFUN
	JRST	BEGINC			;DONE WITH THE DEFINITION

DEFIN3:	TTCALL	11,
	SPEAK	RENMSG			;LET THEM RENAME OR DELETE
	PUSHJ	PDP,SSPACE
	TLNE	CHR,C.CR		;A <CR>?
	ERR				;FORGET THE DEFINITION
	TLNN	CHR,C.LETT
	JRST	DEFIN4			;IMPROPER FUNCTION NAME
	MOVEI	CNT,5
	PUSHJ	PDP,LABIN
	JRST	LABLON
	TLNN	CHR,C.CR
	JRST	DEFIN4
	MOVEM	SYMBOL,@FUNNXT
	JRST	DEFIN2

DEFIN4:	SPEAK	BADFNM			;BAD FUNCTION NAME
	JRST	DEFIN3			;LET THEM TRY AGAIN


;THE LIST AND PRINT COMMANDS

;THE FORMATS ARE:

;	PRINT ARG1,ARG2,...,ARGN
;	LIST ARG1,ARG2,...,ARGN

;	PRINT ARG1,ARG2,...,ARGN ON DEV:FILNAM.EXT [PROJ,PROG]
;	LIST ARG1,ARG2,...,ARGN ON DEV:FILNAM.EXT [PROJ,PROG]

	IFN FILCAP,<
LISTER:	TRO	FLAGS,F.FCHR		;SET OUTPUT TO FILE (LPT)
	SETZ	A,
	MOVSI	B,(SIXBIT /LPT/)	;DEVICE IS LPT
	MOVEM	B,OPENBK+1
	MOVE	B,CUSP			;FILNAME IS ABACUS
	MOVEM	B,FILDAT
	MOVSI	B,(SIXBIT /LPT/)	;EXTENSION IS LPT
	MOVEM	B,FILDAT+1
	SETZM	FILDAT+2
	SETZM	FILDAT+3
	MOVEI	B,ASCMOD		;MODE IS ASCII
	PUSHJ	PDP,OPENO+1		;OPEN DEVICE AND ENTER FILE
	MOVEI	B,203*2			;GET THIS MUCH BUFFER SPACE
	PUSHJ	PDP,MDOWN
	>				;END OF COND. ON FILCAP

PRINT:	PUSHJ	PDP,GETARG		;GET THE ARGS
	ERRF	NOARGS			;NONE TYPED
	TLNN	CHR,C.TERM		;DID THEY TERMINATE THE LINE RIGHT?
	JRST	PRINT4			;HANDLE THE 'ON' FOR FILES
	SETZ	PIND,			;ZERO AN INDEX TO DUMARG
	TRNE	FLAGS,F.ALV		;PRINT ALL VARIABLES?
	PUSHJ	PDP,PRTALV		;YES
	TRNE	FLAGS,F.ALF		;PRINT ALL FUNCTIONS?
	PUSHJ	PDP,PRTALF		;YES
	PUSHJ	PDP,CRLF

PRINT1:	SKIPN	SYMBOL,DUMARG(PIND)	;GET AN ARGUMENT
	JRST	PRT3A			;DONE WHEN NULL
	PUSHJ	PDP,LABCHK		;LOOK UP AS A VARIABLE
	JRST	PRINT2			;NOT FOUND
	TRNE	FLAGS,F.ALV		;DID WE PRINT IT ALREADY?
	AOJA	PIND,PRINT1		;YES
	MOVE	B,CNT			;NO SO PRINT IT
	PUSHJ	PDP,PRTVAR
	AOJA	PIND,PRINT1

PRINT2:	PUSHJ	PDP,FUNCHK		;LOOK UP AS A FUNCTION
	JRST	PRINT3			;NOT FOUND
	TRNN	FLAGS,F.ALF		;DID WE PRINT IT ALREADY?
	PUSHJ	PDP,PRISRC		;NO
	AOJA	PIND,PRINT1

PRINT3:	PUSH	PDP,FLAGS		;SAVE FLAGS
	TRZ	FLAGS,F.FCHR		;FORCE OUTPUT TO TTY
	SPEAK	NOTDEF			;NEITHER A FUNCTION OR A VARIABLE
	POP	PDP,FLAGS		;RESTORE FLAGS
	AOJA	PIND,PRINT1

PRT3A:	JUMPE	PIND,.+2
	PUSHJ	PDP,CRLF
	TRZN	FLAGS,F.FCHR		;LISTING?
	JRST	BEGIN			;NOPE
	IFN FILCAP,<
	CLOSE	CHANO,			;CLOSE AND RELEASE DEVICE
	RELEASE	CHANO,
	PUSHJ	PDP,MBACK
	JRST	BEGIN
	>				;END OF COND. ON FILCAP

PRINT4:	PUSHJ	PDP,CHKON		;CHECK FOR 'ON'
	IFE FILCAP,<ERR NOFCAP>
	IFN FILCAP,<
	PUSHJ	PDP,FILE
	TLNN	CHR,C.TERM
	ERR	NOTERM
	PUSHJ	PDP,CRLF		;PRINT A CARRIAGE-RETUN
	PUSHJ	PDP,DEVCHK
	TLNN	A,DV.IN			;CHECK FOR INPUT DEVICE
	ERRF	NOTID			;CANT
	PUSHJ	PDP,OPENI		;OPEN THE INPUT DEVICE AND LOOKUP FILE
	JRST	NOIFIL			;FILE NOT FOUND
	MOVEI	B,203*2			;GET THIS MUCH BUFFER SPACE
	PUSHJ	PDP,MDOWN
	PUSHJ	PDP,GETWD		;GET 1ST WORD (FORMAT CODE)
	ERRF	EMPFIL			;FILE IS EMPTY
	CAIE	WD,FILCOD		;IS FORMAT CORRECT
	JRST	BADFIL			;NOPE
	TRNN	FLAGS,F.FCHR		;LISTING?
	JRST	PRT5A			;NOPE
	SPEAK	[ASCIZ /LISTING FROM /]
	PUSHJ	PDP,FILTYP
	PUSHJ	PDP,TABOUT
	PUSHJ	PDP,DATIM
	PUSHJ	PDP,CRLF
	SPEAK	[ASCIZ /FILE CREATED-- /]
	LDB	A,CREDAT		;GET DATE
	PUSHJ	PDP,DATE+1		;AND PRINT IT
	TRNE	FLAGS,F.DTA		;DTA DOESN'T HAVE CREATION TIME
	JRST	PRT4B
	PUSHJ	PDP,TABOUT
	LDB	A,CRETIM		;GET TIME
	IDIVI	A,^D60			;GET # HOURS INTO AC 'A'
	MOVE	N,A
	PUSHJ	PDP,DECPRO		;AND PRINT IT
	PUSHJ	PDP,COLON		;FOLLOWED BY A COLON
	MOVE	N,B			;GET # MINUTES
	PUSHJ	PDP,DECPRO
PRT4B:	PUSHJ	PDP,CRLF2
	JRST	PRT5A
PRINT5:	PUSHJ	PDP,SKIPDF		;SKIP THE DEFINTION
PRT5A:	SETZ	PIND,			;ZERO AN INDEX TO DUMARG
	SETZM	PARWD			;CLEAR PARITY WORD
	PUSHJ	PDP,GETWD		;GET A DEFINITION NAME
	JRST	PRINT8			;FINISH UP
	MOVE	SYMBOL,WD		;NAME SANS BIT 35
	TRZN	SYMBOL,1		;AND CHECK WHAT IT IS
	JRST	PRINT7			;FUNCTION
	SKIPN	A,DUMARG(PIND)		;SCAN ARGUMENT TABLE
	JRST	PRINT6			;NOT FOUND
	CAME	SYMBOL,A
	AOJA	PIND,.-3
	SETOM	DUMARG(PIND)		;NOTE WE'VE FOUND IT
	JRST	PRT6A

PRINT6:	TRNN	FLAGS,F.ALV		;PRINT ALL FUNCTIONS?
	JRST	PRINT5			;NOPE SO SKIP THE DEF
PRT6A:	PUSHJ	PDP,GETWD		;GET THE VALUE
	ERRF	BADEOF
	MOVE	N,WD			;AND SAVE IT IN N
	PUSHJ	PDP,GETWD		;GET PARITY
	ERRF	BADEOF
	SKIPE	PARWD			;AND CHECK IT
	ERRF	PARERR
	SPEAK	[ASCIZ /	%S=%F%_/]
	TRO	FLAGS,F.VARS		;NOTE A VARIABLE'S BEEN PRINTED
	JRST	PRT5A			;LOOP THOURH THE FILE

PRINT7:	SKIPN	A,DUMARG(PIND)		;SCAN ARGUMENT TABLE
	JRST	PRT7A			;NOT FOUND
	CAME	SYMBOL,A
	AOJA	PIND,.-3
	SETOM	DUMARG(PIND)		;NOTE IT'S BEEN FOUND
	JRST	PRT7B

PRT7A:	TRNN	FLAGS,F.ALF		;PRINT ALL FUNCTIONS?
	JRST	PRINT5			;NO SO SKIP THE DEFINITION

PRT7B:	PUSHJ	PDP,TABOUT		;PRINT A TAB
	PUSHJ	PDP,SIXOUT		;AND THE NAME
	PUSHJ	PDP,GETWD		;GET THE HEADER
	ERRF	BADEOF
	HRRZ	FIND,WD			;GET # PNS WORDS
	LDB	CNT,[POINT 12,WD,17]	;AND # SOURCE WORDS

PRT7C:	PUSHJ	PDP,GETWD		;GET A WORD OF DEFINITION SOURCE
	ERRF	BADEOF
	MOVE	SYMBOL,WD
	PUSHJ	PDP,SIXOUT		;PRINT IT
	SOJG	CNT,PRT7C		;AND LOOP BACK FOR MORE
	PUSHJ	PDP,CRLF		;PRINT A RETURN
	PUSHJ	PDP,GETWD		;SKIP OVER THE PNS AND GET PARITY WORD
	ERRF	BADEOF
	SOJGE	FIND,.-2
	SKIPE	PARWD			;CHECK THE PARITY
	ERRF	PARERR
	TRO	FLAGS,F.FUNS		;NOTE A FUNCTION'S BEE PRINTED
	JRST	PRT5A
PRINT8:	TRZN	FLAGS,F.FCHR		;LISTING?
	JRST	RECAL4			;FINISH AS A RECALL
	CLOSE	CHANO,
	RELEASE	CHANO,
	JRST	RECAL4
	>				;END OF COND. ON FILCAP


;THE DELETE OR DEL COMMAND

;THE FORMATS ARE:

;	DELETE ARG1,ARG2,...,ARGN

;	DELETE ARG1,ARG2,...,ARGN ON DEV:FILNAM.EXT [PROJ,PROG]

;THE FIRST DELETES FROM IN CORE STORAGE WHILE THE SECOND DELETES
;FROM THE SPECIFIED FILE.

DELETE:	PUSHJ	PDP,GETARG		;PICK UP THE ARGUMENTS
	ERR	NOARGS			;NONE THERE
	TLNN	CHR,C.TERM		;DID THEY TERMINATE THE LINE RIGHT
	JRST	DELET4			;CHECK FOR FILE SPECIFICATION
	SETZ	PIND,
	TRNE	FLAGS,F.ALV		;DELETE ALL VARIABLES?
	PUSHJ	PDP,DELALV		;YES
	TRNE	FLAGS,F.ALF		;DELETE ALL FUNCTIONS?
	PUSHJ	PDP,DELALF		;YES

DELET1:	SKIPN	SYMBOL,DUMARG(PIND)	;DONE WHEN ZERO WORD
	JRST	BEGINC
	TRNE	FLAGS,F.ALV		;HAVE WE DELETED ALL VARIABLES?
	JRST	DELET2			;YES, NO NEED TO CHECK HERE
	PUSHJ	PDP,LABCHK		;LOOK IT UP AS A VARIABLE
	JRST	DELET2			;NOT FOUND
	CAILE	CNT,2			;DON'T ALLOW DELETION OF 'RESLT' OR 'SRSLT'
	JRST	.+3
	SPEAK	CNGRST
	AOJA	PIND,DELET1
	MOVEI	A,LABTAB(CNT)		;DO THE DELETION
	HRLI	A,LABTAB+2(CNT)		;BY MOVING FURTHER ENTRIES UP
	SOS	B,LABTOT		;A NOTCH AND SUBTRACTING ONE
	IMULI	B,2			;FROM LABTOT
	BLT	A,LABTOT-1(B)
	SPEAK	DELMSG			;TELL THEM IT'S DONE
	AOJA	PIND,DELET1		;AND CONTINUE

DELET2:	TRNE	FLAGS,F.ALF		;HAVE WE DELETED ALL FUNCTIONS?
	JRST	DELET3			;YES
	PUSHJ	PDP,FUNCHK		;LOOK IT UP AS A FUNCTION
	JRST	DELET3			;NOT DEFINED
	SPEAK	DELMSG
	PUSHJ	PDP,DELFN		;DO THE ACTUAL DELETION
	AOJA	PIND,DELET1		;CONTINUE

DELET3:	TRNE	FLAGS,F.ALV		;HAVE WE DELETED ALL VARS
	TRNN	FLAGS,F.ALF		;AND ALL FUNS?
	SPEAK	NOTDEF			;NOPE
	AOJA	PIND,DELET1

DELET4:	PUSHJ	PDP,CHKON		;CHECK FOR 'ON'
	IFE FILCAP,<ERR NOFCAP>
	IFN FILCAP,<

	PUSHJ	PDP,FILE		;GET THE FILE INFO
	TLNN	CHR,C.TERM		;MUST TERMINATE THE LINE
	ERR	NOTERM
	PUSHJ	PDP,DEVCHK		;CHECK ON THE DEVICE
	TLNN	A,DV.DIR		;ONLY MAY DELETE FROM DIRECTORY DEVICE
	ERR	DRONLY
	PUSHJ	PDP,OPENI		;OPEN DEVICE AND LOOK UP FILE
	JRST	NOIFIL			;FILE NOT FOUND
	PUSHJ	PDP,OPENO		;OPEN OUTPUT DEVICE AND DO ENTER
					;ALSO GET BUFFER SPACE
	MOVEI	B,203*4			;GET THIS MUCH BUFFER SPACE
	PUSHJ	PDP,MDOWN
	PUSHJ	PDP,GETWD		;GET FIRST WORD (FORMAT CODE)
	JRST	DELET8
	CAIE	WD,FILCOD		;DOES IT MATCH?
	JRST	BADFIL			;NOPE
	PUSHJ	PDP,PUTWD		;PASS ON THE FILE CODE
DELET5:	SETZM	PARWD			;ZERO PARITY WORD
	PUSHJ	PDP,GETWD		;GET A DEFINITION NAME
	JRST	DELET7			;EOF
	MOVE	SYMBOL,WD		;SANS BIT 35
	TRZ	SYMBOL,1
	SETZ	PIND,			;SCAN THROUGH ARGUMENT TABLE
	SKIPN	A,DUMARG(PIND)
	JRST	DELET6			;NOT FOUND
	CAME	SYMBOL,A
	AOJA	PIND,.-3		;LOOP THROUGH
	SETOM	DUMARG(PIND)		;FOUND SO NOTE THE FACT
	JRST	DELE6A

DELET6:	MOVEI	B,F.ALV			;ASSUME IT'S A VARIABLE
	TRNN	WD,1			;FIND OUT FOR SURE
	MOVEI	B,F.ALF			;'TIS A FUNCTION, THOUGH
	TDNN	FLAGS,B			;DELETE ALL OF LIKE KIND?
	JRST	DELE6B			;NOPE PASS IT ON
DELE6A:	PUSHJ	PDP,SKIPDF		;SKIP (DELETE) IT
	SPEAK	DELMSG
	JRST	DELET5			;LOOP THROUGH THE FILE

DELE6B:	PUSHJ	PDP,PASSDF		;PASS OVER THE DEFINITION
	TRO	FLAGS,F.VARS+F.FUNS	;NOTE WE'VE PASSED ON ONE
	JRST	DELET5			;LOOP THROUGH THE FILE

DELET7:	SETZ	PIND,			;PRINT NAMES NOT FOUND
	SKIPN	SYMBOL,DUMARG(PIND)
	JRST	DELET8
	CAMN	SYMBOL,ONES
	AOJA	PIND,DELET7+1
	SPEAK	NOTDEF
	AOJA	PIND,DELET7+1

DELET8:	PUSHJ	PDP,CLOSF		;DO A REGULAR CLOSE
	TRNE	FLAGS,F.FUNS+F.VARS	;DID WE DELETE EVERYTING?
	JRST	BEGINC			;YES
	MOVEI	B,17			;GET THE DEVICE FOR A DELETE
	MOVEM	B,OPENBK
	SETZM	OPENBK+2
	OPEN	CHANO,OPENBK
	ERR	OUTDER
	MOVE	B,FILBLT
	BLT	B,FILNAM+3
	LOOKUP	CHANO,FILNAM		;LOOKUP THE FILE AGAIN
	JRST	DELERR
	SETZM	FILNAM			;ZERO FILENAME FOR A DELETE
	CLOSE	CHANO,
	RENAME	CHANO,FILNAM		;DELETE THE FILE
	ERRF	RENERR			;CAN'T
	RELEASE	CHANO,
	JRST	BEGINC
	>				;END COND. ON FILCAP



;THE STORE COMMAND -- STORES VARIABLES AND FUNCTIONS ON FILE

;THE FORMAT IS:

;	STORE ARG1,ARG2,...,ARGN ON DEV:FILNAM.EXT<PROT>[PROJ,PROG]

;WHRE ARG1,ARG2,...,ARGN ARE FUNCTION AND VARIABLE NAMES OR THE
;SPECIAL ARGUMENTS 'ALLFUN' AND 'ALLVAR' WHICH STORE ALL FUNCTIONS AND
;ALL VARIABLES RESPECTIVELY.  THE DEFAULT FILE SPECIFICATION IS:

;	DSK:ABACUS.STO<155>[SELF]


	IFN FILCAP,<

STOREF:	PUSHJ	PDP,GETARG		;GET THE ARGUMENTS
	TRO	FLAGS,F.ALF+F.ALV	;ASSUME ALL FUNCTIONS AND VARIABLES
	TLNE	CHR,C.TERM		;STATEMENT TERMINATION
	JRST	STORE1
	PUSHJ	PDP,CHKON		;CHECK FOR 'ON'
STORE1:	PUSHJ	PDP,FILE		;GET FILE SPECS
	TLNN	CHR,C.TERM		;MUST TERMINATE LINE
	ERR	NOTERM
	SETZM	PNS			;ZERO TOP OF PNS
	MOVSI	PIND,-PNSLEN
	TRNN	FLAGS,F.ALF		;STORE ALL FUNCTIONS?
	JRST	STOR1B			;NOPE
	SETZ	CNT,
	MOVEI	A,@FNSTPT		;GET 1ST FUNCTION ADR.
	CAMGE	A,FUNNXT		;ANY DEFINED?
	JRST	STOR1A			;YES
	TRZ	FLAGS,F.ALF		;NOPE--NOTE IT
	SPEAK	NOFUNS			;AND TELL THEM SO
	JRST	STOR1B

STOR1A:	MOVEI	A,@FNSTPT		;GET FUNCTION ADR.
	CAML	A,FUNNXT		;GOT THEM ALL?
	JRST	STOR1B			;YES
	MOVE	SYMBOL,@FNSTPT		;GET FUNCTION NAME
	PUSHJ	PDP,DUMONE		;SET A MATCHING DUMARG ENTRY TO -1
	MOVEM	SYMBOL,PNS(PIND)	;SAVE NAME IN PNS
	AOJ	CNT,			;ADVANCE TO FUNCTION HEADER
	HRRZ	B,@FNSTPT		;GET # PNS WORDS
	LDB	A,FNBPT1		;AND # SORCE WORDS
	ADD	CNT,B
	ADDI	CNT,1(A)		;ADVANCE CNT TO NEXT FUNCTION
	AOBJN	PIND,STOR1A		;LOOP THROUGH FUNCTIONS
	ERR	PNSFUL

STOR1B:	TRNN	FLAGS,F.ALV		;STORE ALL VARIABLES?
	JRST	STOR1D			;NOPE
	MOVE	CNT,LABTOT		;GET NUMBER TO STORE
	CAILE	CNT,2			;BUT DON'T STORE 'RESLT' OR 'SRSLT'
	JRST	.+4
	TRZ	FLAGS,F.ALV		;NOTE THERE ARE NONE
	SPEAK	NOVARS
	JRST	STOR1D
	MOVNS	CNT
	HRLZS	CNT
	ADD	CNT,ONETWO		;SKIP OVER PREDEFINED(2)
	ADD	CNT,ONETWO
STOR1C:	JUMPGE	CNT,STOR1D		;FINISHED BUILDING TABLE?
	MOVE	SYMBOL,LABTAB(CNT)	;GET A VARIABLE NAME
	PUSHJ	PDP,DUMONE
	MOVEM	SYMBOL,PNS(PIND)	;STORE IN PNS
	ADD	CNT,ONETWO		;ADVANCE TO NEXT VARIABLE
	AOBJN	PIND,STOR1C		;LOOP THROUGH VARIABLES
	ERR	PNSFUL

STOR1D:	SETZ	CNT,
STOR1E:	SKIPN	SYMBOL,DUMARG(CNT)	;GET A DUMMY ARG
	JRST	STOR1F			;DONE WHEN ZERO WORD
	CAMN	SYMBOL,ONES		;-1 IF DUPLICATE NAME
	AOJA	CNT,STOR1E
	MOVEM	SYMBOL,PNS(PIND)	;SAVE IT IN PNS
	AOJ	CNT,
	AOBJN	PIND,STOR1E		;LOOP THROUGH DUMARG
	ERR	PNSFUL

STOR1F:	SETZM	PNS(PIND)		;PUT AND END TO PNS
	PUSHJ	PDP,DEVCHK		;GET DEVICE CHARACTER
	TLNN	A,DV.DIR		;DIRECTORY DEVICE?
	JRST	STORE9			;NOPE SO CAN ONLY DO OUTPUT
	PUSHJ	PDP,OPENI		;OPEN INPUT DEVICE AND LOOKUP FILE
	JRST	STORE9			;FILE NOT FOUND
	PUSHJ	PDP,OPENO		;OPEN DEVICE AND ENTER FILE
	MOVEI	B,203*4			;GET THIS MUCH BUFFER SPACE
	PUSHJ	PDP,MDOWN
	PUSHJ	PDP,GETWD		;GET 1ST WORD (FORMAT CODE)
	JRST	STOR9A			;IMMEDIATE EOF
	CAIE	WD,FILCOD		;IS THE FORMAT RIGHT?
	JRST	BADFIL			;TOO BAD!!
	PUSHJ	PDP,PUTWD		;PASS ON THE FORMAT CODE
STORE2:	SETZM	PARWD			;CLEAR PARITY WORD
	PUSHJ	PDP,GETWD		;GET THE SYMBOL NAME
	JRST	STORE7			;EOF OF INPUT FILE--NOW TRANSFER
	MOVE	SYMBOL,WD		;GET NAME SANS BIT 35
	TRZ	SYMBOL,1
	SETZ	PIND,			;ZERO PIND
STOR2A:	SKIPN	A,PNS(PIND)		;GET AN ITEM OF PNS
	JRST	STOR2E			;AT END OF PNS
	CAMN	SYMBOL,A		;SAME AS ON FILE?
	JRST	STOR2B			;MATCH
	AOJA	PIND,STOR2A		;NOPE--KEEP CHECKING

STOR2B:	SETOM	PNS(PIND)		;NOTE THE MATCH
	SPEAK	DEFONE			;TELL THEM SO
	SPEAK	OVERLY			;ASK WHAT TO DO
	PUSHJ	PDP,YESNO		;GET THEIR ANSWER
	JRST	STOR2E			;DON'T WISH TO OVERLAY
	PUSHJ	PDP,FUNCHK		;LOOKUP AS FUNCTION
	JRST	.+3			;NOT FOUND
	PUSHJ	PDP,STOFUN		;STORE IT
	JRST	STOR2C
	PUSHJ	PDP,LABCHK		;LOOKUP AS A VARIABLE
	JRST	STOR2D			;NOT DEFINED
	PUSHJ	PDP,STOVAR		;STORE IT
STOR2C:	PUSHJ	PDP,SKIPDF		;DELETE OLD DEFINITION
	JRST	STORE2			;LOOP THROUGH FILE

STOR2D:	SPEAK	NOTDEF			;NOT DEFINED
STOR2E:	PUSHJ	PDP,PASSDF		;PASS OVER DEFINITON
	JRST	STORE2			;LOOP THOUGH THE FILE

STORE7:	SETZ	PIND,			;ZERO PIND
STOR7A:	SKIPN	SYMBOL,PNS(PIND)	;GET NAME FROM PNS
	JRST	STORE8			;FINISHED AT LAST WITH TRANSFER
	CAMN	SYMBOL,ONES		;THIS ONE DONE ALREADY?
	AOJA	PIND,STOR7A		;YES
	PUSHJ	PDP,FUNCHK		;LOOK UP AS A FUNCTION
	JRST	.+3
	PUSHJ	PDP,STOFUN		;STORE IT
	AOJA	PIND,STOR7A		;LOOP THROUGH PNS
	PUSHJ	PDP,LABCHK		;LOOK UP AS A VARIABLE
	JRST	STOR7B			;NOT FOUND
	PUSHJ	PDP,STOVAR		;STORE IT
	AOJA	PIND,STOR7A		;LOOP THOUGH PNS

STOR7B:	SPEAK	NOTDEF
	AOJA	PIND,STOR7A

STORE8:	PUSHJ	PDP,CLOSF		;CLOSE FILES
	JRST	BEGINC			;RETURN TO COMMAND LEVEL

STORE9:	TLNN	A,DV.OUT		;CAN THE DEVICE DO OUTPUT?
	ERRF	NOTOD			;NOPE
	PUSHJ	PDP,OPENO		;OPEN THE DEVICE AND ENTER THE FILE
	MOVEI	B,203*2			;GET THIS MUCH BUFFER SPACE
	PUSHJ	PDP,MDOWN
STOR9A:	MOVEI	WD,FILCOD		;GET THE FILE FORMAT WORD
	PUSHJ	PDP,PUTWD		;AND OUTPUT IT
	JRST	STORE7			;NOW TRANSFER THE DEFINTIONS TO FILE
	>				;END OF COND. ON FILCAP


;THE RECALL COMMAND -- RECALLS VARIABLES AND FUNCTIONS FROM FILE

;THE FORMAT IS:
;	RECALL ARG1,ARG2,...,ARGN ON DEV:FILNAM.EXT[PROJ,PROG]

;WHRE ARG1,ARG2,...,ARGN REPRESENT THE NAMES OF THE VARIABLES OR
;FUNCTIONS TO BE RECALLED.  THE SPECIAL ARGUMENTS 'ALLVAR' AND 'ALLFUN'
;MAY BE USED TO RECALL ALL VARIABLES AND FUNCTIONS RESPECTIVELY.

	IFN FILCAP,<
RECALL:	PUSHJ	PDP,GETARG		;GET THE ARGUMENTS
	TRO	FLAGS,F.ALF+F.ALV	;ASSUME ALL FUNCTIONS AND VARIABLES
	TLNE	CHR,C.TERM		;STATEMENT TERMINATED?
	JRST	RECAL1			;YES--SET DEFAULT FILE
	PUSHJ	PDP,CHKON		;CHECK FOR 'ON'
RECAL1:	PUSHJ	PDP,FILE		;GET THE FILE INFO
	TLNN	CHR,C.TERM		;MUST TERMINATE
	ERR	NOTERM
	PUSHJ	PDP,DEVCHK		;CHECK DEVICE CHARACTER
	TLNN	A,DV.IN			;CAN IT DO INPUT
	ERR	NOTID			;NOPE--YOU GOOFED
	PUSHJ	PDP,OPENI		;OPEN DEVICE AND LOOKUP FILE
	JRST	NOIFIL			;NOT FOUND
	MOVEI	B,203*2			;GET THIS MUCH BUFFER SPACE
	PUSHJ	PDP,MDOWN
	PUSHJ	PDP,GETWD		;GET 1ST WORD OF FILE (FORMAT CODE)
	ERRF	EMPFIL
	CAIE	WD,FILCOD		;CHECK THE FORMAT
	JRST	BADFIL			;WRONG!!
	PUSHJ	PDP,CRLF		;FANCY UP TO TTY
	JRST	.+2			;SKIP OVER THIS ON ENTRY
RECL1A:	PUSHJ	PDP,SKIPDF		;SKIP THE DEFINITION
RECL1B:	SETZ	PIND,			;ZERO AN INDEX TO DUMARG
	SETZM	PARWD			;ZERO PARITY WORD
	PUSHJ	PDP,GETWD		;GET A DEFINITION NAME
	JRST	RECAL4			;EOF
	MOVE	SYMBOL,WD		;GET NAME SANS BIT 35
	TRZN	SYMBOL,1		;AND CHECK TYPE
	JRST	RECAL3			;FUNCTION
	SKIPN	A,DUMARG(PIND)		;VARIABLE--SCAN DUMARG TABLE
	JRST	RECAL2			;NOT FOUND
	CAME	SYMBOL,A
	AOJA	PIND,.-3
	SETOM	DUMARG(PIND)		;NOTE WE'VE FOUND THIS ONE
	JRST	RECL2A

RECAL2:	TRNN	FLAGS,F.ALV		;WANT ALL VARIABLES?
	JRST	RECL1A			;NOPE SO WE SKIP THIS DEF

RECL2A:	PUSHJ	PDP,GETWD		;GET VALUE
	ERRF	BADEOF
	MOVE	N,WD			;AND SAVE IT
	PUSHJ	PDP,GETWD		;GET PARITY
	ERRF	BADEOF
	SKIPE	PARWD			;AND CHECK IT
	ERRF	PARERR
	PUSHJ	PDP,LABCHK		;SEE IF THE VARIABLE EXISTS
	JRST	RECL2C			;NOT THERE
RECL2B:	MOVEM	N,LABTAB+1(CNT)		;STORE THE VALUE
	SPEAK	RECMSG			;TELL THEM ALL'S WELL
	TRO	FLAGS,F.VARS		;NOTE WE'VE GOT A VARIABLE
	JRST	RECL1B			;LOOP THROUGH THE FILE

RECL2C:	PUSHJ	PDP,RESCHK		;IS IT A RESERVED WORD?
	JRST	RECL1B			;YES--DON'T LET THEM SAVE IT
	HLLI	CNT,			;CLEAR LEFT OF CNT
	CAILE	CNT,LTLEN		;ROOM FOR ONE MORE VARIABLE?
	ERRF	LABFUL			;NOPE
	MOVEM	SYMBOL,LABTAB(CNT)	;CREATE NEW LABLE IN TABLE
	AOS	LABTOT			;AND SHOW ONE MORE
	JRST	RECL2B

RECAL3:	SKIPN	A,DUMARG(PIND)		;FUNCTION--SCAN THROUGH DUMARG
	JRST	RECL3A			;NOT FOUND
	CAME	SYMBOL,A
	AOJA	PIND,.-3
	SETOM	DUMARG(PIND)		;NOTE WE'VE FOUND IT
	JRST	RECL3B

RECL3A:	TRNN	FLAGS,F.ALF		;RECALL ALL FUNCTIONS?
	JRST	RECL1A			;NOPE--SKIP THIS DEF

RECL3B:	PUSHJ	PDP,RESCHK		;CHECK FOR RESERVED WORDS
	JRST	RECL3E			;OH-OH!
	MOVEM	SYMBOL,@FUNNXT		;SAVE THE NAME
	MOVEI	FIND,1			;TO POINT TO PLACE FOR HEADER
	MOVE	A,FUNNXT
	HRRM	A,FUNPNT		;SET UP FUNCTION POINTER WORD
	PUSHJ	PDP,GETWD		;GET HEADER WORD
	ERRF	BADEOF
	HRRZ	B,WD			;GET # PNS WORDS
	LDB	C,[POINT 12,WD,17]	;AND # SOURCE WORDS
	ADDI	B,1(C)			;ADD TO GET # WORDS TO READ
	ADDI	A,1(B)			;ADD AGAIN TO GET MAX CORE LOCATION
	CAMGE	A,FUNMAX		;NEED TO EXPAND CORE?
	JRST	RECL3C			;NOPE
	CALLI	A,11			;THE CORE UUO
	ERRF	NOCORE			;CAN'T EXPAND
	HRRZ	A,.JBREL
	MOVEM	A,FUNMAX		;NEW MAXIMUM

RECL3C:	MOVNS	B			;SET UP AOBJN WORD
	HRL	FIND,B			;IN AC 'FIND'
RECL3D:	MOVEM	WD,@FUNPNT		;STORE A WORD OF DEF
	PUSHJ	PDP,GETWD		;GET A WORD FROM FILE
	ERRF	BADEOF
	AOBJN	FIND,RECL3D		;LOOP THROUG THE DEF
	SKIPE	PARWD			;CHECK PARITY WORD
	ERRF	PARERR			;BAD!
	MOVEI	A,@FUNPNT		;GET NEW FUNNXT LOCATION
	MOVEM	A,FUNNXT		;AND UPDATE
	SPEAK	RECMSG			;TELL THEM IT'S OK
	TRO	FLAGS,F.FUNS		;NOTE WE'VE GRABED A FUNCTION
	JRST	RECL1B			;LOOP THROUGH THE FILE

RECL3E:	PUSHJ	PDP,THRUST		;SKIP TO END OF STATEMENT
	SPEAK	RENMSG			;ASK WHAT TO DO
	PUSHJ	PDP,SSPACE		;GET A CHARACTER
	TLNE	CHR,C.CR		;CR IF DON'T WANT TO RECALL
	JRST	RECL1A			;SKIP THE DEFINITION
	TLNN	CHR,C.LETT		;LETTER MUST START NEW NAME
	JRST	RECL3F
	MOVEI	CNT,5
	PUSHJ	PDP,LABIN
	JRST	RECL3F
	PUSHJ	PDP,THRUST		;SKIP TO END OF STATEMENT
	JRST	RECL3B

RECL3F:	SPEAK	BADFNM			;BAD FUNCTION NAME
	JRST	RECL3E			;TRY AGAIN

RECAL4:	CLOSE	CHANI,			;CLOSE THE INPUT FILE
	RELEASE	CHANI,			;AND RELEASE DEVICE
	PUSHJ	PDP,MBACK		;RECLAME BUFFER SPACE
	TRNN	FLAGS,F.ALF		;DID THEY WANT ALL FUNCTIONS?
	JRST	RECL4A			;NOPE
	TRNN	FLAGS,F.FUNS		;YES--BUT DID WE SEE ANY?
	SPEAK	NOFUNS			;TELL THEM WE DIDN'T
RECL4A:	TRNN	FLAGS,F.ALV		;DID THEY WANT ALL VARIABLES?
	JRST	RECL4B			;NOPE
	TRNN	FLAGS,F.VARS		;YES--BUT DID WE SEE ANY?
	SPEAK	NOVARS			;NOPE
RECL4B:	SETZ	PIND,			;ZERO INDEX TO DUMARG
	SKIPN	SYMBOL,DUMARG(PIND)	;SCAN TABLE FOR THOSE NOT FOUND
	JRST	BEGINC			;DONE!!!!!!
	CAME	SYMBOL,ONES		;ALL ONES MEANS FOUND
	SPEAK	NOTDEF
	AOJA	PIND,RECL4B+1		;LOOP THROUGH
	>				;END OF COND. ON FILCAP


;THE HELP COMMAND

;THE FILE DSK:ABACUS.HLP [LIBPPN] IS PRINTED ON THE TTY OR LPT (IF /L)

	IFN FILCAP,<
HELP:	MOVSI	B,(SIXBIT /TTY/)	;ASSUME TTY
	TLNE	CHR,C.TERM		;DID THEY TERMINATE AFTER 'HELP'?
	JRST	HELP1			;YES
	MOVEI	C,'/'			;SLASH FOR SWITCH?
	CAIE	C,(CHR)
	ERR	BADHLP			;NOPE
	PUSHJ	PDP,SSPACE		;GET NEXT CHARACTER
	MOVEI	CNT,1			;ALLOW ONLY ONE
	PUSHJ	PDP,LABIN		;GET LABLE
	ERR	BADHLP
	CAME	SYMBOL,[SIXBIT /L/]
	ERR	BADHLP			;NOPE
	TLNN	CHR,C.TERM		;MUST TERMINATE
	ERR	NOTERM			;SHAME
	MOVSI	B,(SIXBIT /LPT/)	;SET FOR LPT
HELP1:	MOVEM	B,OPENBK+1		;SAVE DEVICE NAME
	CALLI	B,4			;DEVCHR CALLI
	TLNN	B,DV.LPT+DV.TTY		;MUST BE TTY OR LPT (IF ASS)
	ERR	BADHP1
	MOVEI	B,ASCMOD		;MODE IS ASCII
	MOVEM	B,OPENBK
	MOVEI	B,OBUF
	HRLZM	B,OPENBK+2		;SET UP OUTPUT BUFFER
	OPEN	CHANO,OPENBK		;OPEN THE DEVICE
	ERR	OUTDER
	MOVE	B,CUSP			;SET UP FILE NAME
	MOVEM	B,FILDAT
	MOVSI	B,(SIXBIT /HLP/)
	MOVEM	B,FILDAT+1
	SETZM	FILDAT+2
	SETZM	FILDAT+3
	MOVSI	B,(SIXBIT /SYS/)	;SET UP OPEN BLOCK
	MOVEM	B,OPENBK+1
	MOVEI	B,ASCMOD		;INPUT MODE IS ASCII
	PUSHJ	PDP,OPENI+1		;OPEN INPUT DEVICE AND LOOKUP FILE
	JRST	NOIFIL			;NOT FOUND
	MOVE	B,[EXP 203*2+37*2]	;GET THIS MUCH BUFFER SPACE
	PUSHJ	PDP,MDOWN
HELP2:	PUSHJ	PDP,GETWD		;GET A CHARACTER
	ERRF				;DONE SO CLOSE FILES
	PUSHJ	PDP,PUTWD		;PUT OUT A CHARACTER
	JRST	HELP2			;LOOP
	>				;END OF COND. ON FILCAP


;THE STATUS OR STAT COMMAND -- PRINTS A USAGE SUMMARY

STATS:	TLNN	CHR,C.TERM		;MUST TERMINATE LINE
	ERR	SINGLE
	SPEAK	STMSG
	PUSHJ	PDP,TIME		;PRINT TIME OF DAY
	PUSHJ	PDP,CRLF2
	SPEAK	RUNMSG
	PUSHJ	PDP,RNTIME		;THE RUNTIME
	PUSHJ	PDP,TABOUT
	SPEAK	CNTMSG
	PUSHJ	PDP,CNTIME		;THE CONNECT TIME
	PUSHJ	PDP,CRLF2
	MOVE	N,RESLT			;THE VALUES OF 'RESLT' AND 'TOT'
	SPEAK	RSTMSG
	MOVE	N,TOT
	SPEAK	SRTMSG
	PUSHJ	PDP,PRTALV		;ALL VARIABLE ASSIGNMENTS
	PUSHJ	PDP,PRTALF		;ALL FUNCTION DEFINITIONS
	IFN DEBUG,<
	PUSHJ	PDP,CORUSR		;AND CORE USAGE (IF DEBUG MODE)
	>
	JRST	BEGINC


;THE CORUSE COMMAND -- PRINTS CORE USAGE (IF DEBUG MODE)

	IFN DEBUG,<

CORUSE:	PUSHJ	PDP,CORUSR
	JRST	BEGINC

CORUSR:	PUSHJ	PDP,CRLF
	HRRZ	N,FNSTPT
	SPEAK	CORUS1		;INITIAL FUNC. LOC.
	MOVE	N,FUNNXT
	SPEAK	CORUS2		;NEXT FUNCT. LOC.
	MOVE	N,FUNMAX
	SPEAK	CORUS3		;MAX FUNCT. LOC.
	HRRZ	B,.JBREL
	IDIVI	B,^D1024	;CALCULATE NUMBER OF BLOCKS OF CORE
	SKIPE	C
	ADDI	B,1
	MOVE	N,B
	SPEAK	CORUS4		;BLOCKS CORE
	POPJ	PDP,


;THE PNS COMMAND -- PRINTS PNS IN READABLE FORM (IF DEBUG MODE)

PNSCHK:	SETZ	PIND,
	PUSHJ	PDP,CRLF
	MOVE	N,PNS(PIND)		;GET ITEM OF PNS
	LDB	A,[POINT 6,N,5]		;GET THE OPCODE
	TLZ	N,770000		;CLEAR THE OPCODE
	MOVE	SYMBOL,OPCLAB(A)	;GET THE OPCODE MNEMONIC
	PUSHJ	PDP,SIXOUT
	PUSHJ	PDP,SPACEO
	CAIN	A,6			;AN OPDC?
	JRST	PNSCH1
	CAIN	A,13			;AN FJUMP?
	JRST	PNSCH2
	CAIE	A,10			;A PCALL?
	CAIN	A,14			;A STORE?
	JRST	PNSCH4
	CAIN	A,7			;A CONCAL?
	JRST	PNSCH3
	CAIE	A,11			;ARE WE DONE?
	CAIN	A,15
	JRST	BEGINC			;YES
	AOJA	PIND,PNSCHK+1		;NO, KEEP AT IT

PNSCH1:	MOVE	SYMBOL,N
	LSH	SYMBOL,6
	PUSHJ	PDP,SIXOUT
	PUSHJ	PDP,SPACEO
	PUSHJ	PDP,LABCHK
	AOJA	PIND,PNSCHK+1
	MOVE	N,LABTAB+1(CNT)
	PUSHJ	PDP,FLOCON
	AOJA	PIND,PNSCHK+1

PNSCH2:	MOVE	SYMBOL,N
	PUSHJ	PDP,SIXOUT
	AOJA	PIND,PNSCHK+1

PNSCH3:	AOJ	PIND,
	MOVE	N,PNS(PIND)
	PUSHJ	PDP,FLOCON
	AOJA	PIND,PNSCHK+1

PNSCH4:	PUSHJ	PDP,DECPNT
	AOJA	PIND,PNSCHK+1

OPCLAB:	SIXBIT	/PLUS/			;TABLE OF SIXBIT OPCODES
	SIXBIT	/MINUS/
	SIXBIT	/MULT/
	SIXBIT	/DIVIDE/
	SIXBIT	/EXPON/
	SIXBIT	/NEGAT/
	SIXBIT	/OPDC/
	SIXBIT	/CONCAL/
	SIXBIT	/PCALL/
	SIXBIT	/FRET/
	SIXBIT	/REDYF/
	SIXBIT	/FJUMP/
	SIXBIT	/STORE/
	SIXBIT	/DONE/
	SIXBIT	/DOCALL/




;THE DDT COMMAND -- TRANSFERS CONTROL TO DDT (IF DEBUG MODE)


DDTST:	SKIPN	.JBDDT		;IS DDT LOADED?
	ERR	[ASCIZ /DDT NOT LOADED/]
	TTCALL	11,
	HRRZ	BPT,.JBDDT
	JRST	(BPT)

	>					;END COND. ON DEBUG
SUBTTL VARIOUS SUBROUTINES

;ROUTINE TO GET A VALUE EITHER AS A NUMBER FROM THE TTY OR AS A VALUE
;TO A LABLE FROM THE TTY
;CALL PUSHJ PDP,GETVAL
;GETVAL INPUTS THE FIRST CHARACTER ITSELF!!

GETVAL:	PUSHJ	PDP,SSPACE		;GET NEXT CHR
	TLNN	CHR,C.OPR		;CHECK OPERATOR
	JRST	.+6
	MOVEI	A,(CHR)			;GET RIGHT HALF
	CAIE	A,'-'			;NEG SIGN?
	JRST	.+3
	TRO	FLAGS,F.MINV		;NOTE THAT IT'S NEG.
	PUSHJ	PDP,SSPACE		;NO GET ANOTHER
	TLNN	CHR,C.DIGI+C.DOT	;NUMBER?
	JRST	GETVL1
	PUSHJ	PDP,FLICON		;GET THE NUMBER
	TRZE	FLAGS,F.MINV		;IS IT NEG?
	MOVNS	N			;YES SO DO YOUR THING
	POPJ	PDP,

GETVL1:	TLNN	CHR,C.LETT		;LETTER?
	ERR	BADLVR
	MOVEI	CNT,5			;5 CHRS MAX
	PUSHJ	PDP,LABIN		;GET THE LABLE
	JRST	LABLON
	PUSHJ	PDP,LABCHK		;LOOK IT UP
	ERR	UNDVAR			;UNDEFINED
	MOVE	N,LABTAB+1(CNT)		;GET ITS VALUE INTO AC "N"
	POPJ	PDP,


;ROUTINE TO CONVERT TO POLISH STRING NOTATION
;ENTRY POINTS: 1) PUSHJ PDP,POLCON    --  FULL SCAN
;              2) PUSHJ PDP,POLCON+1    -- "CHR" READY TO GO
;              3) PUSHJ PDP,POLC1     --  NOT AN ALPHA
;              4) PUSHJ PDP,POLC2     --  A NUMBER
;              5) PUSHJ PDP,POLC3     --  "SOMETHING ELSE"
;	       6) PUSHJ PDP,POLC4   --  A LABLE ALREADY GOTTEN
;UNLESS ERROR, RETURNS ALWAYS WITH A POPJ PDP,

POLCON:	PUSHJ	PDP,SSPACE		;GET A CHARACTER SKIPING SPACES
	TLNE	CHR,C.LETT		;A LETTER?
	JRST	VARBLE
POLC1:	TLNE	CHR,C.DIGI+C.DOT	;NUMERIC?
	JRST	POLC2			;YES
POLC3:	TLNE	CHR,C.LPAR		;A LEFT PARENTHESIS?
	JRST	LPAREN
	TLNE	CHR,C.RPAR		;A RIGHT PARENTHESIS?
	JRST	RPAREN
	TLNE	CHR,C.OPR		;OPERATOR?
	JRST	OPERAT			;YES IT SURE IS
	TLNE	CHR,C.COMA		;COMMA BETWEEN ARGS?
	JRST	COMMA			;YOU BET!
	TLNE	CHR,C.EQAL		;EQUAL SIGN?
	ERR	BADEQL			;BAD EQUAL SIGN HERE
	TLNN	CHR,C.TERM		;END OF THIS STATEMENT?
	ERR	BADCHR			;BAD CHARACTER
	TRNE	FLAGS,F.LOPP		;LAST OPERATOR FLAG?
	ERR	TRAOPP			;YES TRAILING OPERATOR
DONE1:	CAMN	STACK,STKST		;DL EMPTY?
	JRST	DONE2			;YES
	POP	STACK,SYMBOL		;POP IT OFF DL
	MOVEM	SYMBOL,PNS(PIND)	;STORE IN PNS
	LDB	SYMBOL,OPCPNT		;GET THE OPCODE
	CAIN	SYMBOL,13		;AN FJUMP?
	ERR	BADFCL			;BAD END TO CALL
	CAIN	SYMBOL,15		;A LEFT PARENTHESIS?
	ERR	NORPAR
	AOBJN	PIND,DONE1		;CONTINUE TO TRANSFER DL
	ERR	PNSFUL

DONE2:	TRNE	FLAGS,F.LPAR		;THIS MUST NOT BE ON
	ERR	IMPEXP			;IMPROPER EXPRESSION
	MOVE	SYMBOL,.DONE		;GET THE DONE OPCODE
	TRNE	FLAGS,F.DEFN		;IS THIS A DEFINITION?
	MOVE	SYMBOL,.FRET		;GET THE FRET OPCODE
	MOVEM	SYMBOL,PNS(PIND)	;STORE IN PNS
	POPJ	PDP,			;WE DONE DID IT!!

VARBLE:	TRZ	FLAGS,F.LPAR+F.LOPP
	TRZE	FLAGS,F.LVAR		;TWO VARIABLES OR NUMBERS ADJACENT?
	ERR	ADJVAR			;YES
	MOVEI	CNT,5			;ALLOW 5 CHARACTERS MAX
	PUSHJ	PDP,LABIN		;GET THE LABLE
	JRST	LABLON			;TOO MANY
POLC4:	TLNE	CHR,C.EQAL		;EQUAL SIGN?
	JRST	VARBL4			;GREAT!
	TLNE	CHR,C.LPAR		;LEFT PARENTHESIS TO START ARGS?
	JRST	VARBL8			;GOODY!
	TRNN	FLAGS,F.DEFN		;DEFINING?
	JRST	VARBL1			;NO
	MOVN	CNT,NARGS		;NUMBER OF DUMMY ARGUMENTS
	HRLZS	CNT
	CAMN	SYMBOL,DUMARG(CNT)	;IS IT THIS DUMMY ARG?
	JRST	VARBL3			;MATCH
	AOBJN	CNT,.-2			;NOT THIS ONE-SO KEEP LOOKING
VARBL1:	LSH	SYMBOL,-6		;NOT A DUMMY ARG AT ALL
	IOR	SYMBOL,.OPDC		;MAKE AN OPCODE OPDC
VARBL2:	MOVEM	SYMBOL,PNS(PIND)	;STORE IN PNS
	TRO	FLAGS,F.LVAR		;FLAG AS A LAST VARIABLE
	AOBJN	PIND,POLCON+1		;ADVANCE PNS INDEX AND CONTINUE
	ERR	PNSFUL

VARBL3:	HLLI	CNT,			;CLEAR THE LEFT HALF
	SUB	CNT,NARGS		;SET UP THE PCALL WORD
	MOVN	SYMBOL,CNT
	IOR	SYMBOL,.PCALL
	JRST	VARBL2


VARBL4:	TRO	FLAGS,F.LPAR		;SET TO ALLOW NEGATION
	CAMN	STACK,STKST		;EMPTY STACK?
	JRST	VARBL5			;YES
	LDB	A,[POINT 6,(STACK),5]	;GET LAST OPCODE

VARBL5:	PUSHJ	PDP,LABCHK		;LOOK UP THE VARIABLE
	JRST	VARBL7			;NOT FOUND
	CAIG	CNT,2			;DON'T CHANGE 'RESLT' OR 'TOT'
	ERR	CNGRST
VARBL6:	MOVE	SYMBOL,.STORE		;SET UP STORE OPCODE
	HRR	SYMBOL,CNT
	PUSH	STACK,SYMBOL
	JRST	POLCON			;AND CONTINUE

VARBL7:	PUSHJ	PDP,RESCHK		;IS IT A RESERVED WORD?
	ERR				;YES
	HLLI	CNT,			;CLEAR LEFT
	CAILE	CNT,LTLEN		;ROOM FOR ONE MORE VARIABLE?
	ERR	LABFUL			;NOPE
	MOVEM	SYMBOL,LABTAB(CNT)	;SAVE THE NAME
	SETZM	LABTAB+1(CNT)		;GIVE IT A ZERO VALUE
	AOS	LABTOT			;SHOW WE'VE ONE MORE LABLE
	JRST	VARBL6			;AND BACK WE GO

VARBL8:	LSH	SYMBOL,-6		;IS A FUNCTION CALL THEN
	IOR	SYMBOL,.FJUMP		;SET UP OPCODE FJUMP
	PUSH	STACK,SYMBOL		;AND PUSH ONTO DELIMITER LIST
	MOVE	SYMBOL,.REDYF		;SET UP OPCODE REDYF
	MOVEM	SYMBOL,PNS(PIND)	;STORE IN PNS
	TRO	FLAGS,F.LPAR		;TURN ON LEFT PAREN FLAG
	AOBJN	PIND,POLCON
	ERR	PNSFUL

POLC2:	TRZ	FLAGS,F.LOPP+F.LPAR
	TROE	FLAGS,F.LVAR
	ERR	ADJVAR
	PUSHJ	PDP,FLICON		;GET IN THE NUMBER
	MOVE	SYMBOL,.CONCL		;SET UP OPCODE CONCAL
	MOVEM	SYMBOL,PNS(PIND)	;STORE IN PNS
	AOBJN	PIND,.+2
	ERR	PNSFUL
	MOVEM	N,PNS(PIND)		;PLACE VALUE IN PNS
	AOBJN	PIND,POLCON+1
	ERR	PNSFUL

LPAREN:	TRZ	FLAGS,F.LOPP
	TRZE	FLAGS,F.LVAR		;CAN ONLY HAPPEN IF NBER WAS
	ERR	MISOPP
	TRO	FLAGS,F.LPAR
	PUSH	STACK,.LPARN		;PUSH LEFT PAREN CODE ONTO DL
	JRST	POLCON

RPAREN:	TRZE	FLAGS,F.LPAR+F.LOPP
	ERR	MISRP			;MISPLACED RIGHT PAREN
	CAMN	STACK,STKST		;DL EMPTY?
	ERR	EXRP			;EXTRA RIGHT PAREN
	POP	STACK,SYMBOL
	LDB	A,OPCPNT		;GET OPCODE
	CAIN	A,13			;IS IT THE FJUMP?
	JRST	LPARN1
	CAIN	A,15			;IS IT A LEFT PARENTHESIS?
	JRST	POLCON			;YES--SIMPLY TOSS AWAY
	MOVEM	SYMBOL,PNS(PIND)	;TRANSFER TO PNS
	AOBJN	PIND,RPAREN+2
	ERR	PNSFUL

LPARN1:	MOVEM	SYMBOL,PNS(PIND)	;MOVE THE FJUMP TO PNS
	AOBJN	PIND,POLCON
	JRST	PNSFUL

OPERAT:	TRZ	FLAGS,F.LVAR
	TROE	FLAGS,F.LOPP		;SET AND CHECK F.LOPP
	JRST	OPERA2			;CHECK FURTHER TO ALLOW NEGATION
	TRZE	FLAGS,F.LPAR		;IS LEFT PAREN ON?
	JRST	OPERA2			;CHECK FURTHER FOR NEGATION
	PUSHJ	PDP,OPPCHK		;LOOK UP THE OPERATOR

OPERA1:	JUMPG	B,OPERA3		;PRIORITY=1 THEN DONE?
	POP	STACK,SYMBOL		;NO SO POP OFF DL
	MOVEM	SYMBOL,PNS(PIND)	;AND SAVE IN PNS
	PUSHJ	PDP,DELPRI		;GET THE NEW PRIORITY
	AOBJN	PIND,OPERA1
	ERR	PNSFUL

OPERA2:	HLLI	CHR,			;IS IT NEGATION?
	CAIE	CHR,'-'
	ERR	LEDADJ			;ONLY NEG. AT START OF EXPRESSION
	MOVE	A,.NEGAT		;SET UP OPCODE NEGAT
OPERA3:	PUSH	STACK,A			;PUSH ONTO DL
	JRST	POLCON

;ROUTINE TO HANDLE OPERATOR AND PRIORITY LOOKUPS
;FOR NEW OPERATOR--CALL PUSHJ PDP,OPPCHK
;RETURN OPCODE IN BITS 0-5 OF "A" AND PRIORITY IN "B"
;ON SUBSEQUENT SEARCHES--CALL PUSHJ PDP,DELPRI
;NOTE: 1) DO NOT DESTROY AC "CNT" BETWEEN CALLS ON SAME NEW OPERATOR
;      2) 0 PRIORITY MEANS TO POP THE LAST DL
;         1 PRIORITY MEANS TO PUSH NEW DL
;      3) IF OPERATOR IS NOT FOUND--JRSTS TO BADEQ

OPPCHK:	HLLI	CHR,			;CLEAR LEFT HALF OF "CHR"
	HRLZI	CNT,OTLEN		;SET UP A CONTROL COUNT
	HLRZ	A,OPPTAB(CNT)		;GET LH OF TABLE ENTRY
	CAMN	CHR,A			;COMPARE THE TWO
	JRST	OPPCH1			;FOUND!
	AOBJN	CNT,OPPCHK+2		;NOT THIS ONE
	ERR	INTEQ			;BAD PLACE FOR EQUAL SIGN

OPPCH1:	HRLZ	A,CNT			;SET UP OPCODE BY SHIFTING COUNT
	LSH	A,^D12			;INTO BITS 0-5 OF "A"
DELPRI:	MOVEI	B,1
	CAMN	STACK,STKST		;IS DL EMPTY?
	POPJ	PDP,			;YES SO PRIORITY=1
	MOVE	SYMBOL,(STACK)		;GET LAST DELIMITER
	LDB	SYMBOL,OPCPNT		;GET ITS OPCODE
	CAIL	SYMBOL,13		;IS IT FJUMP,STORE, OR "("
	POPJ	PDP,			;YES SO PRIORITY=1
	HRLZ	B,OPPTAB(CNT)		;GET PRIORITY OR FLAG
	JUMPGE	B,CPOPJ			;IT IS PRIORITY SO RETURN
	SETZ	B,			;FLAGGED SO LOOK FURTHER
	CAIG	SYMBOL,1		;OPCODE>1 SO, 0 PRIORITY
	MOVEI	B,1			;SET PRIORITY=1 IF OPCODE<=1
CPOPJ:	POPJ	PDP,

OPPTAB:	XWD	'+',0			;TABLE OF OPERATORS AND THEIR PRIORITY
	XWD	'-',0
	XWD	'*',-1
	XWD	'/',-1
	XWD	'^',1
	OTLEN=OPPTAB-.			;LENGTH OF TABLE

COMMA:	TRZ	FLAGS,F.LVAR		;CLEAR THE LAST VAR FLAGS
	TRZE	FLAGS,F.LPAR+F.LOPP
	ERR	MISPC1			;MISPLACED COMMA (MESSAGE 1)
	TRO	FLAGS,F.LPAR
COMMA1:	CAMN	STACK,STKST		;DL EMPTY?
	ERR	MISPC2			;MISPLACED COMMA (MESSAGE 2)
	MOVE	SYMBOL,(STACK)		;GET LAST DELIMITER
	LDB	A,OPCPNT		;EXTRACT OPCODE
	CAIN	A,13			;FJUMP
	JRST	POLCON
	CAIN	A,15			;LEFT PAREN?
	ERR	NORPAR			;MISSING RIGHT PAREN
	POP	STACK,SYMBOL
	MOVEM	SYMBOL,PNS(PIND)
	AOBJN	PIND,COMMA1		;KEEP AT IT
	ERR	PNSFUL



;ROUTINES TO EVALUATE THE POLISH STRING
;CALL PUSHJ PDP,PNSVAL
;BEFORE ENTRY, THE STACK SHOULD BE INITIALIZED

PNSVAL:	MOVEI	A,PNS			;GET BASE ADR OF PNS
	HRRM	A,PNSLOC		;STORE IN INDIRECT WORD
	SETZ	PIND,			;ZERO THE INDEX
PNSVL1:	MOVE	SYMBOL,@PNSLOC		;GET AN ITEM OF PNS
	LDB	A,OPCPNT		;GET THE OPCODE
	PUSHJ	PDP,@OPCODE(A)		;GO TO THE PROPER ROUTINE
	AOJA	PIND,PNSVL1		;CONTINUE TIL DONE

;THESE ARE THE OPCODES USED BY ABACUS

OPCODE:	PLUS	;0
	MINUS	;1
	MULT	;2
	DIVIDE	;3
	EXPON	;4
	NEGAT	;5
	OPDC	;6
	CONCAL	;7
	PCALL	;10
	FRET	;11
	REDYF	;12
	FJUMP	;13
	STORE	;14
	DONE	;15
	DOCALL	;16

.PLUS:	0
.EXPON:	4B5
.NEGAT:	5B5
.OPDC:	6B5
.CONCL:	7B5
.PCALL:	10B5
.FRET:	11B5
.REDYF:	12B5
.FJUMP:	13B5
.STORE:	14B5
.DONE:	15B5
.LPARN:	15B5
.DOCAL:	16B5


;THE FOLLOWING ROUTINES HANDLE ARITHMETIC OPERATIONS ON THE STACK
;AND ARE CALLED FROM PNSVAL

BCALC:
PLUS:	POP	STACK,A			;REMOVE 1ST FROM STACK
	MOVE	N,(STACK)		;MOVE 2ND FROM STACK
	FADR	N,A			;ADD THE TWO
	MOVEM	N,(STACK)		;AND PUT BACK IN STACK
	POPJ	PDP,

MINUS:	POP	STACK,A			;REMOVE FIRST ELEMENT
	MOVE	N,(STACK)		;GET SECOND ELEMENT
	FSBR	N,A			;SUBTRACT THE TWO
	MOVEM	N,(STACK)
	POPJ	PDP,

MULT:	POP	STACK,A			;REMOVE 1ST FROM STACK
	MOVE	N,(STACK)		;GET THE 2ND
	FMPR	N,A			;MULTIPLY THE TWO
	MOVEM	N,(STACK)		;AND STORE RESULT IN STACK
	POPJ	PDP,

DIVIDE:	POP	STACK,A			;GET DIVISOR
	MOVE	N,(STACK)		;GET DIVIDEND
	FDVR	N,A			;DIVIDE THE TWO		
	MOVEM	N,(STACK)		;STORE BACK IN STACK
	POPJ	PDP,


EXPON:	POP	STACK,N1		;PICK UP EXPONENT
	POP	STACK,N			;PICK UP BASE
	PUSHJ	PDP,EXP3.0		;DO THE CALCULATION
	PUSH	STACK,N			;PUT RESULT ON STACK
	POPJ	PDP,			;RETURN

NEGAT:	POP	STACK,N			;PICK UP VALUE
	MOVNS	N			;NEGATE IT
	PUSH	STACK,N			;AND PUSH BACK ONTO STACK
	POPJ	PDP,

ECALC:


;THE FOLLOWING ROUTINES HANDLE OTHER STACK OPERATIONS
;AND ARE CALLED FROM PNSVAL

;OPDC PUSHES THE VALUE OF THE SPECIFIED VARIABLE ONTO THE STACK

OPDC:	LSH	SYMBOL,6		;PNS ITEM IN "SYMBOL"
	PUSHJ	PDP,LABCHK		;LOOKUP THE LABLE
	ERR	UNDVAR
	PUSH	STACK,LABTAB+1(CNT)	;PUSH VALUE ONTO STACK
	POPJ	PDP,

;DOCALL PUSHES THE CURRENT DO VALUE ONTO THE STACK

DOCALL:	PUSH	STACK,DOREG1		;PUSH DO LOOP VAL. ON STACK
	POPJ	PDP,			;RETURN

;CONCAL PUSHES A CONSTANT (NEXT WD IN PNS) ONTO THE STACK

CONCAL:	AOJ	PIND,			;ADVANCE PNS INDEX TO PICK UP CONSTANT
	PUSH	STACK,@PNSLOC		;PUSH CONSTANT ONTO STACK
	POPJ	PDP,

;PCALL PUSHES A PARAMETER SUPPLED TO A FUNCTION ON TO THE TOP OF
;THE STACK.

PCALL:	PUSHJ	PDP,PCALL1
	PUSH	STACK,(A)
	POPJ	PDP,

PCALL1:	HRRZ	A,LINK			;GET LINK
	MOVE	B,(A)			;GET WORD ADRESSED BY A
	TRZN	B,400000		;IS BIT 18 SET?
	JRST	.+3			;NO
	HRRZ	A,B			;USE THIS WORD TO REFERENCE 
	JRST	PCALL1+1		;CONTINUE TIL BIT 18 IS NOT SET
	SUBI	A,1(SYMBOL)
	POPJ	PDP,

FRET:	POP	STACK,SYMBOL		;SAVE THE RESULT
	POP	STACK,A			;GET JUMP CONTROL WORD
	POP	STACK,B			;GET PNS WORD
	HRRM	B,PNSLOC		;PLACE THIS ADR IN PNSLOC
	SETZ	PIND,			;RESET THE PNS INDEX
	MOVE	STACK,A			;MOVE JUMP CONTROL INTO STACK POINTER
	POP	STACK,A			;GET THE REDYF WORD
	TRZ	A,400000		;CLEAR BIT 18
	MOVEM	A,LINK			;UPDATE LINK
	PUSH	STACK,SYMBOL		;PUT THE RESULT BACK IN STACK
	POPJ	PDP,

;REDYF PREPARES THE STACK FOR FUNCTION HANDLING

REDYF:	MOVE	SYMBOL,LINK		;GET CURRENT LINK
	TRO	SYMBOL,400000		;SET BIT 18
	PUSH	STACK,SYMBOL		;PUSH REDYF WORD ONTO STACK
	MOVEM	STACK,LINK		;UP DATE LINK
	POPJ	PDP,

;FJUMP PERFORMS A FUNCTION JUMP

FJUMP:	LSH	SYMBOL,6		;GET FUNCTION NAME
	PUSHJ	PDP,INTCHK		;IS IT AN INTRINSIC?
	JRST	FJUMP1			;YES
	PUSHJ	PDP,FUNCHK		;IS IT USER DEFINED?
	ERR	UNDFUN			;NO
	AOJ	CNT,
	LDB	N,[POINT 6,@FNSTPT,5]	;GET # ARGS
	PUSHJ	PDP,FJUMP2		;SEE IT DONE BELOW
	LDB	C,FNBPT1		;GET # SOURCE WORDS FROM HEADER
	ADDI	CNT,(C)			;ADVANCE COUNT TO 1ST PNS WORD
	MOVEI	A,@FNSTPT		;GET THE ABS. ADR THERE
	HRRM	A,PNSLOC		;STORE IT IN RH OF PNSLOC
	SETZ	PIND,			;SET PNS INDEX TO 0
	POPJ	PDP,

FJUMP1:	AOJ	CNT,
	LDB	N,[POINT 6,FUNTAB(CNT),5]
	PUSHJ	PDP,FJUMP2		;DO YOUR THING
	JRST	@FUNTAB(CNT)		;GO TO FUNCTION (RETURN TO PNSVL1)

FJUMP2:	HRRZ	B,LINK			;CALCULATE # PARAMETERS SUPPLIED
	SUBI	B,(STACK)
	MOVNS	B
	CAME	N,B			;DO THEY MATCH?
	JRST	FJUMP3			;IN CORRECT NBER OF ARGS
	MOVEI	A,@PNSLOC		;GET LOCATION OF THIS PNS WORD
	PUSH	STACK,A			;PUSH IT ONTO STACK
	PUSH	STACK,LINK		;PUSH CURRENT LINT ONTO STACK
	MOVEM	STACK,LINK		;AND UP DATE LINK
	POPJ	PDP,

FJUMP3:	SPEAK	INCARG
	MOVE	N,B
	ERR	NUMSUP

;STORE STORES THE RESULT AT TOP OF STACK INTO A VARIABLE

STORE:	HLLI	SYMBOL,			;ZERO THE LEFT
	MOVE	N,(STACK)		;GET THE RESULT FROM THE STACK
	MOVEM	N,LABTAB+1(SYMBOL)	;STORE IN LABTAB
	POPJ	PDP,

;DONE DOES JUST THAT!!

DONE:	POP	PDP,A			;DUMMY UP A POPJ
	POPJ	PDP,			;DONE AT LAST!!!!!!!!!


;ROUTINE TO INPUT A SIXBIT LABLE INTO AC "SYMBOL"
;"CNT" THE MAXIMUM NUMBER OF CHARACTERS SHOULD BE SET BEFORE ENTRY

LABIN:	MOVE	BPT,[POINT 6,SYMBOL]	;SET UP BYTE POINTER
	SETZ	SYMBOL,			;ZERO THE DESTINATION AC
LABIN1:	TLNN	CHR,C.LETT+C.DIGI
	JRST	LABIN2
	SOJL	CNT,CPOPJ		;MORE THAN ALLOWED?
	IDPB	CHR,BPT			;STORE IN SYMBOL
	PUSHJ	PDP,CHRIN		;GET NEXT CHR
	JRST	LABIN1
LABIN2:	AOS	(PDP)			;FOR SKIP RETURN
	JRST	SSPAC1			;SKIP SPACES AND RETURN

;ROUTINE TO LOOK UP LABLES AS VARIABLES
;CALL PUSHJ PDP,LABCHK
;ON ENTERING, LABLE IS LEFT JUSTIFIED IN "SYMBOL"
;NON-SKIP RETURN IF NOT FOUND -- "CNT" INDEXES NEXT FREE SPACE
;SKIP IF FOUND -- "CNT" INDEXES THE ENTRY

LABCHK:	MOVN	CNT,LABTOT		;NUMBER OF ITEMS IN TABLE
	HRLZS	CNT			;SET UP A CONTROL COUNT
LABCK1:	CAMN	SYMBOL,LABTAB(CNT)	;COMPARE THE TWO
	JRST	LABCK2			;MATCH
	ADD	CNT,ONETWO		;INCREMENT COUNT
	JUMPL	CNT,LABCK1		;TRY AGAIN IF MORE LEFT
	POPJ	PDP,			;NOT IN TABLE
LABCK2:	HLLI	CNT,			;ZERO OUT THE LEFT HALF
CPOPJ1:	AOS	(PDP)
	POPJ	PDP,

ONETWO:	XWD	1,2			;FOR INCREMENTING TWO WORD COUNTERS

;ROUTINE TO CHECK COMMANDS
;CALL PUSHJ PDP,COMCHK -- LABLE IN "SYMBOL" ON ENTRY
;SKIP RETURN IF NOT VALID
;NON-SKIP RETURN IF A COMMAND

COMCHK:	HRLZI	A,COMLEN		;SET UP A COUNTER
	CAMN	SYMBOL,COMTAB(A)	;COMPARE THE TWO
	POPJ	PDP,			;MATCH--NORMAL RETURN
	ADD	A,ONETWO		;ADVANCE COUNT
	JUMPL	A,COMCHK+1		;TRY AGAIN IF MORE LEFT
	AOS	(PDP)
	POPJ	PDP,			;FOR SKIP RETURN

;TABLE OF ABACUS COMMANDS
;FIRST WORD IS SIXBIT COMMAND NAME
;SECOND WORD IS THE LOCATION OF THE COMMAND
;HANDLING ROUTINE

	DEFINE COM (A,B)
	 <SIXBIT /'A'/
	  B
	 >

COMTAB:	COM (TYPE,TYPE)
	COM (TY,TYPE)
	COM (TOTAL,TOTAL)
	COM (T,TOTAL)
	COM (SUBTOT,SUBTOT)
	COM (S,SUBTOT)
	COM (DISPLY,DISPLY)
	COM (DIS,DISPLY)
	COM (STOP,STOP)

	IFN BYER,<
	COM (BYE,BYE)
	>

	COM (CLRSUB,CLRSUB)
	COM (CLRTOT,CLRTOT)
	COM (FOR,FOR)
	COM (DAYTIM,DAYTIM)
	COM (DA,DAYTIM)
	COM (PJOB,PJOBER)
	COM (STATUS,STATS)
	COM (STAT,STATS)
	COM (BACKUP,BACKUP)
	COM (BK,BACKUP)
	COM (CNGSGN,CNGSGN)
	COM (CS,CNGSGN)
	COM (DEFINE,DEFINF)
	COM (DEF,DEFINF)
	COM (PRINT,PRINT)
	COM (DELETE,DELETE)
	COM (DEL,DELETE)
	COM (RUNTIM,RNTIM)
	COM (CONTIM,CONTIM)

;FILE HANDLING COMMANDS

	IFN FILCAP,<
	COM (RECALL,RECALL)
	COM (STORE,STOREF)
	COM (LIST,LISTER)
	COM (HELP,HELP)
	>

;DEBUGGING COMMANDS

	IFN DEBUG,<
	COM (CORUSE,CORUSE)
	COM (PNS,PNSCHK)
	COM (DDT,DDTST)
	>

	COMLEN=COMTAB-.			;LENGTH OF TABLE

;ROUTINE TO PROMPT USER WITH A "#"
;CALL PUSHJ PDP,PROMPT

PROMPT:	TTCALL	14,			;THIS IS TO CLEAR A CONTROL O
	JRST	.+1
	MOVEI	C,"#"
	TTCALL	1,C
	JRST	SPACEO

;ROUTINE TO FETCH A CHARACTER FROM TTY

;THE CALLING SEQUENCE IS:
;	PUSHJ PDP,CHRIN
;	NORMAL RETURN

;ON A NORMAL RETURN, AC 'CHR' IS OF THE FORM  XWD FLAGS,SIXBIT VALUE

CHRIN:	TTCALL	4,CHR			;ONE CHR FROM TTY
	CAIN	CHR,"&"			;LINE CONTINUATION?
	JRST	CHRIN1
	CAIN	CHR,"'"			;COMMENT TO FOLLOW?
	JRST	CHRIN2
	CAIN	CHR,TAB			;CONVERT TAB TO SPACES
	MOVEI	CHR,SPACE
	CAIN	CHR,CR			;CARRIAGE RETURN?
	JRST	CHRIN			;YES, SKIP OVER
	CAIN	CHR,LF			;LINE FEED?
	MOVEI	CHR,CR			;YES, CONVERT TO <CR>
	HLL	CHR,CHRTAB(CHR)		;GET FLAGS FROM LEFT
	TRNE	CHR,100
	HRL	CHR,CHRTAB-100(CHR)	;OR RIGHT OF CHARACTER TABLE
	TLNE	CHR,C.ILEG		;ILLEGAL?
	ERR	ILLCHR			;TOO BAD. . .
	TLNE	CHR,C.LOWC		;LOWER CASE
	SUBI	CHR,40			;GETS CONVERTED TO UPPER
	TLNN	CHR,C.CR		;CONVERT TO SIXBIT UNLESS <CR>
	SUBI	CHR,40
	TRNE	FLAGS,F.DEFN		;DEFINING A FUNCTION?
	PUSHJ	PDP,STOSRC		;MEANS TO STORE SOURCE CODE
	POPJ	PDP,			;DONE SO RETURN

CHRIN1:	TTCALL	4,CHR
	CAIN	CHR,CR			;READ OVER AND CHECK FOR <CR><LF>
	JRST	CHRIN1
	CAIN	CHR,LF
	JRST	CHRIN
	ERR	BADAND			;ALSO BAD USE OF "&"

CHRIN2:	PUSH	PDP,FLAGS		;SAVE FLAGS
	TRZ	FLAGS,F.DEFN		;TURN OFF DEFINE FLAG
	PUSHJ	PDP,THRUST		;SKIP TO END OF LINE
	POP	PDP,FLAGS		;RESTORE FLAGS
	POPJ	PDP,			;AND RETURN

;CHARACTER TABLE

CHRTAB:	XWD	C.ILEG,C.OTHR	;N  @
	XWD	C.ILEG,C.LETT	;SOH  A
	XWD	C.ILEG,C.LETT	;STX  B
	XWD	C.ILEG,C.LETT	;ETX  C
	XWD	C.ILEG,C.LETT	;EOT  D
	XWD	C.ILEG,C.LETT	;ENQ  E
	XWD	C.ILEG,C.LETT	;ACK  F
	XWD	C.ILEG,C.LETT	;BEL  G
	XWD	C.ILEG,C.LETT	;BS  H
	XWD	C.SPAC,C.LETT	;HT  I
	XWD	C.OTHR,C.LETT	;LF  J
	XWD	C.ILEG,C.LETT	;VT  K
	XWD	C.ILEG,C.LETT	;FF  L
	XWD	C.CR,C.LETT	;CR  M
	XWD	C.ILEG,C.LETT	;SO  N
	XWD	C.ILEG,C.LETT	;SI  O
	XWD	C.ILEG,C.LETT	;DEL  P
	XWD	C.ILEG,C.LETT	;DC1  Q
	XWD	C.ILEG,C.LETT	;DC2  R
	XWD	C.ILEG,C.LETT	;DC3  S
	XWD	C.ILEG,C.LETT	;DC4  T
	XWD	C.ILEG,C.LETT	;NAK  U
	XWD	C.ILEG,C.LETT	;SYN  V
	XWD	C.ILEG,C.LETT	;ETB  W
	XWD	C.ILEG,C.LETT	;CAN  X
	XWD	C.ILEG,C.LETT	;EM  Y
	XWD	C.ILEG,C.LETT	;SUB  Z
	XWD	C.ILEG,C.LBRK	;ESC  [
	XWD	C.ILEG,C.ILEG
	XWD	C.ILEG,C.RBRK	;GS  ]
	XWD	C.ILEG,C.OPR	;RS  ^
	XWD	C.ILEG,C.EQAL	;US  _
	XWD	C.SPAC,C.OTHR	;SP  '
	XWD	C.OTHR,C.LETL	;!  
	XWD	C.OTHR,C.LETL	;"
	XWD	C.OTHR,C.LETL	;#
	XWD	C.OTHR,C.LETL	;$
	XWD	C.OTHR,C.LETL	;%
	XWD	C.OTHR,C.LETL	;&
	XWD	C.OTHR,C.LETL
	XWD	C.LPAR,C.LETL	;(
	XWD	C.RPAR,C.LETL	;)
	XWD	C.OPR,C.LETL	;*
	XWD	C.OPR,C.LETL	;+
	XWD	C.COMA,C.LETL	;,
	XWD	C.OPR,C.LETL	;-
	XWD	C.DOT,C.LETL	;.
	XWD	C.OPR,C.LETL	;/
	XWD	C.DIGI,C.LETL	;0
	XWD	C.DIGI,C.LETL	;1
	XWD	C.DIGI,C.LETL	;2
	XWD	C.DIGI,C.LETL	;3
	XWD	C.DIGI,C.LETL	;4
	XWD	C.DIGI,C.LETL	;5
	XWD	C.DIGI,C.LETL	;6
	XWD	C.DIGI,C.LETL	;7
	XWD	C.DIGI,C.LETL	;8
	XWD	C.DIGI,C.LETL	;9
	XWD	C.COLN,C.LETL	;:
	XWD	C.SEMI,C.LETL	;;
	XWD	C.LTR,C.ILEG	;<
	XWD	C.EQAL,C.ILEG	;=
	XWD	C.GTR,C.ILEG	;>
	XWD	C.OTHR,C.ILEG	;? DEL

;ROUTINE TO INPUT AND CHECK FOR SPACES
;CALL PUSHJ PDP,SSPACE TO INPUT NEXT CHARACTER UNTIL NON-BLANK
;CALL PUSHJ PDP,SSPAC1 TO CHECK CURRENT CHARACTER FOR BLANK AND INPUT NEXT

SSPACE:	PUSHJ	PDP,CHRIN		;INPUT A CHARACTER
SSPAC1:	TLNN	CHR,C.SPAC		;SPACE?
	POPJ	PDP,
	JRST	SSPACE

;FLOATING POINT NUMBER INPUT ROUTINE ADAPTED FROM BASIC VERSION 17
;CALL PUSHJ PDP,FLICON AFTER SETTING UP "CHR" AS THE FIRST CHARACTER
;ON RETURN -- N CONTAINS THE RESULT

;AC'S USED:
;	CHR - FOR CHARACTERS
;	N - RETURNS THE RESULT
;	A, B, SYMBOL, D - WORK SPACE
;	FLAGS - FOR FLAGS IN LEFT HALF

FLICON:	SETZB	N,SYMBOL		;CLEAR NUMBER AND SCALE FACTORS
	MOVEI	D,8			;ONLY 8 DIGITS ARE SIGNIFICENT
	HLLI	FLAGS,			;CLEAR LEFT OF FLAGS
	JRST	.+2
FLIC1:	PUSHJ	PDP,CHRIN		;GET A CHARACTER
	TLNN	CHR,C.DIGI		;IS IT A DIGIT?
	JRST	FLIC2			;NO
	TLO	FLAGS,F.NUM		;YES - REMEMBER WE'VE SEEN ONE
	JUMPE	N,FLIC1A		;SKIP LEADING ZEROS
	SOJG	D,FLIC1A		;COUNT THOSE DIGITS
	AOJA	SYMBOL,FLIC1B		;ADD TO SCALE FACTOR IF MORE THAN 8
FLIC1A:	IMULI	N,^D10			;ACCUMULATE THE DIGIT
	ADDI	N,-20(CHR)
FLIC1B:	TLNE	FLAGS,F.DOT		;HAS A DOT BEEN SEEN?
	SUBI	SYMBOL,1		;YES - DECREMENT THE SCALE FACTOR
	JRST	FLIC1			;CONTINE ON TO NEXT CHARACTER

FLIC2:	TLNN	CHR,C.DOT		;MAYBE IT'S A DOT?
	JRST	FLIC3			;NOT QUITE. . .
	TLOE	FLAGS,F.DOT		;YES - REMEMBER WE'VE SEEN ONE
	ERR	ONEDOT			;DON'T ALLOW TWO, THOUGH
	JRST	FLIC1			;CONTINUE

FLIC3:	MOVEI	D,'E'			;SCIENTIFIC NOTATION?
	CAIE	D,(CHR)
	JRST	FLIC6			;NOPE - MAYBE WE'RE DONE?
	PUSHJ	PDP,SSPACE		;GET NEXT IGNORING BLANKS
	TLNN	CHR,C.OPR		;OPERATOR (+ OR - ONLY)
	JRST	FLIC4+1			;NO, MAYBE ITS A DIGIT
	MOVEI	D,(CHR)
	CAIN	D,'+'			;IS IT POSITIVE?
	JRST	FLIC4
	CAIE	D,'-'			;OR NEGATIVE?
	JRST	FLIC4+1			;OR ASSUMED POSITIVE?
	TLO	FLAGS,F.MINN		;NOTE THE EVENT IF NEGATIVE
FLIC4:	PUSHJ	PDP,CHRIN		;GET NEXT
	SETZ	D,
	TLNN	CHR,C.DIGI		;IS IT A DIGIT?
	ERR	BADEDG			;BAD DIGIT AFTER E
	IMULI	D,^D10
	ADDI	D,-20(CHR)
	PUSHJ	PDP,CHRIN
	TLNE	CHR,C.DIGI
	JRST	.-4			;CONTINUE TO BUILD THE EXPONENT

FLIC5:	TLNE	FLAGS,F.MINN		;IS IT NEGATIVE
	MOVNS	D			;YEP - MAKE IT THUS
	ADD	SYMBOL,D		;ADD EXPONENT TO SCALE FACTOR
FLIC6:	TLNN	FLAGS,F.NUM		;DID WE SEE A DIGIT?
	ERR	NODIGT			;TOO BAD
	JUMPE	N,SSPAC1		;DONE IF ZERO
FLIC6A:	MOVE	A,N			;REMOVE TRAILING ZEROS IN "MANTISSA"
	IDIVI	A,^D10			;SO THAT .1,.10,.100, ETC ARE THE
	JUMPN	B,FLIC6B		;SAME
	MOVE	N,A
	AOJA	SYMBOL,FLIC6A

FLIC6B:	TLO	N,233000		;FLOAT N
	FAD	N,[0]
FLIC6C:	CAIGE	SYMBOL,^D15		;SCALE UP IF >=10^15
	JRST	FLIC6D
	SUBI	SYMBOL,^D14		;SUBTRACT 14 FROM SCALE FACTOR
	FMPR	N,D1E14			;MULTIPLY BY 10^14
	JRST	FLIC6C			;AND LOOK AT SCALE AGAIN

FLIC6D:	CAML	SYMBOL,[EXP -^D4]	;SCALE DOWN IF <10^-4
	JRST	FLIC6E
	ADDI	SYMBOL,^D18		;ADD 18 TO SCALE FACTOR
	FMPR	N,D1EM18		;MULTIPLY BY 10^-18
	JRST	FLIC6D

FLIC6E:	FMPR	N,DECTAB(SYMBOL)	;SCALE N
	TRNE	FLAGS,F.OVER		;OVERFLOW?
	ERR	NUMOVR			;NUMBER OVERFLOWED
	TRNE	FLAGS,F.UNDR		;UNDERFLOW?
	ERR	NUMUND			;NUMBER UNDERFLOWED
	JRST	SSPAC1

;POWER OF 10 TABLE

D1EM18:	OCT	105447113564		;10^-18
D1EM4:	OCT	163643334273		;10^-4
	OCT	167406111565
	OCT	172507534122
	OCT	175631463146

DECTAB:	DEC	1.0			;10^0
	DEC	1.0E1
	DEC	1.0E2
	DEC	1.0E3
	DEC	1.0E4
	DEC	1.0E5
	DEC	1.0E6
	DEC	1.0E7
	DEC	1.0E8
	DEC	1.0E9
	DEC	1.0E10
	DEC	1.0E11
	OCT	250721522451		;10^12
	OCT	254443023471
D1E14:	OCT	257553630410		;10^14

DECFIX:	EXP	225400000000
FIXCON:	EXP	233400000000


;ROUTINE TO PRINT SIXBIT WORD IN "SYMBOL"
;CALL PUSHJ PDP,SIXOUT -- IGNORES BLANKS

SIXOUT:	MOVE	BPT,[POINT 6,SYMBOL]	;SETUP BYTE POINTER
	ILDB	C,BPT			;GET A CHARACTER
	JUMPE	C,.+3			;<SP>?
	ADDI	C,40			;CONVERT TO SEVEN BIT
	PUSHJ	PDP,OUTCHR		;PUT IT OUT
	TLNE	BPT,770000		;DONE?
	JRST	SIXOUT+1
	POPJ	PDP,

;ROUTINE TO PRINT OUT  DEV:FILNAM.EXT [PROJ,PROG]
;CALL PUSHJ PDP,FILTYP

	IFN FILCAP,<

FILTYP:	SKIPN	SYMBOL,OPENBK+1		;GET SIXBIT DEVICE
	JRST	FILTY1			;NONE SPECIFIED
	PUSHJ	PDP,SIXOUT		;PRINT IT
	PUSHJ	PDP,COLON		;FOLLOW UP WITH YOU KNOW WHAT
FILTY1:	MOVE	SYMBOL,FILNAM		;GET SIXBIT FILE NAME
	PUSHJ	PDP,SIXOUT
	HLLZ	SYMBOL,FILNAM+1		;GET SIXBIT EXTENSION
	JUMPE	SYMBOL,FILTY2		;NONE SPECIFIED
	PUSHJ	PDP,PERIOD		;SPIT OUT A DOT
	PUSHJ	PDP,SIXOUT
FILTY2:	SKIPE	A,FILDAT+3		;GET PROJ-PROG NUMBER
	JRST	PPNOUT			;PRINT IT AND RETURN
	POPJ	PDP,			;NONE SPECIFIED SO RETURN

;ROUTINE TO PRINT  [PROJ,PROG]  IN STANDARD DEC FORM
;CALL	PUSHJ PDP,PPNOUT
;AFTER MOVING THE VALUE INTO AC 'A'

PPNOUT:	HLRZ	N,A			;GET THE PROJECT
	SPEAK	[ASCIZ / [%O,/]		;AND PRINT IT
	HRRZ	N,A			;GET THE PROGRAMMER
	SPEAK	[ASCIZ /%O]/]		;AND PRINT IT TOO
	POPJ	PDP,
	>				;END OF COND. ON FILCAP

;ROUTINE TO PRINT ALL USER DEFINED VARIABLES
;CALL PUSHJ PDP,PRTALV

PRTALV:	MOVE	B,LABTOT		;NUMBER OF VARIABLES
	CAIG	B,2			;ANY USER DEFINED ONES?
	JRST	PRTAV1			;NOPE
	SPEAK	VARTTL			;PRINT A TITLE FIRST
	MOVNS	B
	HRLZS	B
	ADD	B,ONETWO		;SKIP OVER PREDEFINED
	ADD	B,ONETWO		;VARIABLES (2)
	PUSHJ	PDP,PRTVAR
	ADD	B,ONETWO
	JUMPL	B,.-2
	POPJ	PDP,

PRTAV1:	PUSH	PDP,FLAGS		;SAVE FLAGS
	TRZ	FLAGS,F.FCHR		;FORCE OUTPUT TO TTY
	SPEAK	NOVARS
	POP	PDP,FLAGS		;RESTORE FLAGS
	POPJ	PDP,

;ROUTINE TO PRINT ALL USER DEFINED FUNCTIONS
;CALL PUSHJ PDP,PRTALF

PRTALF:	SETZ	CNT,
	HRRZ	A,FNSTPT		;GET STARTING LOC. OF FUNCTIONS
	CAML	A,FUNNXT		;ANY USER DEFINED ONES?
	JRST	PRTAF2			;NOPE
	SPEAK	FUNTTL			;PRINT A TITLE FIRST
PRTAF1:	MOVEI	A,@FNSTPT		;GET ABSOLUTE ADR. OF NAME
	CAML	A,FUNNXT
	POPJ	PDP,
	PUSHJ	PDP,PRISRC		;PRINT THE DEFINITION
	JRST	PRTAF1			;CONTINUE

PRTAF2:	PUSH	PDP,FLAGS
	TRZ	FLAGS,F.FCHR
	SPEAK	NOFUNS
	POP	PDP,FLAGS
	POPJ	PDP,


CRLF2:	PUSHJ	PDP,CRLF
CRLF:	MOVEI	C,15
	PUSHJ	PDP,OUTCHR
	MOVEI	C,12
	PUSHJ	PDP,OUTCHR
	POPJ	PDP,

TABOUT:	MOVEI	C,11			;A TAB, WHAT ELSE?
	JRST	OUTCHR

SPACEO:	MOVEI	C,SPACE			;A SPACE
	JRST	OUTCHR

EQOUT:	MOVEI	C,"="			;AN EQUAL SIGN
	JRST	OUTCHR

COLON:	MOVEI	C,":"			;A COLON, YOU DUMMY!
	JRST	OUTCHR

PERIOD:	MOVEI	C,"."			;WOULD YOU BELIEVE, A PERIOD?
	JRST	OUTCHR

NEGOUT:	MOVEI	C,"-"			;A NEGATIVE SIGN
	JRST	OUTCHR

ZEROUT:	MOVEI	C,"0"			;A ZERO
	JRST	OUTCHR

;ROUTINE TO PRINT DATE IN DEC FORMAT
;CALL PUSHJ PDP,DATE

DATE:	CALLI	A,14			;GET DATE IN 12 BIT FORMAT
	IDIVI	A,^D31
	MOVEI	N,1(B)
	PUSHJ	PDP,DECPRO		;PUT OUT THE DAY
	IDIVI	A,^D12
	MOVE	SYMBOL,MONTAB(B)	;GET THE ASCII MONTH
	PUSHJ	PDP,SIXOUT		;AND PUT IT OUT
	MOVEI	N,^D64(A)
	JRST	DECPRO			;PUT OUT YEAR AND RETURN

MONTAB:	SIXBIT	/-JAN-/
	SIXBIT	/-FEB-/
	SIXBIT	/-MAR-/
	SIXBIT	/-APR-/
	SIXBIT	/-MAY-/
	SIXBIT	/-JUN-/
	SIXBIT	/-JUL-/
	SIXBIT	/-AUG-/
	SIXBIT	/-SEP-/
	SIXBIT	/-OCT-/
	SIXBIT	/-NOV-/
	SIXBIT	/-DEC-/

;ROUTINE TO PRINT OUT THE USER'S RUNTIME

RNTIME:	SETZ	A,
	CALLI	A,27
	SUB	A,INRNTM
	IDIVI	A,^D10			;REMOVE THOUSANDTHS
	IDIVI	A,^D100			;SECONDS TO A, HUNDREDTHS TO B
	MOVE	N,A			;OUTPUT THE SECONDS
	PUSHJ	PDP,DECPNT
	PUSHJ	PDP,PERIOD		;A PERIOD
	MOVE	N,B			;AND THE FRACTIONAL PART
	PUSHJ	PDP,DECPRO
	SPEAK	[ASCIZ / SEC./]
	POPJ	PDP,


CNTIME:	CALLI	A,23	
	SUB	A,INCNTM
	JRST	.+2
TIME:	CALLI	A,23			;GET THE TIME IN MILLISECONDS
	IDIV	A,[EXP ^D60000*^D60]
	MOVE	N,A
	PUSHJ	PDP,DECPRO		;PUT OUT THE HOUR
	PUSHJ	PDP,COLON		;FANCY IT UP
	MOVE	A,B
	IDIVI	A,^D60000
	MOVE	N,A
	PUSHJ	PDP,DECPRO		;PUT OUT THE MINUTES
	PUSHJ	PDP,COLON
	MOVE	N,B
	IDIVI	N,^D1000
	PUSHJ	PDP,DECPRO		;PUT OUT THE SECONDS
	POPJ	PDP,

;ROUTINE TO PRINT OUT DATE AND TIME

DATIM:	PUSHJ	PDP,DATE
	PUSHJ	PDP,TABOUT
	PUSHJ	PDP,TIME
	JRST	CRLF

;INTEGER PRINTING ROUTINES FOR VALUE IN "N"
;CALL PUSHJ PDP,DECPRO -- FOR DECIMALS WITH DESIRED LEADING ZEROS
;CALL PUSHJ PDP,DECPNT -- FOR DECIMALS
;CALL PUSHJ PDP,OCTPNT -- FOR OCTALS

DECPRO:	CAIG	N,^D9			;DOES A ZERO LEAD IT OFF?
	PUSHJ	PDP,ZEROUT
DECPNT:	SKIPA	BPT,[12]		;"BPT" CONTAINS THE RADIX
OCTPNT:	MOVEI	BPT,10			;FOR OCTAL PRINT RADIX
RDXPNT:	IDIVI	N,(BPT)			;CONVERT TO BASE IN "BPT"
	HRLM	N1,(PDP)		;SAVE REMAINDER IN LH PDL
	SKIPE	N			;DONE WHEN ZERO
	PUSHJ	PDP,RDXPNT		;KEEP AT IT
	HLRZ	C,(PDP)			;TAKE OFF PDL
	ADDI	C,60			;CONVERT TO SEVENBIT ASCII
OUTCHR:	TRNE	FLAGS,F.FCHR		;OUTPUT TO TTY?
	JRST	OUTCR1			;NOPE
	TTCALL	1,C
	POPJ	PDP,

OUTCR1:	MOVE	WD,C			;OUTPUT THE CHARACTER
	IFN FILCAP,<JRST PUTWD>
	JRST	OUTCHR+2





;FLOATING OUTPUT CONVERSION ROUTINE ADAPTED FROM BASIC V17
;CALL PUSHJ PDP,FLOCON
;ON ENTRY THE VALUE TO BE PRINTED IS IN "N"
;FLOCON  USES AC'S  A,B,C,CNT,SYMBOL,BPT,N,N1

FLOCON:	PUSH	PDP,B			;SAVE B
	PUSH	PDP,CNT			;SAVE CNT
	PUSHJ	PDP,FLOC1
	POP	PDP,CNT
	POP	PDP,B
	POPJ	PDP,

FLOC1:	HLLI	FLAGS,
	SKIPGE	N			;NEGATIVE?
	TLO	FLAGS,F.MINN		;YES SO NOTE IT
	MOVMS	N			;"A" CONTAINS THE NUMBER ON CALL
	JUMPE	N,ZEROUT		;SIMPLY PRINT A ZERO IF SUCH
FLOC2:	MOVEI	CNT,0			;"CNT" CONTAINS THE SCALE FACTOR
FLOC2A:	CAMG	N,D1E14			;SCALE IF >10^14
	JRST	FLOC2B
	ADDI	CNT,^D18		;ADD 18 TO SCALE
	FMPR	N,D1EM18		;AND MULTIPLY BY 10^-18
	JRST	FLOC2A

FLOC2B:	CAML	N,D1EM4			;SCALE IF <10^-4
	JRST	FLOC2C
	SUBI	CNT,^D14		;SUBTACT 14 FROM SCALE
	FMPR	N,D1E14			;AND MULTIPLY BY 10^14
	JRST	FLOC2B

FLOC2C:	MOVE	B,[XWD -^D18,-^D4]
	CAMLE	N,DECTAB(B)

	AOBJN	B,.-1			;LOOK UNTIL A GREATER ONE IS FOUND
	HRRES	B			;CLEAR LEFT HALF OF B PROPERLY
	CAME	N,DECTAB(B)		;FUDGE BY ONE IF EXACT MATCH
	SUBI	B,1
	JUMPN	CNT,FLOC3		;NOT AN INTEGER IF WE SCALED
	CAIGE	B,^D8			;CHECK B FOR 8 DIGIT INTEGER
	CAIGE	B,0
	JRST	FLOC3
	CAML	N,FIXCON		;IS IT 2^36?
	JRST	FLOC2D
	MOVE	N1,N
	FAD	N1,FIXCON		;INTEGER?
	FSB	N1,FIXCON
	CAME	N1,N
	JRST	FLOC3			;NOT SO - LOST FRACTIONAL PART
	FAD	N,FIXCON		;SUCH SO FIX THE NUMBER
	TLZ	N,377400
FLOC2D:	TLZ	N,377000		;IN CASE 27 BIT INTEGER
	TLNE	FLAGS,F.MINN		;NEGATIVE?
	PUSHJ	PDP,NEGOUT
	JRST	DECPNT			;PRINT IT OUT

FLOC3:	SETZM	NUMFLG			;ALL PURPOSE FLAG!
	FDVR	N,DECTAB(B)		;GET MANTISSA
	FMPR	N,DECTAB+5		;MULTIPLY BY 10^5
	TRNN	N,7
	SETOM	NUMFLG
	FADR	N,FIXCON
	TLZ	N,377400		;FIX IT
	CAMGE	N,[EXP ^D1000000]
	JRST	.+3
	IDIVI	N,^D10			;ROUNDING MADE 7 DIGITS
	ADDI	B,1			;MAKE IT 6 AGAIN
	CAIL	N,^D100000		;ROUNDING MADE 5 DIGITS
	JRST	.+3
	IMULI	N,^D10			;YES SO MAKE 6 AGAIN
	SUBI	B,1
	ADDB	B,CNT			;ADD TOGETHER THE PARTS OF SCALE
	AOJ	CNT,
	CAILE	CNT,6
	SETZM	NUMFLG
	CAMG	CNT,[OCT -7]
	SETZM	NUMFLG
	SKIPN	NUMFLG
	JUMPL	CNT,.+2			;BETWEEN 10^-1 AND 10^6?
	CAILE	CNT,6
	SKIPA	CNT,[EXP 1]
	PUSHJ	PDP,FLOC5
	TLNE	FLAGS,F.MINN		;NEGATIVE?
	PUSHJ	PDP,NEGOUT
	SKIPN	NUMFLG
	JUMPN	CNT,FLOC4		;SHOULD A POINT PRECEED NUMBER?
	PUSHJ	PDP,ZEROUT
	PUSHJ	PDP,PERIOD
	SKIPN	NUMFLG
	JRST	FLOC4
FLOC3A:	AOJG	CNT,FLOC3B		;PUT IN ZERO'S AFTER THE POINT
	PUSHJ	PDP,ZEROUT
	JRST	FLOC3A

FLOC3B:	SETZ	CNT,
FLOC4:	SETZM	NUMFLG
	PUSHJ	PDP,DNPRNT		;PRINT THE NUMBER
	JUMPE	B,CPOPJ			;ANY EXPONANT?
	MOVSI	SYMBOL,(SIXBIT / E+/)
	SKIPGE	B			;POSITIVE?
	MOVSI	SYMBOL,(SIXBIT / E-/)
	PUSHJ	PDP,SIXOUT
	MOVM	N,B			;THE DIGITS
	JRST	DECPNT

FLOC5:	CAIL	CNT,0
	SETZM	NUMFLG
	MOVEI	B,0
	POPJ	PDP,

DNPRNT:	MOVEI	BPT,-1			;SIGNAL TRAILING ZERO UNLESS
	JUMPE	B,.+2			;E NOTATION
	MOVEI	BPT,0
DNPRN0:	IDIVI	N,^D10			;GET LAST DIGIT
	JUMPE	N,DNPRN1		;IS IT FIRST
	JUMPN	N1,.+2			;NON ZERO DIGIT
	SKIPA	N1,BPT			;NO SO STASH ZERO OR TRAIL ZERO
	MOVEI	BPT,0			;YES SO TRAILING IS OVER
	HRLM	N1,(PDP)		;NO SO STASH DIGIT
	PUSHJ	PDP,DNPRN0		;RECURSIVELY CALL
	HLRE	N1,(PDP)		;RESTORE THE DIGIT
	JUMPGE	N1,.+3			;ORDINARY?
	JUMPLE	CNT,CPOPJ		;NO SO TRAIL ZERO AFTER "."?
	MOVEI	N1,0			;NO SO STASH A ZERO
DNPRN1:	MOVEI	C,60(N1)		;PRINT DIGIT
	PUSHJ	PDP,OUTCHR
	SOJN	CNT,CPOPJ		;COUNT DIGITS
	JRST	PERIOD



;ROUTINE TO STORE THE SOURCE CODING OF A FUNCTION DEFINITION
;CALL PUSHJ PDP,STOSRC

STOSRC:	TLNE	CHR,C.CR		;CARRIAGE RETURN?
	POPJ	PDP,
	IDPB	CHR,C			;DEPOSIT THE BYTE (C IS BYTE POINTER)
	TLNE	C,770000		;NEED TO ADVANCE A WORD?
	POPJ	PDP,			;NOPE
	AOBJN	FIND,.+2
	PUSHJ	PDP,CHKCOR
	MOVEM	WD,@FUNPNT		;SAVE THE WORD WE'VE BUILT
	MOVE	C,[POINT 6,WD]		;REINITIALIZE BYTE POINTER
	SETZ	WD,			;ZERO DESTINATION WORD
	POPJ	PDP,			;RETURN

;ROUTINE TO CHECK FOR SUFFICIENT CORE ON A FUNCTION DEFINITION
;LEFT HALF OF "FIND" IS SET TO THE NEGATIVE OF THE NUMBER OF WORDS
;REMAINING BEFORE AND EXPANSION IS NECESSARY

CHKCOR:	PUSH	PDP,A			;SAVE A AND B

	PUSH	PDP,B
	HRRZI	A,@FUNPNT		;GET CURRENT ADR IN FUNCTION TABLE
	MOVE	B,FUNMAX		;GET HIGHEST AVAILABLE ADR
	CAILE	B,(A)			;EXPANSION NEEDED?
	JRST	COROK			;NOPE
	ADDI	B,1			;EXPAND BY 1K ONLY
	CALLI	B,11			;CORE UUO
	ERR	NOCORE			;FAILED
	HRRZ	B,.JBREL		;UPDATE FUNMAX
	MOVEM	B,FUNMAX
COROK:	SUB	B,A			;SET UP LH OF "FIND"
	MOVNS	B
	HRL	FIND,B
	POP	PDP,B			;RESTORE A AND B
	POP	PDP,A
	POPJ	PDP,


;ROUTINE TO PRINT SOURCE CODE OF A FUNCTION
;CALL PUSHJ PDP,PRISRC
;ON ENTRY,"CNT" REFERENCES FUNCTION NAME IN TABLE
;WHEN DONE, "CNT" REFERENCES NEXT FUNCTION NAME

PRISRC:	PUSHJ	PDP,TABOUT		;PRINT A TAB
	MOVE	SYMBOL,@FNSTPT		;GET AND PRINT NAME OF FUNCTION
	PUSHJ	PDP,SIXOUT
	AOJ	CNT,
	HRRZ	B,@FNSTPT		;GET NUMBER OF PNS WORDS
	LDB	A,FNBPT1		;GET NUMBER OF SOURCE WORDS
	ADDI	B,1(A)
	ADDI	B,(CNT)
	MOVNS	A
	HRL	CNT,A
	AOJ	CNT,
	MOVE	SYMBOL,@FNSTPT		;GET A WORD OF DEF AND PRINT IT
	PUSHJ	PDP,SIXOUT
	AOBJN	CNT,.-2
PRISC1:	MOVE	CNT,B			;ADVANCE CNT TO END
	JRST	CRLF

;ROUTINE TO CHECK FOR RESERVED WORDS AND PRINT APPROPRIATE MESSAGE
;CALL PUSHJ PDP,RESCHK
;ON ENTRY "SYMBOL" CONTAINS THE LABLE
;SKIP RETURN IF EVERYTHING OK

RESCHK:	PUSH	PDP,CNT			;SAVE C
	PUSHJ	PDP,COMCHK		;IS IT A COMMAND
	JRST	RESCK1
	PUSHJ	PDP,LABCHK		;IS IT A VARIABLE?
	JRST	.+2
	JRST	RESCK2
	PUSHJ	PDP,INTCHK		;IS IT AN INTRINSIC FUNCTION
	JRST	RESCK3
	PUSHJ	PDP,FUNCHK		;IS IT A USER DEFINED FUNCTION?
	JRST	.+4
	SPEAK	ISUFUN
	POP	PDP,CNT
	POPJ	PDP,
	POP	PDP,CNT
	JRST	CPOPJ1
RESCK1:	SPEAK	ISCOM
	POP	PDP,CNT
	POPJ	PDP,

RESCK2:	SPEAK	ISVAR
	POP	PDP,CNT
	POPJ	PDP,

RESCK3:	SPEAK	ISIFUN
	POP	PDP,CNT
	POPJ	PDP,

;ROUTINE TO LOOK UP A FUNCTION WHOSE NAME IS IN "SYMBOL"
;CALLING SEQUENCE:
;	PUSHJ PDP,FUNCHK
;	  NOT FOUND RETURN
;	NORMAL RETURN	(AC 'CNT' REFERENCES THE FUNCTION NAME)

FUNCHK:	SETZ	CNT,
	MOVE	A,FUNNXT		;GET LOC OF NEXT FUNCTION
	TRNE	FLAGS,F.DEFN		;HAVE TO FUDGE IF DEFINING
	SUBI	A,1

FUNCK1:	CAIG	A,@FNSTPT		;IS THIS THE END OF TABLE?
	POPJ	PDP,			;YES--FUNCTION NOT FOUND
	CAMN	SYMBOL,@FNSTPT		;CHECK NAME
	JRST	CPOPJ1			;MATCH--FUNCTION FOUND
	AOJ	CNT,			;ADVANCE TO HEADER+1
	HRRZ	B,@FNSTPT		;GET # PNS WORDS
	LDB	D,FNBPT1		;GET # SOURCE WORDS
	ADD	B,D
	ADDI	CNT,1(B)		;ADVANCE CNT TO NEXT FUNCTION
	JRST	FUNCK1			;AND CONTINUE


;ROUTINE TO CRUNCH CORE AFTER A FUNCTION DELETEION
;CALL PUSHJ PDP,CRUNCH

CRUNCH:	MOVE	A,FUNMAX		;MAX FUNCTION LOCATION
	SUBI	A,^D1024		;1K OF CORE
	CAMG	A,FUNNXT		;CAN WE DO IT?
	POPJ	PDP,				;NOPE
	CALLI	A,11			;CORE UUO
	ERR	NOCRUN
	HRRZ	A,.JBREL		;NEW MAXIMUM LOCATION
	MOVEM	A,FUNMAX
	JRST	CRUNCH+1

OPCPNT:	POINT 6,SYMBOL,5		;POINTER FOR OPCODES
SRCPNT:	POINT 6,WD			;POINTER TO SOURCE WORDS

;ROUTINE TO DELETE ALL VARIABLES
;CALL PUSHJ PDP,DELALV

DELALV:	MOVE	B,LABTOT
	CAIG	B,2
	JRST	DELAV1			;NO VARIABLES DEFINED
	MOVEI	CNT,2			;KEEP 2 PREDEFINED
	MOVEM	CNT,LABTOT
	MOVNS	B
	HRLZS	B
	ADD	B,ONETWO		;SKIP OVER 2 PREDEFINED
	ADD	B,ONETWO
	MOVE	SYMBOL,LABTAB(B)	;PRINT NAME OF THAT DELETED
	SPEAK	DELMSG
	ADD	B,ONETWO
	JUMPL	B,.-3
	POPJ	PDP,

DELAV1:	SPEAK	NOVARS
	POPJ	PDP,

;ROUTINE TO DELETE ALL FUNCTIONS
;CALL PUSHJ PDP,DELALF

DELALF:	HRRZ	CNT,FNSTPT		;GET START OF FUNCTION TABLE
	CAML	CNT,FUNNXT		;ANY DEFINED?
	JRST	DELAF2			;NOPE
	SETZ	CNT,
	MOVEI	A,@FNSTPT
	CAML	A,FUNNXT
	JRST	DELAF1			;DONE WITH PRINTING NAMES
	MOVE	SYMBOL,@FNSTPT		;GET THE NAME
	SPEAK	DELMSG
	AOJ	CNT,
	HRRZ	A,@FNSTPT
	LDB	B,FNBPT1
	ADD	A,B
	ADDI	CNT,1(A)
	JRST	DELALF+4		;CONTINUE TO NEXT FUNCTION

DELAF1:	HRRZ	CNT,FNSTPT
	MOVEM	CNT,FUNNXT
	JRST	CRUNCH			;TRY TO CRUNCH CORE

DELAF2:	SPEAK	NOFUNS			;NONE DEFINED
	POPJ	PDP,

;ROUTINE TO DELETE A PARTICULAR FUNCTION  WHOSE NAME IS IN "SYMBOL"
;CALL PUSHJ PDP,DELFN
;SKIPS IF SUCCESSFUL

DELFN:	MOVEI	A,@FNSTPT
	AOJ	CNT,
	HRRZ	B,@FNSTPT		;GET # PNS WORDS
	LDB	D,FNBPT1		;GET # SOURCE WORDS
	ADDI	D,1(B)
	ADD	CNT,D
	HRLI	A,@FNSTPT
	ADDI	D,2
	SUB	D,FUNNXT
	MOVNM	D,FUNNXT
	BLT	A,@FUNNXT
	AOS	FUNNXT
	PUSHJ	PDP,CRUNCH		;TRY TO CRUNCH CORE
	POPJ	PDP,


;ROUTINE TO SCAN A TTY LINE TO PICK UP FUNCTION AND/OR VARIABLE
;NAMES AS ARGUMENTS TO THE FOLLOWING COMMANDS:
;	PRINT,DELETE,STORE,RECALL,LIST,REMOVE

;CALLING SEQUENCE:
;	PUSHJ	PDP,GETARG
;	  ERROR RETURN      (NO ARGUMENTS SEEN)
;	NORMAL RETURN

;GETARG SETS THE FLAGS F.ALF AND F.ALV UPON SEEING THE ARGUMENTS
;'ALLFUN' AND 'ALLVAR' RESPECTIVELY

;THE ARGUMENTS ARE STORED BEGINNING AT LOCATION DUMARG WITH
;THE RIGHT HALF OF AC 'A' CONTAINING THE NUMBER OF ITEMS IN THE TABLE

GETARG:	SETZM	DUMARG			;ZERO IT IN CASE QUICK RETURN
	TRZ	FLAGS,F.ALF+F.ALV	;CLEAR FLAGS
	MOVSI	A,-MAXARG		;SET UP AOBJN WORD
	TLNE	CHR,C.TERM		;ANYTING TYPED?
	POPJ	PDP,			;NO, ERROR RETURN

GETAG1:	TLNN	CHR,C.LETT		;MUST BEGIN WITH LETTER
	ERR	LETOLY
	MOVEI	CNT,6			;6 CHRS MAXIMUM
	PUSHJ	PDP,LABIN
	JRST	LABLON			;6 CHRS MAXIMUM
	CAMN	SYMBOL,ALLFUN		;CHECK SPECIAL ARGS
	JRST	GETAG3
	CAMN	SYMBOL,ALLVAR
	JRST	GETAG4
	CAIGE	CNT,1			;5 CHRS ONLY NOW
	JRST	LABLON
	HRRZ	B,A			;GET # CURRENTLY IN TABLE
	CAMN	SYMBOL,DUMARG-1(B)	;CHECK FOR DUPLICATION
	JRST	GETAG2			;SINCE WE'VE GOT IT, SKIP
	SOJG	B,.-2
	MOVEM	SYMBOL,DUMARG(A)	;SAVE THE ARG
	AOBJN	A,.+2
	ERR	TOCMAG			;TOO MANY ARGUMENTS
GETAG2:	TLNE	CHR,C.COMA		;COMMA TO SHOW NEXT ARG
	JRST	.+4
	SETZM	DUMARG(A)		;SHOW END OF TABLE
	AOS	(PDP)
	POPJ	PDP,
	PUSHJ	PDP,SSPACE		;YES, SO SKIP COMMA
	JRST	GETAG1

GETAG3:	TROA	FLAGS,F.ALF		;SET ALLFUN SEEN FLAG
GETAG4:	TRO	FLAGS,F.ALV		;OR ALLVAR SEEN FLAG
	JRST	GETAG2			;AND DO AS USUAL


;ROUTINE TO CHECK FOR A 'YES' OR 'NO' ANSWER
;CALLING SEQUENCE:

;	PUSHJ PDP,YESNO
;	NO RETURN
;	YES RETURN

	IFN FILCAP,<
YESNO:	PUSH	PDP,SYMBOL		;SAVE SYMBOL
	PUSHJ	PDP,THRUST		;KILL OFF REST OF LINE
	PUSHJ	PDP,SSPACE		;GET 1ST CHARACTER
	MOVEI	CNT,3			;3 CHARACTERS MAX
	PUSHJ	PDP,LABIN		;GET ANSWER
	JRST	YESN1			;TOO LONG
	CAME	SYMBOL,NO		;NO?
	JRST	.+3			;GUESS NOT
	POP	PDP,SYMBOL		;RESTORE SYMBOL
	JRST	THRUST			;KILL LINE AND RETURN
	CAME	SYMBOL,YES		;YES?
	JRST	YESN1			;BAD ANSWER
	POP	PDP,SYMBOL		;RESTORE SYMBOL
	AOS	(PDP)			;FOR SKIP RETURN
	JRST	THRUST			;KILL OFF LINE AND RETURN
YESN1:	SPEAK	BADANS
	JRST	YESNO+1
	>				;END OF COND. ON FILCAP


;ROUTINE TO SCAN DUMARG FOR THE LABLE IN AC "SYMBOL" AND
;SET THE ENTRY TO -1 IF FOUND
;CALL PUSHJ PDP,DUMONE

DUMONE:	SETZ	C,
	SKIPN	A,DUMARG(C)		;SCAN TABLE
	POPJ	PDP,			;NOT FOUND
	CAME	SYMBOL,A		;IS IT THIS ONE
	AOJA	C,DUMONE+1		;NOPE
	SETOM	DUMARG(C)		;YES
	POPJ	PDP,PDP			;RETURN

;ROUTINE TO SET UP FOR STORE AND DELETE TO DTA'S

;CALL PUSHJ PDP,DTAFIL

;DTAFIL SETS THE FLAG F.DTA AND THEN SETS UP A FILE NAME OF THE FORM:

;	###ABS.TMP  WHRE ### ARE 3 DECIMAL DIGITS OF THE USER'S JOB NUMBER

	IFN FILCAP,<
DTAFIL:	MOVEI	CNT,3			;3 DECIMAL DIGITS ONLY
	CALLI	A,30			;GET JOB NUMBER
	IDIVI	A,12			;DIVIDE BY 10 TO MAKE DECIMAL
	ADDI	B,20			;DIGITS--CONVERT TO SIXBIT
	LSHC	B,-6			;AND BUILD NAME INTO AC 'C'
	SOJG	CNT,.-3
	HRRI	C,(SIXBIT /ABS/)
	MOVEM	C,ABSTMP		;SAVE THE TMP NAME
	POPJ	PDP,
	>				;END OF COND. ON FILCAP

;ROUTINE TO SCAN A TTY LINE FOR FILE SELECTION INFO
;CALL PUSHJ PDP,FILE

;FILE RETURNS WITH THE FOLLOWING INFORMATION

;	OPENBK+1  (SIXBIT DEVICE NAME -- DEFAULT IS 'DSK')
;	FILDAT    (SIXBIT FILE NAME -- DEFAULT IS 'ABACUS')
;	FILDAT+1  (SIXBIT FILE EXTENSION -- DEFAULT IS 'STO')
;	FILDAT+2  (PROTECTION IN PROPER BITS -- DEFAULT IS 0)
;	FILDAT+3  (PPN -- DEFAULT IS [SELF])

	IFN FILCAP,<
FILE:	MOVSI	A,(SIXBIT /DSK/)	;DEFAULT DEVICE
	MOVEM	A,OPENBK+1		;STORE IN OPEN BLOCK PLUS 1
	MOVE	A,CUSP			;DEFAULT FILNAM
	MOVEM	A,FILDAT		;STORE IN FILDAT
	MOVSI	A,(SIXBIT /STO/)	;DEFAULT EXT
	MOVEM	A,FILDAT+1		;STORE IN FILDAT+1
	SETZM	FILDAT+2		;ZERO PROTECTION
	SETZM	FILDAT+3		;ZERO PPN FOR DEFAULT
	MOVEI	CNT,6			;6 CHARACTERS IN DEV OR FILNAM
	PUSHJ	PDP,LABIN		;GET SIXBIT LABLE
	ERR	LNGDEV
	TLNN	CHR,C.COLN		;COLON TO SHOW DEVICE?
	JRST	FILE1			;NO
	JUMPN	SYMBOL,.+2		;ANY SPECIFIED?
	ERR	NODEV
	MOVEM	SYMBOL,OPENBK+1		;STORE IN OPEN BLOCK PLUS 1
	PUSHJ	PDP,SSPACE		;GET NEXT CHARACTER
	MOVEI	CNT,6			;6 CHARACTERS IN FILNAM
	PUSHJ	PDP,LABIN		;GET THE LABLE
	ERR	LNGFIL
FILE1:	JUMPN	SYMBOL,.+4		;ANY SPECIFIED?
	TLNE	CHR,C.DOT		;NO, BUT DID THEY DOT IT
	ERR	NOFILE
	JRST	FILE3
	MOVEM	SYMBOL,FILDAT		;STORE FILENAME IN FILDAT
	TLNE	CHR,C.DOT
	JRST	FILE2			;YES SO GET EXTENSION
	SETZM	FILDAT+1		;NO SO ZERO OUT EXTENSION
	JRST	FILE3
FILE2:	PUSHJ	PDP,SSPACE		;GET NEXT CHR
	MOVEI	CNT,3			;3 CHARACTERS IN EXTENSION
	PUSHJ	PDP,LABIN
	ERR	LNGEXT
	MOVEM	SYMBOL,FILDAT+1
FILE3:	TLNE	CHR,C.LTR		;PROTECTION NEXT?
	PUSHJ	PDP,FILPRO		;YES SO GO GET IT
	TLNN	CHR,C.LBRK		;'[' TO SHOW PPN NEXT?
	POPJ	PDP,			;NO SO WE'RE ALL DONE
	PUSHJ	PDP,FILPPN		;YES SO GO GET IT
	TLNE	CHR,C.LTR		;CHECK PROTECTION AGAIN IN CASE
	PUSHJ	PDP,FILPRO
	POPJ	PDP,			;DONE IN EITHER CASE


;ROUTINE TO INPUT OCTAL NUMBER UNTIL A DELIMITER
;CALL PUSHJ PDP,OCTIN
;NOTE--OCTIN INPUTS THE FIRST CHARACTER
;RETURN IS ALWAYS TO NEXT LOCATION
;WITH RESULT IN AC "N"

OCTIN:	SETZ	N,
	PUSHJ	PDP,SSPACE
	TLNN	CHR,C.DIGI		;IS IT A DIGIT?
	POPJ	PDP,			;NO SO DONE
	MOVEI	CHR,(CHR)		;GET RIGHT HALF
	CAIL	CHR,'0'			;IS IT IN OCTAL RANGE?
	CAILE	CHR,'7'
	ERR	NONOCT
	IMULI	N,10
	ADDI	N,-20(CHR)
	PUSHJ	PDP,CHRIN
	JRST	OCTIN+2

FILPRO:	PUSHJ	PDP,OCTIN		;GET THE OCTAL NUMBER
	CAILE	N,777			;IN PROPER RANGE?
	ERR	LNGPRO
	TLNN	CHR,C.GTR		;.GT. SIGN MUST END THE PROT. CODE
	ERR	NOGTR
	PUSHJ	PDP,SSPACE
	LSH	N,^D27			;SHIFT OVER PROTECTION
	MOVEM	N,FILDAT+2		;AND STORE IN FILDAT+2
	POPJ	PDP,

FILPPN:	PUSHJ	PDP,OCTIN		;GET PROJECT NUMBER
	CAIL	N,400000		;MUST BE LESS THAN 400000
	ERR	PPNLON
	HRLZM	N,FILDAT+3		;SAVE IT IN PROPER PLACES
	TLNN	CHR,C.COMA		;COMMA TO SEPARATE PROJ AND PROG?
	ERR	ILLPRJ
	PUSHJ	PDP,OCTIN		;GET PROGRAMMER NUMBER
	CAIL	N,400000
	ERR	PPNLON
	TLNN	CHR,C.RBRK		;']' TO END PPN?
	ERR	ILLPRG
	HRRM	N,FILDAT+3
	JRST	SSPACE			;GET NEXT NON BLANK AND RETURN

;ROUTINE TO CHECK DEVICE FOR THE FOLLOWING CHARCTERISTICS
;	1)  EXISTANCE
;	2)  AVAILABILITY TO THIS JOB
;	3)  LEGALITY OF BINARY MODE

;CALL PUSHJ PDP,DEVCHK

;ON RETURN THE DEVCHR WORD IS IN AC 'A'

DEVCHK:	MOVE	A,OPENBK+1		;GET DEVICE NAME
	CALLI	A,4			;DEVCHR CALLI
	JUMPN	A,.+2
	ERR	NOTDEV			;NO SUCH DEVICE
	TRNN	A,10000			;IS BINARY MODE 13 LEGAL?
	ERR	BADMOD
	TLNN	A,DV.AVL		;IS DEVICE AVAILABLE?
	ERR	NOTAVL			;NOPE
	POPJ	PDP,

	>				;END OF COND. ON FILCAP

;ROUTINE TO CHECK PROPER USE OF 'ON' BEFORE FILE SPECIFICATION

;CALL PUSHJ PDP,CHKON

CHKON:	MOVEI	CNT,2			;2 CHARACTERS ONLY
	PUSHJ	PDP,LABIN
	ERR	NOON
	CAME	SYMBOL,ON
	ERR	NOON
	POPJ	PDP,

;ROUTINE TO OPEN THE INPUT CHANNAL AND LOOK UP THE FILE

;CALL PUSHJ PDP,OPENI

;NON-SKIP RETURN IF FILE NOT FOUND

	IFN FILCAP,<
OPENI:	MOVEI	B,MODE			;SET UP THE OPEN BLOCK
	MOVEM	B,OPENBK		;OPENBK: MODE
	MOVEI	B,IBUF			;------- SIXBIT /DEVICE/
	MOVEM	B,OPENBK+2		;------- XWD 0,IBUF
	OPEN	CHANI,OPENBK		;DO THE OPEN
	ERRF	INDER			;CAN'T
	MOVE	B,FILBLT		;GET THE FILE INFO
	BLT	B,FILNAM+3
	SETZM	OLDFIL			;ZERO IN CASE FILE NOT FOUND
	LOOKUP	CHANI,FILNAM		;LOOK UP THE FILE
	POPJ	PDP,			;FILE NOT FOUND
	MOVE	B,FILNAM+2		;GET OLD PROT AND CREATION DATE
	MOVEM	B,OLDFIL		;AND SAVE IT
	AOS	(PDP)			;FILE FOUND SO SKIP
	POPJ	PDP,

;ROUTINE TO OPEN THE OUTPUT CHANNAL AND ENTER THE FILE

;CALL PUSHJ PDP,OPENO

OPENO:	MOVEI	B,MODE			;SET UP OPEN BLOCK
	MOVEM	B,OPENBK
	MOVEI	B,OBUF
	HRLZM	B,OPENBK+2
	OPEN	CHANO,OPENBK
	ERRF	OUTDER			;CAN'T OPEN FILE
	TLNN	A,DV.DTA		;DECTAPE?
	JRST	OPENO1			;NOPE
	TRO	FLAGS,F.DTA
	MOVE	B,ABSTMP		;GET TMP FILE NAME
	MOVEM	B,FILNAM
	MOVSI	B,(SIXBIT /TMP/)
	MOVEM	B,FILNAM+1
	SETZM	FILNAM+2
	SETZM	FILNAM+3
	JRST	OPENO2

OPENO1:	MOVE	B,FILBLT
	BLT	B,FILNAM+3
OPENO2:	SKIPN	A,OLDFIL		;GET OLD PROT,CREATION IF ANY
	HRLZI	A,STDPRO			;NONE SO USE STANDAR PROTECTION
	LDB	B,[POINT 27,A,35]	;KEEP OLD CREATION IF ANY
	DPB	B,[POINT 27,FILNAM+2,35]
	LDB	B,[POINT 9,A,8]		;GET OLD PROT IF ANY
	SKIPN	FILDAT+2		;DID THEY SPECIFY PROTECTION?
	DPB	B,[POINT 9,FILNAM+2,8]	;NOPE
	ENTER	CHANO,FILNAM		;ENTER THE FILE
	JRST	NOOFIL			;CAN'T
	POPJ	PDP,			;RETURN

;ROUTINE TO MOVE FUNCTION LOCATIONS DOWN IN CORE TO PROVIDE
;ROOM FOR I/O BUFFERS
;CALL PUSHJ PDP,MDOWN
;ONE ENTRY AC 'B' CONTAINS THE NUMBER OF FREE WORDS REQUIRED

MDOWN:	MOVE	A,FUNNXT		;SET UP A POP POINTER
	SUBI	A,1
	ORCMI	A,777777
	ADDB	B,FUNNXT
	MOVE	C,.JBREL
	CAMGE	B,C
	JRST	MDOWN1
	ADDI	C,2000			;EXPAND BY 1 K
	CALLI	C,11
	ERRF	NOBUFC
	MOVE	C,.JBREL
	MOVEM	C,FUNMAX
	JRST	.-7
MDOWN1:	SUBI	B,1
	HRR	C,FNSTPT

MDOWN2:	CAILE	C,(A)
	JRST	MDOWN3
	POP	A,(B)
	SOJA	B,MDOWN2

MDOWN3:	ADDI	B,1
	HRRM	B,FNSTPT
	POPJ	PDP,


;ROUTINE TO MOVE FUNCTION LOCATIONS UP IN CORE TO RECLAIM I/O
;BUFFER SPACE
;CALL PUSHJ PDP,MBACK

MBACK:	HLRZ	A,.JBSA			;SET UP BLT WORD
	HRL	A,FNSTPT
	HLRZ	B,.JBSA
	HRRZ	D,FNSTPT
	SUB	B,D
	ADDB	B,FUNNXT
	HRRM	A,FNSTPT
	HRRZM	A,.JBFF
	BLT	A,-1(B)
	JRST	CRUNCH

;ROUTINE TO INPUT A BYTE FROM FILE INTO AC 'WD'

;CALLING SEQUENCE:
;	PUSHJ PDP,GETWD
;	  EOF RETURN
;	NORMAL RETURN

GETWD:	SOSGE	IBUF+2
	JRST	GETBUF
	ILDB	WD,IBUF+1
	XORM	WD,PARWD		;FOR PARITY CHECK
	AOS	(PDP)
	POPJ	PDP,

GETBUF:	IN	CHANI,
	JRST	GETWD
	GETSTS	CHANI,WD
	TRNN	WD,74B23
	JRST	GETBF1
	ERRF	INPERR			;INPUT ERROR!!!!!!!!!

GETBF1:	TRNE	WD,1B22		;EOF?
	POPJ	PDP,
	JRST	GETBUF


;ROUTINE TO OUTPUT A BYTE FROM AC 'WD' TO THE FILE

;CALLING SEQUENCE:

;	PUSHJ	PDP,PUTWD
;	NORMAL RETURN

PUTWD:	SOSG	OBUF+2			;ADVANCE BYTE COUNTER
	JRST	PUTBUF			;OUTPUT A BUFFER FULL
PUTER:	IDPB	WD,OBUF+1		;INCREMENT AND DEPOSITE
	POPJ	PDP,			;RETURN

PUTBUF:	OUT	CHANO,			;PUT IT ALL OUT
	JRST	PUTER			;NICE -- NO ERRORS
	ERRF	OUTERR			;OUTPUT ERROR!!!!!!!!!

;ROUTINE TO CLOSE THE FILES

;CALL PUSHJ PDP,CLOSF

CLOSF:	CLOSE	CHANI,			;CLOSE INPUT CHANNAL
	CLOSE	CHANO,			;AND OUTPUT CHANNAL
	STATZ	CHANO,740000		;ANY ERRORS ON LAST CLOSE?
	ERRF	OUTERR
	TRNN	FLAGS,F.DTA		;DEVICE DTA?
	JRST	CLOSF2			;NOPE
	MOVE	B,FILBLT
	BLT	B,FILNAM+3		;GET FILE INFO
	LOOKUP	CHANI,FILNAM		;LOOKUP OLD FILE
	JRST	CLOSF1			;NOT FOUND
	LDB	A,CREDAT		;GET CREATION DATE
	SETZM	FILNAM
	RENAME	CHANI,FILNAM		;DELETE THE FILE
	JRST	DELERR			;HUH??
CLOSF1:	CLOSE	CHANI,
	MOVE	B,ABSTMP		;GET TMP FILE INFO AGAIN
	MOVEM	B,FILNAM
	MOVSI	B,(SIXBIT /TMP/)
	MOVEM	B,FILNAM+1
	LOOKUP	CHANO,FILNAM		;LOOKUP THE TMP FILE (DAMN DTA'S)
	JRST	RENERR			;HUH????
	CLOSE	CHANO,			;DTA'S MUST CLOSE BEFORE RENAME
	MOVE	B,FILBLT		;GET OLD FILE NAME
	BLT	B,FILNAM+3
	DPB	A,CREDAT		;KEEP OLD CREATION DATE
	RENAME	CHANO,FILNAM		;RENAME THE TMP FILE
	JRST	RENERR
	CLOSE	CHANO,			;CLOSE THE FILE
CLOSF2:	RELEASE	CHANI,			;RELEASE BOTH CHANNALS
	RELEASE	CHANO,
	JRST	MBACK			;RECLAIM BUFFER SPACE AND RETURN
	>				;END OF COND. ON FILCAP

;ROUTINE TO STORE A FUNCTION DEFINITION ON THE OUTPUT FILE

;CALL PUSHJ PDP,STOFUN

;BEFORE ENTRY, A LOOKUP IS DONE ON THE FUNCTION NAME IN AC 'SYMBOL'
;SO THAT AC 'CNT' REFERENCES THE FUNCTION NAME VIA A BASE OF
;FNSTPT.  STOFUN THEN OUTPUTS THE FUNCTION, CALCULATES AND OUTPUTS
;A PARITY WORD, AND THEN PRINTS AN OK MESSAGE.

	IFN FILCAP,<
STOFUN:	PUSH	PDP,WD			;SAVE WD
	PUSH	PDP,PARWD		;SAVE PARWD
	MOVE	WD,SYMBOL		;GET FUNCTION NAME
	AOJ	CNT,			;ADVANCE CNT TO HEADER WORD
	HRRZ	B,@FNSTPT		;GET # PNS WORDS IN DEFINTION
	LDB	A,FNBPT1		;AND # SOURCE WORDS
	ADDI	A,2(B)			;COMBINE AND ADD TWO EXTRA
					;FOR HEADER AND PARITY WORD
	MOVNS	A			;SET UP AN AOBJN WORD
	HRL	CNT,A			;IN AC 'CNT'
	SETZM	PARWD			;CLEAR PARITY WORD
STOFN1:	XORM	WD,PARWD		;BUILD PARITY
	PUSHJ	PDP,PUTWD		;OUTPUT A WORD
	MOVE	WD,@FNSTPT		;GET NEXT WORD OF DEFINTION
	AOBJN	CNT,STOFN1		;LOOP THROUGH TIL DONE
	MOVE	WD,PARWD		;GET AND OUTPUT THE PARITY WORD
	PUSHJ	PDP,PUTWD
	SPEAK	STOMSG			;TELL THEM EVERYTHINGS OK
	POP	PDP,PARWD		;RESTORE PARWD
	POP	PDP,WD			;AND WD
	POPJ	PDP,			;RETURN

;ROUTINE TO STORE A VARIABLE DEFINITION ON THE OUTPUT FILE

;CALL PUSHJ PDP,STOVAR

;BEFORE ENTRY, A LOOKUP IS DONE ON THE VARIABLE NAME IN AC 'SYMBOL'
;SO THAT AC 'CNT' REFERENCES THE VARIABLE NAME VIA A BASE OF LABTAB
;STOVAR THEN OUTPUTS THE VARIABLE, CALCULATES AND OUTPUTS A PARITY WORD
;AND THEN PRINTS AN OK MESSAGE.

STOVAR:	PUSH	PDP,WD			;SAVE WD
	PUSH	PDP,PARWD		;AND PARWD
	MOVE	WD,SYMBOL		;GET VARIABLE NAME
	TRO	WD,1			;SET BIT 35 TO SHOW VARIABLE
	MOVEM	WD,PARWD		;SET UP PARITY WORD
	PUSHJ	PDP,PUTWD		;PUT OUT THE NAME
	MOVE	WD,LABTAB+1(CNT)	;GET THE VALUE
	XORM	WD,PARWD		;BUILD PARITY
	PUSHJ	PDP,PUTWD		;PUT OUT THE VALUE
	MOVE	WD,PARWD		;GET AND OUTPUT THE PARITY WORD
	PUSHJ	PDP,PUTWD
	SPEAK	STOMSG			;TELL THEM SO
	POP	PDP,PARWD		;RESTORE PARWD
	POP	PDP,WD			;AND WD
	POPJ	PDP,

;ROUTINE TO SKIP OVER OR PASS ON TO THE OUTPUT FILE A DEFINITION
;BEING READ IN FORM THE INPUT FILE

;CALLING SEQUENCES:
;	PUSHJ PDP,PASSDF	(TO PASS ON THE DEFINITION)
;	PUSHJ PDP,SKIPDF	(TO SKIP OVER THE DEFINITION)

;ON ENTRY, AC 'WD ' CONTAINS THE NAME OF THE DEFINITION TO BE
;OPERATED ON.  IF BIT 35 OF AC 'WD' IS ON, THE DEFINTION IS A VARIABLE.

PASSDF:	TRO	FLAGS,F.PASS		;SET OUTPUT FLAG
	PUSHJ	PDP,PUTWD		;OUTPUT THE NAME
	JRST	.+2
SKIPDF:	TRZ	FLAGS,F.PASS		;CLEAR OUTPUT FLAG
	MOVEI	A,2			;ASSUME ITS A VARIABLE
	TRNE	WD,1			;WERE WE RIGHT?
	JRST	SKIPD2			;YES
	PUSHJ	PDP,GETWD		;NO, ITS A FUNCTION -- GET HEADER WORD
	ERRF	BADEOF
	HRRZ	B,WD			;GET # OF PNS WORDS
	LDB	A,[POINT 12,WD,17]	;AND # SOURCE WORDS
	ADDI	A,1(B)
SKIPD1:	TRNE	FLAGS,F.PASS		;OUTPUT OR NOT?
	PUSHJ	PDP,PUTWD		;YES
SKIPD2:	PUSHJ	PDP,GETWD		;GET A WORD OF DEFINITION
	ERRF	BADEOF			;BAD END TO FILE
	SOJG	A,SKIPD1
	TRNE	FLAGS,F.PASS		;OUTPUT OR NOT?
	PUSHJ	PDP,PUTWD		;AND PASS ON THE PARITY
	SKIPN	PARWD			;DOES THE PARITY CHECK
	POPJ	PDP,			;YES, SO RETURN
	ERRF	PARERR			;NOPE, SOMETHING'S SCREWED UP!

	>				;END OF CONDITIONAL ON FILCAP

;ROUTINE TO LOOK UP AN INTRINSIC FUNCTION

;CALLING SEQUENCE:

;	PUSHJ PDP,INTCHK
;	FOUND RETURN
;	NO FOUND RETURN

;ON ENTRY AC 'SYMBOL' CONTAINS THE SIXBIT NAME.  ON RETURN, AC
;'CNT' REFERENCES THE FUNCTION NAME WITH RESPECT TO FUNTAB

INTCHK:	MOVSI	CNT,FUNLEN		;NEG NUMBER OF FUNCTIONS
	CAMN	SYMBOL,FUNTAB(CNT)	;IS THIS THE ONE?
	POPJ	PDP,			;YES -- NON SKIP RETURN
	ADD	CNT,ONETWO		;ADVANCE COUNT
	JUMPL	CNT,.-3
	AOS	(PDP)			;NOT FOUND SO SKIP RETURN
	POPJ	PDP,

;TABLE OF INTRINSIC ABACUS FUNCTIONS

	DEFINE FUNCTS (A,B,C)
	<SIXBIT /A/
	 BYTE (6)B(12)0(18)C
	>


FUNTAB:	FUNCTS	(SQRT,1,SQRT)
	FUNCTS	(LOG,1,LOG)
	FUNCTS	(EXP,1,EXP)
	FUNCTS	(SIN,1,SIN)
	FUNCTS	(COS,1,COS)
	FUNCTS	(SIND,1,SIND)
	FUNCTS	(COSD,1,COSD)
	FUNCTS	(TAN,1,TAN)
	FUNCTS	(TAND,1,TAND)
	FUNCTS	(COT,1,COT)
	FUNCTS	(COTD,1,COTD)
	FUNCTS	(ATAN,1,ATAN)
	FUNCTS	(ATAND,1,ATAND)
	FUNCTS	(ABS,1,ABS)
	FUNCTS	(INT,1,INT)
	FUNCTS	(MOD,2,MOD)
	FUNCTS (FACT,1,FACT)
	FUNLEN=FUNTAB-.



;ROUTINE TO PRINT A VARIABLE ASSIGNMENT
;CALL PUSHJ PDP,PRTVAR
;ON ENTRY, "B" SHOULD INDEX LABTAB

PRTVAR:	MOVE	SYMBOL,LABTAB(B)
	MOVE	N,LABTAB+1(B)
	SPEAK	[ASCIZ /	%S=%F%_/]
	POPJ	PDP,


;ROUTINE TO HANDLE THE FOLLOWING PROCESSOR TRAPS
;	1)PDL OVERFLOW (BIT 19 -- 200000)
;	2)ARITH. OVER/UNDERFLOW (BIT 32 -- 10)

;AT STARTUP, .JBAPR POINTS TO TRAPIT AND THE APRENB CALL IS ISSUED

;TRAPIT SET THE FLAGS F.OVER AND F.UNDR APPROPRIATELY
;AND IF THE TRAP IS IN AN OPERATION ROUTINE, PRINTS A MESSAGE
;AND SUPPLIES AC 'N' WITH AN OVER OR UNDERFLOW VALUE, THEN CONTINUES

;PDL OVERFLOWS ARE ANALYZED AND A MESSSAGE PRINTED WITH CONTROL
;BEING TRANSFERRED TO THE TOP LEVEL

TRAPIT:	TRZ	FLAGS,F.OVER+F.UNDR	;CLEAR OVER/UNDERFLOW FLAGS
	PUSH	PDP,A			;SAVE AC 'A'
	MOVE	A,.JBTPC		;GET PC FLAGS
	TLNE	A,(1B11)		;UNDERFLOW?
	JRST	TRAP1
	TLNE	A,(1B12)		;ZERO DIVIDE?
	JRST	TRAP3
	TLNE	A,(1B3)			;OVERFLOW?
	JRST	TRAP2
	JUMPL	STACK,.+2		;STACK OVERFLOW?
	ERR	STKOVF
	JUMPLE	PDP,TRAP4			;REGULAR PDL OVERFLOW?
	HRRZ	N,A			;GET ADR. OF TRAP
	ERR	PDLOVF

TRAP4:	POP	PDP,A			;RESTORE AC 'A'
	JRST	@.JBTPC			;CONTINUE PROGRAM

TRAP1:	TROA	FLAGS,F.UNDR		;SET UNDER
TRAP2:	TRO	FLAGS,F.OVER		;OR OVERFLOW FLAGS
	HRRZ	A,.JBTPC		;GET TRAP LOCATION
	CAIL	A,BCALC			;IS IT IN A USER OPERATION?
	CAIL	A,ECALC
	JRST	TRAP4			;NO, SO WE'RE DONE HERE
	TRNN	FLAGS,F.OVER		;OVERFLOW?
	JRST	TRAP2B			;NO, SO MUST BE UNDERFLOW
	JUMPL	N,TRAP2A		;WHAT KIND OF OVERFLOW?
	SPEAK	POSOVF
	HRLOI	N,377777		;LARGEST POS. NUMBER
	JRST	TRAP4

TRAP2A:	SPEAK	NEGOVF
	MOVE	N,MIFI			;LARGEST NEG. NUMBER
	JRST	TRAP4

TRAP2B:	SPEAK	UNDFLO
	SETZ	N,			;ZERO N
	JRST	TRAP4

TRAP3:	TRO	FLAGS,F.OVER
	SPEAK	DIVZER
	JRST	TRAP4


;UUO HANDLING ROUTINE
;CALLS ARE AS FOLLOWS:
;	SPEAK [ASCIZ /TEXT/]
;	ERR   [ASCIZ /TEXT/]
;	ERRF  [ASCIZ /TEXT/]
;	 ALL OUTPUT THE MESSAGE BUT SPEAK RETURNS TO THE FOLLOWING LOCATION
;	 WHILE ERR REINITIALIZES THE PDL AN RETURNS TO BEGIN AND ERRF
;	 CLOSES FILES BEFORE RETURNING TO BEGIN

;IF THE CHARACTER "%" IS FOUND IN THE TEXT, THEN A SPECIAL CHARACTER
;IS ASSUMED TO BE NEXT.  THESE SPECIAL CHARACTERS CAUSE THE EXECUATION
;OF THE FOLLOWING OPERATIONS:
;	1) "_" MEANS PRINT A <CR>
;	2) "O" MEANS PRINT THE OCTAL VALUE IN AC 'N'
;	3) "D" MEANS PRINT THE DECIMAL INTEGER IN AC 'N'
;	4) "F" MEANS PRINT THE FLOATING POINT VALUE IN AC 'N'
;	5) "S" MEANS PRINT THE SIXBIT WORD IN AC 'SYMBOL'
;	6) "P" MEANS PRINT THE SIXBIT DEVICE IN OPENBK+1
;	7) "B" MEANS PRINT THE FILE SPECIFICATION FROM FILDAT
;	8) ANY OTHERS ARE PRINTED AS THEY ARE

UUOH:	PUSH	PDP,A
	PUSH	PDP,B
	PUSH	PDP,C
	PUSH	PDP,D
	LDB	A,[POINT 9,.JBUUO,OPFLD]
	CAIG	A,3
	JRST	.+1(A)
	ERR	BADUUO
	JRST	SPEAKR
	JRST	ERROR
	JRST	ERRORF

SPEAKR:	PUSHJ	PDP,TALKER
	POP	PDP,D
	POP	PDP,C
	POP	PDP,B
	POP	PDP,A
	POPJ	PDP,
ERRORF:	IFN FILCAP,<
	CLOSE	CHANI,0
	RELEASE	CHANI,
	CLOSE	CHANO,40
	RELEASE	CHANO,
	PUSHJ	PDP,MBACK
	>				;END OF COND. ON FILCAP

ERROR:	TRZ	FLAGS,F.FCHR		;SWITCH BACK TO TTY
	PUSHJ	PDP,TALKER
	PUSHJ	PDP,CRLF2
	TRZE	FLAGS,F.DEFN
	SOS	FUNNXT
	MOVE	PDP,PDLPNT
	PUSHJ	PDP,THRUST		;READ THROUGH STATEMENT
	JRST	BEGIN

TALKER:	MOVSI	D,(POINT 7,0)
	HRR	D,.JBUUO
	JRST	TALK2			;SKIP OVER PRINT FIRST TIME
TALK1:	PUSHJ	PDP,OUTCHR		;PRINT THE CHARACTER
TALK2:	ILDB	C,D
	JUMPE	C,CPOPJ			;DONE?
	CAIE	C,"%"			;SPECIAL CHARACTER FOLLOWS?
	JRST	TALK1			;NO, SO PUT IT OUT
					;YES, GET AND ANALYZE THE NEXT
	ILDB	C,D
	JUMPE	C,CPOPJ
	CAIN	C,"_"			;PRINT <CR?
	JRST	PUTCR
	CAIN	C,"O"			;PRINT OCTAL NUMBER?
	JRST	PRTOCT
	CAIN	C,"D"			;PRINT DECIMAL INTEGER?
	JRST	PRTDEC
	CAIN	C,"F"			;PRINT FLOATING POINT NUMBER?
	JRST	PRTFLT
	CAIN	C,"S"			;PRINT SIXBIT WORD?
	JRST	PUTSIX
	CAIN	C,"P"			;PRINT DEVICE NAME?
	JRST	PRTDEV
	CAIE	C,"B"			;PRINT FILE SPECIFICATION?
	JRST	TALK1

	IFE FILCAP,<ERR NOFCAP>
	IFN FILCAP,<
PRTFL:	PUSHJ	PDP,FILTYP
	JRST	TALK1
	>

PUTSIX:	PUSHJ	PDP,SIXOUT
	JRST	TALK2

PUTCR:	PUSHJ	PDP,CRLF
	JRST	TALK2

PRTOCT:	PUSHJ	PDP,OCTPNT
	JRST	TALK2

PRTDEC:	PUSHJ	PDP,DECPNT
	JRST	TALK2

PRTFLT:	PUSHJ	PDP,FLOCON
	JRST	TALK2

PRTDEV:	IFN FILCAP,<
	MOVE	SYMBOL,OPENBK+1
	PUSHJ	PDP,SIXOUT
	>
	JRST	TALK1

;ROUTINE TO SKIP OVER THE REMAINDER OF A TTY INPUT LINE
;CALL PUSHJ PDP,THRUST

THRUST:	TLNE	CHR,C.TERM
	POPJ	PDP,
	PUSHJ	PDP,CHRIN
	JRST	THRUST

SUBTTL MATHEMATICAL ROUTINES ADAPTED FROM BASIC V17


;FLOATING POINT SINGLE PRECISION EXPONENTIAL FUNCTION
;THE ARGUMENT IS RESTRICTED TO THE FOLLOWING RANGE
;	-88.028<X<88.028
;IF X<-88.028, THE PROGRAM RETURNS ZERO AS THE ANSWER
;IF X>88.028, THE PROGRAM RETURNS +INFINITY AS THE ANSWER
;THE RANGE OF THE ARGUMENT IS REDUCED AS FOLLOWS:
;EXP(X) = 2**(X*LOG(B)BASE2) = 2**(M+F)
;WHERE M IS AN INTEGER AND F IS N FRACTION
;2**M IS CALLCULATED BY ALGEBRAICALLY ADDING M TO THE EXPONENT
;OF THE RESULT OF 2**F, 2**F IS CALCULATED AS

;2**F = 2(0.5+F(A+B*F^2) - F -C(F^2 + D)**-1)**-1

;THE ROUTINE HAS THE FOLLOWING CALLING SEQUENCE:
;	PUSHJ PDP,EXP
;THE ARGUMENT IS IN N--ANSWER RETURNED IN N



EXP:	MOVEI	SYMBOL,1
	PUSHJ	PDP,PCALL1
	MOVE	N,(A)
	PUSHJ	PDP,EXPB
	PUSH	STACK,N
	JRST	FRET


EXPB:	MOVE	A,N
	MOVM	N,A			;GET ABS. VAL.
	CAMLE	N,E7			;IS ARGUMENT IN RANGE?
	JRST	EXTOLG			;EXPONENT TOO LARGE

EXP1:	SETZM	ES2
	MULI	A,400			;SEPARAGE FRACTION AND EXPONENT
	TSC	A,A			;GET N POSITIVE EXPONENT
	MUL	B,E5			;FIXED POINT MULTIPLY BY LOG2(B)
	ASHC	B,-242(A)		;SEPARATE FRACTION AND INTEGER
	AOSG	B			;ALGORITHM CALLS FOR MULT BY 2
	AOS	B			;ADJUST IF FRACTION WAS NEG.
	HRRM	B,EX1			;SAVE FOR FUTURE SCALE
	ASH	C,-10			;MAKE ROOM FOR EXPONENT
	TLC	C,200000		;PUT 200 IN EXPONENT BITS
	FADB	C,ES2			;NORMALIZE
	FMP	C,C			;FORM X^2
	MOVE	N,E2			;GET 1ST CONSTANT
	FMP	N,C			;E2*X^2 INTO N
	FAD	C,E4			;ADD E4 INTO RESULTS IN B
	MOVE	A,E3			;PICK UP E3
	FDV	A,C			;CALCULATE E3/(F^2 +E4)
	FSB	N,A			;E2*F^2-E3(F^2+E4)**-1
	MOVE	B,ES2			;GET F AGAIN
	FSB	N,B			;SUBTRACT FROM PARTIAL SUM
	FAD	N,E1			;ADD IN E1
	FDVM	B,N			;DIVIDE BY F
	FAD	N,E6			;ADD 0.5
	XCT	EX1			;EXECUTE SCALE OF RESULTS
	POPJ	PDP,			;DONE


;CONSTANTS USED IN ROUTINE ABOVE

E1:	204476430062			;9.95459578
E2:	174433723400			;0.03465735903
E3:	212464770715			;617.97226953
E4:	207535527022			;87.417497202
E5:	270524354513			;LOG(B), BASE 2
E6:	0.5
E7:	207540071260			;88.028

EXTOLG:	JUMPG	A,EXTOL1
	SPEAK	UNDEXP
	SETZ	N,			;GIVE A ZERO VALUE
	POPJ	PDP,			;RETURN

EXTOL1:	SPEAK	OVREXP
	HRLOI	N,377777		;GIVE LARGEST VALUE
	POPJ	PDP,			;RETURN

;FLOATING POINT SINGLE PRECISION LOGARITHM FUNCTION
;LOG(ABSF(X)) IS CALCULATED BY THE SUBROUTINE, AND AN
;ARGUMENT OF ZERO IS RETURNED AS MINUS INFINITY.  THE ALGORITHM IS

;LOG2(F) = C1*Z + C3*Z^3 + C5*Z^5 -1/2
;AND Z = (F-SQRT(2))/(F+SQRT(2))

;THE CALLING SEQUENCE IS:
;	PUSHJ PDP,LOGB
;THE ARGUMENT IS IN N, RESULT IS RETURNED IN N


LOG:	MOVEI	SYMBOL,1		;ONE ARGUMENT
	PUSHJ	PDP,PCALL1		;GET IT'S ADR.
	MOVE	N,(A)			;AND MOVE IT INTO N
	PUSHJ	PDP,LOGB		;EVALUATE FUNCTION
	PUSH	STACK,N			;PUSH RESULT ON STACK
	JRST	FRET			;FUNCTION RETURN


LOGB:	JUMPL	N,ALOGB1		;TEST FOR LOG OF NEG NBER
ALOGB2:	MOVMS	N			;GET ABSF(X)
	JUMPE	N,LZERO			;CHECK FOR ZERO ARG
	CAMN	N,ONE			;CHECK FOR 1.0 ARG
	JRST	ZERANS			;IF SO RETURN ZERO
	ASHC	N,-33			;SEPARATE FRACTION FROM EXPONENT
	ADDI	N,211000		;FLOAT THE EXPONENT AND MULT. BY 2
	MOVSM	N,C3			;NUMBER NO IN CORRECT FL. FORM
	MOVSI	N,567377		;SET UP -401.0 FROM EXP.*2
	FADM	N,C3			;SUBTRACT 401 FROM EXP.*2
	ASH	N1,-10			;SHIFT FRACTION FOR FLOATING
	TLC	N1,200000		;FLOAT THE FRACTIONAL PART
	FAD	N1,L1			;B = T-SQRT(2.0)/2.0
	MOVE	N,N1			;PUT RESULTS IN N
	FAD	N,L2			;A = N+SQRT(2.0)
	FDV	N1,N			;B =B/A
	MOVEM	N1,LZ			;STORE NEW VARIABLE IN LZ
	FMP	N1,N1			;CALCULATE Z^2
	MOVE	N,L3			;PICK UP FIRST CONSTANT
	FMP	N,N1			;MULTIPLY BY Z^2
	FAD	N,L4			;ADD IN NEXT CONSTANT
	FMP	N,N1			;AND MULTIPLY BY Z^2
	FAD	N,L5			;ADD IN NEXT CONSTANT
	FMP	N,LZ			;MULTIPLY BY Z
	FAD	N,C3			;ADD IN EXPONENT TO FORM LOG2(X)
	FMP	N,L7			;MULTIPLY TO FORM LOGE(X)
	POPJ	PDP,			;RETURN

LZERO:	SPEAK	LOGZER
	MOVE	N,MIFI			;PICK UP MINUS INFINITY
	POPJ	PDP,

ZERANS:	SETZI	N,			;MAKE ARG ZERO
	POPJ	PDP,

;CONSTANTS FOR ALOGB

ONE:	201400000000
L1:	577225754146			;-0.707106781187
L2:	201552023632			;1.414213562374
L3:	200462532521			;0.5989786496
L4:	200754213604			;0.9614706323
L5:	202561251002			;2.8853912903

ALOGB1:	SPEAK	LOGNEG
	JRST	ALOGB2			;USE ABS. VAL.

L7:	200542710300			;0.69314718056
MIFI:	XWD 400000,000001		;LARGEST NEGATIVE NBER

;SINGLE PRECISION EXP.2 FUNCTION
;THIS ROUTINE CALCULATES A FLOATING POINT NBER TO A FIXED POINT
;POWER. THE CALCULATION IS A**B WHRE T IS OF THE FORM
;	T=Q(1)*2 + Q(2)*4 + . . . WHERE Q(I)=0 OR 1

;THE BASE IS IN ACCUMULATOR N
;AND THE EXPONENT IS IN ACCUMULATOR N1 WHEN THE ROUTINE IS CALLED
;THE ANSWER IS RETURNED IN ACCUMULATOR N.
;EXP.2 IS CALLED ONLY BY EXP.3  IT IS GUARANTEED THAT THE BASE AND
;THE EXPONENT ARE NON-ZERO.

EXP2.0:	PUSH	PDP,N1			;SAVE FOR OVER/UNDERFLOW CHECK
	PUSH	PDP,N
	MOVSI	A,(1.0)
	JUMPGE	N1,FEXP2
	MOVMS	N1
	FDVRM	A,N
	MOVSI	A,(1.0)
	JRST	FEXP2
FEXP1:	FMP	N,N			;FORM A**N IN FLOATING POINT
	LSH	N1,-1			;SHIFT EXPONENT FOR NEXT BIT
FEXP2:	TRZE	N1,1			;IS THE BIT ON?
	FMP	A,N			;YES, MULTIPLY ANSWER BY A**N
	JUMPN	N1,FEXP1		;UPDATE A**N UNLESS ALL DONE
	MOVE	N,A			;PICK UP RESULT FROM A
	TRNE	FLAGS,F.OVER+F.UNDR	;OVER OR UNDERFLOW?
	JRST	FEXP4
	POP	PDP,N1			;CLEAR UP PDL
	POP	PDP,N1
	POPJ	PDP,

FEXP4:	POP	PDP,N			;OVER/UNDERFLOW ROUTINE
	POP	PDP,N1
	MOVM	A,N
	CAMG	A,ONE
	JRST	.+3				;BASE >1, EXP>0 MEANS OVER
	JUMPG	N1,.+3		;BASE >1, EXP<0 MEANS UNDER
	JRST	EXP3D3			;BASE <1, EXP>0 MEANS OVER
	JUMPG	N1,EXP3D3		;BASE <1, EXP<0 MEANS OVER
	JUMPG	N,.+3			;THIS IS OVER, CHECK SIGN
	TRNE	N1,1
	JRST	FEXP5
	PUSHJ	PDP,EXP3D2
	HRLOI	N,377777
	POPJ	PDP,

FEXP5:	PUSHJ	PDP,EXP3D2
	MOVE	N,MIFI			;RETURN - INFINITY
	POPJ	PDP,

;SINGLE PRECISION FORTRAN IV EXP.3 FUNCTION
;THIS ROUTINE CALCULATES A FLOATING POINT NUMBER RAISED TO A
;FLOATING POINT POWER.  THE CALCULATION IS
;	A**B = EXP(B*LOG(N))

;IF THE EXPONENT IS AN INTEGER THE RESULT WILL BE COMPUTED BY EXP2.0

;THE CALLING SEQUENCE FOR THE ROUTINE IS AS FOLLOWS:
;	PUSHJ PDP,EXP3.0
;THE BASE IS IN ACCUMULATOR N
;AND THE EXPONENT IS IN ACCUMULATOR N1 WHEN THE ROUTINE IS CALLED.
;THE RESULT IS RETURNED IN ACCUMULATOR N.

EXP3.0:	JUMPE	N1,EXP3A		;ZERO EXPONENT?
	JUMPN	N,EXP3A0		;ZERO BASE?
	JUMPL	N1,EXPB3		;ERROR IF BASE=0 AND EXP<0
	POPJ	PDP,			;IMMEDIATE RETURN IF BASE=0, EXP>=0
EXP3A0:	MOVM	B,N1			;SET UP ABS. VAL. OF EXPON FOR SHIFT
	JUMPL	N,EXP3C			;IS BASE NEGATIVE?
EXP3A1:	MOVEI	A,0			;CLEAR A
	LSHC	A,11			;SHIFT 9 BITS TO LEFT
	SUBI	A,200			;TO OBTAIN SHIFT FACTOR
	JUMPLE	A,EXP3GO		;IS A > 0?
	HRRZ	C,A			;SET UP C AS INDEX REG.
	CAILE	C,43
	JRST	EXP3GO
	MOVEI	A,0
	LSHC	A,(C)			;SHIFT LEFT BY CONTINTS OF C
	JUMPN	B,EXP3GO		;IS EXPONENT AN INTEGER?
	SKIPGE	N1			;YES, WAS IT NEGATIVE?
	MOVNS	A			;YES , NEGATE IT
	MOVE	N1,A			;MOVE INTEGER INTO N1
	JRST	EXP2.0			;OBTAIN RESULT USING EXP2.0

EXP3GO:	PUSH	PDP,N1			;SAVE EXPONENT
	PUSHJ	PDP,LOGB		;CALCULATE LOG OF N
	FMPR	N,(PDP)			;CALCULATE B*LOG(N)
	POP	PDP,N1			;RESTORE EXPONENT
	TRNE	FLAGS,F.UNDR+F.OVER
	JRST	EXP3D
	MOVM	N1,N
	CAMLE	N1,E7
	JRST	EXP3D1
	PUSHJ	PDP,EXPB		;CALCULATE EXP(B*LOG(N))
	POPJ	PDP,			;RETURN

EXP3D:	MOVM	N1,N
	CAML	N1,ONE			;LESS THAN 1.0?
	JRST	EXP3A			;UNDERFLOW MEANS ANSWER=1
EXP3D1:	JUMPL	N,EXP3D3		;OVERFLOW MEANS OVER/UNDER IN ANS.
EXP3D2:	SPEAK	OVRUPO
	HRLOI	N,377777		;RETURN LARGEST VALUE
	POPJ	PDP,

EXP3D3:	SPEAK	UNDUPO
	SETZ	N,
	POPJ	PDP,

EXP3A:	MOVSI	N,(1.0)			;ANSWER IS 1.0
	POPJ	PDP,

EXPB3:	SPEAK	NEGPOW
	HRLOI	N,377777
	POPJ	PDP,

EXP3C:	MOVE	D,B
	FAD	D,FIXCON
	FSB	D,FIXCON
	CAMN	B,D
	JRST	EXP3A1			;NEGATIVE BASE, INTEGRAL POWER
	SPEAK	ABSPOW
EXP3C0:	MOVMS	N
	JRST	EXP3A0


;FLOATING POINT SINGLE PRECISION SQUARE ROOT FUNCTION
;THE SQUARE ROOT OF THE ABSOLUTE VALUE OF THE ARGUMENT IS CALCULATED.
;THE ARGUMENT IS WRITTEN IN THE FORM
;	X= F*(2**2B)  WHERE 0<F<1
;SQRT(X) IS THEN CALCULATED AS (SQRT(X))*(2**B)
;SQRT(F) IS CALCULATED BY N LINEAR APPROXIMATION, THE NATURE
;OF WHICH DEPENDS ON WHETHER 1/4 <F < 1/2 OR 1/2 < F < 1.
;FOLLOWED BY TWO ITERATIONS OF NEWTON'S METHOD.
;THE CALLING SEQUENCE IS
;	PUSHJ PDP,SQRTB
;THE ARGUMENT IS IN N ON ENTRY, THE RESULT IS RETURNED IN N.


SQRT:	MOVEI	SYMBOL,1
	PUSHJ	PDP,PCALL1
	MOVE	N,(A)
	PUSHJ	PDP,SQRTB
	PUSH	STACK,N
	JRST	FRET


SQRTB:	MOVE	A,N			;PICK UP THE ARGUMENT IN N1
	JUMPL	A,SQRMIN		;SQRT OF NEG. NBER?
	JUMPE	A,SQRT1			;ARGUMENT OF ZERO?
SQRTB0:	ASHC	A,-33			;PUT EXPONENT IN A,FRACTION IN B
	SUBI	A,201			;SUBTRACT 201 FROM EXPONENT
	ROT	A,-1			;CUT EXP IN HALF, SAVE ODD BIT
	HRRM	A,EX1			;SAVE FOR FUTURE SCALING OF ANS
					;IN FSC N,. INSTRUCTION
	LSH	A,-43			;GET BIT SAVE ABOVE
	ASH	B,-10			;PUT FRACTION IN PROPER POSITION
	FSC	B,177(A)		;PUT EXPONENT OF FRACT TO -1 OR 0
	MOVEM	B,N			;SAVE IT. 1/4 < F < 1
	FMP	B,SQCON1(A)		;LINEAR 1ST APPROX. DEPENDS ON
	FAD	B,SQCON2(A)		;WHETHER 1/4 < F <1/2 OR 1/2<F<1
	MOVE	A,N			;START NEWTON'S METHOD WITH FRAC
	FDV	A,B			;CALCULATE X(0)/X(1)
	FAD	B,A			;X(1)+X(0)/X(1)
	FSC	B,-1			;1/2(X(1)+X(0)/X(1))
	FDV	N,B			;X(0)/X(2)
	FADR	N,B			;X(2)+X(0)/X(2)
	XCT	EX1			;SCALE
SQRT1:	POPJ	PDP,			;RETURN

SQCON1:	0.8125				;CONSTANT IF 1/4<FRAC<1/2
	0.578125			;CONSTANT IF 1/2<FRAC<1
SQCON2:	0.302734			;CONSTANT IF 1/4<FRAC<1/2
	0.421875			;CONSTANT IF 1/2<FRAC<1

SQRMIN:	PUSH	PDP,A			;SAVE A
	SPEAK	SQTNEG
	POP	PDP,A
	MOVMS	A
	JRST	SQRTB0


;FLOATING POINT SINGLE PRECISION SINE AND COSINE FUNCTION
;THE ARGUMENT IS IN RADIANS
;ENTRY POINTS ARE SINB AND COSB
;COSB CALLS SINB TO CALCULATE SINB(PI/2+X)

;THE ROUTINE CALCULATES SINES AFTER REDUCING THE ARGUMENT TO THE
;FIRST QUADRANT AND CHECKING THE OVERFLOW BITS TO DETERMINE
;THE QUADRANT OF THE ORIGINAL ARGUMENT
;000 - 1ST QUADRANT
;001 - 2ND QUADRANT, X=-(X-PI)
;010 - 3RD QUADRANT, X=-(X-PI)
;011 - 4TH QUADRANT, X=X-3*PI/2-PI/2
;THE ALGORITHM USES N MODIFIED TAYLOR SERIES TO CALCULATE
;THE SINE OF THE NORMALIZED ARGUMENT.


COSD:	TRO	FLAGS,F.DEG		;DEGREES RATHER THAN RADIANS
COS:	MOVEI	SYMBOL,1		;ONE ARG
	PUSHJ	PDP,PCALL1
	MOVE	N,(A)
	TRZE	FLAGS,F.DEG
	FDVR	N,DEGTRD		;CONVERT DEG. TO RAD.
	PUSHJ	PDP,COSB
	PUSH	STACK,N
	JRST	FRET

SIND:	TRO	FLAGS,F.DEG		;WANT DEGREES NOT RADIANS
SIN:	MOVEI	SYMBOL,1
	PUSHJ	PDP,PCALL1
	MOVE	N,(A)
	TRZE	FLAGS,F.DEG		;CONVERT DEG. TO RAD.?
	FDVR	N,DEGTRD		;CONVERT
	PUSHJ	PDP,SINB
	PUSH	STACK,N
	JRST	FRET

COSB:					;ENTRY TO COSINE IN RADIANS
	FADR	N,PIOT			;ADD PI/2
					;FALL INTO SINE ROUTINE

SINB:					;ENTRY INTO SINE IN RADIANS
	MOVE	A,N			;PICK UP ARGUMENT IN A
	MOVEM	A,SX			;SAVE IT
	MOVMS	A			;GET ABS. VAL.
	CAMG	A,SP2			;SINX = X IF X<2^-10
	POPJ	PDP,			;EXIT WITH ANS=ARGUMENT
	FDV	A,PIOT			;DIVIDE X BY PI/2
	CAMG	A,ONE			;IS X/(PI/2) <1.0?
	JRST	S2			;YES, ARG IN 1ST QUADRANT
	MULI	A,400			;NO, SEPARATE FRACTION AND EXP.
	ASH	B,-202(A)		;GET X MODULO 2PI
	MOVEI	A,200			;PREPARE FLOATING FRACTION
	ROT	B,3			;SAVE 3 BITS TO FIND QUADRANT
	LSHC	A,33			;ARGUMENT NOW IN RANGE (-1,1)
	FAD	A,SP3			;NORMALIZE THE ARGUMENT
	JUMPE	B,S2			;REDUCED TO FIRST QUAD IF BITS 00
	TLCE	B,1000			;SUBRACT 1.0 FROM ARG IF BITS ARE
	FSB	A,ONE			;01 OR 11
	TLCE	B,3000			;CHECKR FOR FIRST QUADRANT, 01
	TLNN	B,3000			;CHECK FOR 3RD QUADRANT, 10
	MOVNS	A			;01,10
S2:	SKIPGE	SX			;CHECKR SIGN OF ORIGINAL ARG
	MOVNS	A			;SIN(-X) = -SIN(X)
	MOVEM	A,SX			;STORE REDUCED ARGUMENT
	FMPR	A,A			;CALCULATE X^2
	MOVE	N,SC9			;GET 1ST CONSTANT
	FMP	N,A			;MULTIPLY BY X^2
	FAD	N,SC7			;ADD IN NEXT CONSTANT
	FMP	N,A			;MULTIPLY BY X^2
	FAD	N,SC5			;ADD IN NEXT CONSTANT
	FMP	N,A			;MULTIPLY BY X^2
	FAD	N,SC3			;ADD IN NEXT CONSTANT
	FMP	N,A			;MULTIPLY BY X^2
	FAD	N,PIOT			;ADD IN LAST CONSTANT
S2B:	FMPR	N,SX			;MULTIPLY BY X
	POPJ	PDP,			;DONE

SC3:	577265210372			;-0.64596371106
SC5:	175506321276			;0.07968967928
SC7:	606315546346			;0.00467376557
SC9:	164475536722			;0.00015148419

PIOT:	201622077325			;PI/2
DEGTRD:	57.2957795			;CONVERSION FOR DEGREES TO RADIANS
SP2:	170000000000			;2**-10
SP3:	0				;0
CD1:	90.0
SCD1:	206712273406			;


;TANGENT/COTANGENT FUNCTION USING SIN AND COS
;SHALL WE GET N REAL TAN ROUTINE?

;TANGENT(X)=SIN(X)/COS(X)
;COTAN(X)=TAN(PI/2-X)


TAND:	TRO	FLAGS,F.DEG
TAN:	MOVEI	SYMBOL,1
	PUSHJ	PDP,PCALL1
	MOVE	N,(A)
	TRZE	FLAGS,F.DEG
	FDVR	N,DEGTRD
	PUSHJ	PDP,TANB
	PUSH	STACK,N
	JRST	FRET

COTD:	TRO	FLAGS,F.DEG
COT:	MOVEI	SYMBOL,1
	PUSHJ	PDP,PCALL1
	MOVE	N,(A)
	TRZE	FLAGS,F.DEG
	FDVR	N,DEGTRD
	PUSHJ	PDP,COTB
	PUSH	STACK,N
	JRST	FRET


COTB:	MOVNS	N				;CALCULATE -X
	FADR	N,PIOT				;ADD IN PI/2
TANB:	MOVEM	N,C3				;SAVE IT
	PUSHJ	PDP,COSB			;CALCULATE COSINE
	JUMPE	N,TANB1				;IS COS=0?
	EXCH	N,C3				;SAVE COS, GET ARG
	PUSHJ	PDP,SINB			;CALCULATE SINE
	FDVR	N,C3				;CALCULATE SIN/COS
	POPJ	PDP,				;AND RETURN

TANB1:	SPEAK	POTTAN
	HRLOI	N,377777			;LARGEST NBER_
	POPJ	PDP,

;FLOATING POINT SINGLE PRECISION ARCTANGENT FUNCTION
;ATAN(X) = X(B0+A1(Z+B1-A2(Z+B3)**-1)**-1)**-1)
;WHERE Z=X^2 IF 0<X<=1

;IF X>1 THEN ATAN(X)=PI/2 - ATAN(1/X)
;IF X>1 THEN RH(A) =-1 AND LH(A)= -SGN(X)
;IF X<1 THEN RH(A) = 0 AND LH(A)=  SGN(X)

ATAND:	TRO	FLAGS,F.DEG			;WANT ANSWER IN DEGREES
ATAN:	MOVEI	SYMBOL,1
	PUSHJ	PDP,PCALL1
	MOVE	N,(A)
	PUSHJ	PDP,ATANB
	TRZE	FLAGS,F.DEG
	FMPR	N,DEGTRD		;CONVERT ANSWER TO DEGREES
	PUSH	STACK,N
	JRST	FRET

ATANB:					;ENTRY TO ATAN ROUTINE
	MOVM	A,N			;GET ABS OF ARG
	CAMG	A,A1			;IF A<2^-33 THEN RETURN
	POPJ	PDP,			;WITH ATAN(X)=X
	HLLO	C,N			;SAVE SIGN WITH RH=-1
	CAML	A,A2			;IF A>2^33 THEN RETURN
	JRST	AT4			;WITH ATAN(X)=PI/2
	MOVSI	B,(1.0)
	CAMG	A,B			;IS ABS(X)>1.0?
	TRZA	C,-1			;IF T<=1.0 THEN RH(C)=0
	FDVM	B,A			;BB IS REPLACED BY 1.0/B
	TLC	C,(C)			;XOR SIGN WITH .G. 1.O INDICATOR
	MOVEM	A,C3			;SAVE THE ARG
	FMP	A,A			;GET B^B
	MOVE	B,KB3				;PICK UP N CONATANT
	FAD	B,A			;ADD B^2
	MOVE	N,KA3			;ADD IN NEXT CONSTANT
	FDVM	N,B			;FORM -A3/(B^2+B3)
	FAD	B,A			;ADD B^2 TO PARTIAL SUM
	FAD	B,KB2			;ADD B2 TO PARTIAL SUM
	MOVE	N,KA2			;PICK UP -A2
	FDVM	N,B			;DIVIDE PARTIAL SUM BY -A2
	FAD	B,A			;ADD B^2 TO PARTIAL SUM
	FAD	B,KB1			;ADD B1 TO PARTIAL SUM
	MOVE	N,KA1			;PICK UP A1
	FDV	N,B			;DIVIDE PARTIAL SUM BY A1
	FAD	N,KB0			;ADD B0
	FMP	N,C3			;MULTIPLY BY ORIGINAL ARG
	TRNE	C,-1			;CHECK .G. 1.0 INDICATOR
	FSB	N,PIOT				;ATAN(N)= -ATAN(1/A)-PI/2)
	CAIA				;SKIP
AT4:	MOVE	N,PIOT				;GET PI/2 AS ANS.
NEGANS:	SKIPGE	C			;LH(A)=-SGN(A) IF B>1.0
	MOVNS	N			;NEGATE IT
	POPJ	PDP,			;RETURN

A1:	145000000000			;2**-33
A2:	233000000000			;2**33
KB0:	176545543401			;0.1746554388
KB1:	203660615617			;6.762139240
KB2:	202650373270			;3.316335425
KB3:	201562663021			;1.448631538
KA1:	202732621643			;3.709256262
KA2:	574071125540			;-7.106760045
KA3:	600360700773			;-0.2647686202

;ROUTINE TO TAKE ABSOLUTE VALUE

ABS:	MOVEI	SYMBOL,1
	PUSHJ	PDP,PCALL1
	MOVM	N,(A)
	PUSH	STACK,N
	JRST	FRET

;ROUTINE TO TRUNCATE FRACTIONAL PART OF FLOATING POINT NUMBER

INT:	MOVEI	SYMBOL,1
	PUSHJ	PDP,PCALL1
	MOVM	N,(A)
	SKIPGE	(A)			;NEGATIVE?
	FAD	N,ALMST1		;YES, MAKE INT(-2.3)=-3,ETC.
	CAML	N,MOD1			;IS ARG <=2^26?
	JRST	INT1			;YES; MUST BE INTEGER ANYWAY
	FAD	N,MOD1
	FSB	N,MOD1
INT1:	SKIPGE	(A)
	MOVNS	N
	PUSH	STACK,N
	JRST	FRET

MOD1:	XWD 233400,000000		;2^26
ALMST1:	XWD 200777,777777		;1.0-<SMALEST QUANTITY>

;FLOATING POINT SINGLE PRECISION MOD FUNCTION
;MODF(A,B)=A-[A/B]*B WHERE [A/B] IS THE GREATEST INTEGER
;IN THE MAGNITUDE OF A/B. THE TERM A/B MUST BE LESS THAN
;2^26 IN MAGNITUDE.


MOD:	MOVEI	SYMBOL,2		;GET FIRST ARG
	PUSHJ	PDP,PCALL1
	MOVE	N,(A)
	MOVEI	SYMBOL,1		;GET SECOND ARG
	PUSHJ	PDP,PCALL1
	MOVE	N1,(A)
	MOVM	A,N1			;GET ABS OF SECOD ARG
	FDVM	N,N1			;CALCULATE A/B
	TRNE	FLAGS,F.OVER+F.UNDR	;OVER OR UNDERFLOW?
	JRST	DETRMN
	MOVMS	N1			;CALCULATE ABS(A/B)
	CAML	N1,MOD1			;IF A/B .GT. 2^26
	JRST	TOOLRG
	FAD	N1,MOD1			;TAKE INTEGER PART
	FSB	N1,MOD1
	FMP	A,N1			;C=B*ABS([A/B])
	SKIPGE	N			;RESTORE THE SIGN
	MOVNS	A
	FSB	N,A			;CALCULATE N-[A/B]*N1
OUT:	PUSH	STACK,N			;PUSH RESULT ONTO STACK
	JRST	FRET			;RETURN

DETRMN:	TRNE	FLAGS,F.OVER		;OVERFLOW?
	JRST	OUT			;NO, UNDERFLOW
TOOLRG:	SETZ	N,
	JRST	OUT

;ROUTINE TO RETURN N! WHERE N IS INTEGER 0<=N<=33

FACT:	MOVEI	SYMBOL,1
	PUSHJ	PDP,PCALL1
	MOVM	N1,(A)
	SKIPGE	(A)
	SPEAK	NEGFCT
	MOVE	N,N1			;TEST IF FRACTION
	FAD	N1,MOD1			;MAKE N1 INTEGER
	FSB	N1,MOD1
	CAME	N,N1
	SPEAK	FRCFCT			;NOT AN INTEGER -- TELL THEM SO
	CAMLE	N1,FCT33		;WILL OVERFLOW IF N1>33
	JRST	FACT1A
	MOVE	N,ONE			;0!=1.0
FACT1:	JUMPE	N1,FACT2		;DONE?
	FMP	N,N1
	FSB	N1,ONE
	JRST	FACT1

FACT1A:	SPEAK	FCTOVR
	HRLOI	N,377777		;RETURN LARGEST NUMBER

FACT2:	PUSH	STACK,N			;PUSH RESULT ONTO STACK
	JRST	FRET			;AND DO FUNCTION RETURN

FCT33:	33.0					;FLOATING POINT 33

	SUBTTL ERROR ROUTINES AND OTHER MESSAGES


NOTIMP:	ERR	[ASCIZ /%S COMMAND NOT YET IMPLEMENTED/]

NOFCAP:	ASCIZ /%S COMMAND NOT IMPLEMENTED IN THIS VERSION/

LABLON:	PUSHJ	PDP,LABLN
	ERR

LABLN:	SPEAK	TOOMNY
	PUSHJ	PDP,SIXOUT
	JUMPE	CNT,.+5
	MOVEI	CNT,6
	PUSHJ	PDP,LABIN
	JRST	.-4
	PUSHJ	PDP,SIXOUT
	POPJ	PDP,

;ERROR ROUTINES FOR FILE CAHANDLING OPTIONS

	IFN FILCAP,<

;ROUTINE TO PRINT LOOKUP OR ENTER ERROR CODE MESSAGES
;CALL PUSHJ PDP,FILERR

INPERR:	ASCIZ /INPUT ERROR -- CANNOT RECOVER/

OUTERR:	ASCIZ /OUTPUT ERROR -- CANNOT RECOVER/

BADEOF:	ASCIZ /BAD END TO INPUT FILE %B/

FILERR:	HRRZ	A,FILNAM+1		;GET ERROR CODE
	CAILE	A,2			;ONLY 3 DIFFERENT MESSAGES
	MOVEI	A,3			;UNDEFINED ERROR MESSAGE
	SPEAK	@FILMSG(A)		;OUTPUT THE MESSAGE
	POPJ	PDP,			;AND RETURN

FILMSG:	NOTFND				;CODE 0 -- FILE NOT FOUND
	INCPPN				;CODE 1 -- INCORRECT PPN
	PROTFA				;CODE 2 -- PROTECTION FAILURE
	UNDEFE				;CODE .GT.2 -- UNDEFINED ERROR

NOIFIL:	PUSHJ	PDP,FILERR		;PUT OUT ERROR CODE MESSAGE
	ERRF	NOIFLM

NOIFLM:	ASCIZ /INPUT FILE %B/

NOOFIL:	PUSHJ	PDP,FILERR
	ERRF	NOOFLM

NOOFLM:	ASCIZ /OUTPUT FILE %B/


BADANS:	ASCIZ /PLEASE TYPE 'YES' OR 'NO'-- /

BADHLP:	ASCIZ %ONLY /L MAY FOLLOW THE HELP COMMAND%

BADHP1:	ASCIZ /HELP COMMAND MUST OUTPUT TO TTY OR LPT ONLY/

DELERR:	MOVE	B,FILBLT		;GET FILE NAME
	BLT	B,FILNAM+3
	ERRF	.+1
	ASCIZ /CAN'T DELETE THE FILE %B/
RENERR:	MOVE	B,ABSTMP		;GET TMP FILE NAME
	MOVEM	B,FILNAM
	MOVSI	B,(SIXBIT /TMP/)
	MOVEM	B,FILNAM+1
	ERRF	.+1
	ASCIZ /CAN'T RENAME THE TEMPORARY FILE %B/

LNGDEV:	ASCIZ /DEVICE OR FILENAME OF MORE THAN 6 CHARACTERS/

NODEV:	ASCIZ /NO DEVICE PRECEEDS COLON/

LNGFIL:	ASCIZ /FILENAME OF MORE THAN 6 CHARACTERS/

NOFILE:	ASCIZ /NO FILENAME PRECEEDS PERIOD/

LNGEXT:	ASCIZ /EXTENSION OF MORE THAN 3 CHARACTERS/

NONOCT:	ASCIZ /NON OCTAL DIGIT SEEN/

LNGPRO:	ASCIZ /PROTECTION CODE IS A 3 DIGIT OCTAL NUMBER/

NOGTR:	ASCIZ /PROTECTION CODE MUST END WITH A GREATER THAN SIGN/

PPNLON:	ASCIZ /BAD OCTAL NUMBER %O -- MUST RANGE FROM 1 TO 377777/

ILLPRJ:	ASCIZ /BAD DELIMITER FOR PROJECT NUMBER %O -- MUST BE COMMA/

ILLPRG:	ASCIZ /BAD END FOR PROGRAMMER NUMBER %O -- MUST BE "]"/

NOTDEV:	ASCIZ /NON-EXISTANT DEVICE %P/

BADMOD: ASCIZ /BINARY MODE IS ILLEGAL FOR DEVICE %P/

NOTAVL: ASCIZ /DEVICE %P IS UNAVAILABLE AT THE MOMENT/

NOTID:	ASCIZ /DEVICE %P CANNOT DO INPUT/

INDER:	ASCIZ /CANNOT OPEN INPUT DEVICE %P/

NOTOD:	ASCIZ /DEVICE %P CANNOT DO OUTPUT/

OUTDER:	ASCIZ /CANNOT OPEN OUTPUT DEVICE %P/

NOTFND:	ASCIZ /CAN'T FIND OR ENTER /

INCPPN:	ASCIZ /NON-EXISTANT UFD FOR /

PROTFA:	ASCIZ /PROTECTION FAILURE OR DTA DIRECTORY FULL FOR /

UNDEFE:	ASCIZ !UNDEFINED I/O ERROR CODE FOR !

PARERR:	ASCIZ /BAD PARITY FOR DEFINITION %S -- CAN'T RECOVER/

EMPFIL:	ASCIZ /FILE %B IS EMPTY/

BADFIL:	MOVE	B,FILBLT
	BLT	B,FILNAM+3
	ERRF	BADFL1

BADFL1:	ASCIZ /IMPROPER FORMAT FOR INPUT FILE %B/

NOBUFC:	ASCIZ /CAN'T EXPAND CORE TO SET UP A BUFFER AREA/
RECMSG:	ASCIZ /	%S RECALLED%_/

DEFONE:	ASCIZ /DEFINITON %S EXISTS ON THE FILE%_/

OVERLY:	ASCIZ /DO YOU WISH TO OVERLAY WHAT'S ON THE FILE? /

STOMSG:	ASCIZ /	%S STORED%_/

	>				;END OF COND. ON FILCAP

HDMSG:	ASCIZ /ABACUS -- V/

TOOMNY:	ASCIZ /TOO MANY CHARACTERS IN /

NOCOMD:	ASCIZ /NO SUCH COMMAND AS %S/

CNGRST:	ASCIZ /%S MAY NOT BE UPDATED BY THIS COMMAND/

LABFUL:	ASCIZ /NO ROOM FOR VARIABLE %S/

PNSFUL:	ASCIZ /NO MORE ROOM IN PNS/

FORLET:	ASCIZ /FOR VARIABLE MUST BEGIN WITH A LETTER ONLY/

FOREQ:	ASCIZ /EQUAL SIGN MUST FOLLOW FOR VARIABLE/

BADST:	ASCIZ /IMPROPER DELIMITER AFTER STARTING VALUE/

ZERINC:	ASCIZ /INCREMENT OF ZERO IS ILLEGAL/

ENDLST:	ASCIZ /END<START ILLEGAL FOR POSITIVE INCREMENT/

STLEND:	ASCIZ /END>START ILLEGAL FOR NEGITIVE INCREMENT/

NODO:	ASCIZ /THE WORD "DO" MUST PRECEED THE EXPRESSION/

NOCNG:	ASCIZ /NO CHANGES IN VALUES -- INCREMENT TOO SMALL/

BADLVR:	ASCIZ /DO LOOP VALUES MUST BE NUMERIC OR VARIABLES/
UNDVAR:	ASCIZ /UNDEFINED VARIABLE %S/

BADCHR:	ASCIZ /BAD CHARACTER SEEN IN EXPRESSION/

TRAOPP:	ASCIZ /TRAILING OPERATOR/

BADFCL:	ASCIZ /BAD END TO FUNCTION CALL/

IMPEXP:	ASCIZ /IMPROPER EXPRESSION/

ADJVAR:	ASCIZ /ADJACENT TERMS/

MISOPP:	ASCIZ /MISSING OPERATOR/

NORPAR:	ASCIZ /MISSING RIGHT PARENTHESIS/

MISRP:	ASCIZ /MISPLACED RIGHT PARENTHESIS/

EXRP:	ASCIZ /EXTRA RIGHT PARENTHESIS/

ADJOPP:	ASCIZ /ADJACENT OPERATORS/

LEDADJ:	ASCIZ /ONLY NEGATION MAY BE A LEADING OR ADJACENT OPERATOR/

INTEQ:	ASCIZ /ONLY A SINGLE VARIABLE MAY PRECEED AN EQUAL SIGN/

MISPC1:	ASCIZ /MISPLACED COMMA -- CAN'T FOLLOW LEFT PAREN OR OPERATOR/

MISPC2:	ASCIZ /MISPLACED COMMA -- NO PRECEEDING FUNCTION CALL/

UNDFUN:	ASCIZ /UNDEFINED FUNCTION %S/

INCARG:	ASCIZ /%S IS A FUNCTION OF %D ARGUMENTS /
NUMSUP:	ASCIZ /%D WERE SUPPLIED/

ILLCHR:	ASCIZ /ILLEGAL CHARACTER SEEN ON INPUT/

NOON:	ASCIZ /THE WORD 'ON' MUST PRECEED THE FILE SPECIFICATION/


BADAND:	ASCIZ /"&" MAY ONLY COME AT END OF LINE/

ONEDOT:	ASCIZ /ONLY ONE DECIMAL POINT PER NUMBER PLEASE/

BADE:	ASCIZ /A DIGIT MUST PRECEED "E" FOR SCIN. NOTATION/

BADEDG:	ASCIZ /NO NUMBER SEEN AFTER "E" IN NUMBER/

NODIGT:	ASCIZ /NO DIGIT FOUND AFTER A DECIMAL POINT/

NUMOVR:	ASCIZ /OVERFLOW -- CONSTANT TOO LARGE/

NUMUND:	ASCIZ /UNDERFLOW -- CONSTANT TOO SMALL/


DISMSG:	ASCIZ /	CURRENT DISPLAY=%F%_/

SUBMSG:	ASCIZ /	SUBTOTAL=%F%_/

SUBOVR:	ASCIZ /OVERFLOW ON TAKING A SUBTOTAL/

SUBUND:	ASCIZ /UNDERFLOW ON TAKING A SUBTOTAL/

TOTMSG:	ASCIZ /	TOTAL=%F%_/

CLRTMG:	ASCIZ /	TOTAL CLEARED%_/

CLRSMG:	ASCIZ /	SUBTOTAL CLEARED%_/

BAKMSG:	ASCIZ /	BACKED UP%_/

CNGMSG:	ASCIZ /	SIGN CHANGED/

JOBMSG:	ASCIZ /JOB %D%_/

LETOLY:	ASCIZ /LABLES MUST BEGIN WITH A LETTER/

BADFLT:	ASCIZ /FUNCTION NAMES MUST BEGIN WITH A LETTER/

BADDUM:	ASCIZ /DUMMY ARGUMENTS MUST BE ENCLOSED IN PARENTHESES/

BADDLT:	ASCIZ /DUMMY FUNCTION ARGUMENTS MUST BEGIN WITH A LETTER/

TOOMAG:	ASCIZ /ONLY %D DUMMY ARGUMENTS MAY BE SUPPLIED/

BADARG:	ASCIZ /IMPROPER DUMMY ARGUMENT DELIMITER/

BADFEQ:	ASCIZ /EQUAL SIGN MUST FOLLOW FUNCTION NAME AND ARGS/

DEFFUN:	ASCIZ /	%S DEFINED%_/

RENMSG:	ASCIZ /TYPE NEW NAME TO RENAME CURRENT FUNCTION OR <CR> TO DELETE--/

BADFNM:	ASCIZ /IMPROPER FUNCTION NAME %S%_/

NOCORE:	ASCIZ /CAN'T EXPAND CORE TO CREATE MORE FUNCTION SPACE/

BADDL:	ASCIZ /ONLY COMMAS AND CARRIAGE RETURNS ARE LEGAL DELIMITERS/

NOTDEF:	ASCIZ /	%S NOT DEFINED%_/

ISUFUN:	ASCIZ /%S IS IN USE AS A USER DEFINED FUNCTION.%_/

ISCOM:	ASCIZ /%S IS RESERVED AS A COMMAND.%_/

ISIFUN:	ASCIZ /%S IS RESERVED AS AN INTRINSIC FUNCTION.%_/

ISVAR:	ASCIZ /%S IS IN USE AS A VARIABLE.%_/

NOCRUN:	ASCIZ /CAN'T CRUNCH CORE/

DELMSG:	ASCIZ /	%S DELETED%_/

DRONLY:	ASCIZ /DEVICES MUST BE DSK OR DTA FOR DELETION/

NOFDEL:	ASCIZ /MAY NOT DELETE FROM A FILE/

NOVARS:	ASCIZ /%_	NO USER DEFINED VARIABLES%_/

NOFUNS:	ASCIZ /%_	NO USER DEFINED FUNCTIONS%_/

STMSG:	ASCIZ /%_STATUS OF ABACUS AT /

RUNMSG:	ASCIZ /RUN TIME-- /

CNTMSG:	ASCIZ /ELAPSED TIME--/

RSTMSG:	ASCIZ /MAIN REGISTER 'RESLT'=%F%_/

SRTMSG:	ASCIZ /TOTAL REGISTER 'TOT'=%F%_%_/

VARTTL:	ASCIZ /%_	USER DEFINED VARIABLES:%_%_/

FUNTTL:	ASCIZ /%_	USER DEFINED FUNCTIONS:%_%_/

	IFN DEBUG,<

CORUS1:	ASCIZ /	INITIAL FUNCTION LOCATION -- %O%_/

CORUS2:	ASCIZ /	NEXT FUNCTION LOCATION -- %O%_/

CORUS3:	ASCIZ /	MAXIMUM FUNCTION LOCATION -- %O%_/

CORUS4:	ASCIZ /	BLOCKS CORE (LOW SEGMENT) -- %D%_/

	>			;END OF COND ON DEBUG

STKOVF:	ASCIZ /STACK OVERFLOW -- FUNCTION CALLS ITSELF/

PDLOVF:	ASCIZ /PDL OVERFLOW AT LOCATION %O/

POSOVF:	ASCIZ /POSITIVE OVERFLOW%_/

NEGOVF:	ASCIZ /NEGATIVE OVERFLOW%_/

UNDFLO:	ASCIZ /UNDERFLOW%_/

DIVZER:	ASCIZ /DIVISION BY ZERO%_/

UNDEXP:	ASCIZ /UNDERFLOW IN EXP ROUTINE%_/

OVREXP:	ASCIZ /OVERFLOW IN EXP ROUTINE%_/

LOGZER:	ASCIZ /LOG OF ZERO%_/

LOGNEG:	ASCIZ /LOG OF NEGATIVE NUMBER%_/

OVRUPO:	ASCIZ /OVERFLOW IN EXPONENTIAL ROUTINE%_/

UNDUPO:	ASCIZ /UNDERFLOW IN "^" OPERATOR%_/

NEGPOW:	ASCIZ /ZERO TO A NEGATIVE POWER%_/

ABSPOW:	ASCIZ /ABSOLUTE VALUE RAISED TO A POWER%_/

SQTNEG:	ASCIZ /SQRT OF NEGATIVE NUMBER%_/

POTTAN:	ASCIZ !TAN OF PI/2 OR COTAN OF ZERO%_!

NEGFCT:	ASCIZ /FACTORIAL OF NEGETIVE NUMBER%_/

FRCFCT:	ASCIZ /FACTORIAL OF FRACTIONAL NUMBER%_/

FCTOVR:	ASCIZ /FACTORIAL ARGUMENT MUST BE LESS THAN 33%_/

NOCONT:	ASCIZ /?CAN'T CONTINUE%_/

NOLOGO:	ASCIZ /CAN'T DO A LOG OUT--TRY IT FROM MONITOR%_/

NOREDR:	ASCIZ /CANNOT RETURN TO READER/
BADEQL:	ASCIZ /IMPROPERLY PLACED EQUAL SIGN/

TOCMAG:	ASCIZ /TOO MANY ARGUMENTS SUPPLIED TO COMMAND/

NOARGS:	ASCIZ /NO ARGUMENTS SUPPLIED TO COMMAND/

SINGLE:	ASCIZ /%S COMMAND MUST BE FOLLOWED BY <CR> OR ";"/

NOTERM:	ASCIZ /IMPROPER TERMINATION OF LINE -- MUST BE <CR> OR ";"/

BADUUO:	ASCIZ /UNDEFINED UUO/

LIST

;MISC. CONSTANTS

PDLPNT:	IOWD	PDLLEN,PDL		;REG. PDL POINTER

STKST:	IOWD	STKLEN,STK		;STACK PDL POINTER

ONES:	EXP -1					;WORD OF ALL ONES
	IFN FILCAP,<
FILBLT:	XWD FILDAT,FILNAM		;WORD FOR BLT OF FILE INFO
SYSPRO:	XWD	12,16				;FOR GETTAB ON STANDARD PROTECTION
CRETIM:	POINT 11,FILNAM+2,23		;FILE CREATION TIME BYPE POINTER
CREDAT:	POINT 12,FILNAM+2,35		;FILE CREATION DATE BYTE POINTER
	>
GETSYM:	POINT 35,WD,34			;POINTER TO GET NAME
					;INPUTED SANS BIT 35
FNBPT1:	POINT 12,@FNSTPT,17		;POINTER TO GET # SOURCE WORDS

ALLFUN:	SIXBIT /ALLFUN/				;ARG MEANING ALL VARIABLES
ALLVAR:	SIXBIT /ALLVAR/				;ARG MEANING ALL VARIABLES
ON:	SIXBIT /ON/				;DELIMITER ARGUMENT
NO:	SIXBIT /NO/
YES:	SIXBIT /YES/
CUSP:	SIXBIT /ABACUS/				;NAME OF THE PROGRAM
SUBTTL STORAGE AND STUFF LIKE THAT

	IFN PURE,<RELOC 0>


LOWBEG:					;FIRST ADR OF LOW SEGMENT
EX1:	BLOCK	1			;INSTRUCTION FOR SCALE EXECUTION
ES2:	BLOCK	1			;TEMP LOCATION FOR EXP ROUTINE
C3:	BLOCK	1			;TEMP LOCATIONS FOR LOG ROUTINE
LZ:	BLOCK	1
SX:	BLOCK	1			;TEMP LOCATION FOR SIN ROUTINE

FORVAR:	BLOCK	1				;FOR VARIABLE NAME TO SAVE
DOREG1:	BLOCK	1			;START VALUE OF DO LOOP
DOREG2:	BLOCK	1		;END VALUE OF DO LOOP
DOREG3:	BLOCK	1		;INCREMENT VALUE OF DO LOOP




PDL:	BLOCK	PDLLEN			;REGULAR PUSH DOWN LIST


STK:	BLOCK	STKLEN			;STACK PUSH DOWN LIST


INRNTM:	BLOCK	1				;INITIAL RUN TIME
INCNTM:	BLOCK	1				;INITIAL CONNECT TIME

PNS:	BLOCK	PNSLEN				;POLISH STRING STORAGE

VARNAM:	BLOCK	1				;NAME OF STORAGE VARIABLE

NUMFLG:	BLOCK	1					;FLAG FOR NUMBER I/O

BRESLT:	BLOCK	1				;BACK UP RESULT
BTOT:	BLOCK	1				;BACK UP TOTAL


;****DO NOT SEPARATE THE FOLLOWINGENTRIES****

LABTOT:	BLOCK	1				;TOTAL NUMBER OF ITEMS IN LABLE TABLE
LABTAB:	BLOCK	1				;THE LABLE TABLE ITSELF
RESLT:	BLOCK	1				;RESLT OF CHAIN OPERATIONS
	BLOCK	1
TOT:	BLOCK	1
	BLOCK	LTLEN

;***************************************

NARGS:	BLOCK	1				;NUMBER OF ARGS IN FUNCTION BEING DEFINED
DUMARG:	BLOCK	MAXARG				;DUMMY ARG LIST

FUNNXT:	BLOCK	1				;POINTER TO NEXT FREE FUNCTION SPACE
FUNMAX:	BLOCK	1				;MAXIMUM LOCATION AVAILABLE TO FUNCTIONS
FNSTPT:	BLOCK	1			;PERMANENT FUNCTION POINTER
FUNPNT:	BLOCK	1				;INDIRECT FUNCTION POINTER

	IFN FILCAP,<

OPENBK:	BLOCK	3				;I/O OPEN BLOCK

FILDAT:	BLOCK	4				;FILE INFORMATION STORAGE

IBUF:	BLOCK	3				;INPUT BUFFER HEADER

OBUF:	BLOCK	3				;OUTPUT BUFFER HEADER

ABSTMP:	BLOCK	1				;NAME OF TMP FILE

PARWD:	BLOCK	1				;PARITY WORD
OLDFIL:	BLOCK	1				;SAVE OF OLD PROT, CREATION DATE

	>					;END OF COND. ON FILCAP

FILNAM:	BLOCK	6				;FILE LOOKUP, ENTER, RUN BLOCK

PNSLOC:	BLOCK	1			;INDIRECT PNS REFERENCE POINTER
LINK:	BLOCK	1				;LINK TO STACK ADRESSES
LOWEND:						;LAST ADR OF LOW SEGMENT

	IFN PURE,<RELOC>

	LIT				;PUT LITERALS HERE

	END ABACUS