Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-10 - 43,50516/basicl.mac
There is 1 other file named basicl.mac in the archive. Click here to see a list.

	IFNDEF NOCODE,<NOCODE==0>	;NOCODE=1 : JUST DEFINE SYMBOLS FOR
						   ;GETSEG SEGMENTS

	IFE NOCODE,<
	TITLE	BASIC-PLUS V-1	IMPURE SECTION 4-JUL-79
>
	IFN NOCODE,<
	UNIVERSAL	BSYICL
>
	SUBTTL IMPURE AREA

;***COPYRIGHT 1969, 1970, 1971, 1972, 1973,1974, DIGITAL EQUIPMENT CORP., MAYNARD, MASS.***

;ALPHABETICAL LIST OF INTERNALS.

	INTERN LCRFNH,GOSBFL,TTYCRF,OUCRFF,CRFERR
	INTERN ACTBL,AFLAG,APBMAX,APPLST,APPMAX,ARAROL,ARATOP,ARGROL
	INTERN BA,BADGNN,BATCH,BGNTIM,BLOCK
	INTERN CATFL1,CATCNT,CATLOK
	INTERN C3,CADROL,CATFLG,CEIL,CHAFL2,CHAFLG,CLOSED,CMDROL,CODROL,COMTIM
	INTERN COMTOP,CONROL,COPFLG,CORINC,CURBAS,CURDEV,CUREXT,CURLIN,CURNAM
	INTERN CRTVAL
	INTERN DATAFF,DATLIN,DECROL,DETER,DEVBAS,DEVICE,DREL,DRMBUF,DSKSYS
	INTERN ELETOP,ENT,ENTDSK,EOFFLG,ERR,ERL,ERRGO,ERRTRO,ES2,EX1
	INTERN ELECT1,ELECT2,ELECT3,EXTD,EXTFG
	INTERN FADROL,FCLROL,FCNLNK,FCNROL,FILCNT,FILD,FILD1,FILDIR
	INTERN FILFLG,FILNM,FILTYP,FIRSFL,FLOAT,FLOOR,FMTPNT,FORROL
	INTERN FPPN,FRSTLN,FUNAME,FUNLOW,FUNSTA 
	INTERN GSBROL,GTSTS
	INTERN HEDFLG,HPOS
	INTERN IBDSK,IBDSK2,IBF,IFFLAG,IFIFG,IFNFLG,INDSK
	INTERN ININI1,INITO,INNDSK,INPFLA,INPRES,INVFLG,INVLRG
	INTERN LADROL,LASREC,LASTLN,LEAD,LETSW,LIBFLG,LINB0,LINNUM
	INTERN LINROL,LITROL,LOCLOF,LOK,LOKUP,LOWEST,LOWSTA,LZ
	INTERN MARGIN,MARWAI,MASAPP,MASMAX,MIDSAV,MINFLG,MODBLK,MONLVL,MTIME
	INTERN MIXFLG
	INTERN NEWOL1,NUMAPP,NUMCOT,NUMMSP,NUMRES,NXTROL,NEGONE,NOBFLG
	INTERN OBF,OBDSK,OBDSK2,ODF,OLDFLA,ONCESW,OUTDSK,OUTTDS
	INTERN PAGCNT,PAGLIM,PAKFLA,PAKFLG,PARAM,PINPNM,PINPUT
	INTERN PIVOT,PLIST,POINT,PSAV,PREAD,PROTEC,PSHPNT,PSHROL,PTMROL
	INTERN PTHBLK,QUERYF,QLIST,QLSPEC,QUOFL1,QUOFLG,QUOTBL,RENDON
	INTERN RANCNT,RANTST,REAINP,REATMP,REFROL,REGPNT,RELROL,RENAMD,RENFLA
	INTERN RENSW,RETUR1,REVFL,RNDDAT,RNDIDX,ROLMSK,ROLTOP,RUNFLA,RUNLIN
	INTERN SADROL,SAVE1,SAVI,SB1M1,SB2M1,SCAROL,SEQPNT,SEXROL,SJOBRL
	INTERN SJOBSA,SLTROL,SORCLN,SPEC,SRTDBA,STADSK,STARFL,STAROL,STMROL
	INTERN STODSK,STOTRP,STQDSK,STRCTR,STRFCN,STRLEN,STRPTR
	INTERN STWDSK,SVRBOT,SVRROL,SVRTOP,SWAPSS,SX
	INTERN TABFG,TABLE,TABVAL,TEMLOC,TEMP1,TEMP2,TEMP3,TMPLOW,TMPPNT
	INTERN TMPROL,TOPSTG,TRAIL,TRNFL2,TRNFLG,TRPLOC,TTYBUF,TTYPAG
	INTERN TXTROL,TYI,TYO,TTYIN,TYPE,FTYPE,PFLAG,INLNFG
	INTERN UFD,USETID,USETOD,USGFLG,UUOH,UXFLAG
	INTERN VALPTR,VARFRE,VARROL,VECT1,VECT2,VPAKFL,VRFBTB,VRFBOT
	INTERN VRFSET,VRFTOP,VSPROL,VIRSIZ,VIRDIM,VIRROL
	INTERN VIRWRD,VIRBLK
	INTERN WRIPRI,WRREFL
	INTERN ZONFLG

;ALPHABETICAL LIST OF EXTERNALS.

	EXTERN CMDCEI,CMDFLO,RELCEI,RELFLO,STACEI,STAFLO
	DECCEI==0
	DECFLO==0
	EXTERN UUOHAN,ERRTTY

;******	UOFP SEGMENTED BASIC	******

	T=1
	X1=13
	X2=14
	P=17
	EXTERN .JBOPC,.JBTPC,.JBSA,.JBFF,.JBREL
	EXTERN EDTXIT,UXIT1,RUNNH,EXECUT,OVTRAP,REUXIT,BASCRF
	EXTERN HSGVER,SAVE,TIMOUT
	INTERN LBASIC,LUXIT,LUXIT1,LRUNNH,LEXECT
	INTERN LOVRFL,REENTR,ERRBPT,ERRTCN,ERRTBL,ERRTXT
	INTERN FORCAR,FORPNT
	INTERN SAVRUN,NOTLIN,MULLIN,OLDCOD,RUNFIL,RUNUUO
	INTERN LSAVE,LCHAIN,START,SVDV,IOW
	INTERN KWDIND,THENAD,THNCNT,THNELS,FTRUTH,LOGNEG,TRUTH,RELNEG,JFCLAD
	INTERN CENTRY,JAROUN,ELSFLG,ELSEAD,OPNFLG,INPOUT,INPPRI
	INTERN ONGFLG


IFN NOCODE,<
IF2,<	END>
>

