Google
 

Trailing-Edge - PDP-10 Archives - BB-M836C-BM - tools/exec-mods/execmi.mac
There are 16 other files named execmi.mac in the archive. Click here to see a list.
; UPD ID= 233, SNARK:<6.1.EXEC>EXECMI.MAC.4,  10-Jun-85 08:44:19 by DMCDANIEL
; UPD ID= 190, SNARK:<6.1.EXEC>EXECMI.MAC.3,   7-May-85 11:24:47 by PRATT
;TCO 6.1.1368 - Use a real byte pointer before the TEXTI call in GETFL2
; UPD ID= 175, SNARK:<6.1.EXEC>EXECMI.MAC.2,   3-May-85 08:31:28 by DMCDANIEL
;Update copyrights for 6.1.
; UPD ID= 289, SNARK:<6.EXEC>EXECMI.MAC.12,  17-Jun-83 12:04:43 by TSANG
;TCO 6.1688 - Make comment character in column one work properly. 
; Upd ID= 243, SNARK:<6.EXEC>EXECMI.MAC.11,  15-Jan-83 19:24:50 by CHALL
;TCO 6.1464 - UPDATE COPYRIGHT NOTICE
; UPD ID= 198, SNARK:<6.EXEC>EXECMI.MAC.10,  24-Nov-82 10:06:26 by CHALL
;TCO 6.1370 EOF1- Move label up a couple of instrs, so /SUPPRESS:YES works.
;Also, MICNST- change channel 35 to ^D35. It really should be decimal.
; UPD ID= 147, SNARK:<6.EXEC>EXECMI.MAC.9,   5-Aug-82 15:04:42 by LEACHE
;TCO 6.1213  Remove MIC conditionals
; UPD ID= 95, SNARK:<6.EXEC>EXECMI.MAC.7,   8-Jan-82 15:55:59 by CHALL
;TCO 6.1052 - UPDATE COPYRIGHT NOTICE AND DELETE PRE-V4.1 EDIT HISTORY
; UPD ID= 44, SNARK:<6.EXEC>EXECMI.MAC.5,  27-Aug-81 10:35:29 by CHALL
;TCO 5.1459 .DO- MAKE MIC.MIC BE THE DEFAULT MIC FILESPEC
; UPD ID= 20, SNARK:<6.EXEC>EXECMI.MAC.2,  17-Aug-81 10:13:02 by CHALL
;TCO 5.1454 CHANGE NAMES FROM MIC TO EXECMI AND XDEF TO EXECDE
;REMOVE MFRK CONDITIONALS
; UPD ID= 1347, SNARK:<5.EXEC>EXECMI.MAC.11,  12-Dec-80 10:33:38 by FBROWN
;TCO 5.1212 - Make "batch" commands work if the job is in monitor mode
;	even if there is no "@" at the beginning of the input line
;TCO 5.1211 - Make the ERROR/OPERATOR checking code on PTYOUT smarter
;	by ignoring nulls at either end of the PTY input buffer
; UPD ID= 1341, SNARK:<5.EXEC>EXECMI.MAC.10,   8-Dec-80 13:01:05 by FBROWN
;TCO 5.1209 - Make symbols appear in the inferior fork and change way that
;	MICSFK does checking for maximum depth of macros
; UPD ID= 1277, SNARK:<5.EXEC>EXECMI.MAC.9,  17-Nov-80 09:49:06 by FBROWN
;TCO 5.1197 - Make the parameter handler on the DO command handle "^V"s
;	correctly
; UPD ID= 1245, SNARK:<5.EXEC>EXECMI.MAC.8,   7-Nov-80 10:40:21 by FBROWN
;TCO 5.1192 - Give the Inferior fork the name MIC when it is created
; UPD ID= 1236, SNARK:<5.EXEC>EXECMI.MAC.7,   6-Nov-80 12:43:13 by FBROWN
; Change all occurrances of XTND and NOXTND to MFRK and NOMFRK
; UPD ID= 1218, SNARK:<5.EXEC>EXECMI.MAC.6,  31-Oct-80 16:09:58 by FBROWN
;[TCO 5.1186] Fix problem where @ERROR and @OPERATOR cause inferior fork to die
;<FBROWN.MIC>EXECMI.MAC.26, 15-Oct-80 16:21:38, Edit by FBROWN
;<FBROWN.MIC>EXECMI.MAC.16, 14-Oct-80 15:08:05, Edit by FBROWN
;Put MIC.MAC into EXECMI.MAC to prevent extra EXE file
;<FBROWN.MIC>EXECMI.MAC.2,  6-May-80 15:05:13, Edit by FBROWN
;Add ERROR, NOERROR, OPERATOR and NOOPERATOR support
;<HESS.EXEC>EXECMI.MAC.4,  5-Oct-79 10:04:57, Edit by HESS
;<HESS.EXEC>EXECMI.MAC.3, 14-Sep-79 17:48:45, Edit by HESS
; Preserve JFN obtained from call to FLDSKP that has be stacked
;<HESS.TEMP.E>EXECMI.MAC.7,  9-Aug-79 21:33:28, Edit by HESS
;Modified for release 4 and extended features
;TOPS20 'EXECUTIVE' COMMAND LANGUAGE

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. 1980,1985
;ALL RIGHTS RESERVED.

	SEARCH EXECDE,MICPRM
	UTITLE EXECMI

;THIS FILE CONTAINS ALL THE MIC RELATED COMMANDS


;'DO' COMMAND - RUN MIC IN A SEPARATE FORK FOR MACRO INTERPRETED COMMANDS

.DO::	NOISE (COMMAND FILE)
	TRVAR <MCJFN,MCPAR,MJFNP,MCFLAG,DOLABL>
	SETZM MCFLAG		;CLEAR THE FLAG WORD
	SETZM DOLABL		;CLEAR THE LABEL WORD
	SETZM CJFNBK+1		;CLEAR OUT JFN BLOCK
	MOVE A,[CJFNBK+1,,CJFNBK+2]
	BLT A,CJFNBK+JBLEN-1
	HRROI A,[ASCIZ /MIC/]	;SET UP "MIC" AS DEFAULT FILE AND EXTENSION
	MOVEM A,CJFNBK+.GJNAM	;STORE DEFAULT FILE
	MOVEM A,CJFNBK+.GJEXT	;STORE DEFAULT EXT
	MOVX A,GJ%OLD
	MOVEM A,CJFNBK
GETNXT:	MOVEI B,[FLDDB. .CMFIL,CM%SDH,,<Command file name>,,[
		 FLDDB. .CMSWI,,MICTB1,<Switch,>,,]]
	CALL FLDSKP		;PARSE THE FIELD
	 CMERRX			;ERROR!
	LDB D,[331100,,(C)]	;GET THE FIELD THAT MATCHED
	CAIE D,.CMFIL		;WAS IT A FILE?
	 JRST GETSWT		;NO - GO GET A SWITCH
	MOVEM B,MCJFN		;SAVE FILE'S JFN
	MOVE A,JBUFP		;REMEMBER JFN SLOT
	MOVEM A,MJFNP		; FOR LATER CLEAR (PRESERVE THIS JFN)
	NOISE (PARAMETERS)	;GIVE HIM SOME HELP
	LINEX <Parameters, one line of text>
	 CMERRX			;COMMAND ERROR
	CALL BUFFF		;YES - ISOLATE PARAMETER LIST
	MOVEM A,MCPAR		;SAVE START OF PARAMETERS
	CONFIRM			;REQUIRE CONFIRMATION
	SKIPG A,MICFRK		;DO WE HAVE A MIC FORK?
	 JRST DO1		;NO - MUST START IT
	RFSTS			;GET ITS STATUS
	 ERJMP DO1		;NOT THERE - GO START IT
	HLRZS A			;JUST GET STATUS IN R.H
	TRZ A,400000		;REMOVE FROZEN BIT
	CAIE A,.RFHLT		;HALTED?
	 CAIN A,.RFFPT		;OR ABORTED?
	  JRST [CALL KMIC	;YES - KILL IT
		JRST DO1]	;AND RESTART IT
	JRST DO4		;OTHERWISE DON'T NEED TO RESTART IT

DO1:	SETZM MICFPG		;DON'T KNOW MIC'S FIRST PAGE
	CALL ECFORK		;MAKE A NEW FORK
	MOVX B,FK%BKG!FK%KPT	;PUT INTO BACKGROUND AND KEPT
	IORM B,SLFTAB(A)
	HRROI B,[ASCIZ /MIC/]	;[TCO 5.1192] GIVE US A NAME
	CALL ADDNAM		;[TCO 5.1192] SO USERS NO WHAT IS HAPPENING
	MOVE A,FORK		;[TCO 5.1192] RESTORE FORK HANDLE
	MOVEM A,MICFRK		;[TCO 5.1209] SAVE MIC'S FORK NO.
	MOVE A,[.FHSLF,,0]	;[TCO 5.1209] OURSELF ,, PAGE 0
	HRLZ B,MICFRK		;[TCO 5.1209] INFERIOR FORK,, PAGE 0
	MOVX C,PM%CNT!PM%RD!PM%EX!PM%CPY!777 ;[TCO 5.1209] READ, EXECUTE,
					     ;COPY-ON-WRITE, ALL PAGES
	PMAP			;[TCO 5.1209] MAP THE PAGES INTO INFERIOR FORK
	 ERJMP DO2		;[TCO 5.1209] ERROR - GO KILL MIC
	MOVE A,MICFRK		;[TCO 5.1209] GET THE INFERIOR FORK HANDLE
	MOVE B,[3,,MICINI]	;[TCO 5.1209] WHERE THE ENTRY VECTOR IS
	SEVEC			;[TCO 5.1209] SET THE ENTRY VECTOR
	 ERJMP DO2		;[TCO 5.1209] ERROR - GO KILL MIC
	CALL MICSFK		;SET UP PAGE SO MIC CAN READ IT
	MOVE A,MICFRK		;MIC'S FORK
	MOVEI B,MICPAG		;ADDRESS OF START OF AC BLOCK
	SFACS			;SET MIC'S ACS
	 ERJMP DO2		;COULDN'T SET THEM
	SETZ B,			;[TCO 5.1209] START MIC AT PRIMARY ADDRESS
	SFRKV			;[TCO 5.1209] START IT
	 ERJMP CJERRE		;BLEW IT
	RFORK			;RESUME FROZEN PROCESS
	JRST DO5		;RETURN - MIC SHOULD NOW TYPE FOR USER

DO2:	MOVE A,MCJFN		;CLOSE THE FILE AND RELEASE JFN
	CLOSF			;CLOSE FILE
	 ERJMP .+1
	CALL KMIC		;CLOSE ALL OTHER FILES AND KILL MIC
	JRST CJERRE		;ERROR RETURN

DO4:	CALL MICSFK		;SET UP THE PAGE FOR MIC
	MOVE A,MICFRK		;SET TO INTERRUPT MIC
	MOVX B,1B0		;INTERRUPT ON CHANNEL 0
	IIC			;DO IT
	 ERJMP DO2		;COULDN'T
DO5:	MOVE A,MJFNP		;POINTER TO JFNSTK FOR MCJFN
	SETZM 0(A)		;DON'T ALLOW RLJFNS TO CLOSE IT
	RET			;RETURN

MICSFK:	MOVE A,MCJFN		;GET FILE JFN AGAIN
	MOVX B,<7B5!OF%RD>	;SET TO OPEN THE FILE
	OPENF			;OPEN IT
	 CALL CJERR		;COULDN'T
	MOVEI A,MICEND		;GET LAST ADDRESS OF THIS MODULE
	LSH A,-^D9		;CONVERT TO PAGE NUMBER
	SKIPE MICFPG		;[TCO 5.1209] ALREADY KNOW FIRST PAGE?
	 MOVE A,MICFPG		;[TCO 5.1209] YES - USE THAT INSTEAD
	HRL A,MICFRK		;AND THE FORK HANDLE
				;WE WILL START LOOKING FOR FREE SPACE FROM
				;THIS POINT ON
