Trailing-Edge
-
PDP-10 Archives
-
BB-FT68G-SM
-
exec/execmi.mac
There are 16 other files named execmi.mac in the archive. Click here to see a list.
;EDIT 942 - FIX SUPPRESS SWITCH IN DO COMMAND
; UPD ID= 120, SNARK:<5.EXEC>EXECIN.MAC.21, 28-Dec-81 11:14:01 by CHALL
;TCO 5.1644 - UPDATE COPYRIGHT NOTICE
; UPD ID= 55, SNARK:<5.EXEC>EXECMI.MAC.5, 27-Aug-81 10:20:53 by CHALL
;TCO 5.1459 .DO- MAKE MIC.MIC BE THE DEFAULT MIC FILESPEC
; UPD ID= 27, SNARK:<5.EXEC>EXECMI.MAC.2, 14-Aug-81 18:34:30 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) 1980,1981,1982 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
SEARCH EXECDE,MICPRM
TTITLE EXECMI
;THIS FILE CONTAINS ALL THE MIC RELATED COMMANDS
MIC,<
;'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
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
HRROI Q1,FILTXT(X) ;WHERE WE WANT THE TEXT
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
;**;[942] Add a label to next line YKT JAN-18-83
EOF1: MOVE A,DOSWT(X) ;[942] GET DO COMMAND SWITCHES
TXNE A,DO.SUP ;WANT MESSAGE SUPPRESSED?
JRST EOF2 ;YES - DON'T PRINT IT
;**;[942] Delete a label from next line YKT JAN-18-83
TMSG <
[MICEMF - End of MIC File: > ;[942] 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,,35] ;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
> ; MIC
END
;Local Modes:.
;Mode:MACRO.
;Comment Start:;.
;Comment Begin:; .
;End:.