Trailing-Edge
-
PDP-10 Archives
-
decuslib20-02
-
decus/20-0028/exec.325
There are 2 other files named exec.325 in the archive. Click here to see a list.
TITLE EXEC COMMAND SCANNER FOR SNOBOL
SUBTTL THIS ASSEMBLY MADE WITH EXEC.325
MLON ;ALLOW MULTI LINE LITERALS
IFNDEF REENTR,<REENTR==1>
IFN REENTR,<
TWOSEG
RELOC ^O400000 ;PUT INTO HIGH SEGMENT
>
;CCLSW=1 - GIVES NEW COMMAND LANGUAGE FEATURES
IFNDEF CCLSW,<CCLSW=1> ;NORMALLY ASSEMBLE WITH CCL FEATURES
IFE CCLSW,<TEMPC==0>
INTERNAL CCLSW ;LOADER ERR MESSAGE IF OTHER SUB PROGS DIFFER
INTERNAL ACSAVE
IFN CCLSW,<EXTERNAL CCLFLA>
IFNDEF CCLDMP,<CCLDMP=0> ;FOR CCL, 1 MEANS DO DUMP MODE IO
IFNDEF TEMPC,<TEMPC==0> ;TMPCOR UUO CAN BE USED IF SET TO 1
EXTERN SNONAM
EXTERN SRCFIL
EXTERN ICORE
INTERNAL DSKNIT,RESTRT
ENTRY F4EXEC
EXTERNAL LSTFIL,DEVTB.,SNOBOL
EXTERNAL JOBFF, JOBREL
INTERNAL LSTFLG, BINFLG, CSWFLG, ESWFLG, MSWFLG, TTYFLG
EXTERNAL PDPSET,JOBFFI
EXTERNAL XE, XE1, XE2, XE3
EXTERNAL AC00, AC01, AC02, AC03
EXTERNAL AC04, AC05, AC06, AC07
EXTERNAL AC10, AC11, AC12, AC13
EXTERNAL AC14,AC15,AC16,SNOFLG
IFN TEMPC,
<
EXTERNAL TMPFIL, TMPFLG
>
EXTERNAL CMDBUF, CMDPNT, CMDCNT
EXTERNAL TTOBUF, TTOPNT, TTOCNT
INTERNAL GETSRC
INTERNAL DSWFLG, HDRBIT, MOTFLG
;BITS FOR GETCHR STATUS AND IO STATUS CALLS:
TTYDEV= 10 ;1-DEVICE IS A TTY
OUTBIT= 1 ;1-DEVICE CAN DO OUTPUT
INBIT= 2 ;2-DEVICE CAN DO INPUT
IODATA= 200000 ;1-IO DATA ERROR
IODEV= 100000 ;1-IO PARITY ERROR
IOWRLK= 400000 ;1 IO WRITE LOCK ERROR
IOBKTL= 40000 ;1-IO BLOCK TOO LARGE
IOEOF= 20000 ;1-END OF FILE ON IO DEVICE
BINMOD= 14 ;BINARY MODE
ALMODE= 1 ;ASCII LINE MODE
%00= 0
%01= 1
%02= 2
%03= 3
%04= 4
%05= 5
%06= 6
%07= 7
%10= 10
%11= 11
%12= 12
%13= 13
%14= 14
%15= 15
%16= 16
%17= 17
OPDEF RESET [CALLI 0]
OPDEF DEVCHR [CALLI 4]
OPDEF CORE [CALLI 11]
OPDEF UTPCLR [CALLI 13]
OPDEF DATE [CALLI 14]
OPDEF MSTIME [CALLI 23]
OPDEF PJOB [CALLI 30]
OPDEF EXIT [CALLI 12]
OPDEF SETNAM [CALLI 43]
OPDEF RUN [CALLI 35]
OPDEF SETDDT [CALLI 2]
OPDEF DDTOUT [CALLI 3]
OPDEF TMPCOR [CALLI 44]
;COMPILER AND EXEC FLAGS
;FLAGS SET BY EXEC, USED BY COMPILER (LEFT HALF OF AC 16)
LSTBIT= 001 ; 1-SUPRESS LISTING OUTPUT
BINBIT= 002 ; 1-SUPRESS BINARY OUTPUT
CSWBIT= 004 ; 1-SUPRESS CROSS REFERENCE
ESWBIT= 010 ; 1-SUPRESS LISTING OF BINARY
MSWBIT= 020 ; 1-SUPRESS MACRO LISTING
NSWBIT= 040 ; 1-SUPRESS ERRORS ON TTY
SSWBIT= 100 ; 1-TOGGLE MODE OF OUTPUT
TTYBIT= 200 ; 1-LISTING IS ON TTY
LSTFLG= LSTBIT_9
BINFLG= BINBIT_9
ONEFIL=BINFLG
; STEAL THIS BIT TO INDICATE A COMMAND OF THE FORM FOO<CR>
; TO MEAN DSK:FOO.LST_DSK:FOO.SNO
CSWFLG= <LSTBIT!CSWBIT>_9
ESWFLG= <LSTBIT!ESWBIT>_9
MSWFLG= <LSTBIT!MSWBIT>_9
TTYFLG= <LSTBIT!TTYBIT>_9
DSWFLG= 400 ; 1-SUPPRESSES LONG ERROR MESSAGES
MOTFLG= TTYFLG!MSWFLG ;M SWITCH OR TTY LISTING FLAG
;VARIABLE PARAMETERS
IFNDEF PAGSIZ,
<
PAGSIZ= ^D53 ;NUMBER OF LINES ON A PAGE
>
;FLAGS SET AND USED ONLY BY THE EXEC
ARWBIT= 1 ;1-LEFT ARROW SEEN
EXTBIT= 2 ;1-EXPLICIT EXTENSION SEEN
SWTBIT= 4 ;1-ENTER SWITCH MODE
INFOBIT=10 ;1-VALID INFORMATION SEEN
FILBIT= 20 ;1-EXPLICIT FILE NAME SEEN
NORBIT= 100 ;1-NORMAL MODE COMMAND
ENDBIT= 400 ;1-END OF ALL INPUT FILES
SLSHBIT=1000 ;1-SWITCH MODE ENTERED WITH A </>
STNBIT= 2000 ;1-MORE THAN ONE STANDARD FILE
NULBIT= 10000 ;1-NON-NULL COMMAND STRING
EOFBIT= 20000 ;1-END OF FILE ENCOUNTERED
NCDBIT= 40000 ;1-NEXT CARD ALREADY IN BUFFER
HDRBIT=100000 ;1-NEW PAGE WITH HEADER
TTO= 0 ;DEVICE PARAMETERS
BIN= 1
LST= 2
SRC= 3
CMD= 17
CRFEOF= 37 ;FLAG FOR CREF PROGRAM BREAK
XX= 0 ;INDICATES INSTRUCTION MODIFICATION
;INITIALIZATION OF FORTRAN IV EXECUTIVE PROGRAM
;THE EXEC HAS THREE ENTRY POINTS:
; 1. F4EXEC - THE EXEC SHOULD BE ENTERED HERE ONLY AT
; THE BEGINNING. IT CALLS SIXBIT /RESET/ TO INITIALIZE
; THE IO DEVICES BEFORE FALLING INTO RSTRT1.
; 2. RSTRT1 - THIS ENTRY POINT IS USED EVERY TIME A NEW
; COMMAND STRING IS DESIRED. THIS WILL HAPPEN AFTER ONE
; NORMAL MODE COMMAND STRING (I.E. WITH LEFT ARROWS,
; COLONS ETC.) OR AFTER THE LAST OF A NUMBER OF STANDARD
; COMMANDS HAVE BEEN PROCESSED. RSTRT1 FIRST CHECKS
; TO SEE HOW MUCH CORE IS AVAILABLE TO THE JOB. A CARD
; BUFFER IS SET UP TO HOLD 5 CARDS OR 19 CARDS, AND
; AN INDEX REGISTER IS SET FOR SINGLE OR DOUBLE IO
; BUFFERS, DEPENDING ON THE AMOUNT OF CORE. AFTER
; INITIALIZING THE TTY FOR IO, THE CONTENTS OF JOBFF
; ARE SAVED SO THAT A LATER ENTRY AT RSTRT2 WILL NOT
; CLOBBER THE REMAINDER OF THE COMMAND STRING
; 3. RSTRT2 - THIS IS THE ENTRY POINT USED FOR STANDARD
; COMMANDS. AFTER EACH FILE OF A STANDARD COMMAND
; HAS BEEN PROCESSED, THE EXEC RETURNS TO RSTRT2,
; RE-INITIALIZES THE PUSHDOWN LIST, AND SETS UP OTHER
; PARAMETERS OF COMPILATION.
IFN CCLSW,<IFN CCLDMP,<
JOBDDT= 74 ;CONTAINS STARTING LOCATION OF DDT IF LOADED
JOBS41= 122 ;WHERE JOB LOCATION 41 IS SAVED
JOBCOR= 133 ;CONTAINS NUMBER OF WORDS OF CORE IN USE
INTERNAL JOBDDT,JOBS41,JOBCOR
;IF JOB DATA AREA CHANGES, THIS WILL
;CAUSE LOADER ERROR MESSAGES. GOOD!
EXTERNAL JOBSA,JOB41
RUNDMP: IOWD XX,INHERE ;DMP MODE COMMAND LIST
0 ;STOP DMP MODE IO
RUN2: IN BIN,RUNDMP ;START DUMP MODE IO GOING
JRST RUN3 ;NO ERRORS, GO TO AC'S FOR MORE
RUN2A: MOVEI %00,RUNERR
DDTOUT %00, ;TYPE ERR MESSAGE (REST OF CORE IS GONE)
EXIT
RUNERR: ASCIZ /LINKAGE ERROR/
INHERE: ;THE DUMP MODE IO STARTS LOADING
; NEXT PROG HERE
RUNUUO: MOVEI %00,16 ;SET IO MODE FOR "OPEN" UUO
SKIPN %01 ;ANY DEVICE SPECIFIED?
MOVSI %01,(SIXBIT /SYS/);NO ASSUME SYS
MOVEI %02,0 ;NO BUFFER HEADERS
TRNN %16,EXTBIT ;PERIOD TYPED?
MOVEM %14,XE ;NO, THEN FILENAME IS IN %14
TRNN %16,EXTBIT ;PERIOD TYPED?
MOVSI %14,(SIXBIT /SAV/);NO EXT SPECIFIED ASSUME SAV
HLLZM %14,XE1 ;SET UP EXTENSION
OPEN BIN,%00 ;INIT DEVICE FOR DUMP MODE
JRST RUNER1 ;FAILED
LOOKUP BIN,XE
JRST [MOVSI %14,(SIXBIT /DMP/) ;LOOKUP FAILED, TRY AGAIN
HLLZM %14,XE1 ;ASSUME DMP THIS TIME
TRNN %16,EXTBIT ;WAS EXTENSION EXPLICIT?
LOOKUP BIN,XE ;WILL THIS LOOKUP FAIL?
JRST RUNER1 ;YES, YES, TYPE ERR MESSAGE
JRST .+1] ;"." IS LOC OF JRST TO LITERAL
HLRO %10,XE3 ;GET NEG. WORD COUNT OF DUMP FILE
HRLM %10,RUNDMP ;SAVE IN DMP MODE COMMAND LIST
MOVNS %10 ;GET POS. WORD COUNT
MOVEI %14,JOBDDT-1(%10) ;FIND LAST ADR OF RUNABLE NEW PROGRAM
HRRM %14,RUNBLT+RUNBEG ;SAVE AS "E" FOR THE BLT
MOVE %01,XE ;GET NEW FILE NAME FOR SETNAM
MOVEI %14,INHERE(%10) ;GET LAST ADR OF DUMP FILE IN CORE
JSP %10,DELFIL ;DELETE COMMAND FILE
CORE %14, ;GET AMOUNT OF CORE NECESSARY
JRST RUNER2 ;NEEDED MORE AND COULDN'T GET IT
SETNAM %01, ;MAKE SYSDPY WORK RIGHT
MOVSI %17,RUNBEG
BLT %17,BLTAC ;LOAD AC'S WITH FINAL CODE
JRST RUN2 ;NEXT CODE IS AT BEGINNING SO IT WON'T
;BE OVER WRITTEN BY IO
RUNER1: JSP %10,ERROR
SIXBIT /LINKAGE ERROR FOR 23]/
RUNER2: JSP %10,ERROR
SIXBIT /NOT ENOUGH CORE FOR LINKAGE]/
RUNBEG: PHASE 0 ;THIS CODE RUNS IN AC'S
RUN3: SKIPE RUNAC,INHERE+JOBCOR-JOBDDT ;GET CORE SIZE TO RUN IN
CAMG RUNAC,JOBREL ;DO WE HAVE ENOUGH CORE?
JRST RUN4 ;YES, OR IT DOESN'T MATTER
CORE RUNAC, ;NO, GET THE CORE
JRST RUN2A ;IT FAILED
RUN4: MOVE RUNAC,JOBS41+INHERE-JOBDDT ;GET NEXT PROGRAM'S JOB41
MOVEM RUNAC,JOB41 ;SET IT UP
MOVE RUNAC,INHERE+JOBDDT-JOBDDT ;GET NEXT JOBDDT
SETDDT RUNAC, ;AND SET IT UP WITH UUO
RUNBLT: BLT BLTAC,XX ;ADR MODIFIED
RESET
AOS 1,JOBSA ;GET STARTING ADDRESS
JRST 0(1) ;START UP NEXT PROGRAM
BLTAC: XWD INHERE+1,JOBDDT+1 ;MOVE PROGRAM DOWN (JOBDDT ALREADY SET UP)
RUNAC= . ;TEMP AC
DEPHASE ;AND BACK TO NORMAL ASSEMBLY
>>
;PATCH: BLOCK 50
; INTERNAL PATCH
F4EXEC:
IFN CCLSW,
< TDZA 0,0 ;NORMAL ENTRY, CLEAR CCL FLAG
SETOM 0 ;CCL ENTRY, SET FLAG
MOVEM 0,CCLFLA ;SAVE FLAG (CCL_-1)(NO CCL_0)
>
RESET ;RESET ALL I/O
MOVE %17,PDPSET ;INIT PUSH DOWN LIST POINTER
IFN CCLSW,
< SKIPE CCLFLA ;CCL BEING USED?
PUSHJ %17,DSKNIT ;YES, INIT DSK FOR COMMAND FILE, SKIP RETURN
>
PUSHJ %17,TTINIT ;NO, INIT TTY FOR COMMANDS
INBUF CMD,1 ;SET UP 1 INPUT BUFFER
HRRZ %00,JOBFF
HRLM %00,JOBFFI ;SAVE THIS POINT TO RE-INIT FOR NEXT CCL COMMAND
NXTCCL: ;THE NEXT CCL COMMAND IS PROCESSED STARTING HERE
MOVE %17,PDPSET ;INIT PUSH DOWN LIST POINTER
MOVSI %16,BINBIT!LSTBIT!CSWBIT!ESWBIT!LSTFLG ;SUPPRESS ALL OUTPUTS (EXCEPT TTY)
PUSHJ %17,TTONIT ;INIT TTY FOR OUTPUT
IFN CCLSW,
< SKIPE CCLFLA
JRST RSTRT2 ;DON'T TYPE * IF DOING CCL STUFF
>
MOVEI %02,"*" ;TYPE AN ASTERISK AT THE USER
PUSHJ %17,TTYDMP ;...
OUTPUT TTO, ;REALLY OUTPUT IT
UNITI=5
UNITO=6
; THESE DEFINITIONS MUST CORRESPOND TO THOSE MADE IN 'MACROS'
RSTRT2:JFCL
EXTERN VARPRT
SETZM MSWIT
SETZM DMPFLG
SETZM UNFLAG
; MAKE THE /D AND /U SWITCH SETTINGS GOOD FOR ONLY
; ONE RUN. MUST BE RESET EACH TIME
MOVE %02,[SIXBIT .DSK5.]
MOVEM %02,DEVTB.+UNITI
MOVE %02,[SIXBIT .DSK6.]
MOVEM %02,DEVTB.+UNITO ;FOR REINITIALIZATION PURPOSES
IFN CCLSW,
< SKIPE CCLFLA ;OR USING CCL MODE?
TRO %16,NORBIT ;YES, USE NORMAL COMMAND SCANNER
>
;THE FOLLOWING SECTION OF CODE IS ENTERED EITHER AFTER
;SUCCESSIVE CALLS TO GETBIN,GETLST AND GETSRC, OR AFTER
;THE STANDARD SUBROUTINE FINISHES INITIALIZING A FILE. IT
;SAVES THE FLAG ACCUMULATOR (AC %16), THEN SAVES ALL THE EXEC
;ACCUMULATORS. IF THERE IS A BINARY FILE, IT CALLS OUTBIN
;TO DO AN INITIAL OUTPUT AND SET UP ACCUMULATOR C. SIMILARLY,
;IF THERE IS A LISTING FILE, A CALL IS MADE TO HDRSET (A SUB-
;SECTION OF LSTOUT) TO PRINT THE TITLE, DATE AND TIME ON THE
;FIRST PAGE BEFORE THE COMPILER IS CALLED. FINALLY, INFORMATION
;ABOUT THE BEGINNING AND END OF ROLL MEMORY IS SET UP IN ROLMEM
;AND ACCUMULATOR ZERO ACCORDING TO THE FOLLOWING FORMAT:
; 1. AC 0 - RIGHT HALF HAS ABSOLUTE ADDRESS OF HIGHEST
; LOCATION OF ROLL MEMORY. LEFT HALF HAS ABSOLUTE
; ADDRESS OF FIRST WORD OF ROLL MEMORY.
; 2. ROLMEM - SAME FORMAT AS AC 0, BUT WITH LEFT HALF
; AND RIGHT HALF EXCHANGED.
PUSHJ %17,GETLST ;INITIALIZE THE LISTING FILE
SETZB %01,XE3 ;NO HOLD OVER ON DEVICE OR PROJ,PROG #'S
TRZN %16,ONEFIL
PUSHJ %17,GETSRC ;INITIALIZE THE SOURCE FILE
SRCOK:
IFN CCLSW, ;PRINT MESSAGE GIVING NAME OF FILE COMPILING
< MOVEI %10,[SIXBIT /SNOBOL: 34]/]
SKIPE CCLFLA ;CCL MODE?
PUSHJ %17,LSTMS3
>
REST1: PUSHJ %17,ACSAVE ;SAVE EXEC AC'S
JRST SNOBOL ;CALL THE COMPILER
IFN CCLSW,
<
DSKNIT: ;INIT DSK FOR CCL
IFN TEMPC,
< MOVE %00,JOBFF
ADDI %00,200 ;GET ENOUGH BUFFER SPACE
CORE %00, ;GET CORE !
JRST F4EXEC ;NO CORE AVAILABLE
HRRZ %00,JOBFF ;USE JOBFF AS START OF CCL BUFFER
HRRM %00,CMDPNT ;DUMMY UP BUFFER HEADER
HRRM %00,TMPFIL+1 ;SET UP TMPCOR READ BLOCK
SOS TMPFIL+1 ;MAKE IT PROPER IOWD FORMAT
HRRI %01,(SIXBIT /SNO/)
HRLM %01,TMPFIL ;SETUP NAME OF FILE TO BE READ
MOVNI %01,200 ;AND WORD COUNT
HRLM %01,TMPFIL+1 ;IN READ BLOCK
MOVE %01,[XWD 2,TMPFIL] ;SET UP AC FOR A READ
TMPCOR %01, ;READ AND DELETE "FOR" FILE
JRST TMPEND ;NO FILE IN CORE TRY DISK
ADD %00,%01 ;GET END OF FILE
MOVEM %00,JOBFF ;UPDATE JOBFF SO FILE ISN'T WIPED OUT
HRLM %00,JOBFFI ;SAVE FOR LATER
IMULI %01,5 ;CALCULATE CHARACTER COUNT
MOVEM %01,CMDCNT ;STORE IN BUFFER HEADER
MOVSI %01,(POINT 7,,) ;BYTE POINTER
HLLM %01,CMDPNT ;BUFFER HEADER NOW SETUP
SETOM TMPFLG ;MARK THAT TMPCOR UUO IN PROGRESS
POP %17,%02 ;POP OFF RETURN
JRST NXTCCL ;RETURN TO MAIN STREAM
TMPEND:
>
MOVEI %00,3 ;INIT 3 DIGIT COUNTER
PJOB %02, ;GET JOB NUMBER
DSKNI1: IDIVI %02,^D10 ;GET LAST DIGIT
ADDI %03,"0"-40 ;CONVERT TO SIXBIT
LSHC %03,-6 ;SLIDE CHAR INTO AC4
SOJG %00,DSKNI1 ;3 CHARS YET?
HRRI %04,(SIXBIT /SNO/) ;YES, GET FILENAME ###SNO.TMP
MOVEM %04,XE ;SAVE FILE NAME IN LOOKUP DIRECTORY
MOVSI %04,(SIXBIT /TMP/) ;SET UP EXTENSION
MOVEM %04,XE1 ;SAVE EXTENSION IN LOOKUP DIRECTORY
SETZM XE3 ;ZERO PROJ,PROG #'S
MOVEI %00,ALMODE ;ASCII LINE DATA MODE
MOVSI %01,(SIXBIT /DSK/)
MOVEI %02,CMDBUF ;GET BUFFER HEADER ADDRESS
OPEN CMD,%00 ;INIT DSK OK?
JRST DSKNI2 ;NO, TYPE MESSAGE
LOOKUP CMD,XE ;LOOKUP ###SNO.TMP ON DISK
JRST DSKNI2 ;FILE NOT FOUND
JRST CPOPJ1 ;FILE FOUND, SKIP RETURN
DSKNI2: MOVE %00,JOBFF
HRLM %00,JOBFFI
JRST ERRCF1
>
;INITIALIZE A LISTING FILE
;COLLECTS A DEVICE NAME IN AC %01, A FILE NAME IN XE AND
;AN OPTIONAL FILENAME EXTENSION,
; IF THE DEVICE IS A TTY, THE
;TTYLST FLAG IS SET TO 1, AND THE INBUF/OUTBUF INDEX IS INCREMENTED.
GETLST: SETZM LSTFIL+2
MOVEI %01,0
PUSHJ %17,GETCHR ;GET A DEVICE AND FILE NAME
MOVSI %01,(SIXBIT/TTY/) ;DEFAULT
LST2:
IFN CCLSW,
< SKIPN %01
SKIPA ;IF NONE SPECIFIED, LEAVE IT AT FIL25
>
MOVEM %01,DEVTB.+UNITO
LST3: TRNE %16,ARWBIT ;STANDARD FILE?
TRZN %16,EXTBIT ;WAS THERE AN EXTENSION?
MOVSI %14,(SIXBIT /LST/) ;NO
HLLZM %14,LSTFIL+1
MOVE %14,XE
MOVEM %14,LSTFIL ;SAVE FOR SNOBOL
SKIPE %14,XE3
MOVEM %14,LSTFIL+2 ;STORE PPN
TRNN %16,ONEFIL ;SPECIAL CASE FOR SNOBOL?
POPJ %17, ;EXIT
MOVSI %14,(SIXBIT /SNO/)
HLLZM %14,SRCFIL+1
MOVE %14,LSTFIL
MOVEM %14,SRCFIL
POPJ %17,
;INITIALIZE A SOURCE FILE
;COLLECTS A DEVICE NAME IN AC %01, A FILE NAME IN XE AND
;AN OPTIONAL FILE NAME EXTENSION.
;AND THE FILE NAME ASSOCIATED
;WITH THE SOURCE FILE IS USED AS THE TITLE ON THE LISTING.
GETSRC: SETZM SRCFIL+2
MOVE %01,[SIXBIT .DSK5.]
MOVEM %01,DEVTB.+UNITI ;REDO FOR MULTIPLE SEGMENT SOURCE
;FILE SPECIFICATIONS
SETZB %01,XE3
PUSHJ %17,GETCHR ;GET A DEVICE NAME AND FILE NAME
MOVSI %01,(SIXBIT/TTY/) ;DEFAULT
SRC2:IFN CCLSW,
< SKIPN %01
SKIPA ;IF NOE SPECIFIED, LEAVE IT AT FIL26
>
MOVEM %01,DEVTB.+UNITI
SRC3: TRZE %16,EXTBIT ;WAS AN EXPLICIT EXTENSION SEEN?
JRST SRC3A ;YES, LOOK FOR IT
MOVSI %14,(SIXBIT /SNO/)
SRC3A:
SRC3B: HLLZM %14,SRCFIL+1
MOVE %14,XE
MOVEM %14,SRCFIL
SKIPE %14,XE3 ;PPN SPECIFIED?
MOVEM %14,SRCFIL+2
POPJ %17, ;EXIT
;THE FOLLOWING SMALL ROUTINES PROCESS THE VARIOUS CHARACTERS
;FOUND IN THE COMMAND STRING. THE VARIOUS PECULIARITIES OF THE
;ROUTINES ARE AS FOLLOWS:
; 1. THE LEFT ARROW ROUTINE IDENTIFIES THE COMMAND STRING
; AS BEING OF NORMAL MODE. IT ALSO ACTS AS A FILE
; SPECIFICATION DELIMITER
; 2. THE PERIOD ROUTINE IDENTIFIES THE FOLLOWING THREE
; CHARACTER WORD AS BEING A FILE NAME EXTENSION. THE
; CURRENT WORD IN AC %14 IS STORED AS THE FILE NAME,
; AND THE ROUTINE PROCEEDS TO GATHER THE EXTENSION.
; 3. THE COLON ROUTINE IDENTIFIES THE COMMAND STRNG AS
; A NORMAL MODE COMMAND, AND ALSO DELIMITS A DEVICE
; NAME. THE DEVICE NAME IS PUT IN AC %00+1, AND THE ROUTIE
; RETURNS TO GETCHR TO GATHER MORE OF THE FILE.
; 4. THE COMMA ROUTINE LOOKS FOR A NULL FILE, OTHERWISE
; DISTINGUISHES BETWEEN STANDARD COMMANDS AND NORMAL
; COMMANDS.
; 5. THE CARRIAGE RETURN ROUTINE CHECKS TO SEE IF IT IS
; JUST A RANDOM CARRIAGE RETURN. IF NOT, IT IS TREATED
; THE SAME AS A COMMA
;LEFT ARROW PROCESSOR
LFTARW: TRO %16,ARWBIT+NORBIT;SET APPROPRIATE FLAGS
TRNN %16,EXTBIT ;IS THIS A FILE NAME EXTENSION?
MOVEM %14,XE ;NO, ITS A FILE NAME
TRZE %16,INFOBIT ;IS THIS A NULL FILE?
CPOPJ1: AOS (%17) ;GOOD EXIT
CPOPJ: POPJ %17, ;...
;PERIOD PROCESSOR
PERIOD: TRO %16,EXTBIT ;SET FLAG FOR EXPLICIT EXTENSION
MOVEM %14,XE ;SAVE THE FILE NAME
JRST GETCHR ;RE-ENTER THE GETCHR ROUTINE
;COLON PROCESSOR
COLON: TRO %16,NORBIT ;SET FLAG FOR NORMAL MODE COMMAND
TRZ %16,FILBIT ;IF CHAR. FOLLOW, FILE NAME
MOVE %01,%14 ;SET UP NEW DEVICE NAME
JRST GETCHR ;RETURN FOR MORE COMMAND
;COMMA PROCESSOR
COMMA: TRZN %16,INFOBIT+FILBIT ;IS THIS A NULL FILE? FILBIT IS AN EXTRA
TRNE %16,ARWBIT ;ONLY LOOK FOR THEM IF NO _
SKIPA ;NOT A NULL FILE
POPJ %17, ;NULL FILE, EXIT
COMMA1: TRNN %16,EXTBIT ;DO WE HAVE A FILE NAME EXTENSION?
MOVEM %14,XE ;NO, IT WAS A FILE NAME
JRST CPOPJ1 ;GOOD EXIT
;CARRIAGE RETURN PROCESSOR
CARRTN: TRZN %16,NULBIT
JRST CHKSNO
TRNE %16,ARWBIT
JRST COMMA1
SKIPE %14 ;DONT SET THIS BIT IF "/C<CR>"
TRO %16,ONEFIL
JRST COMMA1 ;YES, TREAT IT LIKE A COMMA
CHKSNO: SKIPN SNOFLG ;ENTERED FROM SNOBOL?
JRST F4EXEC ;NO
EXTERN ETMCL,FAIL
SKIPN ETMCL ;IN THE INTERPRETER?
JRST CHKS1
SETOM XE ;FLAG AS END
JRST CPOPJ1
MOVSI %01,(SIXBIT /TTY/)
CHKS1: TTCALL 3,[ASCIZ /
WAITING FOR TTY INPUT
/]
JRST COMMA1
STNLST:
ERRXCT: <SIXBIT /SRC/>+ERR1
<SIXBIT /LST/>+ERR2
<SIXBIT /BIN/>+ERR3
XWD 0,ERR4
;EXEC COMMAND STRING DISPATCHING
;THIS ROUTINE PICKS UP CHARACTERS FROM THE EXEC TTY BUFFER AND
;DISPATCHES TO THE PROPER ROUTINE DEPENDING ON THE TYPE OF
;CHARACTER. A TABLE OF BYTES AND BYTE POINTERS ALLOWS EACH CHARAC-
;TER IN THE ASCII SET TO BE TREATED INDIVIDUALLY.
GETCHR: SETZ %14, ;CLEAR SYMBOL WORD
MOVE %06,[POINT 6,%14]
GETCMN: PUSHJ %17,GETCMD ;GET NEXT CHARACTER
CAIN %05,"[" ;PROJECT-PROGRAMMER PAIR?
JRST LFTBRA ;YES
CAIGE %10,4 ;MODIFY CODE IF .GE. 4
TRNN %16,SWTBIT ;MODIFY IF SWITCH IS ON
ADDI %10,4 ;CHANGE DISPATCH BY ADDING 4
HRRZ %02,DSPTCH(%10) ;LOAD RIGHT HALF DISPATCH
CAIL %10,10 ;SKIP IF CORRECT
HLRZ %02,DSPTCH-10(%10);OTHERWISE, GET LEFT HALF DSPTCH
JRST @%02 ;GO TO CORRECT ROUTINE
GETCMD: SOSG CMDCNT ;DECREMENT CHAR COUNT. ANY LEFT?
PUSHJ %17,GETCM1 ;NO, GET ANOTHER BUFFER FULL
ILDB %05,CMDPNT ;GET A CHARACTER FROM TTY BUFFER
IFN CCLSW,
< MOVE %00,@CMDPNT ;GET WORD CONTAINING LAST BYTE
TRNE %00,1 ;WAS SEQUENCE # BIT ON?
JRST [MOVNI %00,5 ;YES
ADDM %00,CMDCNT ;REDUCE COUNT BY 5 BYTES
AOS CMDPNT ;ADVANCE BYTE POINTER INTO NEXT WORD
JRST GETCMD] ;GO GET ANOTHER CHARACTER
>
CAIN %05,175 ;NO, IS CHARACTER OLD ALT-MODE?
MOVEI %05,33 ;YES, MAKE IT NEW ALT-MODE
CAIL %05,140 ;IS CHAR LOWER CASE?
TRZ %05,40 ;YES, CHANGE TO UPPER CASE
MOVE %10,%05 ;ANOTHER COPY OF IT IN AC %10
IDIVI %10,^D9 ;TRANSLATE TO 4-BIT CODE
LDB %10,TABLE(%11) ;USE PROPER BYTE POINTER
CAIN %10,4 ;IS IT A NULL?
JRST GETCMD ;YES, TRY AGAIN
POPJ %17, ;NO, EXIT
GETCM1:
IFN CCLSW,<IFN TEMPC,
< SKIPE TMPFLG ;IS A TMPCOR UUO GOING ?
JRST GETCM2 ;YES,THEN WE ARE DONE !
>>
SKIPE SNOFLG ;HANDLE ^Z PROPERLY
JRST GETCM2
IN CMD, ;GET NEXT BUFFER
POPJ %17, ;NO ERRORS OR END-OF-FILE
STATZ CMD,IODATA!IODEV!IOBKTL
JRST ERRCMD ;DATA ERRORS
GETCM2: MOVEI %05,15 ;FOR EOF (AND NO CCL MODE) RETURN CARR RET.
IFN CCLSW,
< SKIPN CCLFLA> ;SKIP FOR CCL MODE COMMANDS
JRST CPOPJ1 ;FOR NON-CCL, SKIP RETURN WITH CARR. RET.
IFN CCLSW,
< JSP %10,DELFIL ;DELETE COMMAND FILE
EXIT
>
;COMMAND DISPATCH TABLE AND BYTE POINTERS
DSPTCH: XWD GETCMN, ERRBS ;IGNORED CHAR, BAD CHAR(SWITCH)
XWD SWTCH, SWTCHA ;<(>, LETTER(SWITCH MODE)
XWD COLON, ERRBS ;<:>, NUMBER(SWITCH MODE)
XWD PERIOD, SWTCHE ;<.>,<)>ESCAPE SWITCH MODE
XWD LFTARW, ERRIC ;<_> OR <=>, BAD CHAR (NORMAL MODE)
XWD COMMA, STORE ;<,>,ALPHABETICH CHAR (NORMAL)
XWD CARRTN, STORE ;<CR>,NUMERIC CHAR (NORMAL)
XWD SLASH, ERRIC ;</>, <)> ILLEGAL ESCAPE
IFN CCLSW,
< XWD RUNUUO,0>
IFE CCLSW,
< XWD ERRIC,0>
TABLE: POINT 4, BITE(%10), 3
POINT 4, BITE(%10), 7
POINT 4, BITE(%10), 11
POINT 4, BITE(%10), 15
POINT 4, BITE(%10), 19
POINT 4, BITE(%10), 23
POINT 4, BITE(%10), 27
POINT 4, BITE(%10), 31
POINT 4, BITE(%10), 35
;BYTE TABLE FOR DISPATCHING
;CLASSIFICATION BYTE CODES
; BYTE DISP CLASSIFICATION
; 00 00 ILLEGAL CHARACTER, SWITCH MODE
; 01 01 ALPHABETIC CHARACTER, SWITCH MODE
; 02 02 NUMERIC CHARACTER, SWTICH MODE
; 03 03 SWITCH MODE ESCAPE, SWITCH MODE
; 00 04 ILLEGAL CHARACTER, NORMAL MODE
; 01 05 ALPHABETIC CHARACTER, NORMAL MODE
; 02 06 NUMERIC CHARACTER, NORMAL MODE
; 03 07 SWITCH MODE ESCAPE, NORMAL MODE
; 04 10 IGNORED CHARACTER
; 05 11 ENTER SWITCH MODE WITH A <(>
; 06 12 DEVICE DELIMITER, <:>
; 07 13 FILE EXTENSION DELIMITER, <.>
; 10 14 OUTPUT SPEC. DELIMITER, <_> OR <=>
; 11 15 FILE DELIMITER, <,>
; 12 16 COMMAND TERMINATOR, <CR>
; 13 17 ENTER SWITCH MODE WITH </>
; 14 18 CCL FILE DELIMITER
;BYTE TABLE:
BITE: BYTE (4) 4,0,0,0,0,0,0,0,0
BYTE (4) 4,12,4,4,12,0,0,0,0
BYTE (4) 0,0,0,0,0,0,0,0,12
BYTE (4) 12,0,0,0,0,4,14,4,0
BYTE (4) 0,0,0,0,5,3,0,0,11
BYTE (4) 0,7,13,2,2,2,2,2,2
BYTE (4) 2,2,2,2,6,0,0,10,0
BYTE (4) 14,0,1,1,1,1,1,1,1
BYTE (4) 1,1,1,1,1,1,1,1,1
BYTE (4) 1,1,1,1,1,1,1,1,1
BYTE (4) 1,0,0,0,0,10,0,0,0
REPEAT 0, ;LOWER CASE CHARS ARE CHANGED TO UPPER CASE
< BYTE (4) 0,0,0,0,0,0,0,0,0
BYTE (4) 0,0,0,0,0,0,0,0,0
BYTE (4) 0,0,0,0,0,0,0,0,12
BYTE (4) 0,4
>
;THE FOLLOWING TWO ROUTINES HANDLE ALPHANUMERIC CHARACTERS
;FOUND IN THE COMMAND STRING. IN NORMAL MODE, THE CHARACTER
;IS DEPOSITED TO FORM A SIXBIT SYMBOL. IN SWITCH MODE, THE
;PROPER INSTRUCTION IS EXECUTED WITH THE AID OF A DISPATCH
;TABLE. THEN, IF SWITCH MODE WAS ENTERED WITH A SLASH, THE
;EXEC EXITS FROM SWITCH MODE.
STORE: TRO %16,INFOBIT+NULBIT+FILBIT;TURN ON BITS FOR CR ROUTINE
SUBI %05,40 ;CONVERT SIXBIT TO ASCII
TLNE %06,770000 ;DON'T STORE IF NO ROOM FOR CHAR
IDPB %05,%06 ;PLOP THE CHARACTER INTO AC %14
JRST GETCMN ;RETURN
SWTCHA: MOVEI %11,-"A"(%05)
MOVE %10,[POINT 4,BYTAB]
IBP %10
SOJGE %11,.-1
LDB %11,%10
JUMPE %11,ERRBS ;ILLEGAL SWITCH IF ZERO
CAILE %11,SWTABA-SWTAB ;SWITCH TO BE SET AFTER _ ?
JRST SWTSET ;YES, SET SWITCH
TRNE %16,ARWBIT ;HAS _ BEEN SEEN?
JRST ERRLA ;YES, ERROR
CAILE %11,SWTABB-SWTAB ;SWITCH TO BE SET AFTER FIRST STANDARD FILE ?
JRST SWTSET ;YES, SET SWITCH
TRNE %16,STNBIT ;HAS FIRST STANDARD FILE BEEN SEEN ?
JRST ERRSF ;YES ERROR
SWTSET: XCT SWTAB-1(%11)
JRST ERRBS
TRZE %16,SLSHBIT ;CALLED BY A SLASH?
TRZ %16,SWTBIT ;YES, EXIT FROM SWITCH MODE
JRST GETCMN ;NO, RETURN FOR MORE CHARACTERS
;THE FOLLOWING THREE ROUTINES HANDLE THE CONTROL CHARACTERS
;IN THE COMMAND STRING WHICH CAUSE THE EXEC TO ENTER INTO AND
;EXIT FROM SWITCH MODE. THERE ARE TWO TYPES OF SWITCH MODE,
;DEPENDING ON WHETHER IT IS ENTERED WITH A </> OR A <(>.
SLASH: TRO %16,SLSHBIT ;TURN ON THE SPECIAL SWITCH MODE
SWTCH: TROA %16,SWTBIT ;TURN ON NORMAL SWITCH MODE
SWTCHE: TRZ %16,SWTBIT ;TURN OFF THE NORMAL SWITCH MODE
JRST GETCMN ;RETURN FOR MORE CHARACTERS
; THIS ROUTINE IS USED TO AID IN MEASURING THE EFFICIENCY
; OO THE HASH CODING. IT ALLOWS THE SYSTEM PROGRAMMER TO
; NATURALLY INPUT A FILE NAME VIA /SFOOBAR.
TSTSET: MOVE 0,LSTFIL
MOVEM 0,TSTNAM
MOVE 0,LSTFIL+1
MOVEM 0,TSTNAM+1
JRST F4EXEC
INTERN CSWSET
CSWSET:
EXTERN DTLIST,ARTHNO
EXTERN MSWIT,ILIST%
CORCHN==^O16 ;MUST BE CONSISTENT WITH DEFINITION
; MADE IN COMMON SUBROUTINES (INTCOR ROUTINE)
INIT CORCHN,17 ;DUMP MODE,RANDOM CHANNEL
SIXBIT/DSK/
Z
HALT .
MOVEI %01,ARTHNO
SUBI %01,DTLIST
MOVNS %01
HRLM %01,ILIST%
MOVEI %01,DTLIST-1 ;FIX UP IOWD
HRRM %01,ILIST%
SETZM ILIST%+1
ENTER CORCHN,SNONAM
SKIPA ;IGNORE SINCE WE MAY COME THRU HERE MANY TIMES
OUTPUT CORCHN,ILIST%
RELEAS CORCHN,
JRST CPOPJ1
;DISPATCH TABLE FOR SWITCHES
DEFINE SETSW (LETTER, INSTRUCTION) <
INSTRUCTION
Y=<"LETTER"-"A">-^D9*<X=<"LETTER"-"A">/^D9>
SETCOD \X,Y>
DEFINE SETCOD (X,Y)
<BYTAB'X=BYTAB'X!<.-SWTAB>B<4*Y+3>>
BYTAB0= 0
BYTAB1= 0
BYTAB2= 0
SWTAB:
SWTABB:
SWTABA:
SETSW C,<PUSHJ %17,CSWSET>
SETSW M,<SOSA MSWIT>
EXTERN DMPFLG
SETSW D,<SOSA DMPFLG>
EXTERN UNFLAG
SETSW U,<SOSA UNFLAG>
EXTERN TSTNAM
SETSW S,<PUSHJ %17,TSTSET>
EXTERN VARPRT
SETSW V,<SOSA VARPRT>
EXTERN NUMIOB
SETSW I,<AOSA NUMIOB>
BYTAB: +BYTAB0
+BYTAB1
+BYTAB2
IF2, <PURGE X, Y, BYTAB0, BYTAB1, BYTAB2 >
LFTBRA: SETZM XE3 ;CLEAR NUMBER
LFTBR1: HRLZS XE3 ;COMMA, MOVE TO LEFT HALF
LFTBR2: PUSHJ %17,GETCMD ;GET NEXT CHAR
CAIN %05,"]" ;TERMINAL?
JRST GETCMN ;YES, EXIT
CAIN %05,"," ;SEPARATOR?
JRST LFTBR1 ;YES
CAIL %05,"0" ;TEST FOR OCTAL NUMBER
CAILE %05,"7"
JRST ERRIC ;IMPROPER CHARACTER
HRRZ %10,XE3 ;OK, GET PREVIOUS VALUE
IMULI %10,8
ADDI %10,-"0"(%05) ;ACCUMULATE NEW NUMBER
HRRM %10,XE3
JRST LFTBR2
IFN CCLSW,
<IFE CCLDMP, ;ASSEMBLE ONLY FOR CCL -AND- NO DUMP MODE IO
<
RUNUUO: ;PASS PROG SPEC TO RUN UUO
SKIPN %01
MOVSI %01,(SIXBIT /SYS/) ;IF NO DEV. SPECIFIED, ASSUME SYS
TRNN %16,EXTBIT ;PERIOD TYPED?
MOVEM %14,XE ;NO, THEN FILE NAME IS IN %14
TRNN %16,EXTBIT ;PERIOD TYPED?
MOVEI %14,0 ;NO, ASSUME 0 EXTENSION
HLLZM %14,XE1 ;SAVE IN DIRECTORY
JSP %10,DELFIL ;DELETE COMMAND FILE
MOVE %00,[XWD 1,%01] ;START INCREMENT,,6 WORD RUN BLOCK ADR
;%01/ DEVICE
MOVE %02,XE ;GET FILENAME
MOVE %03,XE1 ;GET EXTENSION
SETZB %04,%06
MOVE %05,XE3 ;GET PROJ,PROG
RUN %00, ;START NEXT PROGRAM
JSP %10,ERROR ;RUN FAILED
SIXBIT /LINKAGE ERROR FOR 23]/
>
DELFIL: CLOSE CMD,0 ;CLOSE COMMAND FILE
SETZB %04,%05
SETZB %06,%07
IFN TEMPC,
< SKIPE TMPFLG ;IS A TMPCOR UUO BEING USED ?
JRST (%10) ;YES,DON'T TRY TO RENAME FILE !
>
RENAME CMD,%04 ;RENAME TO NULL FILE
JFCL
JRST (%10)
>
;BASIC TELTYPE OUTPUT ROUTINES
;THESE ROUTINES EXIST FOR THE USE OF THE EXEC ONLY, BUT THEIR
;CALLING SEQUENCES ARE THE SAME AS THOSE FOR LSTOUT, LSTMES,
;CONOUT, CONMES, ERROUT, AND ERRMES
LSTSIX: MOVSI %06,(POINT 6,%00,)
MOVEI %01,0 ;CLEAR OUT OLD GARBAGE, POSSIBLY
LSTSI1: ILDB %02,%06
JUMPE %02,CPOPJ
PUSHJ %17,TTYOUT
JRST LSTSI1
TTYOUT: ADDI %02,40 ;CONVERT TO ASCII
CAIN %02,"!" ;TWO LINE ERROR MESSAGE CRLF INDICATOR
JRST CRLF
CAIN %02,"["
MOVEI %02,11 ;TAB
CAIE %02,"_"
JRST TTYDMP ;NOT CARRIAGE RETURN
CRLF: MOVEI %02,15
PUSHJ %17,TTYDMP
MOVEI %02,12
TTYDMP: SOSG TTOCNT ;IS THE BUFFER EMPTY?
OUTPUT TTO, ;YES, GO EMPTY IT
IDPB %02,TTOPNT ;STORE THE CHARACTER
CAIN %02,12 ;WAS IT A LINE FEED?
OUTPUT TTO, ;YES, OUTPUT THE LINE
POPJ %17, ;EXIT
TTINIT: MOVSI %00,(INIT CMD,) ;INITIALIZE TTY FOR INPUT, CH. 4
MOVSI %01,(SIXBIT /TTY/)
MOVEI %02,CMDBUF ;GET BUFFER HEADER ADDRESS
AOJA %00,INIS2 ;INIT ASCII LINE MODE
TTONIT: HLRZ %00,JOBFFI
HRRM %00,JOBFF ;RESET JOBFF
MOVSI %00,(INIT TTO,) ;INITIALIZE TTY FOR OUTPUT, CH. 0
MOVSI %01,(SIXBIT /TTY/)
MOVSI %02,TTOBUF ;GET OUTPUT BUFFER HEADER ADDRESS
AOJA %00,INIS2 ;INIT ASCII LINE MODE
INIS2: MOVE %03,[JRST ERRNA];ERROR EXIT FOR INIT
MOVSI %04,(POPJ %17,)
JRST %00
;ROUTINES TO SAVE AND RESTORE THE COMPILER ACCUMULATORS
ACSAVE: ;SWAP AC'S
EXCH %00,AC00
EXCH %01,AC01
EXCH %02,AC02
EXCH %03,AC03
EXCH %04,AC04
EXCH %05,AC05
EXCH %06,AC06
EXCH %07,AC07
EXCH %10,AC10
EXCH %11,AC11
EXCH %12,AC12
EXCH %13,AC13
EXCH %14,AC14
EXCH %15,AC15
EXCH %16,AC16
POPJ %17,
ERRCMD: JSP %10,ERROR
SIXBIT /DEVICE INPUT ERROR FOR COMMAND STRING]/
IFN CCLSW,
<
ERRCF1: SETZM CCLFLA ;LOOKUP FOR DSK:###FOR.TMP FAILED
> ;EVENTUALLY GO TO F4EXEC
ERRBS: JSP %10,ERROR
SIXBIT /1 IS A BAD SWITCH]/
ERRIC: JSP %10,ERROR
SIXBIT /1 IS AN ILLEGAL CHARACTER]/
ERRNA: JSP %10,ERROR
SIXBIT /2 IS NOT AVAILABLE]/
ERRSE: JSP %10,ERROR
SIXBIT /SYNTAX ERROR IN COMMAND STRING]/
ERRLA: JSP %10,ERROR
SIXBIT /1 SWITCH ILLEGAL AFTER LEFT ARROW]/
ERRSF: JSP %10,ERROR
SIXBIT /1 SWITCH ILLEGAL AFTER FIRST STANDARD FILE]/
ERRNIT: JSP %10,ERROR
SIXBIT /IMPROPER IO FOR DEVICE 2]/
ERROR: MOVEI %16,[XWD <LSTBIT!BINBIT!>_9,ENDBIT]
MOVEM %01,XE2 ;SAVE DEVICE NAME
PUSHJ %17,TTONIT ;INIT TTY FOR MESSAGE
JRST F4EXEC
LSTMSG: MOVSI %00,(SIXBIT /_?/)
PUSHJ %17,LSTSIX ;TYPE CR,"?"
PUSHJ %17,ERRSP ;TYPE SPACE
LSTMS3: HRLI %10,(POINT 6,,)
SKIPA
LSTMS4: PUSHJ %17,ERROUT ;TYPE CHARACTER
LSTMS5: ILDB %02,%10 ;GET CHARACTER
CAIN %02,"]"-40 ;TEST FOR END
JRST ERRCR
CAIL %02,"1"-40
CAILE %02,"5"-40
JRST LSTMS4 ;NOT A SWIT CHARACHTER
HRRZ %02,ERRXCT-<"1"-40>(%02)
PUSHJ %17,0(%02)
JRST LSTMS5
ERR1: MOVE %02,%05 ;GET IMPROPER CHARACTER
JRST TTYDMP
ERR2: MOVE %00,XE2 ;GET DEVICE NAME
PUSHJ %17,LSTSIX
MOVEI %02,":"
JRST TTYDMP
ERR3: MOVE %00,SRCFIL
JRST LSTSIX
ERR4: HLLZ %00,SRCFIL+1
JUMPE %00,CPOPJ ;EXIT IF NULL
MOVEI %02,"."
PUSHJ %17,TTYDMP
JRST LSTSIX
ERRSP: TDZA %02,%02
ERRCR: MOVEI %02,1 ;SIGNAL TO PUT OUT CRLF
ERROUT: JRST TTYOUT
RESTRT:
MTOP.=24B8 ;FORSE UUO
; CLOSE OUT ONLY THE SNOBOL OUTPUT CHANNEL TO PREVENT
; BUGGY PROGRAMS FROM CLOBBERING GOOD FILES
MTOP. 04,UNITO
EXTERN ICORE
; NOW REDUCE CORE IMAGE TO ITS ORIGINAML STARTING SIZE
MOVE 0,ICORE
CALLI 0,^O11 ;CORE UUO
HALT .
HLRZ %00,JOBFFI ;RESTORE DATA AREA
MOVEM %00,JOBFF
SKIPN CCLFLA
JRST F4EXEC
EXIT6: PUSHJ %17,GETCMD
CAIL %05,12 ;BETWEEN CR-LF?
CAILE %05,15
SKIPA ;NO
JRST EXIT6 ;JUST THROW AWAY
MOVSI %05,070000 ;BACK UP POINTER BY ONE
ADDM %05,CMDPNT
AOS CMDCNT
PUSHJ %17,ACSAVE ;RESTORE ACS
JRST NXTCCL
END F4EXEC ;....F4EXEC