LSGVER:	SIXBIT	/BASX13/	;[3] MUST BE CHANGED FOR EACH NEW HI-SEG
				;VERSION, TO AGREE WITH HSGVER
			;OLD BASXCT SHOULD BE SSAVED UNDER THIS NAME

SYSERR:	JFCL			;TEMPORARY CODE TO ALLOW
SYSMES:	BLOCK	20		;EXIT AND SAVE ON SYSTEM ERROR
CRSHCD:	Z
	MOVEM	P,SYSMES+17	;SAVE THE
	MOVEI	P,SYSMES	;ACS
	BLT	P,SYSMES+16
	MOVE	P,.JBREL	;AND THE AREA
	MOVEM	P,.JBFF		;ABOVE .JBFF
	HRLM	P,.JBSA		;FOR LATER INSPECTION
	EXIT	1,		;AND EXIT
	IFNDEF BASTEK,<BASTEK==0>
	INTERN	SYNTAX
SYNTAX:	BLOCK	1
	EXTERN	DDTNH

	INTERN	LDDTNH

	INTERN	DDCODE,DDSTRT,RUNDDT,DDTFLG,DDTCOD,DDTERR,ONGADR
	INTERN	DERRGO,NOLINE
	INTERN	.USREL,.DDFF,.DDREL,.DDSA,.DDTMP
OUCRFF:	Z	;SET TO -1 MEANS ALL ERRORS TO CREF FILE
.USREL:	BLOCK	1
.DDFF:	BLOCK	1
.DDREL:	BLOCK	1
.DDSA:	BLOCK	1
.DDTMP:	BLOCK	1
RUNDDT:	BLOCK	1
DERRGO:	BLOCK	1
NOLINE:	BLOCK	1
DDCODE:	BLOCK	1
DDSTRT:	BLOCK	1
DDTFLG:	BLOCK	1
DDTCOD:	BLOCK	1
DDTERR:	BLOCK	1
ONGADR:	BLOCK	1
	XLIST
	IFN	BASTEK,<
	LIST

	INTERN	NOORG,XORG,YORG,YABS,XABS,PLTTMP,PLTOUT,PLTIN
	INTERN	XMAX,YMAX

NOORG:	BLOCK	1		;FLAG FOR BASCOM
XMAX:	BLOCK	1		;X MAXIMUM VALUE
YMAX:	BLOCK	1		;Y MAXIMUM VALUE
XORG:	BLOCK	1		;XORIGIN
YORG:	BLOCK	1		;YORGIN
YABS:	BLOCK	1		;Y ABSOLUTE
XABS:	BLOCK	1		;X ABSOLUTE
PLTOUT:	BLOCK	1
PLTIN:	BLOCK	1
PLTTMP:	BLOCK	5
	XLIST
>
	LIST

;VIRTUAL ARRAY LOW SEGMENT STORAGE

AFLAG:	BLOCK	1		;A FLAG
VIRDIM:	BLOCK	1	;COMPILE TIME, STORES CHANNEL NUMBER
VIRWRD:	BLOCK	1		;STORES CURRENT WORD
VIRBLK:	BLOCK	1	;STORES CURRENT BLOCK
VIRSIZ:	BLOCK	1	;COMPILE TIME, RELATIVE SIZE OF VIRTUAL ARRAYS
ONCESW:	EXP	-1	;ONCE-ONLY SWITCH FOR START
			;AFTERWARDS, THE CONSTANT ZERO.
VPAKFL:	BLOCK	1	;-1 IF VARIABLE SPACE PACKED.

;TEMPORARY STORAGE FOR RUN-TIME IFN SUBS

PIVOT: ES2: C3:	BLOCK	1
SX: LZ:	BLOCK	1
DEVBAS:	BLOCK	1	;< > 0 ON EXIT FROM FILNAM IF DEV IS FAKED BAS.
FILFLG:	BLOCK	1
STARFL:	BLOCK	1	;***
COMTIM:	BLOCK	1	;-1=COMPILE TIME, 1=EXEC TIME, 0=COMMAND TIME.
FILTYP:	BLOCK	1
CHAFL2:	BLOCK	1
UXFLAG:	BLOCK	1
DATAFF:	BLOCK	1	;DATA/READ FLG AND FIRST DATA PTR
TOPSTG:	BLOCK	1	;HIGHEST UNMOVEABLE(STODGY)ROLL
SVRBOT:	BLOCK	1	;BOTTOM OF STRING VECTOR POINTER SPACE.
SVRTOP:
ARATOP:	BLOCK	1 	;TOP OF SPACE RESERVED FOR ARRAYS.
VARFRE:	BLOCK	1	;NEXT FREE WORD IN VARIABLE SPACE.
FCNLNK:	BLOCK	1	;LINK IN FCN AND GOSUB CALLS
CATCNT:	BLOCK	1		;COUNTER FOR TABS IN CAT/F
CATLOK:	BLOCK	4		;LOOKUP BLOCK FOR PROTECTION
CATFL1:	BLOCK	1	;FLAG FOR CAT/F = -1
CATFLG:	BLOCK	1	;FLAG AND LOOP COUNTER FOR CAT, XFOR, ETC.
CHAFLG:	BLOCK	1	;-1 IF CHAINING, 0 OTHERWISE.

TEMLOC:	BLOCK	1
ININI1:	BLOCK 1
DEVICE:	BLOCK 2
UFD:	BLOCK 4
TABFG:	BLOCK	1
TEMP1:	BLOCK	1
TEMP2:	BLOCK	1
TEMP3:	BLOCK	1
DRMBUF:	BLOCK	203
VECT1=DRMBUF+2		;TEMP SPACE FOR MAT INVERT
VECT2=DRMBUF+102


RENFLA:	EXP	-1	;-1 ALLOWS REEN;0 PREVENTS REEN;>0 REQUESTS REEN
RENDON:	Z		;SET TO -1 WHILE SERVICING ^C

;SYSTEM PARAMETERS.

BATCH:	BLOCK	1	;< > 0 IF UNDER MPB.
DSKSYS:	BLOCK	1
MONLVL:	BLOCK	1	;DISTINGUISHES BETWEEN LEVEL C AND LEVEL D.
SWAPSS:	BLOCK	1	;0 FOR NON-SWAP SYS, -1 FOR SWAPPING.
SJOBSA:	BLOCK	1	;INITIAL LH OF .JBSA.
SJOBRL:	BLOCK	1	;INITIAL .JBREL

;END--SYSTEM PARAMETERS.


;COMMAND TIME.