MICSF1:	RPACS			;GET PAGE ACCESSIBILITY
	TXNE B,PA%PEX		;DOES PAGE EXIST?
	 AOJA A,MICSF1		;YES - GO FIND NEXT
	HRRZS A			;JUST WANT THE PAGE NO.
	MOVEM A,MICPAG		;SAVE THIS PAGE FOR USE LATER
	SKIPN MICFPG		;DO WE ALREADY KNOW THE FIRST PAGE?
	 MOVEM A,MICFPG		;NO - SAVE IT FOR KMIC
	MOVE C,A		;[TCO 5.1209] GET COPY OF PAGE NUMBER
	SUB C,MICFPG		;[TCO 5.1209] MINUS FIRST PAGE
	CAILE C,^D35		;[TCO 5.1209] UNDER THE WIRE?
	 ERROR <MIC Macros nested too deeply>
	HRL A,MICFRK		;WE WILL MAP MIC'S PAGE TO OURS
	PUSH P,A		;[TCO 5.1209] SAVE A
	MOVE B,A		;[TCO 5.1209] GET COPY OF PAGE TO UNMAP
	SETO A,			;[TCO 5.1209] SAY UNMAP THE PAGE
	SETZ C,			;[TCO 5.1209] ONLY UNMAP THIS PAGE
	PMAP			;[TCO 5.1209] UNMAP IT
	POP P,A			;[TCO 5.1209] RESTORE A
	MOVEI B,PAGEMI		;ADDRESS OF PAGE WE WANT
	LSH B,-^D9		;MAKE IT A PAGE
	HRLI B,.FHSLF		;OUR PROCESS
	MOVX C,PM%RD!PM%WR	;WE CAN READ AND WRITE THE PAGE
	PMAP			;MAP IT
	 ERJMP CJERRE		;WE TRIED!
	MOVE A,MCFLAG		;GET THE FLAG WORD
	MOVEM A,PAGEMI+DOSWT	;AND SAVE IT
	MOVE A,DOLABL		;GET LABEL
	MOVEM A,PAGEMI+GTOLBL	;SET IT AS INITIAL GOTO LABEL
	MOVE A,MCJFN		;GET THE MIC FILE JFN
	MOVEM A,PAGEMI+MICJFN	;AND GIVE IT TO MIC
	MOVE A,MCPAR		;RESTORE PARAMETER ADDRESS
	MOVE B,[POINT 7,PAGEMI+PARSPC] ;WHERE WE ARE GOING TO PUT THE PARAMETERS
	MOVEI C,PAGEMI+PARAM	;WHERE TO PUT THE PARAMETER POINTERS
	JSP 16,.SAV2		;SAVE TWO ACS
MICSF3:	MOVE D,MICPAG		;GET MIC'S PAGE NO.
	LSH D,^D9		;MAKE IT INTO ADDRESS
	ADD D,B			;ADD BYTE POINTER
	SUBI D,PAGEMI		;SUBTRACT OUR ADDRESS
	CALL GETPAR		;GET NEXT PARAMETER
	MOVEM D,0(C)		;STORE THE POINTER AWAY
	LDB D,A			;GET LAST CHAR FROM STRING
	JUMPE D,R		;RETURN WHEN DONE
	AOJA C,MICSF3		;OTHERWISE CONTINUE
	RET			;RETURN

GETPAR:	SETZ Q1,		;CLEAR NESTED BRACKET COUNT
GETPR1:	ILDB Q2,A		;GET NEXT CHAR
	JUMPE Q2,[MOVEI Q2,12	;NULL TERMINATES STRING DUMMY UP LF
		  JRST GETPR3]	;AND TERMINATE THE PARAMETER
	CAIN Q2,^D22		;[TCO 5.1197] IS IT A "^V"?
	 JRST [ILDB Q2,A	;[TCO 5.1197] YES - GET NEXT CHAR
		JRST GETPR2]	;[TCO 5.1197] AND RETURN WITHOUT FURTHER TESTING
	CAIN Q2,","		;COMMA?
	 JRST CHKCOM		;YES - CHECK FOR NESTING
	CAIE Q2,"("		;A BRACKET?
	 CAIN Q2,"["		;OF ANY VARIETY?
	  AOJ Q1,		;YES - BUMP TO COUNT
	CAIN Q2,"{"		;SPECIAL BRACKET?
	 JRST CHKOPN		;YES - CHECK FOR FIRST BRACKET
	CAIN Q2,74		;LESS THAN?
GETPR4:	 AOJ Q1,
	CAIE Q2,")"
	 CAIN Q2,"]"
	  SOJ Q1,
	CAIN Q2,"}"		;SPECIAL BRACKET?
	 JRST CHKCLS		;YES - CHECK FOR LAST BRACKET
	CAIN Q2,76		;GREATER THAN?
	 SOJ Q1,
GETPR2:	IDPB Q2,B		;SAVE THE CHAR (AT LAST!!)
	JRST GETPR1		;GET NEXT CHAR

CHKOPN:	JUMPN Q1,GETPR4		;IF NOT FIRST - INCREMENT COUNT AND STORE
	AOJA Q1,GETPR1		;OTHERWISE JUST BUMP COUNT

CHKCLS:	SOJ Q1,			;DECREMENT COUNT
	JUMPN Q1,GETPR2		;IF NOT LAST - STORE CHAR
	JRST GETPR1		;OTHERWISE JUST GO GET NEXT CHAR

CHKCOM:	JUMPN Q1,GETPR2		;STORE IF BRACKET COUNT IS NON-ZERO
				;OTHERWISE FALL INTO GETPR3

GETPR3:	SETZ Q1,		;CLEAR A WORD
	IDPB Q1,B		;AND MAKE THE STRING ASCIZ
	POPJ P,			;BEFORE RETURNING
	SUBTTL DO command - handle switches

GETSWT:	CALL GETKEY		;GET THE ADDRESS OF THE ROUTINE
	CALL 0(P3)		;DISPATCH TO IT
	JRST GETNXT		;GET NEXT SWITCH (OR PARAMETERS)

.LABEL:	MOVEI B,[FLDBK. .CMFLD,,,<Label to start at>,,[
		BRMSK. FLDB0.,FLDB1.,FLDB2.,FLDB3.,<%>,<->]]
	CALL FLDSKP		;PARSE THIS
	 CMERRX			;COMMAND ERROR
	MOVEI B,DOLABL		;WHERE TO PUT LABEL
	CALL GETLAB		;GET IT
	RET

.SUPPR:	KEYWD $YESNO
	 T YES,,1		;DEFAULT IS YES
	 CMERRX <YES or NO required>
	HRRZ B,P3		;RETURN REPONSE IN B
	MOVX A,DO.SUP		;GET THE SUPPRESS BIT
	JUMPE B,.SUPP1		;SUPPRESS OFF?
	 IORM A,MCFLAG		;NO - LIGHT IT IN THE FLAG WORD
	RET			;RETURN

.SUPP1:	ANDCAM A,MCFLAG		;/SUPPRESS:NO - CLEAR FLAG
	RET			;AND RETURN
;KMIC COMMAND - KILLS THE MIC PROCESSOR IF RUNNING

.KMIC::	NOISE (KILL MIC)
	CONFIRM			;MAKE SURE HE WANTS TO DO IT
KMIC::	SKIPG A,MICFRK		;IS MIC RUNNING
	 ERROR <MIC is not running>
	STKVAR <KPGN>
	SKIPN A,MICFPG		;GET MIC'S FIRST PAGE
	 JRST KMIC2		;NEVER SET UP - JUST KILL MIC
	HRL A,MICFRK		;AND ITS FORK
KMIC1:	RPACS			;READ PAGE ACCESS BITS
	TXNN B,PA%PEX		;DOES THIS PAGE EXIST?
	 JRST KMIC2		;NO - WE ARE DONE
	MOVEI B,PAGEMI		;GET A PAGE TO MAP TO
	LSH B,-^D9		;MAKE IT INTO PAGE NO.
	HRLI B,.FHSLF		;MAP IT TO US
	MOVX C,PM%RD		;WE JUST NEED TO READ IT THIS TIMW
	MOVEM A,KPGN		;SAVE CURRENT PAGE NO.
	PMAP			;MAP THE PAGE
	 ERJMP KMIC2		;IF WE FAIL - JUST KILL MIC
	MOVE A,PAGEMI+MICJFN	;GET THE JFN WE GAVE MIC
	CLOSF			;AND CLOSE THE FILE
	 ERJMP .+1		;IGNORE ANY ERRORS
	MOVE A,KPGN		;RESTORE THE PAGE MARKER
	AOJA A,KMIC1		;AND TRY FOR THE NEXT PAGE

KMIC2:	SETZB A,MICFPG		;MIC IS NOT AROUND (OR WON'T BE IN A SEC.)
	SKIPLE A,MICFRK		;GET MIC'S FORK HANDLE
	 CALL KEFORK
;	CALL ERESET		;CLEAN UP ANY LEFT OVER FORKS
	RET			;RETURN
	SUBTTL IF, OPERATOR, NOOPERATOR, ERROR and NOERROR commands

.MICIF::LINEX <Rest of IF command>
	 CMERRX			;COMMAND ERROR
	CONFIRM
	TYPE <%IF command not yet implemented>
	RET			;RETURN

.OPERATOR::
	MOVEI A,"$"		;DEFAULT CHARACTER
	CALL GETCHF		;GET CHAR (WITH CONFIRMATION)
	PUSH P,A		;SAVE THE CHAR
	CALL GETPAG		;MAP CURRENT COMMS PAGE
	 ERROR <MIC is not running>
	POP P,PAGEMI+OPRCHR	;SAVE IT
	RET			;AND RETURN

.NOOPERATOR::
	CONFIRM			;REQUIRE CONFIRMATION
	CALL GETPAG		;MAP CURRENT COMMS PAGE
	 ERROR <MIC is not running>
	SETZM PAGEMI+OPRCHR	;AND ZERO THE OPERATOR CHARACTER
	RET			;RETURN

.ERROR::
	MOVEI A,"?"		;DEFAULT CHARACTER
	CALL GETCHF		;GET CHAR (WITH CONFIRMATION)
	PUSH P,A		;SAVE THE CHARACTER
	CALL GETPAG		;MAP CURRENT COMMS PAGE
	 ERROR <MIC is not running>
	POP P,PAGEMI+ERRCHR	;SAVE IT
	RET			;AND RETURN

.NOERROR::
	CONFIRM			;REQUIRE CONFIRMATION
	CALL GETPAG		;MAP CURRENT COMMS PAGE
	 ERROR <MIC is not running>
	SETZM PAGEMI+ERRCHR	;AND ZERO THE ERROR CHARACTER
	RET			;RETURN
	SUBTTL BACKTO and GOTO commands

.BACKTO::TRVAR <MCLBL,MCBPT>	;DEFINE SOME VARIABLES
	SETZM MCLBL		;ENSURE LABEL IS INITIALLY ZERO
	NOISE (LABEL)		;SOME NOISE
	MOVEI B,[FLDBK. .CMFLD,,,<Label to go BACKTO>,,[
		BRMSK. FLDB0.,FLDB1.,FLDB2.,FLDB3.,<%>,]]
	CALL FLDSKP		;PARSE THIS
	 CMERRX			;COMMAND ERROR
	MOVEI B,MCLBL		;WHERE TO PLACE SIXBIT LABEL
	CALL GETLAB		;GET IT
	MOVEI A,PAGEMI+BKTLBL	;WHERE TO PLACE LABEL IN MIC'S ADDRESS SPACE
	JRST .GOTO1		;AND JOIN THE GOTO CODE

.GOTO::	TRVAR <MCLBL,MCBPT>	;DEFINE SOME VARIABLES
	SETZM MCLBL		;ENSURE LABEL IS INITIALLY ZERO
	NOISE (LABEL)		;SOME NOISE
	MOVEI B,[FLDBK. .CMFLD,,,<Label to GOTO>,,[
		BRMSK. FLDB0.,FLDB1.,FLDB2.,FLDB3.,<%>,]]
	CALL FLDSKP		;PARSE THIS
	 CMERRX			;COMMAND ERROR
	MOVEI B,MCLBL		;WHERE TO PLACE SIXBIT LABEL
	CALL GETLAB		;GET IT
	MOVEI A,PAGEMI+GTOLBL	;WHERE TO PLACE SIXBIT LABEL
.GOTO1:	MOVEM A,MCBPT		;REMEMBER BYTE POINTER
	CONFIRM			;REQUIRE CONFIRMATION
	CALL GETPAG		;GET CURRENT PAGE
	 ERROR <MIC is not running>
	MOVE A,MCLBL		;GET SIXBIT LABEL
	MOVEM A,@MCBPT		;SAVE IT IN MIC'S ADDRESS SPACE
	RET			;AND RETURN

GETLAB:	MOVE A,[440700,,ATMBUF]	;GET WHERE THE LABEL IS
	HRLI B,440600		;MAKE O/P ADDRESS A BYTE POINTER
GETLB1:	ILDB C,A		;GET A CHARACTER
	JUMPE C,R		;RETURN ON NUL
	CAIG C,"z"		;LOWER-CASE?
	 CAIGE C,"a"		;..
	  CAIA			;NO
	   TRZ C,40		;YES - MAKE UPPER-CASE
	SUBI C," "		;MAKE SIXBIT
	TLNN B,770000		;ROOM FOR CHARACTER?
	 ERROR <Label is more than 6 characters>
	IDPB C,B		;SAVE IT
	JRST GETLB1		;AND BACK FOR MORE
	SUBTTL Subroutines

;GETPAG - a routine to map MIC's current communication page
;called by
;	CALL GETPAG
;	 return here if MIC is not active
;	return here with communication page mapped
;
;	uses ACs A,B and C

GETPAG::SKIPG MICFRK		;IS MIC RUNNING?
	 RET			;NO - GIVE ERROR RETURN
	MOVEI A,MICEND		;GET LAST ADDRESS IN INFERIOR
	LSH A,-^D9		;CONVERT TO PAGE NUMBER
	HRL A,MICFRK		;AND THE FORK HANDLE
				;WE WILL START LOOKING FOR FREE SPACE FROM
				;THIS POINT ON
GETPG1:	RPACS			;GET PAGE ACCESSIBILITY
	TXNE B,PA%PEX		;DOES PAGE EXIST?
	 AOJA A,GETPG1		;YES - LOOK FURTHER
	HRRZI A,-1(A)		;NO - RECOVER LAST PAGE NUMBER
	CAMGE A,MICFPG		;BELOW MIC'S DATA AREA?
	 RET			;YES - MIC IS NOT RUNNING - ERROR RETURN
	CAMN A,MICPAG		;IS THIS PAGE MAPPED?
	 RETSKP			;YES - DON'T NEED TO REMAP IT - GOOD RETURN
	MOVEM A,MICPAG		;REMEMBER CURRENT PAGE
	HRL A,MICFRK		;NO - GET MIC'S FORK HANDLE
	MOVEI B,PAGEMI		;GET ADDRESS
	LSH B,-^D9		;MAKE IT A PAGE NO.
	HRLI B,.FHSLF		;OUR PROCESS
	MOVX C,PM%RD!PM%WR	;READ AND WRITE ACCESS
	PMAP			;MAP MIC'S PAGE TO OURS
	 ERJMP CJERRE		;WE FAILED
	RETSKP			;WE ARE DONE

;GETCHF	- Get a single character and wait for confirmation
;called with:
;	MOVEI A,Default character
;	CALL GETCHF
;	Return here with A containing character typed (or defaulted)
;	 (errors in parsing do not return but call ERROR handler)

GETCHF:	STKVAR <DEFCHR>
	MOVEM A,DEFCHR		;REMEMBER DEFAULT
	MOVEI B,[FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ/?/]>,,,[
		 FLDDB. .CMCFM,CM%SDH,,<Confirm to get default>,,[
		 FLDDB. .CMTXT,CM%SDH,,<Single character>,,]]]
	CALL FLDSKP		;PARSE THE FIELD
	 CMERRX			;ERROR - SAY SO
	LDB D,[331100,,(C)]	;GET THE FIELD THAT MATCHED
	CAIN D,.CMTXT		;TEXT?
	 JRST GETCH1		;YES - GO CHECK IT OUT
	CAIN D,.CMCFM		;CONFIRM?
	 JRST [MOVE A,DEFCHR	;YES - GET THE DEFAULT CHAR
		RET]		;      AND RETURN
	CONFIRM			;MUST BE A QUESTION MARK - GET CONFIRMATION
	MOVEI A,"?"		;GET THE QUESTION MARK
	RET			;AND RETURN

