Trailing-Edge
-
PDP-10 Archives
-
BB-FT68E-SM
-
exec/mic.mac
There are 19 other files named mic.mac in the archive. Click here to see a list.
TITLE MIC - MACRO INTERPRETED COMMANDS
SUBTTL F.D. Brown 27-Mar-80
SEARCH MONSYM,MACSYM,MICPRM
SALL
.REQUIRE SYS:MACREL
; AC definitions
F=0 ; flags
A=1 ; reserved for JSYS'S
B=2
C=3
D=4
CF=5 ; Character flags
T1=6 ; temporary ACS
T2=7
X=10 ; points to current process
CH=11 ; holds a char
BP=12 ; holds a byte pointer
WD=13 ; holds a sixbit word
P1=14 ; preserved ACS
P2=15
P=17 ; pushdown pointer
; 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
MIC: MOVEM 0,MICPAG# ; where the parameters are
SETZ X, ; zero X first time through
RESET ; reset the world
MOVE P,[IOWD PDL,PDP] ; setup 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 T1,MICPAG ; get page number EXEC gave us
LSH T1,^D9 ; make into address
CALL SETPRC ; setup 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 ERROR ; yes - handle it
SKIPE T1,GTOLBL(X) ; a label to GOTO?
JRST .GOTO ; yes - handle it
SKIPE T1,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 T2,PARSTK-1(T1) ; address of start of stack minus one
HRLI T2,-^D40 ; make iowd
MOVEM T2,STKPTR(T1) ; store it away
JUMPE X,SETPR1 ; if no current process - skip next bit
MOVE T2,ERRCHR(X) ; otherwise copy appropriate information
MOVEM T2,ERRCHR(T1) ; from the old process area
MOVE T2,OPRCHR(X) ; to the new process area
MOVEM T2,OPRCHR(T1) ; so they can be used there
SETPR1: MOVEM X,LSTPDB(T1) ; remember previous pdb address
MOVE X,T1 ; 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: STKVAR (LAB) ; somewhere to store label
MOVEM T1,LAB ; remember label
.GOTO1: CALL GETLIN ; read a line
JRST .GTOERR ; end of file
MOVE T1,LAB ; get the label
CAME T1,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,T1 ; get the label
CALL PUTLAB ; and print it
JRST EOF ; and handle as for and of file
SUBTTL Handle Error Condition
ERROR: CALL GETLIN ; get next line of file
JRST ERREOF ; eof - tell him
SKIPE T1,LABEL(X) ; get any label
JRST ERROR1 ; there was one - go check it
TXNN F,F.MON ; is this a monitor command?
JRST ERROR ; no - keep looking
MOVE BP,[POINT 7,LINBUF(X)] ; set up byte pointer
CALL GETCOM ; try to parse a batch command
JRST ERROR2 ; its not - just look for %labels
CAIN A,%IF ; it is - is it an IF command?
JRST TYPEIT ; yes - go handle it
JRST ERROR2 ; no - go look for a %label
ERROR1: CAMN T1,[SIXBIT/%ERR/] ; %ERR:: label?
JRST ERROR3 ; yes - we are done
CAME T1,[SIXBIT/%FIN/] ; %FIN:: label?
JRST ERROR ; no - keep looking
TMSG <
[MICFES - %FIN:: Encountered while Searching for %ERR::]
>
ERROR3: TXZ F,F.ERR ; yes - clear the error flag
JRST TYPEIT ; warn him and continue processing
ERROR2: CALL GETLIN ; get next line
JRST ERREOF ; EOF found
SKIPN T1,LABEL(X) ; get label
JRST ERROR2 ; none there - keep looking
CAMN T1,[SIXBIT/%FIN/] ; %FIN?
JRST ERROR1 ; yes - handle it
CAMN T1,[SIXBIT/%ERR/] ; %ERR?
JRST ERROR3 ; yes - we are done
JRST ERROR2 ; 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 CH,GETLN2 ; just return if a null character
IDPB CH,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 CH, ; end-of-line - make ASCIZ
IDPB CH,BP ; do it
RETSKP ; 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: MOVEI CH,(B) ; move the char where getlin expects it
RETSKP ; and 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 CH, ; yes - dummy up a null byte
RETSKP ; and 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 CH, ; yes - dummy up a null byte
RETSKP ; 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 CH, ; return a null byte
RETSKP ; 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
GETLAB: 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 GETLB1 ; we got one - must be a label
CAIN B,15 ; is 2nd char a <CR>
JRST GETLB2 ; yes - handle it
MOVEM B,SAVCHR(X) ; no - save new char
MOVEI B,":" ; restore colon
JRST TYPCHR ; and type it
GETLB1: TXOA F,F.COL1!F.LABL ; we are in column 1 again and we have a label
GETLB2: 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
GETLB3: CALL GETCHR ; get a character
RET ; eof
CAIE B," " ; a space?
CAIN B,11 ; or a tab?
JRST GETLB3 ; yes - ignore it
MOVEM B,SAVCHR(X) ; no - save it for re-analysis
JRST NXTCHR ; and start this line again
SUBTTL Handle comments
COMNT: STKVAR <CMNTCH>
MOVEM B,CMNTCH ; remember current comment char
CALL CHKDUP ; check for second one
RET ; eof
JRST TYPCHR ; duplicate - go type it
MOVE CH,CMNTCH ; restore comment char
MOVEM B,SAVCHR(X) ; save the char
TXO F,F.CMNT ; light the comment flag
TXO F,F.LABL ; can no longer have a label
RETSKP ; return to the caller
CHKLBL: STKVAR <SAVCH>
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: TXNN F,F.MON ; do we have a monitor command?
RETSKP ; no - give skip return
PUSH P,BP ; save byte pointer
CALL GETCOM ; go get a command
JRST [POP P,BP ; not batch - restore BP
RETSKP] ; and skip return (line will be typed)
POP P,T1 ; 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 T2, ; set to back up one byte
ADJBP T2,BP ; back up the byte pointer
MOVEM T2,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 ; and 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 T1, ; no - adjust byte pointer
ADJBP T1,BP ; by one
MOVEM T1,BP ; and save it
RET ; return
SUBTTL batch/MIC command and dispatch table
DEFINE XX (ARG1,ARG2) <
IFNB <ARG2>,<XWD [ASCIZ/ARG1/],%'ARG2>
IFB <ARG2>,<XWD [ASCIZ/ARG1/],%'ARG1>>
DEFINE YY (ARG) <
%'ARG==..YY
..YY==..YY+1
EXP $'ARG>
..YY==0
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 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,T1 ; get byte pointer
PSOUT ; and type it
MOVEI A,12 ; o/p a <lf>
PBOUT ; ..
RET ; return
SUBTTL @IF Command
$IF: PUSH P,T1 ; 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,T1 ; 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 T1,STKPTR(X) ; get parameter stack pointer
AOBJP T1,TOOMNY ; check for recursion
MOVE T2,PARPTR(X) ; get current parameter pointer
MOVEM T2,0(T1) ; and save it away
MOVEM T1,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,T1 ; error in IF command - pop old pointer
TMSG <
?MICIIC - Invalid IF Condition: >
CALL TYPEMC ; tell him he blew it
TMSG <
>
RET ; and return
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
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 T1,PTYPAR ; get number of ptys in T1
MOVNS T1 ; make it a negative number
MOVSI T1,0(T1) ; and convert to an AOBJN word
GETP1: MOVE A,[POINT 7,CTLBUF,20] ; pointer to character after "pty"
MOVEI B,0(T1) ; get next pty number
MOVEI C,10 ; radix 8
NOUT ; convert number to ASCII
JSHLT ; shouldn't happen
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
RET ; return to caller with JFN in A
GETP2: POP P,A ; recover JFN
RLJFN ; release it
JFCL ; ignore error
GETP3: AOBJN T1,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 T1,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 T1,^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 T1,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,T1 ; save an AC
PUSH P,T2 ; or two
MOVE T2,WD ; get word into T2
PUTSX1: SETZ T1, ; where we will put char
LSHC T1,6 ; get next char
MOVEI A," "(T1) ; get ASCII char into A
PBOUT ; and output it
JUMPN T2,PUTSX1 ; continue till done
POP P,T2 ; restore the ACs
POP P,T1 ; ..
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 T1,STKPTR(X) ; no - get parameter stack pointer
AOBJP T1,TOOMNY ; check for recursion
MOVE T2,PARPTR(X) ; get current parameter pointer
MOVEM T2,0(T1) ; and save it away
MOVEM T1,STKPTR(X) ; save the stack pointer
ADDI B,PARAM(X) ; point to parameter area
MOVE T1,-"A"(B) ; get new parameter pointer
MOVEM T1,PARPTR(X) ; and save it away
JRST GETCHR ; get next char (using new parameter)
GTCHR1: MOVE CF,CHRTAB(B) ; get characteristics
RETSKP ; and give good return
GETCH: SKIPE B,SAVCHR(X) ; is there a saved char?
JRST [SETZM SAVCHR(X) ; yes - clear it down
RETSKP] ; and give a skip return
GETCH1: SKIPE PARPTR(X) ; are we reading a parameter?
JRST GETPCH ; yes - get a parameter char
CALL GETFIL ; get char from file
JRST R ; eof - fail return
RETSKP ; got data - good return
GETPCH: ILDB B,PARPTR(X) ; get next char
JUMPN B,RSKP ; non-zero means we have a char
MOVE T1,STKPTR(X) ; null means we are done with this parameter
POP T1,PARPTR(X) ; get the next parameter from the stack
MOVEM T1,STKPTR(X) ; re-save the pointer
TXZ F,F.SUPR ; no longer suppressing parameter substitution
JRST GETCH1 ; and go get a char
GETFIL: ILDB B,FILPTR(X) ; get next char
JUMPE B,CHKEOF ; if nul - check for eof
RETSKP ; 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 T1,RD%JFN ; jfn supplied
MOVEM T1,TXTIBK+.RDFLG ; save it
MOVE T1,MICJFN(X) ; the file's jfn
HRLZM T1,TXTIBK+.RDIOJ ; where TEXTI needs it
HRROI T1,FILTXT(X) ; where we want the text
MOVEM T1,TXTIBK+.RDDBP ; where TEXTI needs it
MOVEI T1,TXTLEN*5-2 ; how much space there is
MOVEM T1,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 T1, ; make sure ASCIZ
IDPB T1,TXTIBK+.RDDBP ; done
MOVE T1,[POINT 7,FILTXT(X)] ; set up byte pointer
MOVEM T1,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 ; 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
MOVE A,DOSWT(X) ; get do command switches
TXNE A,DO.SUP ; want message suppressed?
JRST EOF2 ; yes - don't print it
EOF1: 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 T1,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 MICPAG ; we are now back one page
MOVEI A,.FHSLF ; our fork
MOVE X,T1 ; 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
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 MICPAG ; 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
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
TXZN F,F.LNFD ; first char at start of line ?
JRST PTYOU2 ; no--don't do error checking
LDB D,[POINT 7,CTLBUF,6] ; get first character in buffer
JUMPE D,PTYOU2 ; null character doesn't match
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"
; TXNE F,F.BRK ; is it?
; TXNN F,F.TI ; yes - have we been in TI?
; CAIA ; not in a break
; MOVX B,1B3 ; in BREAK and have seen TI - say PROCEED
IIC ; give ourselves an interrupt
MOVEI A,100 ; wait for it
DISMS ; ..
JRST .+1] ; and continue
SKIPGE 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: 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
XXXXXX: 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 X(BITS,ADDRESS<0>),<
EXP BITS!ADDRESS>
CHRTAB: 0 ; (0) <null>
X C.BRK!C.SBRK ; (1) control-A
X C.BRK!C.SBRK ; (2) control-B
X C.BRK ; (3) control-C
0 ; (4) control-D
0 ; (5) control-E
0 ; (6) control-F
X C.BRK ; (7) control-G (bell)
0 ; (10) control-H
0 ; (11) <tab>
X C.SPEC!C.BRK!C.LNFD,LNFEED ; (12) <LF>
X C.SPEC!C.BRK,VTAB ; (13) <VT>
X C.SPEC!C.BRK,FFEED ; (14) <FF>
X 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
X C.BRK ; (32) control-Z
X C.BRK ; (33) <esc>
0 ; (34) control-\
0 ; (35) control-]
0 ; (36) control-^
0 ; (37) control-_
0 ; (40) space
X C.CMNT!C.COL1,COMNT ; (41) !
0 ; (42) "
0 ; (43) #
0 ; (44) $
X C.ALPH ; (45) %
0 ; (46) &
X C.PARM ; (47) '
0 ; (50) (
0 ; (51) )
X C.USER!C.COL1,USRMOD ; (52) *
0 ; (53) +
0 ; (54) ,
0 ; (55) -
0 ; (56) .
0 ; (57) /
X C.ALPH ; (60) 0
X C.ALPH ; (61) 1
X C.ALPH ; (62) 2
X C.ALPH ; (63) 3
X C.ALPH ; (64) 4
X C.ALPH ; (65) 5
X C.ALPH ; (66) 6
X C.ALPH ; (67) 7
X C.ALPH ; (70) 8
X C.ALPH ; (71) 9
X C.SPEC!C.LABL,GETLAB ; (72) :
X C.CMNT!C.COL1,COMNT ; (73) ;
0 ; (74) <less>
X C.SPRS!C.COL1,SUPPRS ; (75) =
0 ; (76) <greater>
0 ; (77) ?
X C.MON!C.COL1,MONMOD ; (100) @
X C.ALPH ; A
X C.ALPH ; B
X C.ALPH ; C
X C.ALPH ; D
X C.ALPH ; E
X C.ALPH ; F
X C.ALPH ; G
X C.ALPH ; H
X C.ALPH ; I
X C.ALPH ; J
X C.ALPH ; K
X C.ALPH ; L
X C.ALPH ; M
X C.ALPH ; N
X C.ALPH ; O
X C.ALPH ; P
X C.ALPH ; Q
X C.ALPH ; R
X C.ALPH ; S
X C.ALPH ; T
X C.ALPH ; U
X C.ALPH ; V
X C.ALPH ; W
X C.ALPH ; X
X C.ALPH ; Y
X C.ALPH ; Z
0 ; [
0 ; \
0 ; ]
X C.SPEC,CNTRL ; ^
0 ; _
0 ; `
X C.ALPH ; a
X C.ALPH ; b
X C.ALPH ; c
X C.ALPH ; d
X C.ALPH ; e
X C.ALPH ; f
X C.ALPH ; g
X C.ALPH ; h
X C.ALPH ; i
X C.ALPH ; j
X C.ALPH ; k
X C.ALPH ; l
X C.ALPH ; m
X C.ALPH ; n
X C.ALPH ; o
X C.ALPH ; p
X C.ALPH ; q
X C.ALPH ; r
X C.ALPH ; s
X C.ALPH ; t
X C.ALPH ; u
X C.ALPH ; v
X C.ALPH ; w
X C.ALPH ; x
X C.ALPH ; y
X C.ALPH ; z
0 ; {
0 ; |
0 ; }
0 ; ~
0 ; <DEL>
PURGE X ; Don't want the macro and the AC confused
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
;Local Modes:.
;Mode:MACRO.
;Comment Start:; .
;End:.
END MIC