COPFLG:	BLOCK	1	;COPFLG IS USED BY THE COPY ROUTINE.
HEDFLG:	BLOCK	1	;HEADING FLAG FOR QUEUE AND UNSAVE.
BADGNN:	BLOCK	2
CURDEV:	BLOCK	1	;THE DEVICE ASSOCIATED WITH THE "CURRENT" FILE.
CURNAM:	BLOCK	1	;NAME OF THE "CURRENT" FILE.
CUREXT:	BLOCK	1	;ITS EXTENSION.
CURBAS:	BLOCK	1	;< > 0 SAYS CURRENT DEVICE IS FAKED BAS.
RETUR1:	BLOCK	1
USGFLG:	BLOCK	1	;USED BY RES TO SEE IF # FOLLOWING USING IS LINE #.
OLDFLA:	BLOCK	1	;ZERO WHEN FILE NAME SHOULD BE NEW, ELSE -1.
RENSW:	BLOCK	1
REVFL:	BLOCK	1
LOWSTA:	BLOCK	1
SEQPNT:	BLOCK	1	;POINTER TO LINBUF DURING RESEQUENCE.
LOWEST:	BLOCK	1	;RESEQUENCE LINES WITH NUMBERS >=LOWEST
PAKFLG:	BLOCK	1	;FLAG THAT TELLS IF CORE SHOULD BE CRUNCHED.
PAKFLA:	BLOCK	1	;-1 IF TEXT IS NOT PACKED
NOBFLG:	BLOCK	1	;-1 IF GEN NOBLANK, 0 IF GEN
FRSTLN:	BLOCK	1
LASTLN:	BLOCK	1
FILNM:	BLOCK	2

;END--COMMAND TIME.


;COMPILE AND LOAD TIME.

NEGONE:	OCT	-1
LOCLOF:	BLOCK	1	;USED BY XINFCN.
IFFLAG:	BLOCK	1
FILCNT:	BLOCK	1
LETSW:	BLOCK	1	
TYPE:	BLOCK	1
FTYPE:	BLOCK	1
PFLAG:	BLOCK	1
INLNFG:	BLOCK	1
QUERYF:	Z	;0 - OUTPUT QUERY ON INPUT, -1 - DO NOT
WRREFL:	BLOCK	1	;0 IF COMPILING PRINT#/INPUT#, -1 IF WRITE#/READ#.
TABLE:	BLOCK	1
FUNAME:	BLOCK	1	;IF NZERO, NAME OF MULTI-LINE FN BEING DEFINED
RUNFLA:	BLOCK	1	;-1 IF COMPILE OR RUN
FUNSTA:	BLOCK	1	;RHALF HAS LOCATION OF JRST AROUND FUNCTION
			;LHALF SAVES ARGUMENT COUNT IN A MULTILINE FN
FUNLOW:	BLOCK	1	;SAVE VALUE OF TMPLOW DURING MULTILINE FN
REGPNT:	BLOCK	1	;POINTER TO SUBEXP IN REG
TMPLOW:	BLOCK	1	;CURRENT TEMP UNPROTECTED. (-1 TO START)
TMPPNT:	BLOCK	1	;CURRENT TMP USED (-1 TO START)
PSHPNT:	BLOCK	1	;COUNTS GENNED "PUSH" INSTS
TRNFLG:	BLOCK	1	;USED TO HANDLE SETTING A
TRNFL2:	BLOCK	1	;MATRIX EQUAL TO ITS OWN TRANSPOSE.

;END--COMPILE AND LOAD TIME.


;EXECUTION TIME, INTRINSIC FUNCTIONS.

DETER:	BLOCK	1	;CONTAINS THE DETERMINATE OF LAST MAT INVERTED.
NUMRES:	BLOCK	1	;SET BY MAT INPUT TO NUMBER OF ELEMENTS INPUT.
MIDSAV:	BLOCK	1	;USED BY MIDB.
STRFCN: BLOCK	1	;USED BY STRB.
STRPTR: BLOCK	1
STRCTR: BLOCK	1
VALPTR: BLOCK	1	;USED BY VALB.
BGNTIM:	BLOCK	1	;STORAGE USED BY TIM.
FLOAT:	BLOCK	1
RNDIDX:	BLOCK	1	;INDEX FOR RND FUNCTION.
RNDDAT:	BLOCK	7	;DATA LOCATIONS FOR RND FUNCTION.
RANTST:	BLOCK	1
RANCNT:	BLOCK	1

;END--EXECUTION TIME, INTRINSIC FUNCTIONS.


;EXECUTION TIME, CORE MANAGER.

	APBMAX=^D47	;MAX APPEND BLOCK LENGTH
	MASMAX=^D47	;SAME FOR MASTER APP BLOCK
MASAPP:	BLOCK	MASMAX
SRTDBA:	BLOCK	9
BA:	BLOCK	9
CORINC:	BLOCK	1	;INCREMENT FOR CORE DURING PROGRAM EXECUTION.
NUMMSP:	BLOCK	1
NUMAPP:	BLOCK	1
VRFBOT:	BLOCK	1
VRFTOP:	BLOCK	1
VRFBTB:	BLOCK	1
VRFSET:	BLOCK	1

;END--EXECUTION TIME, CORE MANAGER.


;EXECUTION TIME, MISC.

	N=0
EX1:	FSC	N,0	;SCALE THE RESULTS.
IFNFLG:	BLOCK	1
EXTFG:	BLOCK	1
CRTVAL:	BLOCK	1	;CRT VALUE FALG
			;=0 10-13 ILLEGAL IN CHANGE STATEMENT
			;<> 0 10-13 ARE LEGAL
;"ON ERROR GOTO" LOCATIONS
ERR:	BLOCK	1	;ERROR # WHEN ERROR ENCOUNTERED
ERL:	BLOCK	1	;LINE # OF ERROR STATEMENT
ERRGO:	BLOCK	1	;USERS "ON ERROR GOTO" ADDRESS
ERRTRO:	BLOCK	1	;ADDRESS OF ERROR UUO SO CAN FINISH UP
			;NORMAL ERROR PROCESSING IF NEEDED.
MIXFLG:	BLOCK	1		;IF MIX MODE ARITH WAS PERFORMED
INPRES:	BLOCK	1		;SAVES P TO RESUME FROM INPUT ERROR
SORCLN:	BLOCK	1	;AT EXECUTION TIME, THE CURRENT SOURCE LINE NO.
			;POINTER
