Trailing-Edge
-
PDP-10 Archives
-
BB-D348F-SM
-
exec/execp.mac
There are 47 other files named execp.mac in the archive. Click here to see a list.
;<4.EXEC>EXECP.MAC.63, 3-Jan-80 16:07:17, EDIT BY R.ACE
;UPDATE COPYRIGHT DATE
;<4.EXEC>EXECP.MAC.62, 26-Sep-79 16:05:36, Edit by HESS
; Fix filespec typeout on SAVE command (XTND only)
;<4.EXEC>EXECP.MAC.61, 24-Sep-79 12:19:29, Edit by HESS
; Disallow NAME<CR> as a valid command.
;<4.EXEC>EXECP.MAC.59, 20-Sep-79 14:13:56, Edit by HESS
; Use perm free space for FRKTBL
;<4.EXEC>EXECP.MAC.58, 18-Sep-79 14:26:48, Edit by HESS
; Change noise words of NAME command (XTND only)
;<4.EXEC>EXECP.MAC.57, 12-Sep-79 16:25:51, Edit by HESS
; Give warning if "forking" to inferior of inferior
;<4.EXEC>EXECP.MAC.56, 5-Sep-79 10:30:12, EDIT BY OSMAN
;tco 4.2440 - Avoid "?JFN is not assigned" in TV (Don't close jfns after GET
;jsys
;<HESS.E>EXECP.MAC.47, 20-Aug-79 17:56:49, Edit by HESS
; Add extended features
;<4.EXEC>EXECP.MAC.53, 21-Jun-79 13:37:07, EDIT BY OSMAN
;REMOVE EXTRANEOUS REFS TO RLJFNS
;<4.EXEC>EXECP.MAC.52, 19-Jun-79 16:16:48, EDIT BY OSMAN
;tco 4.2297 - Fix error message when trying to save execute-only program
;<4.EXEC>EXECP.MAC.51, 14-Jun-79 14:25:38, EDIT BY OSMAN
;TCO 4.2287 - Give good error if CONTINUE fails due to SFORK
;<4.EXEC>EXECP.MAC.48, 2-May-79 10:07:10, EDIT BY OSMAN
;GET RID OF CJFN1 (ASSUMED JFN WAS FIRST ON STACK, BAD ASSUMPTION!)
;<4.EXEC>EXECP.MAC.47, 30-Apr-79 13:19:13, EDIT BY OSMAN
;MAKE FORK CREATION ONLY DO EPCAP TO TURN OFF ^C
;<4.EXEC>EXECP.MAC.46, 27-Apr-79 16:37:31, EDIT BY OSMAN
;IF CHKPAT ENCOUNTERS ERROR, BOMB OUT
;<4.EXEC>EXECP.MAC.42, 27-Apr-79 15:30:06, EDIT BY OSMAN
;FIX CHKPAT, WHICH HAD TOO MANY POP'S
;<4.EXEC>EXECP.MAC.41, 20-Apr-79 10:01:00, EDIT BY OSMAN
;MAKE FAILING CFORK NOT SAY "JSYS ERROR AT"
;<4.EXEC>EXECP.MAC.39, 28-Mar-79 14:36:56, EDIT BY OSMAN
;tco 4.2226 - Don't save prog as "MACRO.EXE" after "CONTINUE STAY"
;<4.EXEC>EXECP.MAC.38, 19-Mar-79 11:40:13, EDIT BY DNEFF
;Fix ^C, START (or REENTER, etc) of compatible programs.
;<4.EXEC>EXECP.MAC.37, 12-Mar-79 18:02:17, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.EXEC>EXECP.MAC.36, 6-Mar-79 09:54:43, EDIT BY OSMAN
;USE GTJFS INSTEAD OF $GTJFN
;<4.EXEC>EXECP.MAC.35, 16-Feb-79 16:31:52, EDIT BY HEMPHILL
;TCO 4.2191 -- MAKE DDT COMMAND USE UDDT WHEN COMPATABILITY PACKAGE IS PRESENT
;<4.EXEC>EXECP.MAC.34, 31-Jan-79 11:02:35, EDIT BY OSMAN
;INCLUDE SS%WR IN SSAVE ARG
;<4.EXEC>EXECP.MAC.33, 30-Jan-79 17:24:18, EDIT BY OSMAN
;CALL SETPRG before RFORK at WAITA
;<4.EXEC>EXECP.MAC.32, 26-Jan-79 15:12:17, EDIT BY OSMAN
;REMOVE PRESERVE subcommand to SAVE, and make SAVE preserve by default
;<4.EXEC>EXECP.MAC.31, 15-Jan-79 23:00:28, EDIT BY HEMPHILL
;Patch CHKPAT to preserve save AC2 over calls to LOADF
;<4.EXEC>EXECP.MAC.30, 15-Jan-79 02:41:46, EDIT BY HEMPHILL
;MAKE EXEC UNDERSTAND USER EXTENDED ADDRESSING FOR INVOLUNTARY TERMINATION
; ALSO, MAKE "START" ACCEPT A LARGE ADDRESS, EVEN IF IT CAN'T USE IT YET
;<4.EXEC>EXECP.MAC.29, 12-Jan-79 17:36:32, EDIT BY OSMAN
;REMOVE REFS TO RUNFK
;<4.EXEC>EXECP.MAC.27, 8-Dec-78 16:31:50, EDIT BY OSMAN
;PUT IN SUBCOMMANDS TO SAVE COMMAND
;<4.EXEC>EXECP.MAC.26, 4-Nov-78 01:14:22, EDIT BY OSMAN
;tco 4.2077 - Make DDT command work after "fork" command
;<4.EXEC>EXECP.MAC.25, 18-Oct-78 14:40:59, EDIT BY OSMAN
;Improve message when program halts due to system call trap
;<4.EXEC>EXECP.MAC.24, 27-Sep-78 20:22:51, EDIT BY OSMAN
;REMOVE Bn SYMBOLS
;<4.EXEC>EXECP.MAC.18, 16-Sep-78 00:12:02, EDIT BY OSMAN
;REMOVE REFS TO CSBUFP
;<4.EXEC>EXECP.MAC.17, 14-Sep-78 14:10:35, EDIT BY OSMAN
;ONLY SEARCH XDEF, TTITLE DOES REST
;<4.EXEC>EXECP.MAC.15, 12-Aug-78 16:14:14, EDIT BY OSMAN
;CHANGE FAILING SAVES TO CALL OPNERR INSTEAD OF JRSTING TO IT
;<4.EXEC>EXECP.MAC.13, 29-Jun-78 13:10:23, EDIT BY OSMAN
;SAY NOT TOPS20 COMMAND LEVEL WHEN PROGRAM BEING RUN (FOR BATCH)
;<4.EXEC>EXECP.MAC.12, 27-Jun-78 11:22:28, EDIT BY OSMAN
;CHANGE PION/PIOFF TO CALL PION/CALL PIOFF
;<4.EXEC>EXECP.MAC.11, 26-Jun-78 14:10:29, EDIT BY OSMAN
;CLEAR CIPF INSTEAD OF COMAND AT WAITA
;<4.EXEC>EXECP.MAC.10, 13-Jun-78 11:28:04, EDIT BY OSMAN
;FIX PROBLEM WHERE "/RUN:FOO" FOLLOWED BY "G" IN EDIT SAT AND WAITED FOR SUPERFLUOUS CR
;<4.EXEC>EXECP.MAC.8, 9-Jun-78 18:36:57, EDIT BY OSMAN
;USE PION/PIOFF INSTEAD OF DIR/EIR
;<4.EXEC>EXECP.MAC.7, 24-May-78 09:57:11, EDIT BY OSMAN
;CLEAR STAYF, SO "REENTER" AFTER "CONTINUE STAY" DOESN'T STAY AT @ LEVEL
;<4.EXEC>EXECP.MAC.6, 2-Mar-78 09:06:18, Edit by PORCHER
;<4.EXEC>EXECP.MAC.5, 2-Mar-78 08:52:46, Edit by PORCHER
;Add SETGO routine for CCL start (in EXECCS)
;<4.EXEC>EXECP.MAC.4, 31-Jan-78 15:17:16, Edit by PORCHER
;<4.EXEC>EXECP.MAC.3, 30-Jan-78 17:02:41, Edit by PORCHER
;<4.EXEC>EXECP.MAC.2, 30-Jan-78 14:59:14, Edit by PORCHER
;Add changes for execute-only
;<4.EXEC>EXECP.MAC.1, 7-Jan-78 15:18:31, EDIT BY HELLIWELL
;ADD HELP TEXT TO OCTX AT .START+5
;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) 1976,1977,1978,1979,1980 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
SEARCH XDEF
TTITLE EXECP
;THIS FILE CONTAINS
;PROGRAM COMMANDS, LIKE RESET, CONTINUE, RUN, R ETC.
;RESET
NOXTND,<
.RESET::
;GET AND EDIT USE THE FOLLOWING AS A SUBROUTINE
ERESET::CALL PIOFF ;PREVENT THINGS FROM GETTING INCONSISTANT
;KILL ALL INFERIOR FORKS
SETO A,
CALL MAPPF ;UNMAP INFERIOR PAGE, IF ANY.
JFCL ;Unmap shouldn't fail
SKIPG A,FORK
JRST ERESE1
CAIE A,.FHSLF ;DON'T KILL OURSELVES
KFORK ;KILL FORK
ERCAL [TYPE <%Process disappeared
>
JRST ERESE1]
ERESE1: MOVNI A,1 ;RELEASE ANY FORK HANDLES
RFRKH ;...
CALL [PUSH P,A ;SAVE ERROR
CALL PION ;RE-ENABLE PSI SYSTEM
POP P,A ;RESTORE ERROR CODE
JRST CJERR]
SETOM FORK ;SAY THERE'S NO INFERIOR
SETOM EXDPLC ;Reset current examine/deposit location
SETZM DDTFLG ;SAY THERE'S NO DDT IN FORK
CALL PION ;ALLOW CONTROL-C AGAIN
RET
> ; NOXTND
XTND,<
.RESET::NOISE <FORK>
MOVEI B,[FLDDB. .CMKEY,,FRKNMS,<Fork name,>,,[
FLDDB. .CMNUM,CM%SDH,10,<Octal fork number>,,[
FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ "*"]>,<* for all forks>,,[
FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ "."]>,<. for current fork>,,[
FLDDB. .CMCFM,CM%SDH,,<CR for all unkept forks>,,]]]]]
HRRZ A,FRKNMS ; Get number of fork names
SKIPN A ; None?
HRRZ B,.CMFNP(B) ; Yup, skip forks, start with #
CALL FLDSKP ; PARSE ARG
CMERRX <Fork name, number, * or CR required>
LDB D,[POINT 9,.CMFNP(C),8] ; GET ARG TYPE
CAIN D,.CMCFM ; JUST CR?
JRST RESET0 ; YES - GO HANDLE
CAIE D,.CMTOK ; * := ALL FORKS?
JRST .RESE2 ; NO - FIND OUT WHICH ONE
LDB A,[POINT 7,ATMBUF,6] ; YES - LOOK AT TOKEN PARSED
CONFIRM ; CONFIRM FIRST
CAIE A,"*" ; WANT ALL?
JRST [ SKIPG A,FORK ; NO - TRY CURRENT
ERROR <No program>
JRST .RESE3]
MOVX A,FK%KPT!FK%BKG!FK%INT
MOVSI Q2,-NFRKS ; CLEAR ENTIRE TABLE
ANDCAM A,FRKTAB(Q2)
AOBJN Q2,.-1
SETO A, ; RELEASE ALL HANDLES
RFRKH ; (GARBAGE COLLECTION)
JFCL
RESET0: SKIPG A,FORK ; HAVE CURRENT FORK?
JRST RESET2 ; NO - CLEANUP AND EXIT
RESET1: SKIPN SLFTAB(A) ; YES - IN TABLE?
JRST RESET2 ; NO - DONE
HLRZ B,@SLFTAB(A) ; GET HANDLE
CAIE B,.FHSLF ; IS THIS US
JRST [ MOVEI A,0(B) ; NO - KEEP LOOKING
JRST RESET1]
MOVX B,FK%INT ; NO LONGER INTERRUPTED
ANDCAM B,SLFTAB(A) ; CLEAR IT
RESET2: CALL ERESET ; KILL OFF FORK
CALL NXTFRK ; SEE IF THERE IS ONE TO STEP TO
RET ; EXIT
.RESE2: CALL FRKNM0 ; GOBBLE NAME OR SOMETHING
CONFIRM
.RESE3: PUSH P,A ; SAVE HANDLE
CALL PIOFF ; DISABLE INTS
SETO A,
CALL MAPPF ; UNMAP PAGE
JFCL
POP P,A ; RESTORE HANDLE
CALL KEFORK ; KILL IT OFF
CALL PION ; WORLD BACK ON
CALL NXTFRK ; TRY NEXT
RET ; RETURN
;SUBROUTINE TO KILL ALL FORKS
ERESET::CALL PIOFF ; OFF INTS
SETOB A,FORK ; SAY NO CURRENT FORK
SETOM RUNFK ; OR RUNNING FORK
CALL MAPPF ; UNMAP ANY PAGE(S)
JFCL
MOVSI Q2,-NFRKS ; DO ALL FORKS
ERESE1: MOVX B,FK%KPT!FK%BKG ; KEPT OR BACKGROUND TEST
SKIPE CCKEEP ; CHECK INTERRUPTED FORKS ALSO?
TXO B,FK%INT ; YES - TEST ^C BIT ALSO
SKIPE A,FRKTAB(Q2) ; FORK EXISTS
TDNE A,B ; YES - TEST FOR KEEPING
JRST ERESE2 ; DON'T KILL KEPT FORKS
HLRZ B,@A ; GET HANDLE OF OWNER
MOVEI A,.FHSLF(Q2) ; FORM FORK HANDLE
CAIN B,.FHSLF ; DO WE OWN IT?
JRST [ CALL KEFORK ; YES - KILL IT
JRST ERESE2] ; GO ON
RFRKH ; NO - JUST RELEASE HANDLE
ERJMP .+1
MOVE Q1,FRKTAB(Q2) ; FLAGS
MOVEI A,.FHSLF(Q2) ; FORK HANDLE
CALL DELNAM ; DELETE NAME IF ANY
HRRZ B,FRKTAB(Q2) ; BLOCK ADDRS
MOVEI A,.FKSZE ; ENTRY SIZE
MOVEI C,XDICT
CALL RETMEM ; RETURN STORAGE
SETZM FRKTAB(Q2) ; CLEAR TABLE ENTRY
ERESE2: AOBJN Q2,ERESE1 ; LOOP
CALL PION ; INTS ON
RET
;ROUTINE TO KILL FORK IN A
KEFORK::SKIPN Q1,SLFTAB(A)
JRST KEFRK2 ; NON-EX FORK
CALL DELNAM ; REMOVE NAME FROM TABLE
HLRZ B,0(Q1) ; GET HANDLE OF OWNER
CAIN B,.FHSLF ; IS IT US?
HLLZS @SLFTAB(B) ; YES - CLEAR INFERIOR PNTR
PUSH P,A ; SAVE HANDLE
HRRZ A,0(Q1) ; INFERIOR HANDLE
PUSH P,A ; SAVE IT
HRRZ B,Q1 ; ADDRS OF BLOCK
MOVEI A,.FKSZE ; SIZE
MOVEI C,XDICT
CALL RETMEM ; RETURN STORAGE
POP P,A ; RESTORE HANDLE OF INFERIOR
JUMPE A,KEFRK1 ; DONE IF AT TOP (NO MORE INFERIORS)
CALL KEFORK ; RECURSE OVER ALL INFERIORS
KEFRK1: POP P,A ; RESTORE HANDLE
SETZM SLFTAB(A) ; CLEAR TABLE ENTRY FOR IT
KEFRK2: CAIE A,.FHSLF ; THIS US?
KFORK ; NOPE - KILL OFF INFERIOR
ERCAL [TYPE <%Process disappeared
>
RET] ; RETURN NOW
CAMN A,FORK ; CURRENT FORK
SETOM FORK
CAMN A,RUNFK ; RUNNING FORK
SETOM RUNFK
CAMN A,EDFORK ; EDITOR FORK
SETOM EDFORK
CAMN A,IDFORK ; IDDT FORK
SETOM IDFORK
MIC,<
CAMN A,MICFRK ; MIC HERE
SETOM MICFRK
>
RET
;STEP TO NEXT FORK
NXTFRK: MOVEI A,NFRKS-1 ; LOOK THRU TABLE
NXTFR1: SKIPN FRKTAB(A) ; EXISTS?
JRST NXTFR2 ; NO - TRY NEXT
HLRZ B,@FRKTAB(A) ; GET OWNER
CAIN B,.FHSLF ; WE OWN IT
JRST NXTFR3 ; YEP - GOOD ENUF
NXTFR2: SOJE A,NXTFR5 ; STEP TO NEXT
JRST NXTFR1 ; LOOP
NXTFR3: TRO A,400000 ; FORM FORK HANDLE
MOVEM A,FORK ; SAY THIS THE ONE
SKIPE B,SLFTAB(A) ; CHECK FOR NAME
TXNN B,FK%NAM
JRST NXTFR4 ; NO NAME - OR UNKNOWN FORK
HRROI B,.FKNAM(B) ; POINT TO NAME STRING
ETYPE <[%2M]>
RET ; RETURN
NXTFR4: MOVEI B,400000(A) ; FORK NUMBER ONLY
ETYPE <[Fork %2O]>
RET ; RETURN
NXTFR5: SETOB A,FORK ; NO CURRENT FORK
RET
;ROUTINE TO DELETE A FORK NAME Q1 := FRKTAB ENTRY, A := FORK HANDLE
DELNAM: TXNN Q1,FK%NAM ; FORK HAVE NAME?
RET ; NO - JUST RETURN
PUSH P,A ; SAVE HANDLE
MOVEI A,FRKNMS ; FORK NAME TABLE
HRROI B,.FKNAM(Q1) ; POINT TO NAME
TBLUK ; LOOKUP NAME IN TABLE
TXNN B,TL%EXM ; MATCH?
JRST DELNM2 ; NOT IN TABLE
MOVEI B,0(A) ; POINT TO ENTRY
MOVEI A,FRKNMS ; TABLE
TBDEL ; REMOVE NAME
DELNM2: POP P,A ; RESTORE HANDLE
MOVX B,FK%NAM
ANDCAM B,SLFTAB(A) ; NO LONGER HAS NAME
RET
;ROUTINE TO ADD NEW FORK NAME TO TABLE
;*** FORK NAME MAY BE IN TRVAR ***
ADDNAM: STKVAR <AFORK,NAMPTR,NEWNAM>
SETZM NEWNAM ; CLEAR FLAG
MOVEM A,AFORK ; SAVE HANDLE
MOVEI A,NFRKS ; NUMBER OF FORKS (MAX)
SKIPN FRKNMS ; TABLE INIT'D?
MOVEM A,FRKNMS ; NO - STORE INITIAL VALUE
HRROI A,.FKNAM(Q1) ; NAME STRING IN FRKTBL
MOVEM A,NAMPTR ; SAVE IT
MOVEI C,^D18 ; COPY 18 CHARS MAX
SETZ D,
SOUT ; ...
MOVE B,A ; PNTR TO B
IDPB D,A ; GRNTEE NULL
ADDNM2: EXCH B,NAMPTR ; SAVE END OF STRING PNTR
MOVEI A,FRKNMS ; POINT TO TABLE
TBLUK ; CHECK EXISTS ALREADY
HRR B,AFORK ; RESTORE FORK HANDLE
TXNN B,TL%EXM ; EXACT MATCH?
JRST ADDNM3 ; NO - OK
HRROI B,.FKNAM(Q1) ; POINT TO STRING BEGINNING
MOVEM B,NEWNAM ; SAVE FOR NEW NAME PRINT
EXCH B,NAMPTR ; GET END PNTR
LDB A,B ; GET LAST CHAR
JUMPE A,.+2 ; IF NULL - APPEND ZERO
AOJA A,.+2 ; ELSE INCREMENT
MOVEI A,"0"
CAILE A,"9" ; BEYOND DIGITS?
ADDI A,"A"-":" ; YES - SKIP TO LETS
DPB A,B ; REPLACE LAST CHAR
MOVE A,B ; COPY PNTR
IDPB D,A ; APPEND NULL
JRST ADDNM2 ; TRY AGAIN
ADDNM3: HRLI B,.FKNAM(Q1) ; STRING PNTR
MOVEI A,FRKNMS ; NAME TABLE
TBADD ; PUT INTO TABLE
MOVE A,AFORK ; GET FORK HANDLE
MOVX B,FK%NAM ; FORK NOW HAS NAME
IORM B,SLFTAB(A)
SKIPE B,NEWNAM ; MADE A "NEW" NAME?
ETYPE <[%2M]%_> ; YES - PRINT NAME
RET ; RETURN
;ROUTINE TO SET FORK NAME , A := FORK HANDLE, B := JFN
SFKNAM::TRVAR <<SFKBUF,EXTSIZ>,SFKFRK,SFKJFN>
MOVEM A,SFKFRK ; SAVE HANDLE
MOVEM B,SFKJFN ; AND JFN
HRRZ Q1,SLFTAB(A) ; POINTER
MOVEI Q1,.FKPTM(Q1) ; POINT TO PTTYMD BLOCK FOR FORK
MOVE A,B ; JFN TO A
CALL SUBNAM ; GET NAME
HRROI A,SFKBUF ; POINTER TO NAME
MOVE B,SFKJFN ; RECOVER JFN
MOVX C,1B8 ; FILE NAME
JFNS
MOVE A,SFKFRK ; GET FORK HANDLE
MOVE Q1,SLFTAB(A) ; TABLE ENTRY
CALL DELNAM ; REMOVE ANY EXISTING NAME
LDB C,[POINT 7,SFKBUF,6] ; GET FIRST CHAR
JUMPE C,R ; NULL - EXIT
HRROI B,SFKBUF
JRST ADDNAM ; GO ADD NAME
> ; XTND
;REENTER
;DECODE AND CHECK SUBROUTINE ALSO USED BY REDIRECT/DETACH
$REENT::SKIPGE A,FORK
ERROR <No program>
GEVEC
HLRZ B,B
CAIGE B,2 ;LONG ENOUGH TO HAVE REENTER?
ERROR <No REENTER address>
RET
;REENTER COMMAND DISPATCHES HERE
.REENT::NOISE <PROGRAM>
SETZM STAYF ;DON'T STAY AT COMMAND LEVEL (UNTIL "REENTER STAY" IMPLEMENTED!)
CONFIRM
CALL $REENT
;REDIRET/DETACH...(AND) REENTER JOINS HERE
..REEN::MOVNI B,2 ;REENTER CODE FOR PA1050
CALL CHKPAT ;SETUP PA1050 IF THERE
JUMPG B,.+2 ;PA1050 START IF POSITIVE
MOVEI B,1 ;ENTRY VECTOR INDEX 1 FOR REENTER
JRST ..STCR ;Continue below and start process
;CONTINUE
;RESUMES FROZEN INFERIOR FORKS
;DECODE AND CHECK SUBROUTINE ALSO USED BY REDIRECT/DETACH
$CONTI::SKIPGE FORK ;HANDLE OF AN INFERIOR FORK
ERROR <No program> ;NO INFERIORS AT ALL
NOXTND,<
SKIPGE A,FORK ;HANDLE OF LAST RUN INFERIOR, IF ANY.
ERROR <Program hasn't been run> ;NO FORK RUN SINCE RESET.
>
XTND,<
SKIPE B,SLFTAB(A) ; KNOW THIS FORK?
TXNN B,FK%RUN ; YES - HAS IT BEEN RUN BEFORE?
ERROR <Program hasn't been run>
MOVEM A,RUNFK ; SAVE AS RUNNING FORK
>
RFSTS ;GET ITS STATUS (HANDLE IN A)
TLNE A,077700 ;DISTINGUISH -1 FROM 0-5,400000-400005
ERROR <Program disappeared> ;-1 = UNASSIGNED HANDLE.
; JUMPGE A,[UERR [ASCIZ /Not interrupted/]]; ;B0 MEANS FROZEN
RET
NOXTND,<
;"PMODE" ROUTINE LEAVES "STAYF" OFF IF PROGRAM TO BE RUN NORMALLY,
;AND ON IF WE'RE TO STAY AT COMMAND LEVEL WHILE PROGRAM RUNS.
PMODE: KEYWD $PMODE
T NORMALLY ;DEFAULT
CMERRX ;ERROR RETURN
CALLRET (P3) ;SET THE MODE
$PMODE: TABLE
T NORMALLY ;NORMAL PROGRAM CONTROL
T STAY ;LET PROGRAM RUN, BUT STAY AT COMMAND LEVEL
TEND
.NORMA: SETZM STAYF
RET
.STAY: SETOM STAYF
NOISE <AT COMMAND LEVEL WHILE PROGRAM RUNS>
RET
;"CONTINUE" COMMAND DISPATCHES HERE
.CONTI::NOISE (PROGRAM)
CALL PMODE ;DETERMINE MODE IN WHICH TO CONTINUE
CONFIRM
CALL $CONTI
JRST ..CONT
>
XTND,<
;"CONTINUE" COMMAND DISPATCHES TO HERE
.CONTI::CALL .CONT1 ; PARSE COMMAND
CALL $CONTI ; SET FORK
JRST ..CONT ; RESUME PROCESS
.CONT1: NOISE <FORK>
TRVAR <TMPJFN>
SETZM TMPJFN ; CLEAR TEMPORARY
SETZM STAYF
.CONT2: MOVEI B,[FLDDB. .CMKEY,,FRKNMS,<Fork name,>,,[
FLDDB. .CMNUM,CM%SDH,10,<Octal fork number>,,[
FLDDB. .CMCMA,,,,,[
FLDDB. .CMCFM,,,,,]]]]
TLON Z,F1 ; FIRST TIME THRU?
JRST .CON2A
HRRZ B,0(B) ; NO - ONLY ALLOW COMMA OR CR
HRRZ B,0(B)
.CON2A: CALL FLDSKP ; PARSE LINE
CMERRX
LDB D,[POINT 9,.CMFNP(C),8] ; GET FUNCTION CODE
CAIN D,.CMCFM ; CR
JRST .CONT5 ; CHECK MODES
CAIN D,.CMCMA ; COMMA SEEN?
JRST .CONT3 ; YES - CHECK SUBCOMMANDS
CALL FRKNM0 ; PARSE NAME OR NUMBER
MOVEM A,FORK ; SAVE HANDLE
MOVX B,FK%RUN
TDNE B,SLFTAB(A) ; RAN THIS ONE?
MOVEM A,RUNFK ; YES - STORE IN RUNFK
JRST .CONT2 ; LOOK FOR CR OR COMMA
.CONT3: CRRX <Carriage return to enter subcommands>
JRST .CONT4
SUBCOM $PMODE ; GET PROGRAM MODES
JRST .CONT5
.CONT4: KEYWD $PMODE ; LOOKUP A MODE IF NO CR GIVEN
0 ; NO DEFAULT
CMERRX
CALL 0(P3) ; DISPATCH
.CONT5: SKIPE Q1,TMPJFN ; SUBCOMMANDS RETURN HERE
JRST .CONT6 ; DON'T FIDDLE PRIMARY JFNS
SKIPG A,FORK ; DO WE HAVE A FORK
ERROR <No program>
SKIPE B,SLFTAB(A) ; KNOWN FORK
TXNN B,FK%BKG!FK%TTY ; BACKGROUND OR TTY WAITER
JRST .CONT7 ; NO FORK, OR NOT BACKGROUND
MOVX B,FK%BKG
ANDCAM B,SLFTAB(A) ; CLEAR BACKGROUND FLAG
.CONT6: MOVEI A,.FHSLF ; SEE WHAT WE HAVE FOR JFNS
GPJFN
MOVE A,FORK ; GET FORK HANDLE BACK
MOVE D,SLFTAB(A) ; GET ITS FLAGS
TLNE Q1,-1 ; WANT TO CHANGE PRIMARY INPUT?
TXOA D,FK%PRI ; YES - SET FLAG
HLL Q1,B ; NO - GET PRIMARY INPUT JFN
TRNE Q1,-1 ; WANT PRIMARY OUTPUT?
TXOA D,FK%PRO ; YES - SET FLAG
HRR Q1,B ; NO - SET PRIMARY OUTPUT JFN
MOVEM D,SLFTAB(A) ; UPDATE FLAGS
MOVE B,Q1 ; JFNS TO B
MOVE A,FORK ; FORK TO A
SPJFN ; SET PRIMARY JFNS
.CONT7: SKIPN SLFTAB(A) ; KNOW THIS FORK?
RET ; NO - DONE
MOVX B,FK%INT
ANDCAM B,SLFTAB(A) ; CLEAR INTERRUPTED BIT
MOVX B,FK%BKG
SKIPE STAYF ; WANT TO STAY AT COMMAND LEVEL?
IORM B,SLFTAB(A) ; YES - SET BACKGROUND
RET ; RETURN
;SUBCOMMAND TABLE AND ROUTINES
$PMODE: TABLE
T BACKGROUND
T INPUT,,.CINPU
T NO,,.CNO
T OUTPUT,,.COUTP
T QUIET,,.CQUIE
T SIGNAL,,.CSIGN
T STAY
TEND
;REDIRECT OUTPUT TO FILE
.COUTP: NOISE <TO FILE>
SETZ A,
CALL COUTFN ; GET OUTPUT FILE NAME
JRST CERR
CONFIRM
MOVX B,OF%WR ; OPEN FOR WRITE
CALL $OPEN7
JRST .CSIGO ; STORE JFN AND RETURN
;GET INPUT FROM FILE
.CINPU: NOISE <FROM FILE>
MOVX B,GJ%OLD!GJ%MSG ; GTJFN BITS
SETZ A,
CALL SPECFN ; COLLECT AN INPUT FILE
JRST CERR
CONFIRM
MOVX B,OF%RD ; OPEN FOR READ
JRST .CSIGI ; STORE JFN AND RETURN
;"QUIET" - OUTPUT TO NUL:
.CQUIE: CONFIRM
MOVEI A,.NULIO ; SET NULL JFN
HRRM A,TMPJFN ; FOR OUTPUT
JRST .CBAC2 ; SET INPUT JFN FOR TRAP
;STAY AT COMMAND LEVEL
.STAY: CONFIRM
JRST ..STAY
;SIGNAL TTY I/O
.CSIGN: NOISE <WHEN TTY WANTED FOR>
SKIPA A,[677777] ; CAUSE PRIMARY TRAP
.CNO: MOVEI A,.NULIO ; NULL DEVICE
.CSIG2: KEYWD $CSIGN
T EITHER,,.CSIGB ; DEFAULT TO EITHER
JRST CERR
CONFIRM
JRST 0(P3) ; DISPATCH
$CSIGN: TABLE
T EITHER,,.CSIGB ; SIGNAL BOTH
T INPUT,,.CSIGI ; SIGNAL INPUT
T OUTPUT,,.CSIGO ; SIGNAL OUTPUT
TEND
.CSIGB: CALL .CSIGI ; SET INPUT
.CSIGO: HRRM A,TMPJFN ; SET OUTPUT JFN
JRST ..STAY ; RETURN
;SET BACKGROUND MODE
.BACKG: CONFIRM
.CBAC2: MOVEI A,677777 ; SET FOR INPUT TRAP
.CSIGI: HRLM A,TMPJFN ; SET PRIMARY INPUT
..STAY: SETOM STAYF ; STAY AT COMMAND LEVEL
RET ; EXIT
;COMMON ROUTINE TO START / RESTART AND EXISTING FORK
; ENTER WITH C(B) := FRKNMS ENTRY
CONTFK::TRVAR <TMPJFN> ; SEE .CONT1
SETZM TMPJFN
HRRZ A,0(B) ; GET FORK HANDLE FROM TABLE
MOVEM A,FORK ; SET TO CURRENT FORK
SETZM STAYF
CALL .CONT5 ; COMMON SETUP
MOVEM A,RUNFK ; SET AS CURRENT RUNNING FORK
MOVX B,FK%RUN
TDNN B,SLFTAB(A) ; HAS THIS GUY BEEN RUN BEFORE?
JRST CONTF1 ; NO - START IT THEN
TYPE <[Continuing]
>
JRST ..CONT ; ELSE CONTINUE
CONTF1: TYPE <[Starting]
>
JRST .STRT1 ; START IT UP
> ; XTND
;"REDIRECT/DETACH ... (AND) CONTINUE" JOINS HERE
..CONT::
NOXTND,<
MOVE A,FORK
>
XTND,<
MOVE A,RUNFK ; LAST RUN FORK
>
TXO A,SF%CON ;SET "CONTINUE" BIT
SFORK ;CONTINUE PROCESS FROM HALT
ERCAL CJERRE ;FAILED, TELL USER WHY (PROBABLY NEVER STARTED!)
;WHEN THE PROGRAM IS RUNNING WE DON'T WANT THE EXEC TO HAVE ANY
;OF ITS PAGES MAPPED. HENCE CLEAR THE PAGE BUFFER:
NOXTND,<
CALL SETGO ;Setup for program running
>
XTND,<
SETO A, ; UNMAP STUFF
CALL MAPPF
JFCL
MOVE A,RUNFK ; FORK HANDLE
CALL FTTYMD ; SET FORKS MODES
TLO Z,RUNF ; RUN IT
MOVE A,RUNFK ; HANDLE AGAIN
>
JRST WAITF ;GO RESUME FORK AND WAIT FOR IT
;"DDT" COMMAND. LOAD DDT IN INFERIOR FORK IF NECESSARY,
;TRANSMIT SYMBOL TABLE POINTER, START DDT.
.DDT:: SETZM STAYF
NOXTND,<
SKIPGE DDTFLG ;DDT ALREADY LOADED?
JRST DDT4 ;YES
;DETERMINE WHETHER THERE IS INFERIOR FORK WITH SYMBOL TABLE POINTER
;IF NOT, USE DDT THAT ALREADY CONTAINS MONSYM SYMBOLS.
SETZB C,D ;SAYS NO SYM TAB PTR
SKIPGE FORK
JRST DDT2 ;NO FORK
>
XTND,<
SETZB C,D ; ASSUME NO SYMBOL PNTR
SKIPLE A,FORK ; CURRENT FORK?
SKIPN A,SLFTAB(A) ; YES - KNOWN?
JRST DDT2 ; NO FORK - JUST GET DDT
TXNE A,FK%DDT ; DDT PRESENT IN THIS FORK?
JRST DDT4 ; YES - JUST START IT
>
;THERE IS A FORK, SEE IF IT ALREADY CONTAINS SOMETHING THAT LOOKS
;LIKE A DDT. IF SO, LEAVE IT, AS IT MAY CONTAIN BREAKPOINTS,
;MODIFIED SYM TAB PTR, ETC.
MOVEI A,DDTORG ;DDT BEGINNING ADDRESS
CALL MAPPF
JRST CJERRE ;Failed-- type JSYS error
TXNN B,PA%PEX ;PAGE EXISTS?
JRST DDT1 ;NO, FORK DOESN'T HAVE DDT
ANDI A,777 ;LINE ONLY
MOVE A,PAGEN(A) ;LOAD FIRST WORD
CAMN A,[JRST DDTORG+2]
JRST DDT3 ;ALREADY HAVE ACCEPTABLE DDT
;FORK DOESN'T HAVE UDDT SEE IF SOME OTHER DEBUGGER OR IF NOT
;THEN SEE IF THERE IS A SYMBOL TABLE PNTR
DDT1: MOVEI A,JOBDDT ;LOC FOR DEBUGGER ADDRS
CALL MAPPF ;MAP PAGE OF FORK
JRST CJERRE ;Failed-- type JSYS error
TXNE B,PA%PEX ;NO PAGE?
TXNN B,PA%RD ;READ PROTECT?
JRST DDT2 ;NO USEABLE PTR
HRRZ A,PAGEN(A) ;SEE IF ALREADY HAVE START ADDRS
JUMPG A,[PUSH P,A ;IF YES - SAVE ADDRS ON STACK
JRST DDT5] ;AND JOIN COMMON CODE
MOVEI A,JOBSYM&777 ;PNTR TO SYMBOL TABLE
MOVE C,PAGEN(A) ;FETCH SYM TAB PTR WORD
;IF NEGATIVE, IT WILL BE ASSUMED TO BE PTR
MOVE D,PAGEN+1(A) ;.JBUSY IS JOBSYM+1
;NO CHECKING NEEDED, DDT WILL FIX IT UP.
DDT2: PUSH P,C ;SAVE SYM TAB PTR OR 0
PUSH P,D ;SAVE UNDEF SYM PTR
JUMPL C,DDT6 ;IF VALID SYM TAB PTR, GO USE UDDT
MOVE A,FORK ;GET HANDLE ON CURRENT FORK
GCVEC ;IS PA1050 PRESENT?
ERJMP .+2 ;NO FORK, USE SDDT
JUMPG B,DDT6 ;PA1050 PRESENT--USE UDDT
SKIPA B,[POINT 7,[GETSAVE(SYS:SDDT.)]] ;DDT WITH SYMBOLS
DDT6: MOVE B,[POINT 7,[GETSAVE(SYS:UDDT.)]]
;DDT...
;LOAD SELECTED DDT
MOVSI A,(GJ%OLD!GJ%SHT) ;SET UP FOR OLD-FILE AND SHORT FORM GTJFN
CALL GTJFS ;GET AND STACK THE JFN
CALL CJERRE ;IF FAILS, JUST PRINT ERROR
CALL $MERGE ;MERGE IT INTO FORK, CREATING FORK IF NONE,
;AND RELEASE JFN
;STORE SYMBOL TABLE POINTER
POP P,D
POP P,C
JUMPGE C,DDT3 ;NOT A SYMBOL TABLE POINTER
MOVEI A,DDTSYM
CALL MAPPF
JRST CJERRE ;Failed-- type JSYS error
ANDI A,777
HRRZ Q1,PAGEN+1(A) ;WHERE TO STORE UNDEF PTR
HRRZ A,PAGEN(A) ;POINTER TO WHERE TO PUT POINTER
CALL MAPPF
JRST CJERRE ;Failed-- type JSYS error
ANDI A,777
MOVEM C,PAGEN(A) ;STORE POINTER
HRRZ A,Q1 ;WHERE TO PUT UNDEF PTR IN DDT
CALL MAPPF
JRST CJERRE ;Failed-- type JSYS error
ANDI A,777
MOVEM D,PAGEN(A) ;STORE IT
DDT3:
NOXTND,<
SETOM DDTFLG ;SAY DDT LOADED & SYM TAB PTR MOVED
>
XTND,<
SKIPLE A,FORK ; HAVE FORK?
SKIPN B,SLFTAB(A)
JRST DDT4 ; NOPE - JUST START
MOVX B,FK%DDT ; YES - MARK DDT PRESENT
IORM B,SLFTAB(A)
>
;TRANSFER CONTROL TO DDT
DDT4: PUSH P,[DDTORG] ;DEFAULT
DDT5: MOVNI B,3 ;CODE FOR PA1050 IF ANY
CALL CHKPAT ;PA1050 RUNNING IN FORK?
JUMPG B,[POP P,A ;RETURNS RESTART ADDRESS IF YES
JRST GOTO2]
POP P,B ;DDT START ADDRS
JRST GOTO2 ;JOIN "GOTO" COMMAND: UNMAP PAGE, START FORK.
NOXTND,<
;FORK <OCTAL FORK HANDLE>
;SETS FORK ACCESSED BY START, REENTER, GOTO, /, \, TEN50 DDT, SAVE.
;DOESN'T UPDATE SUBSYSTEM NAME (SUBSYS); MAYBE LATER IT SHOULD.
.FORK:: NOISE <IS>
octx <Fork handle>
CMERRX
MOVE A,B ;PUT NUMBER IN A
TRO A,400000 ;OK IF USER OMITS SIGN
CAIN A,400000 ;"SELF" IS LEGAL ONLY FOR WHEELS.
JRST [ MOVX B,WHLU ;INDICATE WHEEL PRIV MUST BE ENABLED
CALL PRVCK ;TEST SPECIAL CAPABILITIES
JRST FORK1 ;NO ENABLE OR NO WHEEL CAPABILITY
JRST FORK2]
CAIL A,400001
CAILE A,400777
FORK1: ERROR <Fork handle must be between 1 and 777>
FORK2: PUSH P,A
CALL DGFRKS ;GET HANDLES ON ALL FORKS IN STRUCTURE
JFCL ;FAILED, DON'T WORRY
MOVE A,(P) ;GET SPECIFIED HANDLE BACK
RFSTS ;SEE IF THIS FORK HANDLE IS ASSIGNED.
ERJMP CJERRE
TLNE A,077700 ;DISTINGUISH -1 FROM 0-5, 400000-400005.
ERROR <No such fork> ;-1 = UNASSIGNED HANDLE.
CONFIRM
POP P,FORK ;SAVE HANDLE FOR OTHER COMMANDS TO USE
SETZM DDTFLG ;FORGET WHETHER DDT IS LOADED OR NOT
CALL UNMDIR ;UNMAP PAGES USED BY GFRKS
JRST CMDIN4
>
XTND,<
;FORK <NAME> OR <NUMBER>
;SETS FORK ACCESSED BY START, REENTER, GOTO, /, \, TEN50 DDT, SAVE.
.FORK:: NOISE (IS)
CALL FRKNMC ; GET NAME, NUMBER ETC.
MOVEM A,FORK ; STORE AS CURRENT FORK
JRST CMDIN4 ; DONE
FRKNMC: TLOA Z,F1 ; EXITS THRU NXTFRK
FRKNAM: TLZ Z,F1 ; GRNTEE CURRENT FORK EXISTS
MOVEI B,[FLDDB. .CMKEY,,FRKNMS,<Fork name,>,,[
FLDDB. .CMNUM,CM%SDH,10,<Octal fork number>,,[
FLDDB. .CMCFM,,,,,]]]
HRRZ A,FRKNMS ; Get number of fork names
SKIPN A ; None?
HRRZ B,.CMFNP(B) ; Yup, skip forks, start with #
CALL FLDSKP ; PARSE FIELD
CMERRX
LDB D,[POINT 9,.CMFNP(C),8] ; SEE WHAT WE GOT
CAIN D,.CMCFM ; JUST TYPED CR?
JRST FRKNM2 ; YES - GET HIM A FORK
CALL FRKNM0 ; CHECK FURTHER ARG
CONFIRM ; FORCE CONFIRM
RET ; RETURN HANDLE
FRKNM2: TLNE Z,F1 ; WANT TO FIND ONE?
JRST NXTFRK ; YES - LOOK IN TABLE
SKIPG A,FORK ; NO - HAVE A CURRENT FORK
ERROR <No current fork>
RET ; RETURN
;PARSED NAME OR NUMBER - CHECK VALIDITY
FRKNM0: CAIN D,.CMKEY ; NAME?
HRRZ B,0(B) ; YES - GET FORK HANDLE FROM TABLE
MOVEI A,(B) ; HANDLE TO A
TRO A,400000 ; MAKE SURE VALID LOOKING
CAIN A,.FHSLF ; WANT SELF?
JRST [ MOVX B,WHLU ; MUST BE WHEEL TO LOOK AT SELF
CALL PRVCK
JRST FRKNMX ; ULOSE
RET] ; OK - RETURN
CAIL A,400001 ; CHECK VALID RANGE
CAILE A,400777
FRKNMX: ERROR <Fork handle must be between 1 and 777>
PUSH P,A ; SAVE IT
RFSTS ; CHECK EXISTENCE
ERJMP CJERRE
TLNE A,077700 ; SEE IF ASSIGNED
ERROR <No such fork>
POP P,A ; RETURN FORK HANDLE
CAIN A,.FHSLF ; DON'T CHECK IF "FORK 0"
RET
SKIPN B,SLFTAB(A) ; KNOW ABOUT THIS FORK?
JRST [ ETYPE < %% Unknown fork%_>
RET]
HLRZ B,.FKOWN(B) ; GET OWNER HANDLE
CAIE B,.FHSLF ; OURS?
ETYPE < %% Fork is not a direct inferior%_>
RET
;MISC FORK COMMANDS
;GIVE A FORK A (NEW) NAME
.NAME:: NOISE <CURRENT FORK AS>
WORDX <Name to call fork by>
CMERRX
CONFIRM
SKIPG A,FORK ; MUST HAVE FORK
ERROR <No current fork>
LDB B,[POINT 7,ATMBUF,6]
SKIPN B ; CHECK FOR NULL NAME
ERROR <No name given>
MOVE Q1,SLFTAB(A) ; POINT TO FORK DATA BLOCK
CALL DELNAM ; DELETE OLD NAME
HRROI B,ATMBUF ; POINT NAME TYPED
CALL ADDNAM ; PUT NEW FORK IN TABLE
RET ; RETURN
;KEEP A FORK
.KEEP:: NOISE <FORK>
CALL FRKNAM ; GET ITS NAME
MOVX B,FK%KPT ; LITE FLAG
IORM B,SLFTAB(A)
RET ; RETURN
;UNKEEP A FORK
.UNKEE::NOISE <FORK>
CALL FRKNAM ; GET NAME
MOVX B,FK%KPT
SKIPE CCKEEP ; KEEPING INTERRUPTED FORKS?
TXO B,FK%INT ; YES - LITE THIS BIT ALSO
TDNN B,SLFTAB(A) ; FORK INTERRUPTED OR KEPT?
JRST [ TYPE <%Fork not kept>
RET]
ANDCAM B,SLFTAB(A) ; CLEAR BIT(S)
RET
;FREEZE A FORK
.FREEZ::NOISE <FORK>
CALL FRKNAM
FFORK ; FREEZE IT
RET ; RETURN
> ; XTND
;MERGE <FILE> COMMAND.
;GETS A FILE INTO CURRENT FORK WITHOUT RESETTING.
;PUTS BACK ENTRY VECTOR WORD THAT WAS THERE BEFORE COMMAND
.MERGE::NOISE <PROGRAM>
CALL $GET1 ;INPUT PROGRAM NAME
CONFIRM
;SUBROUTINE ENTRY FOR "DDT" COMMAND. PASS JFN IN A.
$MERGE: STKVAR <MERJFN,MERENT>
MOVEM A,MERJFN ;REMEMBER PROGRAM BEING MERGED
SKIPGE B,FORK ;SKIP IF EXEC HAS INFERIOR FORK
JRST $GET2 ;NO FORK, CREATE ONE, GET PROG, USE ITS ENTRY.
MOVE A,B ;FORK HANDLE TO A
GEVEC ;ALREADY HAVE A FORK, GET ITS ENTRY VECTOR WD
MOVEM B,MERENT ;SAVE SAME
MOVE A,MERJFN ;TELL $GET2 WHAT PROGRAM TO GET
CALL $GET2 ;GET PROGRAM
MOVE B,MERENT ;PREVIOUS ENTRY VECTOR
MOVE A,FORK ;FORK HANDLE AGAIN
JUMPE B,R ;JUMP IF THERE WAS NO ENTRY VECTOR WD
SEVEC ;SET ENTRY VECTOR TO OLD VALUE
ERJMP CJERRE ;Failed-- type JSYS error
RET
;SUBROUTINE TO INPUT A PROGRAM NAME.
;FIRST PART OF GET, RUN, MERGE.
$GET1: SETZ A, ;NO DEFAULT FOR DEVICE OR DIRECTORY
CALL CPFN ;INPUT PROGRAM NAME AND ASSIGN JFN
SKIPA A,ERCOD ;ERROR
RET
JRST CJERR ;PRINT IT
XTND,<
;ERUN COMMAND - RUN A PROGRAM AS AN EPHEMERON
.ERUN:: NOISE <PROGRAM>
MOVEI A,[ASCIZ "SYS:"] ; DEFAULT TO SYS:
CALL CPFN ; INPUT PROGRAM NAME AND GET JFN
JRST [ MOVE A,ERCOD ; PRINT ERROR
JRST CJERR]
CONFIRM
CALLRET REPH ; START IT UP
>
;R COMMAND. EQUIVALENT TO RUN <SUBSYS>...
.R:: NOISE <PROGRAM>
MOVEI A,[ASCIZ /SYS:/]
CALL CPFN ;COLLECT PROGRAM NAME
CALL [MOVE A,ERCOD ;SET UP ERROR CODE
JRST CJERR] ;PRINT MESSAGE
PUSH P,[..STRT] ;SETUP TO START AFTER GET
JRST GET1 ;JOIN GET
;RUN <PROGRAM> COMMAND = GET + START
.RUN:: PUSH P,[..STRT] ;SET RETURN TO JOIN "START" COMMAND,
;FALL INTO "GET".
;GET <FILE> COMMAND.
;RESETS THEN CREATES ONE FORK AND GETS PROGRAM INTO IT.
;CODED IN SUBROUTINES SO CODE CAN BE SHARED WITH "MERGE".
.GET:: NOISE <PROGRAM>
CALL $GET1 ;INPUT PROGRAM NAME
;<SUBSYSTEM NAME> JOINS HERE AFTER CALLING CPFN AND SETTING
; RETURN TO JOIN START COMMAND (..STRT).
GET1: STKVAR <G1JFN>
CONFIRM
MOVEM A,G1JFN ;ERESET CLOBBERS IT
CALL ERESET ;CLOSE FILES, KILL ALL INFERIOR FORKS.
;NOW FALL INTO $GET2
MOVE A,G1JFN ;GET JFN OF FILE BEING GOTTEN
;GET...
;SUBROUTINE TO GET A PROGRAM INTO CURRENT FORK, FOR GET, RUN, AND MERGE.
;ACCEPTS JFN IN A FOR PROGRAM BEING GOTTEN
$GET2:: STKVAR <GETJFN>
;IF THERE IS NO INFERIOR FORK, CREATE ONE.
MOVEM A,GETJFN ;REMEMBER WHICH FILE TO GET
CALL PNTMES ;ALWAYS MAKE SURE SYSTEM MESSAGES HAVE
;BEEN PRINTED BEFORE ALLOWING ANY PROGRAMS TO BE RUN.
;THIS PREVENTS PROBLEM OF SYSTEMS THAT START UP SPECIAL
;PROGRAMS FROM NEVER SEEING SYSTEM MESSAGES, BECAUSE
;LOGIN.CMD OR COMAND.CMD RUNS PROGRAM.
SKIPL FORK
JRST GET2B ;HAPPENS FOR "MERGE"
CALL ECFORK ;CREATE A FORK
;DETERMINE SUBSYSTEM NAME BUT DON'T SETNM AT THIS POINT
NOXTND,<
MOVE A,GETJFN ;JFN
CALL SUBNAM ;STORES NAME WORD IN CELL "SUBSYS",
>
XTND,<
MOVE B,GETJFN ; JFN
CALL SFKNAM ; SET FORK NAME
>
;FOR USE AT "WAITF"+2 BY "START", ETC.
GET2B:
;PUT THE PROGRAM INTO THE FORK
HRR A,GETJFN
HRL A,FORK
CALL DOGET ;DO THE GET JSYS
JRST GETILI ;FAILED
RET
;ILLEG INST TRAP DURING GET JSYS
;TYPE EXEC ERROR MESSAGES FOR CERTAIN ERRORS
GETILI::CALL %GETER
MOVE A,ERCOD ;SYSTEM ERROR CODE
CAIN A,GETX1
ERROR <Bad .EXE file format>
CAIN A,GETX2
ERROR <System special pages table full>
JRST CJERR
NOXTND,<
;CREATE FORK FOR PROGRAM. USED HERE AND FOR "\"
ECFORK:: MOVX A,CR%CAP ;TELL NEW PROGRAM WHETHER WE'RE "ENABLE"D OR NOT
CFORK
ERCAL CJERRE ;FAILED, SAY WHY
MOVEM A,FORK ;HANDLE OF CURRENT INFERIOR
SETO B,
SETZ C,
SKIPE PAXLFL
SCVEC ;SET ILLEGAL COMPATIBILITY ENTRY IF PA1050 NOT ALLOWED
FFORK ;LEAVE IT FROZEN
SKIPN BATCHF ;DON'T ALLOW UNDER BATCH
SKIPE CCFLAG ;ALLOWING CONTROL-C?
JRST [ MOVE A,FORK ;^C CAPABILITY NOT ALLOWED
RPCAP ;GET CURRENT CAPABILITIES
TXZ B,SC%CTC ;DON'T LET PROGRAM TRAP ^C
TXZ C,SC%CTC
EPCAP ;DOING IT THIS WAY AVOIDS ALWAYS DOING AN EPCAP ON FORK CREATION.
JRST .+1]
MOVE A,[XWD ITTYMD,PTTYMD]
BLT A,PTTYMD+NTTYMD-1 ;SETUP INITIAL TTY MODES
RET
> ; NOXTND
XTND,<
;CREATE FORK FOR PROGRAM
ECFORK::MOVEI A,.FKSZE ; SIZE OF FRKTBL ENTRY
MOVEI B,XDICT ; USE PERM FREE SPACE
CALL GETMEM ; ALLOCATE SOME STORAGE
ERROR <Fork table full, "RESET" some>
MOVE Q1,B ; SAVE ADDRESS IN Q1
ECFRK2: MOVX A,CR%CAP
CFORK ; CREATE A FORK (SAME CAPS)
JRST [ PUSH P,A ; SAVE ERROR CODE
MOVEI A,.FKSZE
MOVE B,Q1 ; BLOCK ADDRS
MOVEI C,XDICT
CALL RETMEM ; RETURN FREEE STG.
POP P,A ; RESTORE CODE
JRST JERR]
MOVEM A,FORK ; SAVE AS CURRENT FORK
HRRZM Q1,SLFTAB(A) ; SAVE POINTER TO FORK DATA
SETO B,
SETZ C,
SKIPE PAXLFL ; LEGAL FOR COMPAT PKG?
SCVEC ; NOPE - CLEAR IT
FFORK ; LEAVE FORK FROZEN
SKIPN BATCHF ; DON'T ALLOW ^C UNDER BATCH
SKIPE CCFLAG ; ^C CAP ALLOWED AT ALL
JRST [MOVE A,FORK ; GET CURRENT CAPS
RPCAP
TXZ B,SC%CTC ; CLEAR ^C CAP
TXZ C,SC%CTC
EPCAP
JRST .+1]
MOVSI B,.FHSLF ; FLAG US AS OWNING FORK
MOVEM B,.FKOWN(Q1)
MOVSI B,ITTYMD ; SET INITIAL MODES
HRRI B,.FKPTM(Q1) ; LOC FOR PROGRAM/TTY MODES
BLT B,.FKPTM+NTTYMD+1(Q1)
RET
> ; XTND
;SUBNAM - SETUP NAME OF PROGRAM BEING RUN IN SIXBIT. USE IF
;FOR SUBSYSTEM NAME ALSO IF PROGRAM CAME FROM SUBSYS.
; A/ THE JFN
; CALL SUBNAM
; RETURN +1, NAMES SETUP IN PTTYMD
SUBNAM: STKVAR <<SSBUF,EXTSIZ>,SUBJFN>
MOVEM A,SUBJFN ;SAVE JFN
HRROI A,SSBUF ;SETUP PLACE TO PUT NAME STRING
MOVE B,SUBJFN
MOVSI C,(1B8) ;REQUEST NAME
JFNS ;GET NAME FIELD FROM JFN
ERCAL JERRE
MOVE A,CSBUFP
MOVEI C,0
JFNS ;CREATE NAME FOR PRINTING AFTER SAVE COMPLETES
HRROI A,SSBUF
CALL GETSIX ;GET SIXBIT OF NAME
JFCL ;USE BEGINNING IF PROBLEM IN MIDDLE
NOXTND,<
MOVEM A,PTTYMD+TTWPNM ;SAVE RESULT
MOVEM A,PTTYMD+TTWSNM ;SAVE AS SUBSYSTEM NAME TOO
>
XTND,<
MOVEM A,TTWPNM(Q1) ; SAVE SUBSYSTEM INFO
MOVEM A,TTWSNM(Q1)
>
;NOW SEE IF NAME CAME FROM DSK:<SUBSYS>, OTHERWISE USE (PRIV)
MOVE A,SUBJFN ;RECOVER JFN
DVCHR
TXNN B,DV%MDD ;DEVICE HAS DIRECTORIES?
JRST SUBNP ;NO, NOT DISK
HRROI A,SSBUF ;SETUP PLACE FOR DIR NAME
MOVE B,SUBJFN ;RECOVER JFN
MOVSI C,(1B5) ;REQUEST DIRECTORY NAME
JFNS
ERCAL JERRE
HRROI A,SSBUF
MOVE B,[POINT 7,[ASCIZ /SUBSYS/]]
stcmp ;compare names
jumpe a,subnx ;jump if names the same
jrst subnp
;USE (PRIV) FOR SYSTEM NAME
SUBNP: MOVE A,[SIXBIT /(PRIV)/]
NOXTND,<
MOVEM A,PTTYMD+TTWSNM
>
XTND,<
MOVEM A,TTWSNM(Q1)
>
SUBNX: RET
;GOTO <OCTAL #>
.GOTO: MOVE B,A ;ADDRESS INTO B FOR USE BELOW
SKIPGE FORK ;CHECK HANDLE OF FORK KNOWN TO EXEC
ERROR <No program> ;NONE AT ALL
PUSH P,B ;Save B over MAPPF
CALL MAPPF ;MAP PAGE CONTAINING ADDRESS. GETS ACCESS.
JRST CJERRE ;Can't map it-- say why
TXNN B,PA%PEX
ERROR <No such page>
TXNN B,PA%EX
ERROR <Can't execute that page>
POP P,B ;Get start address back
CALL CHKPAT ;SETUP STUFF FOR PA1050 IF LOADED
;RESCAN ON GOTO
CALL CRSCAN
;START FORK AT ADDRESS IN B
;"DDT" JOINS HERE
GOTO2:: CALL GOTOR ;DO THE WORK
JRST (A) ;DISPATCH TO APPROPRIATE PLACE
;ROUTINE TO START THE LOWER FORK
;ACCEPTS IN B/ ADDRESS TO START AT (UNLESS LH IS NON-ZERO)
;RETURNS +1: ALWAYS - A/ ADDRESS TO DISPATCH TO WHEN FORK DONE
GOTOR:: CALL SETGO ;Setup for program running
TLNN B,1 ;Don't start fork if CHKPAT did
SFORK ;START FORK (USES A AND B)
ERJMP CJERRE ;Failed-- type JSYS error
CALLRET WAITA ;WAIT FOR IT TO TERMINATE
;"RUN" IS WITH "GET" ABOVE
CSTKLN==50 ;ARG STACK SIZE FOR CSCAVE AND SAVE
DEFINE SAVSTG
< STKVAR <<SAVSTK,CSTKLN>,SAVJFN>
>
;CSAVE (CORE FROM) N (TO) N, (FROM) N (TO) N ... (ON) F
.CSAVE:: SAVSTG
SKIPGE FORK
ERROR <No program>
CALL SAVNAM
MOVEM A,SAVJFN ;REMEMBER JFN
MOVEI Q2,-1+SAVSTK ;FORM STACK POINTER TO ARG STACK
HRLI Q2,-CSTKLN ;USE COUNT TO CATCH TOO MANY ARGUMENTS
SAVE1: NOISE <WORDS FROM>
DEFX <20> ;BEGINNING OF BLOCK DEFAULTS TO 20
octx <First word of memory block to be saved, in octal, or carriage return>
CMERRX
PUSH Q2,B ;BUILD TABLE OF "SAVE" ARGUMENTS IN PUSHDOWN
NOISE <TO>
DEFX <777777> ;THIS IS DEFAULT END OF BLOCK
OCTX <Last word of memory block to be saved, octal>
CMERRX
SUB B,(Q2)
JUMPL B,[ERROR <Second address is smaller than first>]
ADDI B,1
TLNE B,1
JRST [ MOVEI B,1B18 ;FOR 0 TO 777777 LENGTH IS 1000000,
HRLM B,(Q2) ;...WHICH IS MORE THAN 18 BITS,
PUSH Q2,[XWD 400000,400000] ;...SO USE TWO BLOCKS OF HALF SIZE.
JRST .+2]
HRLM B,(Q2) ;FORM XWD LENGTH,LOCATION
COMMAX <Comma to specify another block or confirm with carriage return>
CAIA ;NOT COMMA
JRST SAVE1 ;USER TYPED COMMA, INPUT ANOTHER PAIR
MOVE Q3,[SAVE] ;GET APPROPRIATE JSYS
DOSAV: CONFIRM
PUSH Q2,[0] ;TERMINATE TABLE
NOXTND,<
HRRZ A,SAVJFN
CALL SUBNAM ;SAVE PROGNAME IN STRING SPACE
>
XTND,<
MOVE A,FORK
MOVE B,SAVJFN
CALL SFKNAM ; SETUP FORK NAME
>
HRL A,FORK
HRR A,SAVJFN
MOVEI B,SAVSTK ;GET ADDRESS OF TABLE
XCT Q3 ;SAVE. IGNORES NON-EXISTENT OR 0 CORE.
ERJMP ILISSA
CALLRET SAVPNT ;PRINT "PROGNAME SAVED"
;SAVE (PAGES FROM) N (TO) N, (FROM) N (TO) N ... (ON) FILE
.SAVE:: SAVSTG ;ALLOCATE STORAGE
SAV9: SKIPGE FORK
ERROR <No program>
CALL SAVNAM
MOVEM A,SAVJFN ;REMEMBER PROGRAM
MOVEI Q2,-1+SAVSTK ;FORM STACK POINTER TO ARGUMENT LIST
HRLI Q2,-CSTKLN ;CATCH OVERVERBOSITY
SSAV1: NOISE <PAGES FROM>
defx <0> ;beginning of block defaults to page 0
octx <First page of memory block to save, in octal,
or carriage return to save all of memory>
CMERRX
CAILE B,777
JRST CERR
PUSH Q2,B
NOISE (TO)
DEFX <777> ;DEFAULT END OF BLOCK IS PAGE 777
OCTX <Last page of memory block to be saved>
CMERRX
SUB B,(Q2) ;FORM -# PAGES
MOVN B,B ;..
SUBI B,1 ;..
JUMPGE B,CERR
HRLM B,(Q2)
MOVX A,SS%UCA+SS%CPY+SS%RD+SS%EXE+SS%WR ;DON'T CHANGE ACCESS
IORM A,(Q2) ;PUT PROTECTION IN TABLE WORD
COMMAX <Comma or confirm with carriage return>
CAIA ;NO COMMA TYPED
JRST SSAV1 ;COMMA TYPED, GO GET NEXT BLOCK
MOVE Q3,[SSAVE] ;SET UP CORRECT JSYS
JRST DOSAV
ILISSA: CALL %GETER
MOVE A,ERCOD
MOVE C,SAVJFN
CALLRET OPNERR ;ANALYZE ERROR
SAVNAM: NOISE <ON FILE>
NOXTND,<
SKIPLE FORK ;IS THERE AN ACTIVE FORK?
SKIPN C,PTTYMD+TTWPNM ;YES, GET PROGRAM NAME IF ANY
JRST SAVNM2
>
XTND,< SKIPLE C,FORK ; ACTIVE FORK?
SKIPN C,SLFTAB(C) ; YES - FRKTBL ENTRY
JRST SAVNM2
SKIPE C,.FKPTM+TTWPNM(C) ; GET NAME IF ANY
>
CAMN C,['(PRIV)'] ;THIS IS STANDARD NULL NAME
JRST SAVNM2
MOVE A,CSBUFP ;SOME SCRATCH STRING SPACE
SAVNM1: MOVEI B,"V"-100
IDPB B,A
SETZ B,
LSHC B,6
ADDI B,40
IDPB B,A
JUMPN C,SAVNM1
IDPB C,A
MOVE A,CSBUFP ;GET POINTER TO STRING
CALL BUFFS ;ISOLATE IT
HRL A,A ;PUT FILENAME STRING ADDRESS IN LEFT HALF
HRRI A,[GETSAVE()]
JRST SAVNM3
SAVNM2: HRROI A,[GETSAVE()]
SAVNM3: CALL CSAVFN
JRST CERR
RET
SAVPNT: MOVE A,CSBUFP ;GET POINTER TO NAME
ETYPE < %1M Saved
>
RET
;START
;DECODE AND CHECK SUBROUTINE ALSO USED BY REDIRECT/DETACH
$START::SKIPGE A,FORK ;HANDLE OF INFERIOR FORK, OR -1
ERROR <No program>
GEVEC
HLRZ B,B
CAIGE B,1
ERROR <No START address>
RET
;START COMMAND DISPATCHES HERE
.START::NOISE <PROGRAM>
SETZM STAYF
XTND,<
COMMAX <Comma to enter subcommands,
Octal start address
or Confirm with carriage return>
JRST .STRT0 ; NO COMMA
CALL .CONT3 ; HANDLE SUB-COMMANDS (SET MODE)
JRST .STRT1 ; COMMON CODE
>
.STRT0: CRRX <Octal start address
or Confirm with carriage return>
CAIA ;NOT JUST CR TYPED
JRST .STRT1 ;JUST CR, START AT REAL START ADDRESS
MOVEI A,[ASCIZ /Octal start address/]
MOVEI B,[ASCIZ /Confirm with carriage return/]
CALL OCTCOM ;Allow large start address
HRRZS A ;Truncate to 18-bits for now
CONFIRM
JRST .GOTO
.STRT1: CALL $START ;GET ADDRS
XTND,<
JRST STR1
>
NOXTND,<
; JRST ..STRT ;JOIN COMMON CODE
>
;"RUN" JOINS HERE
;REDIRECT/DETACH...(AND) START JOINS HERE
..STRT::SETZM STAYF
STR1: MOVNI B,1 ;START CODE FOR PA1050
CALL CHKPAT
JUMPG B,.+2 ;PA1050 START IF POSITIVE
SETZ B, ;ENTRY VECTOR INDEX 0 FOR START
;START FORK WHOSE HANDLE IS IN "FORK" USING ENTRY VECTOR INDEX IN B.
;"REENTER" JOINS HERE.
..STCR::
CALL SETGO ;Setup for program running
CAIL B,1000 ;PROPER ENTRY VECTOR DISPATCH?
JRST [ TLNN B,1 ;Don't start fork if CHKPAT did
SFORK ;NO, PA1050 OR OTHER SPECIAL START
ERJMP CJERRE ;Failed-- type JSYS error
JRST WAITR]
SFRKV ;START FORK USING ENTRY VECTOR (USES A,B)
ERJMP CJERRE
;GIVE LAST COMMAND BUFFER TO MONITOR FOR USER RSCAN
WAITR: CALL CRSCAN
;START AND REENTER...
;CONTINUE AND GOTO JOIN HERE.
;ANY OF THE ABOVE WITH REDIRECT OR DETACH ALSO GET HERE.
;WAIT FOR FORK TO TERMINATE, AFTER DETACHING TERMINAL IF "DTACHF" ON.
WAITF::
;NOW WAIT FOR FORK TO TERMINATE
CALL WAITA ;WAIT FOR FORK TO TERMINATE
JRST (A) ;DISPATCH TO NEXT ROUTINE TO BE RUN
;ROUTINE TO WAIT FOR A FORK TO TERMINATE
;RETURNS +1: ALWAYS - A/ ADDRESS OF NEXT ROUTINE TO DISPATCH TO
WAITA:
;CHECK AND DETACH TERMINAL
TLNE Z,DTACHF ;"DETACH" COMMAND?
DTACH ;YES, DETACH CONTROLLING TERMINAL.
SKIPN STAYF ;DON'T SET PROGRAM MODE IF STAYING AT COMMAND LEVEL
CALL SETPRG ;SAY PROGRAM MODE
NOXTND,<
MOVE A,FORK ;HANDLE OF THE INFERIOR THAT'S BEING RUN.
RFORK ;RESUME
>
XTND,<
MOVE A,RUNFK ; FORK WE ARE REALLY RUNNING
RFORK ; RESUME IT
MOVX B,FK%RUN ; SAY WE RAN IT
SKIPE SLFTAB(A) ; KNOW ABOUT THIS ONE?
IORM B,SLFTAB(A) ; YES - MARK AS RUN
>
SETZM CIPF ;CLEAR "COMMAND IN PROGRESS", SO ^T REPORTS WHAT PROGRAM'S DOING
SKIPE STAYF ;STAYING AT COMMAND LEVEL?
JRST NOWAIT ;YES, DONT'T WAIT FOR PROGRAM TO HALT
NOXTND,<
MOVE A,FORK
>
WFORKX: WFORK ;WAIT. WFORKX: M-U-S-T BE ON WFORK
FFORK ;FREEZE IT IMMEDIATELY
NOWAIT:
NOXTND,<
MOVE A,FORK
;FORK HAS TERMINATED. HANDLE IN A.
MOVEI Q1,PTTYMD ;SAVE TTY MODES, AS MODIFIED BY PROGRAM
CALL RTTYMD ;..
SKIPE STAYF ;STAY AT COMMAND LEVEL?
SETZM PTTYMD+TTWPNM ;PREVENT (SEE EXPLANATION BELOW)
>
XTND,<
MOVE A,RUNFK ; HANDLE TO A (FORK JUST RUN)
CALL RFTYMD ; SAVE PROGRAM MODES
SKIPE STAYF ; STAY AT COMMAND LEVEL?
SETZM TTWPNM(Q1) ; YES - PREVENT
>
; @LOAD FOO
; MACRO: ...
; ^C
; @CONTINUE STAY
; @...
; LINK: LOADING
; EXIT
; SAVE
; MACRO.EXE SAVED
;NAME SHOULD BE "FOO". THIS SETZM
;WILL REQUIRE NAME AFTER "SAVE"
;IF LINK LEFT NAME SOMEWHERE IN ADDRESS
;SPACE OR PSB (FOR JSYS TO READ), WE
;COULD MAKE "SAVE<CR>" WORK IN THIS CASE
TLZ Z,RUNF ;SAY PROG'S TTY MODES NOT IN EFFECT
MOVEI Q1,ETTYMD ;RESTORE EXEC'S TTY MODES
CALL LTTYMD ;..
;ANALYZE REASON FOR TERMINATION
MOVEI B,.RFSFL+1 ;Set up for long format RFSTS
MOVEM B,LRFSTS+.RFCNT
HRLI A,(RF%LNG) ;Ask for long format
MOVEI B,LRFSTS
RFSTS ;READ FORK STATUS (HANDLE IN A)
MOVE B,LRFSTS+.RFPSW ;Get status word
TLNN B,077700 ;DISTINGUISH -1 FROM 0-5, 400000-400005.
JRST FRKTRM
SETOM FORK ;-1 = UNASSIGNED HANDLE, SAY NO FORK.
XTND,< SETOM RUNFK>
NOXTND,< SETZM DDTFLG>
ERROR <Program disappeared out from under EXEC!>
FRKTRM: STKVAR <<PRBUF,PRLEN>,PRPTR>
SKIPE STAYF ;NOT WAITING FOR PROGRAM TO STOP?
JRST FRKTRN ;YES, SO DON'T WORRY ABOUT STATUS
CAME B,[1B0+2B17]
CAMN B,[2B17] ;VOLUNTARY TERMINATION IS NORMAL
SKIPA A,FORK ;GET FORK HANDLE
JRST FKTRM1 ;SOMETHING ELSE
HRLI A,.PRARD ;SET TO READ
MOVEI B,PRBUF ;USE THIS
MOVEI C,PRLEN ;A GOOD MAX
PRARG ;READ PROCESS ARGS
ERJMP FRKTRN ;IGNORE IF FAILURE
CAIGE C,3 ;MIN ARG
JRST FRKTRN ;IGNORE
HLRZ A,1+PRBUF ;CHECK HEADER
MOVE B,PRBUF
CAIN B,1 ;# OF ARGS
CAIE A,(4B2+17B12) ;CHECK TYPE
JRST [CALL PRCLR ;CLEAR JUNK
JRST FRKTRN] ;EXIT TO MAIN LUP
CALL PRCLR ;CLEAR PROCESS ARGS
HRRZ B,1+PRBUF ;OFFSET OF FIRST ARG
HRROI A,PRBUF ;ADDRESS OF START OF BLOCK
ADD A,B ;MAKE BYTE POINTER TO FILESPEC (IF EXISTS)
HRRZM A,PRPTR ;REMEMBER ADDRESS OF FILESPEC
CALL BUFFS ;ISOLATE THE FILESPEC
MOVE B,A ;POINTER TO FILESPEC IN B
SKIPN @PRPTR ;SEE IF NULL STRING
SKIPA A,[CMAGN] ;YES - REDO LAST LOAD CMD
MOVEI A,DOCC2 ;TRY TO RUN IT
RET
FRKTRN: MOVEI A,CMDIN2 ;GO TO START OF PARSER
RET
PRCLR: HRRZ A,FORK ;SET TO CLEAR ARGS
HRLI A,.PRAST
SETZB B,C
PRARG
RET
;Here if fork terminates involuntarily after START or REENTER.
;Print reason. Fork handle is in A, status in B.
FKTRM1: LDB C,[POINTR B,RF%STS] ;Get reason minus frozen bit
CAIN C,.RFABK ;ADDRESS BREAK?
JRST [ SOSGE ABKCNT ;DECREMENT REPEAT COUNTER
JRST FKTRM2 ;COUNTER EXPIRED, REPORT IT
JRST WAITA] ;NOT EXPIRED, KEEP RUNNING FORK
CAIN C,.RFTRP ;JSYS/UUO TRAP???
JRST [ MOVE B,LRFSTS+.RFPPC ;Load PC for use with %Y
ERROR <JSYS or UUO trap at %2Y>]
CAIE C,.RFFPT ;FORCED TERMINATION (UNENABLED ERROR PSI)
ERROR <Unusual fork termination status %2O>
MOVEI C,(B) ;MASK PSI CHANNEL THAT CAUSED IT
CAIG C,^D35 ;CHECK AGAINST TABLE LIMITS
CAIGE C,0 ;..
ERROR <Illegal PSI channel %3Q on forced termination>
MOVE A,FORK ;Load fork handle for possible %X
MOVE B,LRFSTS+.RFPPC ;Load PC for possible %Y below
;Message table addressed by WHY is also used by INFORMATION PROGRAM.
;Expects A to contain fork handle for %X, B to contain full word PC
;for possible %Y, and C to contain the channel for possible %Q.
WHY:: XCT .+1(C) ;ERROR MESSAGE FROM TABLE FOLLOWING
ERROR <Channel %3Q interrupt at %2Y> ;Chan 0 These happen if program
ERROR <Channel %3Q interrupt at %2Y> ;Chan 1 activates channel but
ERROR <Channel %3Q interrupt at %2Y> ;Chan 2 does not EIR or SIR or
ERROR <Channel %3Q interrupt at %2Y> ;Chan 3 table word for channel
ERROR <Channel %3Q interrupt at %2Y> ;Chan 4
ERROR <Channel %3Q interrupt at %2Y> ;Chan 5
ERROR <Overflow at %2Y> ;Chan 6
ERROR <Floating overflow at %2Y> ;Chan 7
ERROR <Channel %3Q interrupt at %2Y> ;Chan 8
ERROR <Pushdown overflow at %2Y> ;Chan 9
ERROR <End-of-file at %2Y> ;Chan 10
ERROR <IO data error at %2Y> ;Chan 11
ERROR <Quota exceeded or disk full at %2Y> ;Chan 12
ERROR <File error 4 interrupt at %2Y> ;Chan 13 "file condition 4"
ERROR <Channel %3Q interrupt at %2Y> ;Chan 14. Time of day.
ERROR <Illegal instruction %1X> ;Chan 15. Prints PC, sys msg if JSYS.
ERROR <Illegal memory READ at %2Y> ;Chan 16
ERROR <Illegal memory WRITE at %2Y> ;Chan 17
ERROR <Illegal memory EXECUTE at %2Y> ;Chan 18
ERROR <Fork termination interrupt at %2Y> ;Chan 19
ERROR <File or swapping space exceeded at %2Y> ;Chan 20
REPEAT ^D15,<ERROR <Channel %3Q interrupt at %2Y>
> ;Chan 21-35
;HERE ON ADDRESS BREAK
FKTRM2: SKIPG A,FORK ;GET FORK HANDLE
JRST [ TYPE <No program> ;UNLESS THERE IS NONE
JRST CMDIN2]
HRLI A,.ABRED ;FUNCTION TO READ ADDR BREAK STUFF
ADBRK ;GET ADDR BREAK INFO
MOVE A,LRFSTS+.RFPPC ;Get user's PC in case it was a JSYS
ETYPE <%_%%%Address break at location %2Y from user PC %1Y%%_>
JRST CMDIN2 ;GO TO MAIN SCANNER LOOP
;HERE ON INFERIOR FORK TERMINATION INTERRUPT
INFTRM::PUSH P,A ;GET AN AC
PUSH P,B
PUSH P,C
PUSH P,D
NOXTND,<
MOVE A,FORK ;GET CURRENT FORK
>
XTND,<
CALL INFTR0
>
RFSTS ;GET ITS STATUS
ERJMP INF1 ;IF FAILS, IGNORE
TXNN A,RF%FRZ ;TURN OFF AND TEST FOR FROZENESS
JRST INF2 ;NOT FROZEN, SO WFORK WILL FALL THROUGH NATURALLY
;NOTE: WITHOUT THE ABOVE FROZENESS TEST, THE EXEC
;WILL BE FOOLED INTO THINKING WFORK WOULD BE FORCED
;TO DROP THROUGH IN THE EVENT OF "FORK 1" TERMINATING
;WHILE CURRENT FORK IS "FORK 2".
INF1: HRRZ A,LEV1PC ;GET PC OF INTERRUPTED INSTR+1
CAIE A,WFORKX
CAIN A,WFORKX+1 ;SEE IF WAITING FOR PROGRAM TO STOP
CALL [ MOVSI A,1000 ;LIGHT USERMODE BIT IN LEV1PC
IORM A,LEV1PC ;SO WFORK DROPS OUT
RET]
INF2: POP P,D
POP P,C
POP P,B
POP P,A ;RESTORE A
DEBRK ;AND RETURN
XTND,<
INFTR0: STKVAR <<SQS,3>,<TRFSTS,.RFSFL+1>,SRFPC>
DMOVEM Q1,SQS
MOVEM Q3,2+SQS
MOVSI Q1,-NFRKS ; LOOK AT ALL FORK
INFTR1: SKIPE Q2,FRKTAB(Q1) ; EXISTANT FORK?
TXNN Q2,FK%BKG ; BACKGROUND FORK?
JRST INFTR3 ; NO - KEEP LOOKING
MOVEI A,.FHSLF(Q1) ; FORM HANDLE
MOVEI B,.RFSFL+1 ; LENGTH OF LONG RFSTS BLOCK
MOVEM B,.RFCNT+TRFSTS
MOVEI B,TRFSTS ; POINT TO TEMP BLOCK
TXO A,RF%LNG
RFSTS ; READ ITS STATUS
LDB C,[POINTR <.RFPSW+TRFSTS>,RF%STS] ; GET CODE
CAIN C,.RFHLT ; HALTED?
JRST INFTR2 ; YES - INFORM USER
CAIN C,.RFTTY ; WANTS TTY?
JRST [ TXOE Q2,FK%TTY ; BLOCKED FOR TTY?
JRST INFTR3 ; BEEN HERE BEFORE
HRROI Q3,[ASCIZ "wants the TTY"]
JRST INFTR4] ; INFORM USER FIRST TIME THROUGH
CAIN C,.RFABK ; ADDRESS BREAK
JRST [ HRROI Q3,[ASCIZ "Address break"]
JRST INFT2C]
CAIN C,.RFTRP ; MAYBE JSYS TRAP
JRST [ HRROI Q3,[ASCIZ "JSYS/UUO trap at %2Y"]
JRST INFT2C]
CAIE C,.RFFPT ; FORCED TERMINATION?
JRST INFTR3 ; NO - GO ON
HRRZ C,.RFPSW+TRFSTS ; PSI CHL THAT CAUSED TERMINATION
CAIG C,^D35 ; CHECK VALID CHL
CAIGE C,0
JRST [ HRROI Q3,[ASCIZ "Illegal PSI channel %3Q"]
JRST INFT2C]
HRRO Q3,WHY+1(C) ; SOFTWARE CHL REASON
JRST INFT2C
INFTR2: HRROI Q3,[ASCIZ "finished at %A"]
MIC,<
MOVEI B,.FHSLF(Q1) ; FORM FORK HANDLE
CAMN B,MICFRK ; IS THIS THE MIC?
JRST [ TXZ Q2,FK%BKG ; REMOVE FROM BACKGROUND
MOVEM Q2,FRKTAB(Q1) ; STORE UPDATED STATUS
JRST INFTR3]
>
INFT2C: TXZ Q2,FK%BKG ; NO LONGER BACKGROUND
TXNN Q2,FK%PRI!FK%PRO ; FORK HAVE PRIMARIES CHANGED?
JRST INFTR4 ; NO - REPORT CONDITION
MOVEI A,.FHSLF ; GET PRIMARY I/O FOR SELF
GPJFN
MOVE D,B ; SAVE IN D
MOVEI A,.FHSLF(Q1) ; FORK HANDLE
GPJFN ; GET INFERIORS JFNS
TXZN Q2,FK%PRI ; PRIMARY INPUT CHANGED?
JRST INFT2A ; NO - LOOK AT OUTPUT
HLRZ A,B ; JFN TO A
CAIGE A,100 ; IS IT A FILE? (BE CAREFUL)
CLOSF ; YES - CLOSE IT
JFCL
HLL B,D ; RESET FROM OURS
INFT2A: TXZN Q2,FK%PRO ; PRIMARY OUTPUT CHANGED?
JRST INFT2B ; NO - SET NEW PRIMARY JFNS
HRRZ A,B ; JFN TO A
CAIGE A,100 ; FILE?
CLOSF ; YES - CLOSE IT
JFCL
HRR B,D ; RESET FROM OURS
INFT2B: MOVEI A,.FHSLF(Q1) ; FORK HANDLE
SPJFN ; SET NEW PRIMARY JFNS
INFTR4: MOVEM Q2,FRKTAB(Q1) ; UPDATE FORK FLAGS
TXNN Q2,FK%NAM ; FORK HAVE NAME?
SKIPA Q2,[POINT 7,[ASCIZ "Fork %5P"]]
HRROI Q2,.FKNAM(Q2) ; POINT TO NAME STRING
MOVEI A,.FHSLF(Q1) ; LOAD FORK HANDLE FOR POSSIBLE %X
MOVE B,LRFSTS+.RFPPC ; SAVE THIS (%X USES)
MOVEM B,SRFPC
MOVE B,.RFPPC+TRFSTS ; LOAD PC FOR POSSIBLE %Y
MOVEM B,LRFSTS+.RFPPC ; STORE IN LRFSTS ALSO
HRRZ C,.RFPSW+TRFSTS ; LOAD PSI CHL FOR POSSIBLE %Q
ETYPE <[%6\: %7\]%_>
MOVE B,SRFPC ; RESTORE PC USED BY %X
MOVEM B,LRFSTS+.RFPPC
INFTR3: AOBJN Q1,INFTR1 ; LOOP OVER ALL FORKS
DMOVE Q1,SQS ; RESTORE TERM ACS
MOVE Q3,2+SQS
MOVE A,RUNFK ; RETURN THIS FORK
RET
>
; SETGO - Setup everything to leave EXEC to program mode
; Returns A/ Fork handle
SETGO:: PUSH P,B ;Save B over MAPPF
SETO A,
CALL MAPPF ;UNSHARE MAPPED PAGE, IF ANY
JFCL ;Unmap should never fail
POP P,B ;Restore
NOXTND,<
MOVEI Q1,PTTYMD ;SET UP PROGRAM'S TELETYPE MODES
CALL LTTYMD ;..
>
XTND,<
CALL UTTYMD ; SETUP PROGRAM MODES
>
TLO Z,RUNF ;SAY PROGRAM'S TELETYPE MODES ARE IN EFFECT
MOVE A,FORK ;RETURN FORK HANDLE
XTND,<
MOVEM A,RUNFK ; STORE IN RUNFK
>
RET
;ROUTINE CALLED BY .CLOSE TO CLOSE ALL OPEN FILES IN COMPATIBLE PROGRAMS
;THIS ROUTINE CHECKS IF THE PROGRAM IS COMPATIBLE, THEN STARTS IT WITH
;A -5 ENTRY CODE (CLOSE COMMAND).
;RETURNS +1: ALWAYS - ALL FILES UNMAPPED
CLOPAT::MOVNI B,5 ;SET UP FOR CHKPAT
SETZM STAYF
CALL CHKPAT ;SEE IF THIS IS A COMPATIBLE PROGRAM
JUMPLE B,R ;B IS POSITIVE IF YES
CALL GOTOR ;GO START IT AND WAIT FOR IT TO HALT
RET ;ALL DONE, FILES ARE UNMAPPED
;ROUTINE TO SETUP FORK IF PA1050 HAS BEEN INVOKED. START, REENTER, CLOSE,
; GOTO, AND DDT ALL GO TO PA1050 INSTEAD OF THE PROGRAM.
; THE PREVIOUS FORK PC IS ALSO GIVEN TO PA1050, AND IT IN TURN
; FINDS THE PROGRAM'S OLD PC, SETS UP JOBOPC, AND STARTS THE PGM.
; WORD 6 OF THE PA1050 ENTRY VECTOR IS THE START LOCATION FOR THIS.
; LH OF WORD 7 IS WHERE TO STORE FUNCTION CODE: -1 START, -2 REENTER,
; -3 DDT, +N GOTO N
; RH OF WORD 7 IS WHERE TO STORE FORK'S OLD PC
CHKPAT: STKVAR <PATCOD,SAVAC,SAVAC2>
MOVEM B,PATCOD
MOVE A,FORK
GCVEC ;PA1050 ENTRY VECTOR
ERJMP NOPAXL ;IF NO FORK, THEN NOTHING TO BE DONE
CAMN B,[-1] ;PA1050 DISABLED?
JRST NOPAXL ;NO PA1050
HLRZ C,B ;CHECK FOR LENGTH GREATER THAN 8
CAIGE C,1000 ;WHICH ELIMINATES OLD PA1050 VERSIONS
CAIGE C,10 ;AS WELL AS NON-PA1050 PGMS.
JRST NOPAXL
MOVEI A,6(B)
MOVEM B,SAVAC ;DON'T CLOBBER ENTRY VECTOR INFO
CALL LOADF ;GET PA1050 RESTART LOC
CALL CJERRE ;BOMB OUT (JRST NOPAXL WOULD CAUSE REENTER TO DO THE WRONG THING!)
EXCH A,PATCOD ;SAVE IT, GET CODE WORD
MOVE B,SAVAC ;Restore
MOVEM A,SAVAC
MOVEI A,7(B)
CALL LOADF ;GET PTRS FOR RESTART DATA
CALL CJERRE ;Can't read it, assume no PA1050
MOVEM A,SAVAC2
MOVE A,FORK
RFSTS ;GET FORK'S OLD PC
HLRZ A,A
CAIE A,400002 ;HALT OR FORCE TERM?
CAIN A,400003
JRST [ MOVE A,FORK ;YES, MUST RESTART FORK
SFORK
ERJMP NOPAX1 ;Failed-- assume no PA1050
JRST .+1]
HRRZ A,SAVAC2 ;PTR TO CELL FOR IT
CALL STOREF ;STORE OLD PC IN PA1050 VARIABLE AREA
CALL CJERRE ;Can't set it, assume no PA1050
HLRZ A,SAVAC2 ;PTR TO CELL FOR CODE WORD
MOVE B,SAVAC ;CODE WORD
CALL STOREF ;STORE IT
CALL CJERRE ;Can't set it, assume no PA1050
MOVE B,PATCOD ;RETURN PA1050 RESTART LOC IN B
MOVNI A,0(B) ;IF RH OF WD 6 IS .L. 36, IT IS
CAMG A,[-^D36] ;PSI CHANNEL TO BE GOOSED RATHER THAN
RET ;A RESTART LOCATION
MOVSI B,(1B0) ;COMPUTE PROPER BIT
LSH B,0(A)
MOVE A,FORK
AIC ;BE SURE CHANNEL ON AND PSI ON
EIR
IIC
MOVSI B,1 ;RETURN LH NON-0 TO PREVENT SFORK
RET
NOPAX1: MOVE B,SAVAC2 ;RETURN ORIGINAL START ADDRESS
RET
NOPAXL: MOVE B,PATCOD
RET
;HAND LAST COMMAND LINE TO MONITOR FOR RSCAN
CRSCAN:: PUSH P,A
PUSH P,B
SKIPN A,RSPTR ;GET POINTER TO DATA FOR SENDING TO PROGRAM
HRROI A,CBUF ;USE COMMAND ITSELF, IF NO SPECIAL LINE
RSCAN
TYPE <
%RSCAN failure. Rescanned command truncated, will try to go on.
>
POP P,B
POP P,A
RET
XTND,<
;ROUTINES TO HANDLE EPHEMERALS
;ENTER WITH JFN IN A
REPH:: PUSH P,[CMDIN2] ; RETURN HERE
STEPH:: MOVEI B,0 ; ENTRY VECTOR START OFFSET
REPH1:: STKVAR <PJFN,EVOFF>
MOVEM A,PJFN ; SAVE JFN
MOVEM B,EVOFF ; SAVE OFFSET
SETO A,
CALL MAPPF ; UNMAP FORK PAGE (IF ANY)
CALL PIOFF ; MUST DISABLE ^C TO MUCK WITH EFORK
MOVX A,CR%CAP ; PASS ON CAPS
CFORK
JRST [ CALL PION
ERROR <No forks left - "RESET" some>]
FFORK ; MAKE SURE FROZEN
MOVEM A,EFORK ; SAVE FORK HANDLE
MOVEI A,.FHSLF ; GET CURRENT CAPS (INCLUDING ENABLED)
RPCAP
MOVE A,EFORK ; AND PASS THEM ON
EPCAP
MOVE A,PJFN ; JFN TO A (BEFORE STACK IS MUNGED)
; *** BEWARE OF STKVAR VARIABLES ***
ADJSP P,2 ; MAKE SOME SPACE FOR PROGRAM NAMES
MOVEI Q1,-5(P) ; DUMMY POINTER FOR SUBNAM
CALL SUBNAM ; SET SUBSYS NAME
POP P,B ; RECOVER DUMMY NAME ENTRIES
POP P,A
; *** STACK RECOVERED ***
SETSN
ERJMP .+1
CALL PION ; RE-ENABLE ^C
MOVEI A,GETILI ; WHERE TO GO ON "GET" ERROR
MOVEM A,ILIDSP
HRRZ A,PJFN ; GET JFN OF PROGRAM NAME
HRL A,EFORK ; FORK HANDLE
GET
SETZM ILIDSP ; CLEAR ERROR ADDRS
MOVE A,EFORK
CALL CRSCAN ; LOAD RE-SCAN BUFFER IF NECESSARY
MOVE B,EVOFF ; RECOVER E-V OFFSET
SFRKV ; START FORK
SETZM CIPF ; NO COMMAND IN PROGRESS
RFORK ; THAW IT
WEPHM: WFORK ; WAIT FOR IT TO TERMINATE
CALL PIOFF ; DISABLE ^C
MOVE A,EFORK
FFORK ; FREEZE IT
MOVEI B,.RFSFL+1 ; SETUP FOR LONG FORM RFSTS
MOVEM B,LRFSTS+.RFCNT
TXO A,RF%LNG ; ASK FOR LONG FORM
MOVEI B,LRFSTS
RFSTS ; READ FORK STATUS (HANDLE IN A)
MOVE A,LRFSTS+.RFPSW ; GET STATUS WORD
TXZ A,RF%FRZ ; WE KNOW ITS FROZEN
CAMN A,[.RFHLT,,0] ; HALTED?
JRST [ MOVE A,EFORK ; YES - JUST KILL IT OFF
KFORK
SETOM EFORK ; NO MORE EPHEMERON
CALLRET PION] ; EXIT (CMDIN2)
TLNE A,077700 ; FORK EXISTS?
JRST [ SETOM EFORK ; NO - MUST HAVE SELF DESTRUCTED
CALL PION
ERROR <Ephemeron committed suicide!>]
CALL PION
TYPE <During Ephemeron: >
JRST FKTRM1 ; TELL OF LOSSAGE
>
END