GETCH1:	CALL BUFFF		;TEXT - ISOLATE THE TEXT
	PUSH P,A		;SAVE POINTER
	CONFIRM			;REQUEST CONFIRMATION
	POP P,B			;RESTORE POINTER TO TEXT
	ILDB A,B		;GET HIS CHARACTER
	ILDB C,B		;GET NEXT CHAR
	JUMPE C,R		;IF NUL, WE ARE DONE - RETURN
	 ERROR <Only Single Character Permitted>
				;OTHERWISE GIVE HIM AN ERROR AND EXIT
	SUBTTL MIC switches

MICTB1:	TABLE
	TV LABEL,			;STARTING LABEL
	TV SUPPRESS,			;SUPPRESS THE EOF AT END OF DO COMMAND
	TEND

$YESNO:	TABLE
	T NO,,0
	T YES,,1
	TEND
	SUBTTL The lower fork of EXEC starts here

;AC DEFINITIONS UNIQUE TO MICS LOWER FORK

	F=0			;FLAGS
	BP=Q3			;HOLDS A BYTE POINTER
	X=P3			;POINTS TO CURRENT PROCESS
	CF=P4			;CHARACTER FLAGS
	WD=P5			;HOLDS A SIXBIT WORD

;FLAG DEFINITIONS

	F.MON==1B0
	F.COL1==1B1
	F.CR==1B2
	F.SPCR==1B3		;SUPRESS CRLF AT END OF THIS LINE
	F.BRK==1B4		;WE ARE IN BREAK MODE
	F.CMNT==1B5		;SET IF HANDLING A COMMENT
	F.ABT==1B6		;AN ABORT (CONTROL-A) WAS TYPED
	F.TYP==1B7		;SET IF AN INPUT READY INTERRUPT OCCURED
	F.LABL==1B8		;SET IF WE HAVE A LABEL ON A LINE
	F.CLCM==1B9		;SET IF WE WANT TO CLEAR COMMENT FLAG
	F.XCT==1B10		;SET IF WE WANT A SINGLE "EXECUTE"
	F.LNFD==1B11		;SET IF WE HAVE SEEN A <LF> ON LOGGING PTY
	F.ERR==1B12		;SET IF AN ERROR HAS OCCURED
	F.MON==1B13		;SET IF THE LINE CONTAINS A MONITOR COMMAND
	F.SUPR==1B14		;SET WHEN SUPPRESSING PARAMETER SUBSTITUTION
	F.TI==1B15		;SET IF WE HAVE BEEN IN A TI STATE SINCE BREAK
	F.OPER==1B16		;SET IF WE HAVE SEEN THE OPER CHAR
	SUBTTL	Initialisation

MICINI:	JRST MIC.		;START ADDRESS OF INFERIOR
	JRST MIC.		;REENTER ADDRESS OF INFERIOR
MICVER:	0			;VERSION OF INFERIOR
MICSYM:	0			;POINTER TO SYMBOLS IN INFERIOR

MIC.:	MOVEM 0,MCPAG#		;WHERE THE PARAMETERS ARE
	SETZ X,			;ZERO X FIRST TIME THROUGH
	RESET			;RESET THE WORLD
	MOVE A,.JOBSY		;[TCO 5.1209] GET POINTER TO DDT SYMBOLS
	MOVEM A,MICSYM		;[TCO 5.1209] AND SAVE THEM
	MOVE P,[IOWD PDL,PDP]	;SET UP PUSHDOWN POINTER
	MOVEI A,.FHSLF		;OUR FORK
	MOVE B,[LEVTAB,,CHNTAB]	;PSI TABLES
	SIR			;DEFINE THEM TO THE MONITOR
	MOVX B,1B0!1B1!1B2!1B3!1B4!1B35 ;ACTIVATE CHANNELS 0,1,2,3 AND 4
	AIC			;DO IT
	MOVE A,[.TICCA,,1]	;CHANNEL 1 IS FOR CONTROL-A
	ATI			;ENABLE THAT CHAR
	MOVE A,[.TICCB,,2]	;CHANNEL 2 IS FOR CONTROL-B
	ATI			;ENABLE THAT CHAR
	MOVE A,[.TICCP,,3]	;CHANNEL 3 IS FOR CONTROL-P
	ATI			;ENABLE THAT CHAR
	MOVE A,[^D35,,4]	;CHANNEL 4 IS FOR WAITING FOR INPUT
	ATI			;ENABLE THAT CONDITION
	MOVE A,[.TICCX,,^D35]	;CHANNEL 35 IS FOR CONTROL-X
	ATI			;ENABLE THAT CHAR
MIC1:	MOVE Q1,MCPAG		;GET PAGE NUMBER EXEC GAVE US
	LSH Q1,^D9		;MAKE INTO ADDRESS
	CALL SETPRC		;SET UP THE PDB
	MOVEI A,.FHSLF		;OUR FORK
	EIR			;ENABLE THE INTERRUPT SYSTEM FOR OURSELVES
	 ERCAL BDJSYS		;ERROR
	MOVX F,F.COL1		;ASSUME WE ARE AT COLUMN-1
	SUBTTL	MAIN LOOP

WAIT:	TXZ F,F.TI		;CLEAR THE TI BIT
	SETZM WAITTM#		;CLEAR THE WAIT INTERVAL
WAIT2:	MOVE P,[IOWD PDL,PDP]	;RESET THE STACK IN CASE WE FORGOT WHERE WE WERE
;	MOVE A,.PRIIN		;PRIMARY INPUT
;	DIBE			;WAIT TILL INPUT BUFFER EMPTY
;	MOVEI A,.PRIOU		;PRIMARY OUTPUT
;	DOBE			;WAIT TILL OUTPUT BUFFER EMPTY
WAIT3:	MOVEI A,.PRIIN		;CHECK PRIMARY INPUT
	MOVEI B,.MOPIH		;CHECK INPUT READY FLAG
	MTOPR			;GET FLAG
	JUMPN B,TYPELN		;IT IS READY
WAIT1:	MOVE A,WAITTM		;GET THE WAIT TIME
	CAIL A,^D1000		;LESS THAN ONE SEC?
	 JRST DOWAIT		;NO - DO NOT INCREMENT
	ADDI A,^D100		;INCREMENT
	MOVEM A,WAITTM		;REMEMBER FOR NEXT TIME
	TXZN F,F.TYP		;DON'T SLEEP IF WE GOT AN INTERRUPT
DOWAIT:	DISMS			;SLEEP TIGHT
WAITPC:	JRST WAIT2		;LOOK AGAIN

TYPELN:	TXO F,F.TI		;WE ARE IN TI NOW
	TXNE F,F.BRK		;ARE WE IN A BREAK?
	 TXNE F,F.XCT		;YES - SINGLE EXECUTE?
	  CAIA			;NOT BREAK - OR SINGLE EXECUTE
	 JRST WAIT1		;BREAK - GO BACK TO WAITING
TYPEL1:	TXZ F,F.XCT		;WE WILL EXECUTE A LINE
	SKIPN ERRCHR(X)		;SEE IF THE ERROR STUFF HAS CHANGED
	SKIPE OPRCHR(X)		;OR OPERATOR STUFF
	CALL CHKPTY		;ONE OF THEM HAS - CHECK FOR PTY
	TXNE F,F.ERR		;HAVE WE SEEN AN ERROR?
	 JRST CKERR		;YES - HANDLE IT
	SKIPE Q1,GTOLBL(X)	;A LABEL TO GOTO?
	 JRST %GOTO		;YES - HANDLE IT
	SKIPE Q1,BKTLBL(X)	;A LABEL TO GO BACKTO?
	 JRST %BACKTO		;YES - HANDLE IT
	CALL GETLIN		;READ NEXT LINE IN
	 JRST EOF		;END OF FILE
TYPEIT:	MOVE BP,[POINT 7,LINBUF(X)] ;SET UP BYTE POINTER
	CALL CHKBAT		;CHECK FOR MIC COMMAND AND EXECUTE
	 JRST WAIT		;IT WAS - GO WAIT FOR NEXT LINE
	CALL PUTLIN		;AND PRINT IT
	JRST WAIT		;BACK ROUND FOR THE NEXT LINE

SETPRC:	MOVEI Q2,PARSTK-1(Q1)	;ADDRESS OF START OF STACK MINUS ONE
	HRLI Q2,-^D40		;MAKE IOWD
	MOVEM Q2,STKPTR(Q1)	;STORE IT AWAY
	JUMPE X,SETPR1		;IF NO CURRENT PROCESS - SKIP NEXT BIT
	MOVE Q2,ERRCHR(X)	;OTHERWISE COPY APPROPRIATE INFORMATION
	MOVEM Q2,ERRCHR(Q1)	; FROM THE OLD PROCESS AREA
	MOVE Q2,OPRCHR(X)	; TO THE NEW PROCESS AREA
	MOVEM Q2,OPRCHR(Q1)	; SO THEY CAN BE USED THERE