TRAIL:	BLOCK	1	;FLAGS FOR
LEAD:	BLOCK	1	;USING STATEMENTS.
INVFLG:	BLOCK	1	;NE 0 MEANS INVERTING A MATRIX.
INVLRG:	BLOCK	1	;DURING MAT INV HAS ELM OF LRGS MAG.
REATMP:	BLOCK	1	;USED BY STRETT AND STRETR.
SB1M1:	BLOCK	1
SB2M1:	BLOCK	1
INPFLA:	BLOCK	1	;NON-ZERO DURING INPUT,ZERO DURING READ
LIBFLG:	BLOCK	1
DATLIN:	BLOCK	2	;DATA LINE
PREAD:	BLOCK	2	;POINTER TO DATA LINES
PINPUT:	BLOCK	2	;POINTER TO INPUT LINES
QUOFL1:	BLOCK	1	;-1 SAYS READING A QUOTED STRING.
QUOFLG:	BLOCK	1	;<>0 SAYS MUST QUOTE THIS STRING WHEN PRINTING.
ELETOP:	BLOCK	1	;UPPER BOUND OF "MAT INPUT"
ELECT1:	BLOCK	1	;UPPER BOUND OF COLUMN DIMENSION
ELECT2:	BLOCK	1	;RUNNING COUNT OF PLACE IN COLUMNS
ELECT3:	BLOCK	1	;STORED VALUE FROM ELECT2 AT START OF INPUT

;END--EXECUTION TIME, MISC.


;FORMAT AND FILE CONTROL.

PINPNM:	BLOCK	^D9
LINNUM:	BLOCK	^D9
TABVAL:	BLOCK	^D10
POINT:	BLOCK	^D9	;USED BY THE R.A. ROUTINES.
BLOCK:	BLOCK	^D9
MODBLK:	BLOCK	^D9
STRLEN:	BLOCK	^D9
LASREC:	BLOCK	^D9
ZONFLG:	BLOCK	^D10	;USED TO FORCE COMMAS TO SPACE.
EOFFLG:	BLOCK	^D9
FIRSFL:	BLOCK	^D10	;TELLS IF ANY OUTPUT HAS BEEN DONE ON THIS PAGE.
PROTEC:	BLOCK	^D9	;< > FOR FILES AT RUNTIME.
PAGCNT:	BLOCK	^D10
PAGLIM:	BLOCK	^D10
QUOTBL:	BLOCK	^D10
PARAM:			;WARNING ********************************
WRIPRI:	BLOCK	^D9	;PARAM IS A ^D32 WORD BLOCK FOR USE BY QUEUE.
REAINP:	BLOCK	^D9
MARGIN:	BLOCK	^D10
MARWAI:	BLOCK	^D10
FILD:	BLOCK	^D9
EXTD:	BLOCK	^D9
FPPN:	BLOCK	^D9
ACTBL:	BLOCK	^D9
FMTPNT:	BLOCK	^D10	;LAST FORMAT CHAR FLAG
HPOS:	BLOCK	^D10	;HORIZ POSITION.
TTYPAG:	BLOCK	1
IFIFG:	BLOCK	1	;INPUT FROM DSK (IF NOT ZERO).
ODF:	BLOCK	1

;END--FORMAT AND FILE CONTROL.


;MISC.

NUMCOT:	BLOCK	1	;USED AT COMMAND AND RUNTIME TO ADJUST SEQ. NOS.
RUNLIN:	BLOCK	1	;HAS START LINE NO. FOR PROG EXEC OR -1 IF NONE.
MTIME:	BLOCK	1	;HOLDS TIME FOR "TIME:" MESSAGE.

;END--MISC.


;DISPATCH.

TRPLOC:	XWD	4,TRPMSG
	400000000002
	BLOCK	2

STOTRP:	BLOCK	1	;TEMP USED FOR LOC AT CTRL C INTERP.


UUOH:	BLOCK	1
	JRST	UUOHAN

TRPMSG:	SKIPN	RENDON		;ALREADY SERVICING ONE ?
	AOSE	RENFLA		;OR LOCK ON ?
	JRST	TRPMS0		;YES, JUST DISMISS
TRPMS3:	SETOM	RENDON		;NO, MARK THAT SERVICING STARTS
	SETZM	TRPLOC+2	;ALLOW NEW INTERRUPTS
	SKIPGE	RUNDDT		;RUNNING IN DDT ?
	JRST	TRPMS1		;YES, JUST BACK TO INPUT LEVEL
	SKIPE	RUNDDT		;AT DDT INPUT LEVEL ?
	JRST	LDRXIT		;YES
	SKIPLE	COMTIM		;COMPILE OR EXECUTE ?
	JRST	LREXIT		;EXECUTE
	JRST	LBASIC		;COMPILE
TRPMS0:	AOS	RENFLA		;JUST MARK
	SETZM	STOTRP		;AND GET
	EXCH	TRPLOC+2	;INTERCEPT ADDRESS
	EXCH	STOTRP		;AND RE-ENABLE
	EXCH	TRPLOC+2	;RESTORING AC0
	JRST	2,@STOTRP	;AND CARRY ON

TRPMS1:	SETOM	DDTERR		;RUNNING IN DDT, FAKE AN ERROR
	SETZM	RENDON		;ALLOW NEW INTERRUPTS
	SETOM	RENFLA
	JRST	DDTNH		;AND BACK TO DDT INPUT LEVEL

REENTR:	SKIPL	RENFLA
	JRST	REENT1
	SKIPLE	COMTIM
	JRST	LREXIT		;CLOSE FILES.
	JRST	LBASIC		;REENTER IF ALLOWED
REENT1:	AOS	RENFLA		;MAKE REQUEST BY SETTING FLAG PLUS
	JRST	2,@.JBOPC

LOVRFL:	MOVEM	X1,SEGSAV	;SAVE X1
	MOVE	X1,.JBCNI##	;GET STATE OF APR
	TRNN	X1,230000	;CHECK FOR SYSTEM ERRORS
	JRST	LOVRF1		;NO,
	OUTSTR	[ASCIZ	/
? System error - please contact computer center
/]
	OUTSTR	SYSMES		;PUT OUT ANY SPECIAL MESSAGE
	XCT	SYSERR		;AND EXECUTE ANY SPECIAL PATCH CODE
	MOVE	P,PLIST		;RESTORE P IN CASE PDL OV.
	SETOM	RUNUUO		;GO GET NEW IMAGE
	JRST	NEWIMG		;IN CASE THINGS CLOBBERED
LOVRF1:	MOVE	X1,SEGSAV	;RESTORE X1
	SKIPG	COMTIM
	JRST	OVFLCM
	SKIPN	BXSDDT
	SKIPE	BXSXCT
	JRST	OVTRAP		;GO TO EXECUTE TRAP
OVFLCM:	PUSH	P,X1
	MOVEI	X1,230010
	APRENB	X1,
	SETOM	LIBFLG
	POP	P,X1
	JRST	@.JBTPC


LBASIC:	MOVE	P,PLIST		;RESTORE PDL
LUXIT:	SETZM	SAVRUN		;ERROR, DONT MAKE SAV CODE
	SETZM	NOTLIN		;OR CRUNCH LINES
	SETZM	MULLIN		;AND UNSET MULTI-LINE
	SKIPE	OLDCOD		;ERROR IN CRUNCHED CODE ?
	JRST	GETNEV		;YES, JUST GET NEW IMAGE
	PUSH	P,[XWD	0,EDTXIT]
	JRST	GETIC
LUXIT1:	SKIPN	SAVRUN		;RUNNING SAV CODE ?
	JRST	NUXIT		;NO, NORMAL EXIT
	SKIPE	CHAFLG		;CHAINING ?
	JRST	LCHAIN		;YES, GO CHAIN
	JRST	GETNEW		;ELSE GET NEW IMAGE
NUXIT:	SKIPN	ERRTCN		;ANY ERRORS ?
	JRST	NUXIT2		;NO, CONTINUE
	PUSHJ	P,GETERR	;YES, GO PUT OUT
	SKIPE	RUNDDT		;USING BASDDT?
	JRST	NUXIT1		;YES, BACK TO BASXCT
NUXIT2:	PUSH	P,[XWD	0,UXIT1]
	JRST	GETIC		;AND BACK TO BASIC
NUXIT1:	PUSH	P,[XWD 0,DDTNH]	;GOTO DDTINT
	SETOM	DDTERR		;SET ERROR FLAG
	JRST	GETDDT		;AND BACK TO BASDDT
LRUNNH:	PUSH	P,[XWD	0,RUNNH]
	JRST	GETCOM
START:	TDZA	X1,X1		;STARTED BY MONITOR RUN CMND
	SETO	X1,		;STARTED BY BASEDT OR CHAIN STAT
	MOVEM	X1,RUNUUO	;FLAG WHICH (FOR NEWIMG)
STARTX:	RESET
	MOVE	P,PLIST		;SET UP PUSH-DOWN POINTER
	SETZB	X1,RENDON	;ALLOW ^C
	RUNTIM	X1,		;GET RUN TIME FOR PRINT-OUT
	MOVEM	X1,MTIME
LEXECT:	PUSH	P,[XWD	0,EXECUT]
	JRST	GETXCT
LREXIT:	PUSH	P,[XWD	0,REUXIT]
	JRST	GETXCT
LCRFNH:	PUSH	P,[XWD 0,BASCRF]
	JRST	GETCRF
LDDTNH:	PUSH	P,[XWD 0,DDTNH]
	JRST	GETDDT
LDRXIT:	PUSH	P,[XWD	0,REUXIT]
	JRST	GETDDT

	DEFINE SEGS<
	X IC
	X COM
	X XCT
	X DDT
	X ERR
	X CRF
>
	NUMSEG=0
	DEFINE X(A)
<IFE NUMSEG,<BXS'A:	-1>
IFN NUMSEG,<BXS'A:	Z>
	NUMSEG=NUMSEG+1>

CORSEG:	SEGS

	%N==0
	DEFINE X(A)
<	A'NO==%N
	%N==%N+1>

	SEGS

SAVX1:	Z		;X1 SAVED HERE DURING GETSEG

	DEFINE X(A)
<	SIXBIT	/BAS'A/>

SEGNAM:	SEGS

SEGADR:	TTYIN
	TTYIN
	TTYIN
	TTYIN
	ERRTTY
	TTYIN

	DEFINE X(A)
<GET'A:	PUSHJ	P,MARKER >

	SEGS

	DEFINE X(A)
<	SETZM	BXS'A>

MARKER:	SKIPGE	RENFLA		;ALREADY LOCKED ?
	SETZM	RENFLA		;NO, LOCK OUT ^C FOR GETSEG
	MOVEM	X1,SAVX1	;SAVE X1
	POP	P,X1		;GET CALLING P.C. +1
	HRRZS	X1		;JUST R.H.
	SUBI	X1,GETIC+1	;X1 = SEGMENT INDEX
	SKIPE	CORSEG(X1)	;ALREADY THERE?
	JRST	GODOIT		;YES, DO YOUR THING !
	SEGS			;ELSE
	SETOM	CORSEG(X1)	;MARK NEW SEGMENT IN CORE
	PUSH	P,X1		;SAVE X1
	PUSHJ	P,DELHI		;DELETE HI SEG
	POP	P,X1		;RESTORE X1
	MOVEM	P,SEGSAV+17	;START SAVING ACS
	MOVE	P,SEGNAM(X1)	;GET SEGMENT NAME
	SKIPN	SAVRUN		;SAV FILE ?
	SETNAM	P,		;NO, PUT IT IN SYSTAT TABLE
	MOVEM	P,SEGFIL	;SAVE FOR GETSEG
	MOVEI	P,SEGSAV	;AND FINISH
	BLT	P,SEGSAV+16	;SAVING ACS
	MOVEI	P,SEGARG	;GETSEG BLOCK ADDRESS
	GETSEG	P,		;GET THE NEW SEGMENT
	JRST	[MOVEI	X1,[ASCIZ	/
? Segment control error
/]
		CAIN	P,10	;JUST A CORE HOG ?
		MOVEI	X1,[ASCIZ	/
? Out of room
/]
		TTCALL	3,(X1)	;GIVE MESSAGE
		MOVE	X1,CELIN ;TOP OF LINROL
		HRLI	X1,1	;TO DELETE HI SEG
		CORE	X1,	;CONTRACT
		HALT		;IMPOSSIBLE !
		SKIPN	X1,SEGSAV+X1 ;GET SEG BEING GOT
		EXIT		;BASEDT, JUST GIVE UP
		CAIN	X1,XCTNO ;BASXCT ?
		SKIPN	SAVRUN	;AND SAVE CODE ?
		JRST	LBASIC	;NO, JUST BACK TO BASICS
		MOVE	X1,[SIXBIT /BASXCT/]
		CAME	X1,SEGNAM+XCTNO ;YES, IS IT A DEAD OTS ?
		JUMPE	P,[TTCALL	3,[ASCIZ /
? Version no longer supported - resave
/]
			EXIT]
		MOVE	P,PLIST	;NO, GET A FRESH IMAGE
		JRST	GETNEW]
	MOVSI	P,SEGSAV	;RESTORE
	BLT	P,16		;THE ACS
	MOVE	P,SEGSAV+17	;ALL OF THEM
	CAIN	X1,XCTNO	;GETTING EXECUTE SEG ?
	SKIPN	SAVRUN		;AND RUNNING SAV CODE
	JRST	GODOIT		;NO TO ONE OF ABOVE
	PUSHJ	P,SEGCHK	;YES, CHECK WE HAVE RIGHT VERSION