SETPR1:	MOVEM X,LSTPDB(Q1)	;REMEMBER PREVIOUS PDB ADDRESS
	MOVE X,Q1		;AND SET UP NEW PDB POINTER
	RET			;RETURN TO OUR CALLER
	SUBTTL - handle GOTO and BACKTO commands

%BACKTO:
	MOVE A,MICJFN(X)	;GET FILE'S HANDLE
	SETZ B,			;SET TO START OF FILE
	SFPTR			;DO IT
	 ERJMP BDJSYS		;ERROR - HANDLE IT
	SETZM BKTLBL(X)		;NO LONGER LOOKING FOR A LABEL
	JRST %GOTO2		;SAME AS FOR GOTO
%GOTO:	SETZM GTOLBL(X)		;NO LONGER LOOKING FOR A LABEL
%GOTO2:	MOVEM Q1,LAB#		;REMEMBER LABEL
%GOTO1:	CALL GETLIN		;READ A LINE
	 JRST %GTOERR		;END OF FILE
	MOVE Q1,LAB		;GET THE LABEL
	CAME Q1,LABEL(X)	;SAME AS THE ONE ON THIS LINE?
	 JRST %GOTO1		;NO -  KEEP LOOKING
	JRST TYPEIT		;YES - GO HANDLE THE COMMAND

%GTOERR:TMSG <
?MICFEF -  Found End of File While Searching For >
				;TELL HIM WE BLEW IT
	MOVE WD,Q1		;GET THE LABEL
	CALL PUTLAB		;AND PRINT IT
	JRST EOF		;AND HANDLE AS FOR AND OF FILE
	SUBTTL Handle Error Condition

CKERR:	CALL GETLIN		;GET NEXT LINE OF FILE
	 JRST ERREOF		;EOF - TELL HIM
	SKIPE Q1,LABEL(X)	;GET ANY LABEL
	 JRST CKERR1		;THERE WAS ONE - GO CHECK IT
	TXNN F,F.MON		;IS THIS A MONITOR COMMAND?
	 JRST CKERR		;NO - KEEP LOOKING
	MOVE BP,[POINT 7,LINBUF(X)] ;SET UP BYTE POINTER
	CALL GETCOM		;TRY TO PARSE A BATCH COMMAND
	 JRST CKERR2		;ITS NOT - JUST LOOK FOR %LABELS
	CAIN A,TIF		;IT IS - IS IT AN IF COMMAND?
	 JRST TYPEIT		;YES - GO HANDLE IT
	JRST CKERR2		;NO - GO LOOK FOR A %LABEL

CKERR1:	CAMN Q1,[SIXBIT /%ERR/]	;%ERR:: LABEL?
	 JRST CKERR3		;YES - WE ARE DONE
	CAME Q1,[SIXBIT /%FIN/]	;%FIN:: LABEL?
	 JRST CKERR		;NO - KEEP LOOKING
	TMSG <
[MICFES - %FIN:: Encountered while Searching for %ERR::]
>
CKERR3:	TXZ F,F.ERR		;YES - CLEAR THE ERROR FLAG
	JRST TYPEIT		;WARN HIM AND CONTINUE PROCESSING

CKERR2:	CALL GETLIN		;GET NEXT LINE
	 JRST ERREOF		;EOF FOUND
	SKIPN Q1,LABEL(X)	;GET LABEL
	 JRST CKERR2		;NONE THERE - KEEP LOOKING
	CAMN Q1,[SIXBIT/%FIN/]	;%FIN?
	 JRST CKERR1		;YES - HANDLE IT
	CAMN Q1,[SIXBIT/%ERR/]	;%ERR?
	 JRST CKERR3		;YES - WE ARE DONE
	JRST CKERR2		;OTHERWISE KEEP LOOKING

ERREOF:	TMSG <
?MICFEF - Found End of File while searching for %ERR:: or %FIN::

>
	JRST EOF		;handle as for eof
	SUBTTL Get a line of input to be typed

GETLIN:	TXZ F,F.MON		;ASSUME THIS IS NOT A MONITOR COMMAND
	MOVEI P1,^D80		;INITIALISE CHAR COUNT
	MOVE BP,[POINT 7,LINBUF(X)]	;SET UP WHERE TO PUT A LINE
	TXNN F,F.COL1		;IN COLUMN 1?
	 JRST GETLN1		;NO - DON'T RESET LABEL
	MOVE WD,[POINT 6,LABEL(X)] ;YES - WHERE TO PUT A LABEL
	SETZM LABEL(X)		;CLEAR WHERE LABEL WILL BE ASSEMBLED
	TXZ F,F.LABL		;WE NO LONGER HAVE A LABEL ON THIS LINE
GETLN1:	CALL NXTCHR		;GET THE NEXT CHARACTER
	 RET			;END OF FILE - NON-SKIP RETURN
	JUMPE B,GETLN2		;JUST RETURN IF A NULL CHARACTER
	IDPB B,BP		;SAVE THE CHARACTER AWAY
	TXNN CF,C.BRK		;IS THIS CHARACTER A BREAK CHAR?
	 SOJG P1,GETLN1		;NO - LOOP BACK UNLESS LINE TOO LONG
GETLN2:	SETZ B,			;END-OF-LINE - MAKE ASCIZ
	IDPB B,BP		;DO IT
	RETSKP			;[TCO 5.1209] AND RETURN

NXTCHR:	CALL GETCHR		;GO GET A CHAR
	 RET			;EOF - GIVE NON-SKIP RETURN
	TXNN F,F.LABL		;HAVE WE READ A LABEL YET?
	 CALL CHKLBL		;NO - CHECK FOR POSSIBLE LABEL
	TXNE F,F.COL1		;ARE WE IN COLUMN 1?
	 TXNN CF,C.COL1		;AND IS THE CHARACTER SPECIAL IN COLUMN 1?
	  CAIA			;NO - NO SPECIAL CHECKING
	   JRST 0(CF)		;YES - GO HANDLE THE SPECIAL CHAR
COL2:	TXNE CF,C.SPEC		;SPECIAL CHARACTER?
	 JRST 0(CF)		;YES - GO DO SPECIAL HANDLING
	TXZ F,F.COL1		;NO LONGER IN COLUMN 1
TYPCHR:	RETSKP			;[TCO 5.1209] GIVE SKIP RETURN

VTAB:	JRST TYPCHR		;TYPE THE CHAR BUT DON'T CLEAR COL 1

FFEED:	JRST TYPCHR		;TYPE THE CHAR BUT DON'T CLEAR COL 1

CRET:	TXO F,F.COL1		;SET COLUMN-1 FLAG
	TXNE F,F.SUPR		;RE-TYPING DUE TO @IF?
	 TXOA CF,C.BRK		;YES - LIGHT BREAK BIT AND SKIP
	  TXO F,F.CR		;NO - SET SUPPRESS LF FLAG
	TXNN F,F.CMNT		;ARE WE HANDLING A COMMENT?
	TXNN F,F.SPCR		;NO - DO WANT THIS CR SUPPRESSED?
	 JRST TYPCHR		;NO, OR IN COMMENT - GO TYPE THE CHAR
	SETZ B,			;YES - DUMMY UP A NULL BYTE
	RETSKP			;[TCO 5.1209] GIVE SKIP RETURN - WE ARE DONE

LNFEED:	TXNE F,F.CMNT		;HANDLING A COMMENT?
	 JRST [TXO F,F.CLCM	;YES - WE WANT TO CLEAR FLAG AFTER TYPING
		JRST TYPCHR]	; AND GO TYPE CHARACTER
	TXZN F,F.CR!F.SPCR	;CR TYPED?, OR DO WE WANT THIS LF SUPPRESSED?
	  JRST TYPCHR		;NO - GO TYPE THE CHAR
	SETZ B,			;YES - DUMMY UP A NULL BYTE
	RETSKP			;[TCO 5.1209] AND GIVE SKIP RETURN

CNTRL:	TXNE F,F.SUPR		;SUPPRESSING PARAMETERS ETC.?
	 RET			;YES - JUST RETURN
	CALL CHKDUP		;NO - CHECK FOR DUPLICATE
	 RET			;EOF
	  JRST CNTRL2		;DUPLICATE FOUND
	CALL LOWUP		;DIFFERENT - CONVERT TO UPPER-CASE
	 JFCL			;IGNORE ERRORS (FOR NOW)
	CAIL B,100		;IN RANGE FOR CONTROL-CHARS?
	 CAILE B,137		;WELL?
	  JRST CNTRL1		;NO - PRINT ^ CHAR
	SUBI B,100		;YES - MAKE CONTROL-CHAR
	JRST TYPCHR		;AND GO TYPE THAT

CNTRL1:	MOVEM B,SAVCHR(X)	;SAVE THIS CHARACTER
	MOVEI B,"^"		;GET THE UP-ARROW
	JRST TYPCHR		;AND TYPE IT

CNTRL2:	CALL CHKDUP		;CHECK FOR A THIRD ^
	 JRST [MOVEI B,"^"	;EOF - RESTORE THE UP-ARROW
		JRST TYPCHR]	;AND TYPE IT
	  JRST [MOVEI B,36	;DUPLICATE - SET TO TYPE A CONTROL-UPARROW
		JRST TYPCHR]	;DO IT
	MOVEM B,SAVCHR(X)	;SAVE THIS CHARACTER
	MOVEI B,"^"		;RESTORE THE UP-ARROW
	JRST TYPCHR		;AND TYPE IT
	SUBTTL	Handle special characters

MONMOD:	CALL CHKDUP		;CHECK FOR DUPLICATE
	 RET			;EOF
	  JRST TYPCHR		;DUPLICATE
	TXO F,F.MON!F.LABL	;CAN NO LONGER HAVE A LABEL AND HAVE A COMMAND
	JRST COL2		;GO TYPE TYPE CHAR

RETNUL:	SETZ B,			;RETURN A NULL BYTE
	RETSKP			;[TCO 5.1209] AND GIVE SKIP RETURN

USRMOD:	CALL CHKDUP		;CHECK FOR SECOND ONE
	 RET			;EOF
	  JRST TYPCHR		;DUPLICATE - GO TYPE IT
	TXO F,F.LABL		;CAN NO LONGER HAVE A LABEL
				;DIFFERENT - WE SHOULD CHECK USER MODE HERE
	JRST COL2		;BUT FOR NOW WE WILL JUST TYPE THE CHAR

SUPPRS:	CALL CHKDUP		;CHECK FOR SECOND ONE
	 RET			;EOF
	  JRST TYPCHR		;DUPLICATE - GO TYPE IT
	TXO F,F.SPCR		;NO - SAY WE SHOULD SUPPRESS THE CRLF
	TXO F,F.LABL		;CAN NO LONGER HAVE A LABEL
	JRST COL2		;AND GO LOOK AT THIS CHAR

GTLAB:	TXNE F,F.LABL		;HAVE WE SEEN A LABEL?
	 JRST TYPCHR		;YES - RETURN - WE CAN ONLY SEE ONE
	CALL CHKDUP		;CHECK FOR SECOND COLON
	 RET			;EOF
	 JRST GTLB1		;WE GOT ONE - MUST BE A LABEL
	CAIN B,15		;IS 2ND CHAR A <CR>
	 JRST GTLB2		;YES - HANDLE IT
	MOVEM B,SAVCHR(X)	;NO - SAVE NEW CHAR
	MOVEI B,":"		;RESTORE COLON
	JRST TYPCHR		;AND TYPE IT

GTLB1:	TXOA F,F.COL1!F.LABL	;WE ARE IN COLUMN 1 AGAIN AND WE HAVE A LABEL
GTLB2:	TXO F,F.COL1!F.LABL!F.SPCR ;SAY WE HAVE A LABEL AND SUPPRESS <LF>
	TXZ F,F.CMNT!F.CLCM	;NO LONGER HAVE A COMMENT (OR WANT TO CLEAR IT)
	MOVEI P1,^D80		;RE-INITIALISE CHAR COUNT
	MOVE BP,[POINT 7,LINBUF(X)] ;SET UP WHERE TO PUT A LINE
GTLB3:	CALL GETCHR		;GET A CHARACTER
	 RET			;EOF
	CAIE B," "		;A SPACE?
	 CAIN B,11		;OR A TAB?
	  JRST GTLB3		;YES - IGNORE IT
	MOVEM B,SAVCHR(X)	;NO - SAVE IT FOR RE-ANALYSIS
	JRST NXTCHR		;AND START THIS LINE AGAIN
	SUBTTL	Handle comments