GODOIT:	PUSH	P,SEGADR(X1)
	EXCH	X1,SAVX1	;RESTORE X1, SAVE SEGMENT INDEX
	SKIPN	RENDON		;LOCKED OUT ?
	JRST	GODOT2		;NO, GO SEE IF REQUEST IN
	SKIPE	SAVX1		;YES, GOING TO BASEDT ?
	POPJ	P,		;NO, CARRY ON THE GOOD WORK
	SETZM	RENDON		;YES, RE-ENABLE
GODOT1:	SETOM	RENFLA		;THE ^C INTERRUPT
	POPJ	P,		;AND OFF WE GO ...........
GODOT2:	SKIPG	RENFLA		;WERE WE RUDELY INTERRUPTED ?
	JRST	GODOT1		;NO, RE-ENABLE AND RETURN
	SKIPE	SAVX1		;YES, GOING TO BASEDT ?
	JRST	TRPMS3		;NO, GO HANDLE
	JRST	GODOT1		;YES, JUST CARRY ON

SEGCHK:	MOVE	X2,LSGVER	;GET SAV VERSION
	CAMN	X2,HSGVER	;SAME AS HI-SEG VERSION
	POPJ	P,		;YES, ALL IS WELL
	MOVEM	X2,SEGNAM(X1)	;NO, VERSION IS SIXBIT NAME OF OLD SEG
	TTCALL	3,[ASCIZ	/
% Using obsolete version, resave soon
/]
	SETZM	CORSEG(X1)	;MARK SEG NOT IN CORE
	JRST	STARTX		;GO TRY AGAIN

LCHAIN:	SKIPL	RUNUUO		;RUN BY BASEDT ?
	TDZA	X2,X2		;NO, MUST BE BY RUN CMND
	HRLZI	X2,1		;YES, SO FLAG
	MOVE	X1,NEWOL1	;GET DEVICE
	MOVEM	X1,RUNFIL	;SAVE IN RUN BLOCK
	SETZM	FILDIR+1
	SETZM	FILDIR+2
	SETZM	FILDIR+4	;SET UP FOR RUN
	PUSHJ	P,DELHI		;DELETE HI SEG
	HRRI	X2,RUNFIL	;GET RUN UUO BLOCK
	RUN	X2,		;AND RUN CHAIN FILE
	MOVE	P,PLIST		;ERROR, RESTORE PDL
	AOS	ERRTCN		;SET ERROR COUNT
	TTCALL	3,[ASCIZ	/
? Cannot run /]
	MOVEI	X1,ERRTXT
	MOVEM	X1,ERRTBL	;SET TEXT ADDRESS
	MOVE	X1,[XWD	700,ERRTXT-1]
	MOVEM	X1,ERRBPT
	MOVE	X1,[XWD	440600,FILDIR]
LCHER:	ILDB	X2,X1
	JUMPE	X2,LSCRLF	;GO PUT OUT MESSAGE
	ADDI	X2,40
	IDPB	X2,ERRBPT
	JRST	LCHER
LSCRLF:	MOVEI	X2,15		;<CR>
	IDPB	X2,ERRBPT
	MOVEI	X2,12		;<LF>
	IDPB	X2,ERRBPT
	PUSH	P,[XWD	0,NEWIMG]
	JRST	GETERR		;GO PUT OUT MESSAGE SANS TIME

GETNEV:	SETOM	RUNUUO		;DON'T EXIT
GETNEW:	PUSH	P,[XWD	0,NEWIMG]
	JRST	SVTIME		;DONT MAKE SAV CODE
LSAVE:	PUSH	P,[XWD	0,NEWIMG]
	PUSH	P,[XWD	0,SAVE]
	SETOM	RUNUUO		;DONT EXIT
SVTIME:	PUSH	P,[XWD	0,TIMOUT]
	JRST	GETERR		;GO GET ERROR SEG
NEWIMG:	SETOB	X1,RENFLA	;TURN ON ^C AND ECHO IN CASE
	GETLCH	X1		;IT WAS LEFT OFF
	TLZ	X1,(1B15)	;ECHO BIT ON
	SETLCH	X1		;RESET LINE CHARACTERISTICS
	PUSHJ	P,DELHI		;DELETE HI SEG
	SKIPN	RUNUUO		;RUN BY BASEDT ?
	EXIT			;NO, SO JUST EXIT
	MOVE	X1,SEGNAM
	MOVEM	X1,SEGFIL	;SET TO RUN BASIC
	MOVEI	X1,SEGARG
	RUN	X1,		;RUN IT
	HALT			;MONITOR HANDLES ERRORS

DELHI:	HRLZI	X1,1		;SET CORE ARG
	CORE	X1,		;TO ZAP HI SEG
	HALT			;ERRORS IMPOSSIBLE
	POPJ	P,		;RETURN

TTYIN:	PUSH	P,T
TTYDSK:	MOVEI	T,TTYBUF
	MOVEM	T,.JBFF
	INIT	1
	SIXBIT	/TTY/
	XWD	TYO,TYI
	HALT	.+3
	INBUF	1
	OUTBUF	1
	SETZ	T,
	DEVCHR	T,		;GET DEVICE CHARACTERISTICS
	TLNE	T,10		;TERMINAL ?
	TLNE	T,200100	;AND NOT DSK OR DTA (I.E. NUL:)
	JRST	[OUTSTR		[ASCIZ	/
? Command device is not a terminal, .DEA TTY  &  .CONT
/]
		EXIT	1,
		JRST	TTYDSK]
	POP	P,T
	POPJ	P,

IOW:	BLOCK	2		;IOWD FOR SAVE
SVDV:	EXP	17		;OPEN BLOCK FOR SAVE DEVICE
	SIXBIT	/DSK/
	Z
;GETSEG UUO BLOCK
INTERN SEGARG
SEGARG:	SIXBIT	/SYS/
SEGFIL:	BLOCK	5
;PLACE TO SAVE ACS DURING GETSEG
SEGSAV:	BLOCK	20
;SAVRUN HOLDS SAV FILE NAME IF SAV CODE BEING MADE, ELSE 0
SAVRUN:	Z
;NOTLIN = 0 IF NOT CRUNCHING LINE #S, = -1 IF WE ARE CRUNCHING
NOTLIN:	Z
;RUNUUO = 0 IF RUN AT .JBSA, = -1 IF AT .JBSA+1 (AS BY BASEDT)
RUNUUO:	Z
;MULLIN CONTAINS POINTER TO BEG OF STMNT IF NOT FIRST IN LINE, ELSE 0
MULLIN:	Z
;OLDCOD HAS OLD FLCOD IF CRUNCHING FOR SAV, ELSE 0
OLDCOD:	Z
;THESE TWO HAVE SAVED INFO FOR SCANNING FORS AFTER ASSUMED STEP 1
FORCAR:	Z
FORPNT:	Z
;INDEX OF KEYWORD FOUND IN SEARCH
KWDIND:	Z
;COUNT OF THENS NOT MATCHED BY ELSES
THNCNT:	BLOCK	1
;ADDRESS OF LAST JRST AROUND THEN 
THENAD:	Z
;FLAG THAT REST OF LINE IS UNDER CONDITIONAL
THNELS:	Z
;TRUTH VALUE OF FOR RANGE TEST
FTRUTH:	Z
;LOGNEG=-1 NEGATE LOGIC OF IF =0 DO NOT
LOGNEG:	Z
;TRUTH VALUE OF LAST IF
TRUTH:	Z
;RELNEG=-1 NEGATE LOGIC OF IF RELATIONAL ELEMENT
RELNEG:	Z
;ADDRESS OF JFCL AT BEG OF STMNT, USED FOR JRST INTO MODIFIERS
JFCLAD:	Z
;ADDRES OF ENTRY INTO LAST MODIFIER
CENTRY:	Z
;ADDRESS OF JRST AROUND MODIFIER
JAROUN:	Z
;ELSFLG=-1 ONE-WORD THEN =0 MULTI-WORD THEN
ELSFLG:	Z
;ADDRESS OF LAST JRST AROUND ELSE
ELSEAD:	BLOCK	1
;OPNFLG=-1 OPEN STMNT =0 FILE STMNT
OPNFLG:	Z
ONGFLG:	Z
;INPOUT=-1 FOR OUTPUT =1 FOR INPUT =0 FOR NEITHER IN OPEN STMNT
INPOUT:	Z
;INPPRI=-1 FOR STRING OUTPUT ON INPUT FROM TTY, 0 OTHERWISE
INPPRI:	BLOCK	1
;BYTE POINTER FOR ERRORS STORED IN ERRTXT
ERRBPT:	Z
;COUNT OF ERRORS TO BE OUTPUT BY BASERR
ERRTCN:	Z
;TABLE OF ERROR ADDRESSES FOR BASERR
ERRTBL:	BLOCK 44
;TEXT OF VARIABLE MESSAGES - E.G LINE #S, IN ASCIZ
ERRTXT:	BLOCK 44



;END--DISPATCH.


;IO.

SPEC:	EXP	1
NEWOL1:	SIXBIT	/DSK/
	EXP	TYI

SAVI:	OCT 1
SAVE1:	SIXBIT	/DSK/
	XWD	TYO,

IBF:	BLOCK	3
OBF:	BLOCK	3

RUNFIL:	Z		;DEVICE FOR RUN UUO
FILDIR:	BLOCK	6
FILD1:	BLOCK	4
LOK:	BLOCK	4
ENT:	BLOCK	4
PTHBLK:	BLOCK	^D9	;PATH BLOCK, ROOM FOR 5 SFDS

TYI:	BLOCK	3
TYO:	BLOCK	3
TTYBUF:	BLOCK	46
LINB0:	BLOCK	^D51

APPMAX=^D100		;MAX NO OF APPEND BLOCKS
APPLST:			;APPLST IS RUNTIME, QLSPEC IS COMMAND TIME.
QLSPEC:	BLOCK	APPMAX+1

OBDSK2:	OUTBUF	0,2
OBDSK:	OUTBUF	0,1
IBDSK2:	INBUF	0,2
IBDSK:	INBUF	0,1
OUTDSK:	OUTPUT	0,
OUTTDS:	OUT	0,
INDSK:	INPUT	0,
INNDSK:	IN	0,
STODSK:	STATO	0,740000
STADSK:	STATZ	0,20000
STWDSK:	STATZ	0,400000
STQDSK:	STATZ	0,040000
GTSTS:	GETSTS	0,N
CLOSED:	CLOSE	0,
RENAMD:	RENAME	0,LOK
CURLIN:	BLOCK	1
DREL:	RELEASE	0,
LOKUP:	LOOKUP	0,LOK
ENTDSK:	ENTER	0,ENT
	DEFINE	R(A)
<	IRP	A
<	USETO	A,0>>
USETOD:	R<1,2,3,4,5,6,7,8,9>

	DEFINE	R(A)
<	IRP	A
<	USETI	A,0>>
USETID:	R<1,2,3,4,5,6,7,8,9>

	DEFINE	R(A)
<	IRP	A
<	OPEN	^D<A>,OPS'A>>
INITO:	R<1,2,3,4,5,6,7,8,9>


	DEFINE	R(A)
<IRP	A
<OPS'A:	OCT	1
	SIXBIT /DSK/
	XWD	DO'A,DI'A
	INTERN	OPS'A>>

R<1,2,3,4,5,6,7,8,9>


	XXLOC=.
	DEFINE	R(A)
<	IRP	A
<LINB'A:	BLOCK	^D51
	INTERN	LINB'A	>>

	R<1,2,3,4,5,6,7,8,9>


	DEFINE	R(A)
<	IRP	A
<DO'A:	BLOCK	3
DI'A:	BLOCK	3
	INTERN	DO'A,DI'A	>>

	R<1,2,3,4,5,6,7,8,9>

;END--IO.




;PUSHDOWN LISTS.

PSAV:	XWD	-300,PLIST	;TO SAVE P IN CASE ERROR INTERCEPT IN FN
				;OR GOSUB
PLIST:	XWD	-300,.
	BLOCK	300

QLIST:	XWD	-100,.
	BLOCK	100

;END--PUSHDOWN LISTS.


;ROLLS.

DEFINE ROLLS <
X TXT
X LIN

X COD
X CON
X SLT
X LIT
X ARA
X SVR
X GSB
X VIR
X SCA
X VSP
X PTM
X TMP
X STM
X SEX
X VAR
X ARG
X REF
X FCN
X FCL
X FAD
X CAD
X LAD
X SAD
X FOR
X NXT
X DON
X DLT
X DIT
X DPT
X DTP
	INTERN DONROL,DLTROL,DITROL,DPTROL,DTPROL

>
	PSHROL=200000	;ADDRESS ASSOCIATED WITH THIS
			;PHANTOM ROLL ARE ABSOLUTE, INDEXED BY (P)

DEFINE TBLS<
X CMD
X STA
X DEC
X REL
>

ZZ.=0
DEFINE X(A)
<A'ROL=ZZ.
ZZ.=ZZ.+1
>
TBLS
ROLLS
ROLTOP=ZZ.-1

FLOOR:

DEFINE X(A)
<EXP A'FLO>
TBLS

DEFINE X(A)
<Z>

	ROLLS

CEIL:

DEFINE X(A)
<EXP A'CEI>
TBLS

DEFINE X(A)
<Z>

	ROLLS

COMBOT=SEXROL		;BOTTOM COMPILE ROLL AFTER CODROL
COMTOP=DTPROL		;TOP COMPILE ROLL.