COMNT:	MOVEM B,CMNTCH#		;REMEMBER CURRENT COMMENT CHAR
	CALL CHKDUP		;CHECK FOR SECOND ONE
	 RET			;EOF
	  JRST TYPCHR		;DUPLICATE - GO TYPE IT
	MOVEM B,SAVCHR(X)	;SAVE THE CHAR
	MOVE B,CMNTCH		;RESTORE COMMENT CHAR
	TXO F,F.CMNT		;LIGHT THE COMMENT FLAG
	TXO F,F.LABL		;CAN NO LONGER HAVE A LABEL
	TXZ F,F.COL1		;[6.1688] NO LONGER IN COLUMN ONE
	RETSKP			;[TCO 5.1209] RETURN TO THE CALLER

CHKLBL:	TXNE CF,C.LABL		;IS THIS A COLON?
	 RET			;YES - JUST RETURN
	TXNN CF,C.ALPH		;CAN THIS BE A LABEL?
	 JRST CHKLB1		;NO - SAY SO
	MOVEM B,SAVCH#		;YES - SAVE THE CHAR
	CALL LOWUP		;CONVERT TO UPPER-CASE
	 JFCL			;MAY NOT BE A LETTER (COULD BE %)
	SUBI B," "		;CONVERT TO SIXBIT
	TLNE WD,770000		;ROOM FOR LABEL?
	 IDPB B,WD		;YES - SAVE IT
	MOVE B,SAVCH		;RESTORE THE ORIGINAL CHARACTER
	RET			;AND RETURN

CHKLB1:	SETZM @WD		;CANNOT HAVE A LABEL
	TXO F,F.LABL		;BUT MAKE LOOK LIKE WE HAD ONE
	RET			;AND RETURN
;CHKDUP - Check for duplicate character

CHKDUP:	PUSH P,B		;REMEMBER OLD CHAR
	CALL GETCHR		;GET NEXT CHARACTER
	 JRST CHKDP1		;EOF
	AOS -1(P)		;SET FOR SKIP RETURN
	CAME B,0(P)		;SAME AS ORIGINAL CHAR?
	 AOS -1(P)		;NO - GIVE DOUBLE SKIP
CHKDP1:	POP P,(P)		;CORRECT STACK
	RET			;AND RETURN
;CHKBAT - check for batch commands and execute them

CHKBAT:	CALL CHKMON		;[TCO 5.1212] ARE WE IN MONITOR MODE?
	 JRST CHKBT1		;[TCO 5.1212] YES - PROCEED
	TXNN F,F.MON		;NO - DO WE HAVE A MONITOR COMMAND?
	 RETSKP			;[TCO 5.1209] NO - GIVE SKIP RETURN
CHKBT1:	PUSH P,BP		;SAVE BYTE POINTER
	CALL GETCOM		;GO GET A COMMAND
	 JRST [POP P,BP		;NOT BATCH - RESTORE BP
		RETSKP]		;[TCO 5.1209] SKIP RETURN (LINE WILL BE TYPED)
	POP P,Q1		;REMEMBER ORIGINAL BYTE POINTER
	PUSH P,A		;SAVE A AROUND PUTLAB
	SKIPE WD,LABEL(X)	;WAS THERE A LABEL ON THIS LINE?
	 CALL PUTLAB		;YES - OUTPUT IT
	POP P,A			;RESTORE A
	CALL @DISPCH(A)		;BATCH/MIC - PARSE IT
	RET			;AND RETURN BUT DON'T TYPE LINE

GETCOM:	MOVE WD,[POINT 7,COMBUF] ;POINTER TO SPECIAL COMMAND BUFFER
GETC1:	ILDB B,BP		;LOAD A BYTE FROM INPUT LINE
	CALL LOWUP		;CONVERT TO UPPER CASE
	 JRST GETC2		;NOT ALPHABETIC - EXIT LOOP
	IDPB B,WD		;ALPHABETIC--DEPOSIT IN COMMAND BUFFER
	JRST GETC1		;CONTINUE EATING COMMAND

GETC2:	SETZ B,			;NULL BYTE
	IDPB B,WD		;DEPOSIT AT END OF COMMAND
	SETO Q2,		;SET TO BACK UP ONE BYTE
	ADJBP Q2,BP		;BACK UP THE BYTE POINTER
	MOVEM Q2,BP		;STORE NEW BUFFER POINTER
	MOVEI A,COMTBL		;ADDRESS OF COMMAND TABLE
	HRROI B,COMBUF		;BUFFER POINTER
	TBLUK			;LOOK UP A COMMAND
	TXNN B,TL%EXM		;DID WE GET AN EXACT MATCH ?
	 RET			;NO--GIVE FAILURE RETURN
	PUSH P,A		;SAVE COMMAND TABLE ENTRY
	CALL SPACE		;EAT SPACES AND TABS
	POP P,A			;RESTORE COMMAND TABLE ENTRY
	HRRZ A,0(A)		;GET COMMAND INDEX
	RETSKP			;[TCO 5.1209] GIVE SUCCESSFUL RETURN TO CALLER

SPACE:	ILDB B,BP		;GET NEXT CHAR
	 CAIE B," "		;SPACE?
	  CAIN B,11		;OR TAB?
	   JRST SPACE		;YES - GO GET NEXT
	SETO Q1,		;NO - ADJUST BYTE POINTER
	ADJBP Q1,BP		;BY ONE
	MOVEM Q1,BP		;AND SAVE IT
	RET			;RETURN
	SUBTTL MIC commands

$NOOP:	TMSG <
%MICUIC - Unimplemented Command: >
	CALL TYPEMC		;TELL HIM WHAT WE CANNOT DO AND RETURN
	RET			;RETURN

$GOTO:	CALL TYPEMC		;TYPE THE CURRENT COMMAND
	SETZM GTOLBL(X)		;ZERO OLD LABEL
	MOVE WD,[POINT 6,GTOLBL(X)] ;POINT TO GOTO LABEL SLOT
	JRST $GOTO1		;AND READ A LABEL

$BACKT:	CALL TYPEMC		;TYPE THE CURRENT COMMAND
	SETZM BKTLBL(X)		;ZERO OLD LABEL
	MOVE WD,[POINT 6,BKTLBL(X)] ;POINT TO BACKTO LABEL SLOT
$GOTO1:	ILDB B,BP		;GET NEXT CHAR
	CAIG B," "		;CONTROL CHAR?
	 RET			;YES - WE ARE DONE
	CALL LOWUP		;NO - CONVERT TO UPPER CASE
	 JFCL			;IGNORE NON-SKIP RETURN
	MOVE CF,CHRTAB(B)	;GET CHARACTERISTICS
	TXNN CF,C.ALPH		;CAN THIS BE A LABEL?
	 JRST NOTLAB		;NO - TELL HIM
	SUBI B," "		;MAKE IT SIXBIT
	TLNE WD,770000		;ROOM IN LABEL WORD?
	 IDPB B,WD		;YES - STORE IT
	JRST $GOTO1		;AND BACK FOR MORE

NOTLAB:	TMSG <
%MICICL - Illegal character in label - Command ignored>
	RET			;TYPE ERROR MESSAGE AND RETURN

$ERROR:	CALL TYPEMC		;TYPE THE LINE
	ILDB B,BP		;GET NEXT CHAR
	CAIG B," "		;CONTROL CHAR?
	 MOVEI B,"?"		;YES - MAKE IT QUESTION MARK
	MOVEM B,ERRCHR(X)	;AND SAVE IT FOR LATER
	CALLRET CHKPTY		;SET UP PTY CHECKING IF NECESSARY AND RETURN

$NOERR:	CALL TYPEMC		;TYPE THE LINE
	SETZM ERRCHR(X)		;NO LONGER LOOKING FOR ERRORS
	RET			;RETURN

$OPERA:	CALL TYPEMC		;TYPE THE LINE
	ILDB B,BP		;GET NEXT CHAR
	CAIG B," "		;CONTROL-CHAR?
	 MOVEI B,"$"		;YES - MAKE IT A DOLLAR
	MOVEM B,OPRCHR(X)	;AND SAVE IT
	CALLRET CHKPTY		;SET UP PTY CHECKING IF NECESSARY AND RETURN

$NOOPE:	CALL TYPEMC		;TYPE THE LINE
	SETZM OPRCHR(X)		;NO LONGER ANY OPER CHAR
	RET			;AND RETURN

TYPEMC:	MOVE A,Q1		;GET BYTE POINTER
	PSOUT			;AND TYPE IT
	MOVEI A,12		;O/P A <LF>
	PBOUT			;..
	RET			;RETURN
	SUBTTL @IF Command

$IF:	PUSH P,Q1		;SAVE THE COMMAND POINTER
	MOVE WD,[POINT 7,COMBUF] ;GET POINTER TO SPECIAL COMMAND BUFFER
	ILDB B,BP		;GET NEXT CHAR
	CAIE B,"("		;LEFT PAREN?
	 JRST IFERR		;NO - ERROR
	IDPB B,WD		;YES - SAVE IT

$IF1:	ILDB B,BP		;GET NEXT CHAR
	CALL LOWUP		;CONVERT TO UPPER CASE
	 JRST $IF2		;NOT ALPHABETIC - MUST BE DONE
	IDPB B,WD		;ELSE STORE
	JRST $IF1		;AND GO BACK FOR MORE

$IF2:	CAIE B,")"		;CLOSE PAREN?
	 JRST IFERR		;NO - ERROR
	IDPB B,WD		;YES - SAVE IT
	SETZ B,			;MAKE ASCIZ
	IDPB B,WD		;..
	MOVEI A,[2,,2		;GET ADDRESS OF LOOKUP TABLE
		 [ASCIZ/(ERROR)/],,0 ;CONDITION 0 - ERROR
		 [ASCIZ/(NOERROR)/],,1] ;CONDITION 1 - NOERROR
	HRROI B,COMBUF		;WHERE THE COMMAND IS
	TBLUK			;LOOK UP OPTION
	TXNN B,TL%EXM		;EXACT MATCH?
	 JRST IFERR		;NO - GIVE ERROR
	HRRZ A,0(A)		;YES - GET CONDITION
	TXZN F,F.ERR		;TEST ERROR FLAG (AND CLEAR)
	 JRST [ JUMPE A,IFFLSE	;FALSE
		JRST IFTRUE]	;TRUE
	JUMPE A,IFTRUE		;TRUE
				;FALSE - FALL INTO IFFLSE

IFFLSE:	POP P,Q1		;FALSE - RECOVER OLD POINTER
	CALLRET TYPEMC		;TYPE COMMAND AND RETURN

IFTRUE:	CALL SPACE		;TRUE - GOBBLE SPACES
	HRRZ A,BP		;GET ADDRESS OF CURRENT POINTER
	HRRZ B,0(P)		;ADDRESS OF OLD POINTER
	SUBI A,0(B)		;FIND THE DIFFERENCE
	IMULI A,5		;THERE ARE FIVE BYTES PER WORD
	LDB B,[POINT 6,0(P),5]	;GET BYTE NUMBER OF OLD POINTER
	LDB C,[POINT 6,BP,5]	;GET BYTE NUMBER OF CURRENT POINTER
	SUBI B,0(C)		;FIND THE DIFFERENCE
	IDIVI B,7		;THERE ARE SEVEN BITS PER BYTE
	ADDI A,0(B)		;CALCULATE BYTE DIFFERENCE
	MOVNI C,0(A)		;PUT NEGATIVE OF NUMBER IN C
	POP P,B			;RECOVER OLD POINTER
	MOVEI A,.PRIOU		;PRIMARY OUTPUT DEVICE
	SOUT			;OUTPUT JUST ENOUGH BYTES
	TMSG <
>				;TERMINATE WITH CRLF
	MOVE Q1,STKPTR(X)	;GET PARAMETER STACK POINTER
	AOBJP Q1,TOOMNY		;CHECK FOR RECURSION
	MOVE Q2,PARPTR(X)	;GET CURRENT PARAMETER POINTER
	MOVEM Q2,0(Q1)		;AND SAVE IT AWAY
	MOVEM Q1,STKPTR(X)	;SAVE THE STACK POINTER
	MOVEM BP,PARPTR(X)	;AND SAVE NEW BYTE POINTER
	TXO F,F.SUPR!F.COL1	;SAY NO PARAMETER SUBSTITUTION AND COLUMN 1
	RET			;AND RETURN (WITH OUR FINGERS CROSSED)

IFERR:	POP P,Q1		;ERROR IN IF COMMAND - POP OLD POINTER
	TMSG <
?MICIIC - Invalid IF Condition: >
	CALL TYPEMC		;TELL HIM HE BLEW IT
	TMSG <
>
	RET			;AND RETURN
	SUBTTL	batch/MIC command and dispatch table

DEFINE XX (ARG1,ARG2) <
	IFNB <ARG2>,<XWD [ASCIZ/ARG1/],T'ARG2>
	IFB <ARG2>,<XWD [ASCIZ/ARG1/],T'ARG1>>

	..YY==0


DEFINE YY (ARG) <
	T'ARG==..YY
	..YY==..YY+1
	EXP $'ARG>

COMTBL:	XWD NCOM,NCOM
	XX (BACKTO)
	XX (CHKPNT,NOOP)
	XX (ERROR)
	XX (GOTO)
	XX (IF)
	XX (MESSAGE,NOOP)
	XX (NOERROR)
	XX (NOOPERATOR)
	XX (OPERATOR)
;	XX (PLEASE)
	XX (REQUEUE,NOOP)
	XX (REVIVE,NOOP)
	XX (SILENCE,NOOP)
	NCOM==.-COMTBL-1

DISPCH:	YY NOOP
	YY BACKTO
	YY ERROR
	YY GOTO
	YY IF
	YY NOERROR
	YY NOOPERATOR
	YY OPERATOR
;	YY PLEASE
	SUBTTL PTY handling code

CHKPTY:	SKIPE PTYJFN		;DO WE HAVE A PTY?
	 RET			;YES - JUST RETURN
	MOVE A,['PTYPAR']	;NAME OF PTY PARAMETER TABLE
	SYSGT			;GET PTY PARAMETERS
	MOVEM A,PTYPAR		;SAVE THEM FOR FUTURE REFERENCE
	CALL GETPTY		;GET US A PSEUDO TELETYPE
	 RET			;FAILED - CANNOT HANDLE ERRORS
	MOVEM A,PTYJFN		;SAVE THE JFN OF THE PTY
	DVCHR			;GET THE DEVICE CHARACTERISTICS OF PTY
	ADD A,PTYPAR		;CONVERT TO TERMINAL LINE NUMBER
	ADDI A,.TTDES		;CONVERT DEVICE TO TERMINAL DESIGNATOR
	HRRZM A,PTYLIN		;SAVE THE LINE NUMBER OF THE PTY
	HRRZ A,PTYJFN		;GET PTY'S JFN
	MOVX B,MO%OIR!FLD(<5-1>,MO%SIC)+.MOAPI ;PI CHANNEL 5 FOR O/P READY
	MTOPR			;SET IT UP
	MOVEI A,.FHSLF		;OUR FORK
	MOVX B,1B5		;THE NEW CHANNEL
	AIC			;ENABLE IT
	MOVX A,TL%SAB!TL%ABS	;ENABLE TERMINAL LINKING
	HRR A,PTYLIN		; FOR THE PTY
	TLINK			;DO IT
	 ERCAL BDJSYS		;FAILED
	MOVX A,TL%EOR+.CTTRM	;O/P FROM OUR TERMINAL
	MOVE B,PTYLIN		;IS TYPED ON PTY
	TLINK			;SET IT UP
	 ERCAL BDJSYS		;FAILED
	RET			;RETURN

GETPTY:	MOVE A,[ASCII /PTY/]	;GET ASCII "PTY"
	MOVEM A,CTLBUF		;PUT IN BEGINNING OF A BUFFER
	HLRZ Q1,PTYPAR		;GET NUMBER OF PTYS IN Q1
	MOVNS Q1		;MAKE IT A NEGATIVE NUMBER
	MOVSI Q1,0(Q1)		;AND CONVERT TO AN AOBJN WORD

GETP1:	MOVE A,[POINT 7,CTLBUF,20] ;POINTER TO CHARACTER AFTER "PTY"
	MOVEI B,0(Q1)		;GET NEXT PTY NUMBER
	MOVEI C,10		;RADIX 8
	NOUT			;CONVERT NUMBER TO ASCII
	 JFCL			;IGNORE ANY ERROR
	MOVEI B,":"		;FOLLOW WITH A COLON
	IDPB B,A		;PLACE CHAR IN BUFFER
	SETZ B,			;NULL CHARACTER
	IDPB B,A		;PLACE CHAR IN BUFFER
	MOVX A,GJ%ACC!GJ%SHT	;GET A JFN WHICH LOWER PROCESS CAN'T SEE
	HRROI B,CTLBUF		;FILE NAME IN BUFFER
	GTJFN			;GET THE JFN
	 JRST GETP3		;COULDN'T GET IT
	PUSH P,A		;SAVE JFN ON STACK
	MOVX B,FLD(7,OF%BSZ)!OF%RD!OF%RTD ;ASCII EXCLUSIVE READ ACCESS
	OPENF			;OPEN THE PTY
	 JRST GETP2		;COULDN'T--TRY NEXT PTY
	POP P,A			;RESTORE JFN
	RETSKP			;[TCO 5.1209] SKIP RETURN TO CALLER WITH JFN IN A

GETP2:	POP P,A			;RECOVER JFN
	RLJFN			;RELEASE IT
	 JFCL			;IGNORE ERROR
GETP3:	AOBJN Q1,GETP1		;GO BACK FOR ANOTHER PTY
	TMSG <
%MICCGP -  Couldn't get a PTY
>				;TELL USER WE FAILED
	SETZM ERRCHR(X)		;AND PRETEND WE DIDN'T SEE @ERROR
	SETZM OPRCHR(X)		;OR @OPERATOR
	SETZ A,			;AND SAY WE DON'T HAVE A PTY
	RET			;AND RETURN
;PUTLIN - puts the line in LINBUF out either using STI (for input)
;				OR PSOUT (for output)

PUTLIN:	TXNN F,F.MON		;MONITOR COMMAND?
	 JRST PUTLN2		;NO - CONTINUE
	CALL CHKMON		;YES - ARE WE IN MONITOR MODE?
	 CAIA			;YES - DON'T NEED TO TYPE CONTROL-C
	  CALL PUTCC		;NO - OUTPUT ONE
PUTLN2:	SKIPE WD,LABEL(X)	;WAS THERE A LABEL ON THIS LINE?
	 CALL PUTLAB		;YES - PUT IT OUT
	TXNE F,F.CMNT		;A COMMENT (TO BE OUTPUT)?
	JRST PUTCMN		;YES - OUTPUT THAT
	MOVEI A,.PRIIN		;NO - SET UP FOR STI JSYS
PUTLN1:	ILDB B,BP		;LOAD NEXT BYTE
	JUMPE B,R		;ALL DONE ON NULL BYTE
	STI			;TYPE THE CHAR
	 ERJMP [MOVEI A,100	;ERROR -  SLEEP FOR 100MS
		DISMS		;IN CASE IT IS BUFFER FULL
		MOVEI A,.PRIIN	;RESTORE A FOR STI
		JRST .-1]	;AND TRY IT AGAIN
	MOVE CF,CHRTAB(B)	;GET CHARACTER FLAGS
	TXNN CF,C.SBRK		;SHOULD WE PAUSE ON THIS CHAR?
	 JRST PUTLN1		;NO - GO GET NEXT CHAR
	MOVEI A,^D2000		;YES - SLEEP FOR A WHILE
	DISMS			;SO WE CAN BE INTERRUPTED
	MOVEI A,.PRIIN		;RESTORE AC FOR STI JSYS
	JRST PUTLN1		;AND BACK FOR MORE

PUTCMN:	MOVE A,BP		;GET ADDRESS OF THE LINE TO BE TYPED
	PSOUT			;TYPE IT
	TXZE F,F.CLCM		;DO WE WANT TO CLEAR COMMENT FLAG?
	 TXZ F,F.CMNT		;YES - CLEAR IT
	RET			;RETURN

PUTCC:	MOVEI Q1,100		;MAXIMUM OF 10 SECONDS
	MOVEI B,3		;SEND CONTROL-C
	MOVEI A,.PRIIN		;PRIMARY INPUT
	STI			;FORCE IT OUT
	 ERJMP [MOVEI A,100	;ERROR -  SLEEP FOR 100MS
		DISMS		;IN CASE IT IS BUFFER FULL
		MOVEI A,.PRIIN	;RESTORE A FOR STI
		JRST .-1]	;AND TRY IT AGAIN
	MOVEI Q1,^D20		;MAXIMUM  NO. OF SECS TO WAIT
PUTCC1:	CALL CHKMON		;ARE WE THERE YET?
	 RET			;YES - WE ARE DONE - RETURN
	MOVEI A,^D100		;NO - AND WAIT 100 MILLISECS
	DISMS			;..
	SOJG Q1,PUTCC1		;AND GO WAIT
	RET			;CAN'T HELP HARD LUCK

PUTLAB:	CALL PUTSIX		;OUTPUT WD IN SIXBIT
	TMSG <::
>
	RET			;OUTPUT THE COLONS AND RETURN

PUTSIX:	PUSH P,Q1		;SAVE AN AC
	PUSH P,Q2		; OR TWO
	MOVE Q2,WD		;GET WORD INTO Q2
PUTSX1:	SETZ Q1,		;WHERE WE WILL PUT CHAR
	LSHC Q1,6		;GET NEXT CHAR
	MOVEI A," "(Q1)		;GET ASCII CHAR INTO A
	PBOUT			;AND OUTPUT IT
	JUMPN Q2,PUTSX1		;CONTINUE TILL DONE
	POP P,Q2		;RESTORE THE ACS
	POP P,Q1		; ..
	RET			;THEN RETURN
GETCHR:	CALL GETCH		;GET A BASIC CHAR
	 RET			;END OF FILE
	CAIN B,"'"		;PARAMETER?
	 TXNE F,F.SUPR		;AND NOT SUPPRESSING PARAMETERS?
	  JRST GTCHR1		;NO - GIVE CALLER THE CHAR
	CALL GETCH		;YES - GET NEXT CHAR
	 RET			;END OF FILE
	CAIN B,"'"		;A SECOND PRIME?
	 JRST GTCHR1		;YES - GIVE USER THE PRIME
	CALL LOWUP		;CONVERT TO UPPER-CASE
	 JRST [MOVEM B,SAVCHR(X) ;WASN'T LETTER SAVE THIS CHAR
		MOVEI B,"'"	;RESTORE THE PRIME
		JRST GTCHR1]	;AND RETURN TO OUR CALLER
	MOVE Q1,STKPTR(X)	;NO - GET PARAMETER STACK POINTER
	AOBJP Q1,TOOMNY		;CHECK FOR RECURSION
	MOVE Q2,PARPTR(X)	;GET CURRENT PARAMETER POINTER
	MOVEM Q2,0(Q1)		;AND SAVE IT AWAY
	MOVEM Q1,STKPTR(X)	;SAVE THE STACK POINTER
	ADDI B,PARAM(X)		;POINT TO PARAMETER AREA
	MOVE Q1,-"A"(B)		;GET NEW PARAMETER POINTER
	MOVEM Q1,PARPTR(X)	;AND SAVE IT AWAY
	JRST GETCHR		;GET NEXT CHAR (USING NEW PARAMETER)

GTCHR1:	MOVE CF,CHRTAB(B)	;GET CHARACTERISTICS
	RETSKP			;[TCO 5.1209] AND GIVE GOOD RETURN

GETCH:	SKIPE B,SAVCHR(X)	;IS THERE A SAVED CHAR?
	JRST [SETZM SAVCHR(X)	;YES - CLEAR IT DOWN
		RETSKP]		;[TCO 5.1209] AND GIVE A SKIP RETURN
GTCH1:	SKIPE PARPTR(X)		;ARE WE READING A PARAMETER?
	 JRST GETPCH		;YES - GET A PARAMETER CHAR
	CALLRET GETFIL		;GET CHAR FROM FILE; SKIP OR NORMAL RETURN

GETPCH:	ILDB B,PARPTR(X)	;GET NEXT CHAR
	JUMPN B,RSKP		;NON-ZERO MEANS WE HAVE A CHAR
	MOVE Q1,STKPTR(X)	;NULL MEANS WE ARE DONE WITH THIS PARAMETER
	POP Q1,PARPTR(X)	;GET THE NEXT PARAMETER FROM THE STACK
	MOVEM Q1,STKPTR(X)	;RE-SAVE THE POINTER
	TXZ F,F.SUPR		;NO LONGER SUPPRESSING PARAMETER SUBSTITUTION
	JRST GTCH1		;AND GO GET A CHAR