MINFLG=400000	;MINUS FLAG IN LEFT HALF OF EXPR PNTR
ROLMSK=377777	;ROLL NUMBER MASK IN SAME

SUBTTL	LITERALS
	DEFINE IMP(A)
<	CE'A=CEIL+A'ROL
	FL'A=FLOOR+A'ROL
	INTERN	CE'A,FL'A	>
	IMP	SVR
	IMP	SLT
	IMP	LIT
	IMP	SCA
	IMP	ARA
	IMP	STM
	IMP	PTM
	IMP	LAD
	IMP	GSB
	IMP	VIR
	IMP	FOR
	IMP	FCL
	IMP	CAD
	IMP	ARG
	IMP	REF
	IMP	COD
	IMP	SEX
	IMP	SAD
	IMP	NXT
	IMP	LIN
	IMP	CON
	IMP	VSP
	IMP	TXT
	IMP	TMP
	IMP	FAD
	IMP	VAR
	IMP	DON
	IMP	DLT
	IMP	DIT
	IMP	DPT
	IMP	DTP


;END--ROLLS.


	;LOW SEGMENT STUFF FOR CREF
	RELOC	XXLOC
	HASH=145
	INTERNAL L1,L2,SVJFF,.WPL,WRITEE,WRITEX,AWRITE,M6X,M0XCT
	INTERN DMPXCT,SYNERR,STCLR,OPTBL,MACTBL,SYMTBL,REFBIT,REFINC
	INTERN SRTTMP,FRDTMP,INBUF,INDEV,INDIR,LSTBUF,LSTDEV
	INTERN PPSAV,LPP,PPTEMP,FIRSTL,ERRSTS,CMDTRM,IOJFF,LOWLIM
	INTERN UPPLIM,SVLAB,LEVEL,BLKST,OFLAG,OFLAG1,OFLAG2
	INTERNAL LINUM,CRBUF,VBUF,NLZF
	INTERN OFLAG3,BLKND,ENDCLR,VARMOD,VARNAM,X22,MRDFL
	INTERN SAVII,SAVE11,CRFSUB,FSTPNT
STCLR:		;START BLT CLEAR HERE
L1:	BLOCK	1			; [21] SAVE FOR LONG
L2:	BLOCK	1			; [21]   SYMBOL ROUTINES
SVJFF:	BLOCK	1


.WPL:	BLOCK	1		;NUMBER OF ENTRIES/LINE OF CREF (WPLTTY OR WPLLPT)
WRITEE:	BLOCK	1		;INSTR TO XCT TO GET INTO THE WRITE ROUTINE
WRITEX:	BLOCK	1		;INSTR TO XCT AT GET OUT OF THE WRITE ROUTINE
AWRITE:	BLOCK	1		;ADDRESS OF WRITER (EITHER WRITE OR CPOPJ)
M6X:	BLOCK	1		;INSTR TO XCT TO DECIDE WHETHER TO ENTER A SYMBOL
				;  IN THE SYMBOL TABLE
M0XCT:	BLOCK	1		;INSTRUCTION TO XCT TO WRITE A LEADING TAB.
DMPXCT:	BLOCK	1		;OUT LST, EXCEPT, FOR MTA OUTPUT: PUSHJ P,DMPOUT
SYNERR:	BLOCK	1
OPTBL:	BLOCK	HASH+1		;OPCODE TABLE (EXTRA CELLS NEEDED FOR MERGE)
MACTBL:	BLOCK	HASH+1
SYMTBL:	BLOCK	HASH+1

REFBIT:	BLOCK	1		;TEMP CELL FOR REFERENCE TYPE IN SRCH
REFINC:	BLOCK	1		;TEMP CELL FOR REFERENCE TYPE IN SRCH
SRTTMP:	BLOCK	1		;TEMP CELL FOR SORT
FRDTMP:	BLOCK	1		;TEMP CELL FOR FREAD

INBUF:	BLOCK	3
INDEV:	BLOCK	1		;INPUT DEVICE (FOR ERR MESSAGES ONLY)
INDIR:	BLOCK	4

LSTBUF:	BLOCK	3
LSTDEV:	BLOCK	1		;LIST DEVICE (FOR ERR MESSAGES ONLY)

PPSAV:	BLOCK	1		;RESTORE P FROM HERE FOR "IMPROPER INPUT DATA"
LPP:	BLOCK	1

PPTEMP:	BLOCK	1
FIRSTL:	BLOCK	1		;LINE # AFTER WHICH TO PRINT LISTING
ERRSTS:	BLOCK	1		;HOLDS ERROR STATUS FOR MESSAGES
CMDTRM:	BLOCK	1		;HOLS LAST CHARACTER IN COMMAND SCANNER
IOJFF:	BLOCK	1		;HOLDS .JBFF BEFORE INPUT BUFFERS SETUP

LOWLIM:	BLOCK	1		;LOWER LIMIT (STARTING LINE #)
UPPLIM:	BLOCK	1		;UPPER LIMIT (ENDING LINE #)

SVLAB:	BLOCK	1

LEVEL:	BLOCK	1		;BLOCK LEVEL FOR COMBG.
	BLOCK	1		;BLKST-1 IS CLOBBERD AT R0!!
BLKST:	BLOCK	1		
OFLAG:	BLOCK	1
OFLAG1:	BLOCK	1
OFLAG2:	BLOCK	1
OFLAG3:	BLOCK	1
BLKND:	BLOCK	1
CRBUF:	BLOCK	3	;CREF OUTPUT FILE BUFFER HEADER
VBUF:	BLOCK	^D13		;PAGE HEADER BLOCK
LINUM:	Z		;LINE COUNT
NLZF:	Z			;FLAG = -1 IF DONT WANT TO OUTPUT LEADING ZEROES
VARNAM:	BLOCK	1	;BUILD CREF VARIABLE NAME HERE
VARMOD:	BLOCK	1	;-1 IF VARNAM IS A BEING MODIFIED OR DEFINED TYPE
X22:	BLOCK	1	;POINTER TO VARNAM (7 BIT ASCII)
MRDFL:	BLOCK	1	;MAT READ FLAG
SAVII:	OCT	1	;OPEN BLOCK FOR CREF OUTPUT
SAVE11:	SIXBIT /DSK/		;ALWAYS USE DSK
	XWD	CRBUF,		;CRBUF IS BUFFER HEADER
CRFSUB:	Z		;-1 MEANS PROCESSING SUBSCRIPT
FSTPNT:	Z
GOSBFL:	Z	;-1 MEANS PROCESSING GOSUB
CRFERR:	Z	;-1 MEANS TO RETURN TO FAILER FROM EOLIN

ENDCLR=	.-1
TTYCRF:	Z	;-1 MEANS WANT CREF ON TTY OTHERWISE LPT
	END