GETFIL:	ILDB B,FILPTR(X)	;GET NEXT CHAR
	 JUMPE B,CHKEOF		;IF NUL - CHECK FOR EOF
	RETSKP			;[TCO 5.1209] OTHERWISE SUCCESS RETURN

CHKEOF:	MOVE A,MICJFN(X)	;GET FILE'S JFN
	GTSTS			;GET FILE STATUS
	TXNN B,GS%EOF		;END OF FILE?
	 JRST GETFL2		;NO - GET NEXT LINE
	RET			;YES - EOF (NON-SKIP) RETURN

GETFL2:	MOVX Q1,RD%JFN		;JFN SUPPLIED
	MOVEM Q1,TXTIBK+.RDFLG	;SAVE IT
	MOVE Q1,MICJFN(X)	;THE FILE'S JFN
	HRLZM Q1,TXTIBK+.RDIOJ	;WHERE TEXTI NEEDS IT
	MOVE Q1,[POINT 7,FILTXT(X)] ;SET UP BYTE POINTER
	MOVEM Q1,TXTIBK+.RDDBP	;WHERE TEXTI NEEDS IT
	MOVEI Q1,TXTLEN*5-2	;HOW MUCH SPACE THERE IS
	MOVEM Q1,TXTIBK+.RDDBC	;SAVE IT FOR TEXTI
	MOVEI A,TXTIBK		;WHERE THE TEXTI BLOCK IS
	TEXTI			;DO THE JSYS
	 JFCL			;IGNORE ERRORS - WE WILL CHECK LATER
	SETZ Q1,		;MAKE SURE ASCIZ
	IDPB Q1,TXTIBK+.RDDBP	;DONE
	MOVE Q1,[POINT 7,FILTXT(X)] ;SET UP BYTE POINTER
	MOVEM Q1,FILPTR(X)	;TO START OF TEXT
	JRST GETFIL		;AND GO GET THE CHAR
LOWUP:	CAIG B,"z"		;GREATER THAN LOWER-CASE Z?
	CAIGE B,"a"		;OR LESS THAN LOWER-CASE A?
	CAIA			;YES - DON'T CONVERT
	TRZ B,40		;NO - MAKE UPPER CASE
	CAIG B,"Z"		;A LETTER?
	CAIGE B,"A"		;WELL?
	RET			;NO - NON-SKIP RETURN
	RETSKP			;[TCO 5.1209] YES - SKIP RETURN
	SUBTTL END OF FILE PROCESSING

EOF:	MOVEI A,.FHSLF		;OUR FORK
	DIR			;DISABLE INTERRUPT SYSTEM
	SKIPE LSTPDB(X)		;DO WE HAVE A PREVIOUS PDB?
	 JRST EOF2		;YES - DON'T SAY EOF
	SKIPN PTYJFN		;DID WE HAVE A PTY?
	 JRST EOF1		;NO - DON'T RELEASE IT
	MOVEI A,.FHSLF		;YES - DE-ACTIVATE PTY INTERRUPT CHANNEL
	MOVX B,1B5		;CORRECT CHANNEL
	DIC			;NO MORE INTERRUPTS
	MOVX A,TL%CRO!TL%COR+.CTTRM ;SET TO BREAK THE LINK
	MOVE B,PTYLIN		;FROM THE PTY
	MTOPR			;TO THE TTY
	 ERJMP .+1		;IGNORE ANY ERRORS
	MOVE A,PTYJFN		;GET PTY'S JFN
	CLOSF			;AND CLOSE IT
	 ERJMP .+1		;IGNORE ERRORS
	SETZM PTYJFN		;NO LONGER HAVE A PTY
EOF1:	MOVE A,DOSWT(X)		;GET DO COMMAND SWITCHES
	TXNE A,DO.SUP		;WANT MESSAGE SUPPRESSED?
	 JRST EOF2		;YES - DON'T PRINT IT
	TMSG <
[MICEMF - End of MIC File: >	;PRINT MESSAGE
	MOVEI A,.PRIOU		;WHERE TO PRINT MESSAGE
	MOVE B,MICJFN(X)	;THE FILE NAME
	SETZ C,			;DEFAULT STRING
	JFNS			;PRINT STRING
	TMSG < ]
>				;GIVE HIM A NEW-LINE
EOF2:	HRRZ A,MICJFN(X)	;GET THE JFN OF THE FILE
	CLOSF			;AND CLOSE IT
	ERCAL BDJSYS		;ERROR - TELL THE WORLD
	MOVE Q1,LSTPDB(X)	;SAVE PREVIOUS PDB ADDRESS
	MOVE B,X		;GET OUR CURRENT PDB
	LSH B,-^D9		;MAKE IT INTO PAGE
	HRLI B,.FHSLF		;OUR FORK
	SETO A,			;SET TO UNMAP PAGE
	SETZ C,			;NO SPECIAL FLAGS
	PMAP			;UNMAP IT
	 ERCAL BDJSYS		;FAILED - REPORT IT
	SOS MCPAG		;WE ARE NOW BACK ONE PAGE
	MOVEI A,.FHSLF		;OUR FORK
	MOVE X,Q1		;GET PREVIOUS PDB INTO X
	EIR			;ENABLE INTERRUPT SYSTEM
	JUMPE X,EOF3		;IF NO PREVIOUS PDB, WE ARE DONE
	SKIPN ERRCHR(X)		;DOES OUTER PROCESS WANT TO SEE ERRORS?
	 TXZ F,F.ERR		;NO - CLEAR ANY ERROR INDICATION
	ANDX F,F.BRK!F.ERR	;REMEMBER RELEVANT BITS
	IOR F,FSAV(X)		;AND MERGE IN OLD FLAG WORD
	JRST WAIT		;AND GO BACK TO WAITING

EOF3:	MOVEI A,.TICCA		;CHANNEL 1 IS FOR CONTROL-A
	DTI			;DISABLE THAT CHAR
	MOVEI A,.TICCB		;CHANNEL 2 IS FOR CONTROL-B
	DTI			;DISABLE THAT CHAR
	MOVEI A,.TICCP		;CHANNEL 3 IS FOR CONTROL-P
	DTI			;DISABLE THAT CHAR
	MOVEI A,.TICCX		;CHANNEL 35 IS FOR CONTROL-X
	DTI			;DISABLE THAT CHAR
EOFWPC:	WAIT%			;WAIT FOR AN INTERRUPT
	ERCAL BDJSYS		;SHOULD NEVER GET HERE
	SUBTTL	SUBROUTINES

CHKMON:	SETO A,			;-1 MEANS OUR JOB
	HRROI B,GJIBLK		;BLOCK TO STORE THE REQUIRED INFO
	MOVEI C,.JIT20		;MONITOR-MODE BIT
	GETJI			;GET IT
	 ERCAL BDJSYS		;WE BLEW IT!!
	SKIPN GJIBLK		;-1 MEANS "MONITOR-MODE"
	 AOS (P)		;NO - WE ARE NOT IN MONITOR MODE
	RET			;YES - WE ARE - GIVE NON-SKIP RETURN
	SUBTTL	ERROR MESSAGES

TOOMNY:	TMSG <
?MICPND - Parameters Nested too Deeply - Aborting
>
	JRST EOF

BDJSYS:	AOSE ERRLP		;IS THIS THE SECOND ERROR?
	JRST [TMSG <
?MICTME - Too Many Errors - MIC will exit
>				;TELL HIM WE ARE TRULLY DEAD
		SETO A,		;CLOSE ALL FILES
		CLOSF		;DO IT
		 JFCL		;IGNORE ERRORS THIS TIME
		HALTF		;AND EXIT
		JRST .-1]	;ALL DONE
	TMSG <
?MICJSE - JSYS Error: >		;OUTPUT ERROR MESSAGE
	MOVX A,.PRIOU		;PRIMARY OUTPUT FOR ERROR
	HRLOI B,.FHSLF		;OUR FORK,,LAST ERROR
	ERSTR			;GIVE HIM ERROR MESSAGE
	 JFCL			;IGNORE ERRORS
	 JFCL
	TMSG <
>				;GIVE HIM A NEW-LINE
	JRST EOF2		;LOOK LIKE END OF FILE
	SUBTTL	INTERRUPT CODE

MICABT:	TXOE F,F.ABT		;ARE WE ALREADY ABORTED?
	JRST MICAB1		;YES - JUST DISMISS THIS INTERRUPT
	MOVEI A,EOF		;CHANGE THE PC FOR THE DEBRK
	MOVEM A,LVL1PC		;DO IT
	TMSG <
[MICABT - MIC is aborting]
>				;TELL HIM WHAT WE ARE DOING
MICAB1:	DEBRK			;BACK TO EOF
	 ERCAL BDJSYS		;WE BLEW IT

MICBRK:	TXOE F,F.BRK		;ARE WE ALREADY IN A BREAK?
	 JRST MICBK1		;YES - DON'T RETYPE MESSAGE
	PUSH P,A		;SAVE AN AC
	TMSG <
[MICBRK - MIC is breaking]
>				;TELL USER WE ARE BREAKING
	POP P,A			;RESTORE THE AC
MICBK1:	DEBRK			;YES - DISMISS INTERRUPT
	ERCAL BDJSYS		;HOW DID WE GET HERE!!!!?

MICPRC:	TXZN F,F.BRK		;ARE WE IN A BREAK?
	JRST MICPC1		;NO - JUST DISMISS INTERRUPT
	PUSH P,A
	TMSG <
[MICPRC - MIC is proceeding]
>				;TELL USER WE ARE CONTINUING
	POP P,A
MICPC1:	DEBRK			;DISMISS THE INTERRUPT
	 ERCAL BDJSYS		;WE BLEW IT

MICXCT:	TXNE F,F.BRK		;ARE WE IN A BREAK?
	 TXO F,F.XCT		;YES - LIGHT THE EXECUTE FLAG
	DEBRK			;AND DISMISS INTERRUPT
	ERCAL BDJSYS		;WHAT!!!

MICTYP:	TXO F,F.TYP		;SAY WE GOT AN INPUT READY INTERRUPT
	PUSH P,A		;SAVE AN AC
	HRRZ A,LVL1PC		;GET WHERE WE WERE
	CAIN A,WAITPC		;IS IT THE DISMS IN WAIT?
	JRST [MOVEI A,WAIT	;YES - CHANGE IT TO THE BEGINNING
		MOVEM A,LVL1PC	;SO THAT WE STOP SLEEPING
		JRST .+1]	;AND RETURN TO MAIN-LINE CODE
	POP P,A			;RESTORE THE AC WE USED
	DEBRK			;AND RETURN
	 ERCAL BDJSYS		;BLEW IT!

MICNST:				;HERE WHEN WE RECEIVE A NESTED CALL FROM EXEC
	MOVEM F,FSAV(X)		;SAVE OUR FLAG WORD
	AOS MCPAG		;GO TO NEXT PAGE
	SETZM ERRLP		;ZERO RECURSIVE ERROR FLAG
				;RE-ASSIGN TERMINAL CODES IN CASE GONE AWAY
	MOVE A,[.TICCA,,1]	;CHANNEL 1 IS FOR CONTROL-A
	ATI			;ENABLE THAT CHAR
	MOVE A,[.TICCB,,2]	;CHANNEL 2 IS FOR CONTROL-B
	ATI			;ENABLE THAT CHAR
	MOVE A,[.TICCP,,3]	;CHANNEL 3 IS FOR CONTROL-P
	ATI			;ENABLE THAT CHAR
	MOVE A,[.TICCX,,^D35]	;CHANNEL 35 IS FOR CONTROL-X
	ATI			;ENABLE THAT CHAR
	MOVEI A,.FHSLF		;OUR FORK
	DIR			;DISABLE THE INTERRUPT SYSTEM FOR A WHILE
				;(MIC1 TURNS IT ON AGAIN)
	MOVEI A,MIC1		;GET ADDRESS OF WHERE TO RESTART
	HRRM A,LVL1PC		;AND MAKE IT LOOK LIKE OLD PC
	DEBRK			;DISMIS INTERRUPT
	 ERCAL BDJSYS		;WE BLEW IT
PTYOUT:	ADJSP P,4		;MAKE ROOM FOR SOME ACS
	DMOVEM A,-3(P)		;SAVE A AND B
	DMOVEM C,-1(P)		;AND C AND D
PTYOU1:	MOVE A,PTYLIN		;GET LINE NUMBER OF PTY
	SOBE			;IS ANYTHING THERE ?
	 SKIPA			;YES--ENTER CODE TO GET IT
	  JRST PTYOU3		;NO--GO RESUME PROGRAM
	MOVE A,PTYJFN		;GET JFN OF PTY
	CAILE B,PTYSIZ*5	;TOO MANY CHARACTERS FOR BUFFER ?
	 MOVEI B,PTYSIZ*5	;YES--GET MAXIMUM SIZE
	PUSH P,B		;[TCO 5.1121] REMEMBER FOR LATER
	MOVE C,B		;NUMBER OF CHARACTERS
	HRROI B,CTLBUF		;POINTER TO PTY INPUT BUFFER
	MOVEI D,.CHLFD		;READ UNTIL LINEFEED
	SIN			;GET A STRING FROM PTY
	EXCH B,(P)		;[TCO 5.1121] SAVE TERMINATING BYTE POINTER
				;[TCO 5.1121] AND GET ORIGINAL NUMBER OF CHARS
	TXNN F,F.LNFD		;[TCO 5,1121] FIRST CHAR AT START OF LINE ?
	 JRST PTYOU2		;NO--DON'T DO ERROR CHECKING
	MOVE A,[POINT 7,CTLBUF]	;[TCO 5.1121] SET UP BYTE POINTER TO BUFFER
	SUB B,C			;[TCO 5.1121] GET NUMBER OF CHARACTERS READ
PTYOU4:	ILDB D,A		;[TCO 5.1121] GET NEXT CHARACTER
	JUMPE D,[SOJG B,PTYOU4	;[TCO 5.1121] IF NUL, LOOK AT NEXT
				;[TCO 5.1121] UNLESS EXHAUSTED COUNTER
		POP P,(P)	;[TCO 5.1121] EXHAUSTED COUNTER,CLEAN UP STACK
		JRST PTYOU1]	;[TCO 5.1121] CANNOT HAVE ERROR/OPERATOR
				;[TCO 5.1121]  CHARACTER OR LINEFEED
	CAMN D,OPRCHR(X)	;IS IT THE "OPERATOR" CHARACTER ?
	 JRST [TXO F,F.OPER	;YES - SAY WE HAVE SEEN THE OPER CHAR
		MOVEI A,.FHSLF	;SET UP FOR SOFTWARE INTERRUPT
		MOVX B,1B2	;ASSUME ITS A "BREAK"
		IIC		;GIVE OURSELVES AN INTERRUPT
		MOVEI A,100	;WAIT FOR IT
		DISMS		;..
		JRST .+1]	;AND CONTINUE
	SKIPG ERRCHR(X)		;ARE WE PAYING ATTENTION TO ERRORS ?
	 JRST PTYOU2		;NO--SKIP THE TEST
	CAIE D,"?"		;IS CHAR A QUESTION MARK ?
	CAMN D,ERRCHR(X)	;OR IS IT THE SELECTED ERROR CHAR ?
	 TXO F,F.ERR		;MARK THAT AN ERROR HAS OCCURRED

PTYOU2:	TXZ F,F.LNFD		;[TCO 5.1121] ASSUME LINE DOESN'T END WITH <LF>
	POP P,B			;[TCO 5.1121] RESTORE TERMINATING BYTE POINTER
	LDB D,B			;GET LAST CHARACTER IN BUFFER
	CAIE D,.CHLFD		;IS IT A LINEFEED ?
	 JRST PTYOU1		;NO - GO BACK FOR MORE
	TXO F,F.LNFD		;YES, MARK IT
	TXZE F,F.TI		;HAVE WE BEEN IN TI
	TXZN F,F.OPER		;AND DID WE SEE THE OPER CHAR?
	 JRST PTYOU1		;NO - GO BACK FOR MORE
	MOVEI A,.FHSLF		;SET UP FOR SOFTWARE INTERRUPT
	MOVX B,1B3		;SAY PROCEED
	IIC			;GIVE OURSELVES AN INTERRUPT
	MOVEI A,100		;WAIT FOR IT
	DISMS			;..
	JRST PTYOU1		;AND BACK FOR MORE

PTYOU3:	DMOVE C,-1(P)		;RESTORE C AND D
	DMOVE A,-3(P)		;RESTORE A AND B
	ADJSP P,-4		;DEALLOCATE SPACE ON STACK
	DEBRK			;DISMISS THE INTERRUPT
	SUBTTL CHAR - character table

	C.SPEC==1B0		;THIS CHARACTER IS SPECIAL
	C.CMNT==1B1		;THIS CHARACTER IS A COMMENT CHAR
	C.MON==1B2		;THIS CHARACTER IS THE MONITOR-MODE CHAR
	C.USER==1B3		;THIS CHARACTER IS THE USER-MODE CHAR
	C.LABL==1B4		;THIS CHARACTER IS THE LABEL CHAR
	C.SPRS==1B5		;THIS CHARACTER MEANS SUPPRESS <CR><LF>
	C.BRK==1B6		;THIS CHARACTER IS A BREAK CHAR
	C.PARM==1B7		;THIS CHARACTER DONOTES A PARAMETER
	C.COL1==1B8		;THIS CHARACTER IS SPECIAL IN COL-1
	C.CRET==1B9		;THIS IS THE <CR> CHARACTER
	C.LNFD==1B10		;THIS IS THE <LF> CHARACTER
	C.ALPH==1B11		;THIS IS A VALID LABEL CHARACTER
	C.SBRK==1B12		;THIS IS A SPECIAL BREAK (MUST PAUSE ON IT)

	DEFINE CHX(BITS,ADDRESS<0>),<
	EXP BITS!ADDRESS>


CHRTAB:	0			;(0) <NULL>
	CHX C.BRK!C.SBRK	;(1) CONTROL-A
	CHX C.BRK!C.SBRK	;(2) CONTROL-B
	CHX C.BRK		;(3) CONTROL-C
	0			;(4) CONTROL-D
	0			;(5) CONTROL-E
	0			;(6) CONTROL-F
	CHX C.BRK		;(7) CONTROL-G (BELL)
	0			;(10) CONTROL-H
	0			;(11) <TAB>
	CHX C.SPEC!C.BRK!C.LNFD,LNFEED ;(12) <LF>
	CHX C.SPEC!C.BRK,VTAB	;(13) <VT>
	CHX C.SPEC!C.BRK,FFEED	;(14) <FF>
	CHX C.SPEC!C.CRET,CRET	;(15) <CR>
	0			;(16) CONTROL-N
	0			;(17) CONTROL-O
	0			;(20) CONTROL-P
	0			;(21) <XOFF>
	0			;(22) CONTROL-R
	0			;(23) <XOFF>
	0			;(24) CONTROL-T
	0			;(25) CONTROL-U
	0			;(26) CONTROL-V
	0			;(27) CONTROL-W
	0			;(30) CONTROL-X
	0			;(31) CONTROL-Y
	CHX C.BRK		;(32) CONTROL-Z
	CHX C.BRK		;(33) <ESC>
	0			;(34) CONTROL-\
	0			;(35) CONTROL-]
	0			;(36) CONTROL-^
	0			;(37) CONTROL-_
	0			;(40) SPACE
	CHX C.CMNT!C.COL1,COMNT	;(41) !
	0			;(42) "
	0			;(43) #
	0			;(44) $
	CHX C.ALPH		;(45) %
	0			;(46) &
	CHX C.PARM		;(47) '
	0			;(50) (
	0			;(51) )
	CHX C.USER!C.COL1,USRMOD ;(52) *
	0			;(53) +
	0			;(54) ,
	0			;(55) -
	0			;(56) .
	0			;(57) /
	CHX C.ALPH		;(60) 0
	CHX C.ALPH		;(61) 1
	CHX C.ALPH		;(62) 2
	CHX C.ALPH		;(63) 3
	CHX C.ALPH		;(64) 4
	CHX C.ALPH		;(65) 5
	CHX C.ALPH		;(66) 6
	CHX C.ALPH		;(67) 7
	CHX C.ALPH		;(70) 8
	CHX C.ALPH		;(71) 9
	CHX C.SPEC!C.LABL,GTLAB ;(72) :
	CHX C.CMNT!C.COL1,COMNT	;(73) ;
	0			;(74) <less>
	CHX C.SPRS!C.COL1,SUPPRS ;(75) =
	0			;(76) <greater>
	0			;(77) ?
	CHX C.MON!C.COL1,MONMOD	;(100) @
	CHX C.ALPH		;A
	CHX C.ALPH		;B
	CHX C.ALPH		;C
	CHX C.ALPH		;D
	CHX C.ALPH		;E
	CHX C.ALPH		;F
	CHX C.ALPH		;G
	CHX C.ALPH		;H
	CHX C.ALPH		;I
	CHX C.ALPH		;J
	CHX C.ALPH		;K
	CHX C.ALPH		;L
	CHX C.ALPH		;M
	CHX C.ALPH		;N
	CHX C.ALPH		;O
	CHX C.ALPH		;P
	CHX C.ALPH		;Q
	CHX C.ALPH		;R
	CHX C.ALPH		;S
	CHX C.ALPH		;T
	CHX C.ALPH		;U
	CHX C.ALPH		;V
	CHX C.ALPH		;W
	CHX C.ALPH		;X
	CHX C.ALPH		;Y
	CHX C.ALPH		;Z
	0			;[
	0			;\
	0			;]
	CHX C.SPEC,CNTRL	;^
	0			;_
	0			;`
	CHX C.ALPH		;a
	CHX C.ALPH		;b
	CHX C.ALPH		;c
	CHX C.ALPH		;d
	CHX C.ALPH		;e
	CHX C.ALPH		;f
	CHX C.ALPH		;g
	CHX C.ALPH		;h
	CHX C.ALPH		;i
	CHX C.ALPH		;j
	CHX C.ALPH		;k
	CHX C.ALPH		;l
	CHX C.ALPH		;m
	CHX C.ALPH		;n
	CHX C.ALPH		;o
	CHX C.ALPH		;p
	CHX C.ALPH		;q
	CHX C.ALPH		;r
	CHX C.ALPH		;s
	CHX C.ALPH		;t
	CHX C.ALPH		;u
	CHX C.ALPH		;v
	CHX C.ALPH		;w
	CHX C.ALPH		;x
	CHX C.ALPH		;y
	CHX C.ALPH		;z
	0			;{
	0			;|
	0			;}
	0			;~
	0			;<DEL>
	SUBTTL	DATA AND STORAGE

BRKLST:	EXP 2,3,12,13,14,15,33
	BRKLEN==.-BRKLST

ERRLP:	EXP -1			;ERROR COUNT

LEVTAB:	EXP LVL1PC		;WHERE TO STORE THE PC & FLAGS
	EXP LVL2PC
	EXP LVL3PC

CHNTAB:	XWD 1,MICNST		;(0) NESTED CALL INTERRUPT - FROM EXEC
	XWD 1,MICABT		;(1) CONTROL-A INTERRUPT
	XWD 1,MICBRK		;(2) CONTROL-B INTERRUPT
	XWD 1,MICPRC		;(3) CONTROL-P INTERRUPT
	XWD 1,MICTYP		;(4) WAITING FOR INPUT INTERRUPT
	XWD 2,PTYOUT		;(5) OUTPUT AVAILABLE ON PTY
	BLOCK ^D29		;(6-34) NOT ASSIGNED
	XWD 1,MICXCT		;(35) SINGLE STATEMENT EXECUTE

LVL1PC:	0
LVL2PC:	0
LVL3PC:	0

GJIBLK:	BLOCK 1			;WHERE TO STORE SUB-SYSTEM NAME

TXTIBK:	EXP 4			;ARGUMENT BLOCK FOR TEXTI
	BLOCK 4			;ONLY NEED FIRST 4 WORDS

COMBUF:	BLOCK 20		;ENOUGH SPACE FOR A COMMAND STRING

PTYJFN:	0			;JFN OF "ERROR" PTY

PTYPAR:	0			;PTY PARAMETERS

PTYLIN:	0			;LINE NUMBER OF PTY

	PTYSIZ==100		;MAX LENGTH OF LINE (WORDS)
CTLBUF:	BLOCK PTYSIZ		;SPACE FOR LOGGING ETC.

	PDL==100

PDP:	BLOCK PDL
	SUBTTL literals and variables

	XLIST			;SUPPRESS LISTING
	LIT			;ALL LITERALS
	VAR			;ALL VARIABLES
	LIST			;RESTORE LISTING

MICEND:				;WHERE THE INFERIOR FORK ENDS


	END

;Local Modes:.
;Mode:MACRO.
;Comment Start:;.
;Comment Begin:; .
;End:.