github.com/PDP-10.stacken
1
0
Fork 0
mirror of https://github.com/PDP-10/stacken.git synced 2026-02-16 20:51:02 +00:00
Code Issues Projects Releases Wiki Activity
Files
6e18f5ebefd9acb0d718ef31a08f33a60fc9fca2
PDP-10.stacken/files/stacken-tape-backup/dskb:10_7/mic/mic.mac
Lars Brinkhoff 6e18f5ebef Extract files from tape images. 
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

10761 lines
298 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
TITLE MIC - MACRO INTERPRETED COMMANDS PETE HENRY/FRED BROWN/JOHN (IAN) SERVICE
SUBTTL HATFIELD POLYTECHNIC COMPUTER CENTRE DEC 72
;********************************************************************************
;
;
;******COPYRIGHT HATFIELD POLYTECHNIC COMPUTER CENTRE*********
;******1972,1973,1974,1975,1976,1977,1978****************
;
;MIC was written at the HATFIELD POLYTECHNIC COMPUTER CENTRE
; THE HATFIELD POLYTECHNIC
; P.O. BOX 109
; HATFIELD
; HERTFORDSHIRE
; ENGLAND
;
;
;********************************************************************************
;
;
; This version of MIC was modified at the University of YORK by
; John Service to include :-
; 1. support for lower case
; 2. error codes for more error messages
; 3. GALAXY support for COJOBS
; 4. PATH. UUO support
; 5. Revised control-C trapping
; 6. And all edits >1000
;
;
;********************************************************************************
;
;
; As of edit 1000 of MIC renumber MIC as
; version 10(1000) and start including an edit history in this file
;
;
;*******************************************************************************
; Table of Contents for MIC.
;
;
; SECTION PAGE
; 1. Edit History.......................................... 3
; 2. DEFINITIONS........................................... 4
; 3. Some special Hi-Segment Data.......................... 9
; 4. Flag Definitions...................................... 10
; 5. Immediate Mode Definitions............................ 12
; 6. Macros................................................ 13
; 7. Conditionals.......................................... 15
; 8. Definitions - Profile word............................ 16
; 9. Beginning of the Code................................. 18
; 10. Command table definitions............................. 20
; 11. Slave processor - record user command: COJOB.......... 29
; 12. Slave processor - record user command: DO............. 32
; 13. Slave processor - Handle COJOB switches............... 46
; 14. Slave processor - Check COJOB logfile specification... 52
; 15. SLAVE PROCESSOR - LOOKUP FILE......................... 55
; 16. Slave Processor - Store COJOB switches................ 60
; 17. SLAVE PROCESSOR - READ ARGUMENTS...................... 61
; 18. SLAVE PROCESSOR - ERROR MESSAGES...................... 77
; 19. SLAVE PROCESSOR - SUBROUTINES......................... 82
; 20. SLAVE PROCESSOR - READ FILE SPEC...................... 84
; 21. SLAVE PROCESSOR - OUTPUT A FILE SPEC.................. 92
; 22. PLEASE COMMAND........................................ 93
; 23. MIC OPR COMMAND - COJOB/SYSTEM OPERATOR COMMUNICATIO.. 95
; 24. SLAVE PROCESS......................................... 96
; 25. SILENCE,REVIVE,ABORT,PROCEED,BREAK,NO/OPERATOR,NO/ER.. 97
; 26. INPUT Command......................................... 101
; 27. CLEAR COMMAND - TO CLEAR A LINES MIC WORD............. 103
; 28. FNDCMD A ROUTINE TO SEARCH THE COMMAND TABLE......... 104
; 29. SLAVE PROCESS WHENEVER OR ON COMMAND.................. 107
; 30. SLAVE PROCESS - MIC SET COMMAND....................... 110
; 31. SLAVE PROCESS - GOTO COMMAND.......................... 120
; 32. LET COMMAND........................................... 121
; 33. RESPONSE COMMAND - READ ERROR LINE FEATURE............ 127
; 34. IF COMMAND............................................ 128
; 35. MASTER PROCESS INITIALIZATION......................... 160
; 36. MASTER PROCESS - CRASH CONTROL........................ 161
; 37. MASTER PROCESS - CORE MANAGEMENT...................... 162
; 38. MASTER PROCESS - SCHEDULE SLAVE REQUEST............... 164
; 39. MASTER PROCESS - HANDLE NON-DEFAULT ACTIONS........... 187
; 40. MASTER PROCESS - READ A LINE FROM THE FILE............ 190
; 41. FUNCTION SERVICE ROUTINE.............................. 210
; 42. STATUS - PRODUCE DISPLAY OF CURRENT MIC STATUS........ 236
; 43. WHAT.................................................. 239
; 44. OTHER PRINT ROUTINES.................................. 240
; 45. COJOB SERVICING AND INITIALIZATION.................... 243
; 46. PROCESS CONTROL AREA IN LOW CORE COMMON TO ALL MODES.. 281
; 47. PROCESS CONTROL AREA IN SHARED CORE................... 283
; 48. PROCESS DATA AREA IN SHARED CORE...................... 284
; 49. COJOB NON-SHARED PROCESS AREA......................... 286
; 50. LOW STORAGE FOR SLAVE PROCESS SPECIAL COMMANDS........ 288
; 51. SPECIAL LOW STORAGE FOR / COMMAND..................... 289
; 52. MASTER PROCESS - ONCE ONLY INITIALLISATION............ 290
; 53. INITIALLISE SOFTWARE INTERUPTS TO MAKE MIC SELF-REST.. 293
; 54. CLRLDB - ON A RESTART CLEAR UP ANY OLD LDBMIC WORDS... 294
SUBTTL Edit History
comment |
****** edit history *****
[1000] renumber MIC as version 10
put in fix for feature test on ife ftgala
[1001] fix up cojob /time switches to give the correct time
[1002] give better message when cojob fails to log in
should now say [COJOB <n> LOGIN FAILED]
more often.
[1003] include support for university of arizona login queue
i.e. don't allow cojobs to go in the Q
by including a /noque switch in the login text
Inside a FTLGNQ switch.
[1004] 27-nov-78 jds
fix to print out correct path for
mpb style KJOB. (inside ife ftgala).
[1005] 12-dec-78 jds
fix up COJOB login for long login lines - now that we support
SFD's we can have very long LOGIN lines due to PATH stuff
and these were breaking MIC
[1006] 10-jan-79 jds
Fix for 6-digit project numbers and clean up kludge that allowed
6-digit programmer numbers.
[1007] 10-jan-79 jds
No. of COJOB's in use was not being decremented if a COJOB failed
to start because no PTY's were available or similar .
[1010] 20-feb-79 jds
System parmeters (e.g. '<gettab....> ) with a -ve typeout mode
caused MIC to crash - may also have caused earlier versions
to loop.
[1011] 22-feb-79 jds
Error in edit 765 , executable instruction in AC Y could
be changed in certain circumstances. - Thanks Colin.
[1012] 06-MAR-79 jds
COJOBs occasionally get lots of control-c's to force them to
monitor mode in order that they may be KJOB'ed. Fix so they only
get one and we notice when we try to give them the next one.
[1013] 06-mar-79 jds
Fix the MIC STATUS and REENTER command output to use a simple
bufferring scheme and not do it all a chracter at a time.
[1014] 09-MAR-79 jds
Edit 1012 wasn't right, nobody got ^C's - fix it
[1015] 05-JULY-79 jds
Commands of the form COJOB <name>-WHAT<escape> gobbled the
next line typed by the user. Fix code to remember that we have
had the terminator.
[1016] 17-july-79 jds
Change the title line to be ...JOHN (IAN) SERVICE to stop people from
thinking that IAN SERVICE and JOHN SERVICE are different people!
[1017] 17-july-79 jds/Patch from CRTB of NIH.
When a LOOKUP fails , original code does a MOVE T1,DEV(X) followed
by a CAMN T1,MICDEV. This fails because MICDEV has the device name
in the right half,whereas DEV(X) has the device name in the left half.
Change to a MOVS T1,DEV(X).
[1020] 17-july-79 jds/Patch from CRTB of NIH
MIC original read a TMPCOR file with a .TCRRF (just read it). This
edit changes it to a .TCRDF (read and delete). An analogous RENAME
has been added for the case of the equivalent disk file.
[1021] 17-july-79 jds
Include code in MIC TYPE and MIC DISPLAY commands to follow
the normal "^" control character conventions of MIC and BATCH.
[1022] 17-july-79 jds
Start on a code clean up, remove unused and redundant feature
tests FTAKJ,FT602,FT603,FTOLDL,FTLG56.
[1023] 23-july-79 jds/Patch from CRTB of NIH
Change tst for protection digit from 2 to either 2 or 6.
If a MIC file is protected <2nn> the standard is to start out silenced.
The change is bacause of the File Daemon convention of protecting files
with an owner protection digit of 4 higher than otherwise. Therefore
<6nn> files should get silenced too!
[1024] 9-aug-79 jds/feature from CRTB and RB of NIH
Include the FTDDT feature tests of NIH's MIC to make it easier
to debug a single user private MIC under timesharing. Also document
how to use this feature in the (new) MIC instatllation and maintenance guide.
[1025] 9-aiug-79 jds
More of code clean up. Remove feature test FTRLSE from several places
and replace by FTBHIV to support flashy BEEHIVE terminals, and also
FTHATF to support non-standard options used by HATFIELD.
[1026] 9-aug-79 jds
Redo the checks for valid modes in the function stuff, in order
to make it easier to add new modes.
[1027] 9-aug-79 jds
Put an error message in COJOB log files when they fail to LOGIN,
then flush the buffer as suggested by CRTB of NIH.
[1030] 9-aug-79 jds
Clean up some error messages -
MIC RESPONSE
Up arroe in display [1020]
[1031] 9-aug-79 jds
Include the support for the new octal format-
LET %<parameter>=expression
means store the results of the expression as an octal string.
Also remove unused label LET3:.
[1032] 9-aug-79 jds/fix from JB of HATFIELD
Path stuff didn't always work properly for COJOB log files
because the checks to see if using PATH not PPN were the wrong
way round in the routine LOG -- change two TLNE's to TLNN's.
[1033] jds 10-aug-79
Fix to old octal constants stuff brought to lite by new octal
parameter modes. We were testing the wrong half of the flag word
in ATOM1A plus a few.
[1034] jds 16-aug-79
Fix to problem reported by IP of UMIST. Silenced macros were waking
ip too soon on PTY's, also noticable on terminals which had the clumping
code from Big Buffer (and 7 series??) in use. The fix is to remove the
test for silenced at TAL3-a few and mak all macros check if output
is still in progress before typing there next line. This could slow
MIC down a little so may be worth redoing later.
[1035] jds 16-aug-79
Make CMDEND a few instructions shorter in one case.
[1036] jds 17-aug-79
Expand the output storage available to the functions stuff. This
is neccesary because some of the proposed new functions e.g. '<PATH>
generate a long result.
[1037] jds 24-aug-79
Change format of System Parameter results even further and put the
system parameter result block (formerly SYMBUF) in the PDB for
system parameters executed by the master process - leave it where it
was for thos e executed on the slave. Reason is that if the system
parameter result more than fills the MIC typein buffer the next time round
someone else may have done a system parameter and the result would be
peculiar output.
[1040] 6-NOV-79 JDS/BUG REPORTED BY JS OF HATFIELD
Strings in subscripts are not fixed up if MIC SET NO
LC is on.
[1041] 6-nov-79 jds/patch from cb of nih
After a LOOkUP of a MIC file fails, search [,,MIC] before
trying supervisor, MIC: etc. This allows the user to have a
private MIC library in that SFD.
[1042] 6-nov-79 jds
Add supported for inverted case as requested by NIH. If the feature
test FTCASE is turned on the default of MIC SET LC is changed to
MIC SET NO LC.
[1043] 12-NOV-79 JDS
Add the '<RETURN> command to the action parameters and
clean up some minor sillies in the ne dispatch code for parameters.
[1044] 12-NOV-79 jds
Re-format the MIC STATUS o/p slightly in order to give
job number and full mic file spec.
[1045] 12-nov-79 jds
Problem with '<exit> actually substituting values, the setzm symbuf
in ACTCDE shud b a SETZM SYMBFX(x) to take account of the new
personalised system parameter buffer.
[1046] 22-NOV-79 JDS
Re-re-format the MIC STATUS O/P to only give full macro spec.
to owner or [1,2] as some users objected.
[1047] 22-nov-79 JDS
Yet more of clean up. Revise many error messages, and modify
many error messages to be in upper and lower case.
[1050] 3-DEC-79 JDS
A bit more of clean up, plus a couple more fixes from NIH
including the octal 0 problem.
[1051] 3-dec-79 jds
Lots of error messaages fixed up.
[1052] 3-dec-79 jds
ASCII mode GETTABS were failing as a result of new style SYMBUF.
[1053] 3-dec-79 JDS
Add the PATH parameter.
'<path> gives a users PATH.
[1054] 10-DEC-79 JDS
Add a new SLPTIM word to the PDB as start of nw HIBER/SCHEDULE
code to support '<SLEEP(n)> and MIC SLEEP n commands. Also add the new sleep functions
[1055] 10-dec-79 JDS
Add the '<PTHPPN> function, gives the PPN of a users path.
[1056] 14-DEC-79 JDS
Clean up a couple more error messages and then make this version of
MIC into MIC version 11(1056) and let it to the
waiting(?) world.
[1057] 17-JAN-80 JDS
Bug reported by gr of ILFORD, the [PROJ,1] (FTSUPR) facillity was
not working. Cure, after we calculate [PROJ.,1] store it in the right place.
[1060] 17-jan-80 jds
New error message code had broken LABEL error messages. Cure, set the
message up in the right AC.
[1061] 15-JAN-80 JDS
Fix to make expressions of the form
IF (sysparameter=N)
work, just to please NIGEL of ADP.
[1062] 18-JAN-80 JDS
Unable to use octal system parameters in octal expressions
as no check for octal with no leading zeroes. Also the error message
MICGTR was not quite right.
[1063] 8-FEB-80 JDS
Problems with the '<length(x)> function -
1/ new error message code does not handle slave errors while master
is using INSTR code.
2/ space reserved for saving strings while we count them is not secure
in master process --- may possibly corrupt master.
Temporary solution --- remove master mode '<length>
[1064] 19-FEB-80 JDS
THE '<RETURN> function gives ill mem ref's in master,
didn't fix up to allow for new SYMBUF (SYMBFX) in hi seg., move
ACTXCT label back 1 instr.
[1065] 19-FRB-80 JDS
Edit 1033 was either wrong or ineffective fix it.
[1066] 10-dec-80 jds
Fix problem of nested MIC macros where:-
a. RESPONSE is set in outer macro.
b. Error occurs in inner macro.
c. No error traps in inner macro therefore [Abort on Error]
d. Mic wrongly resets RESPONSe at end of macro instead of propogating
search for error trap.
Solution is don't propogate response outwards.
[1067] 25-Mar-81 JDS
MIC SLEEP n does not work where n is less than 20 seconds,
and '<SLEEP(n)> does not work in some circumstances.
Causes, MIC may not wake up for 20 secs min if system and MIC
are very quiet, and the wron ac is being used in SCHD4b.
Cure, wake MIC maste after a slave mode sleep command
and correct the AC usage.
[1070] 26-MAR-81 JDS/PATCH FROM TOMMY AT QZ
MIC does not know about FRCLIN and does RESCAN's among other
undesirable things.
Cure: tell it about FRCLIN!
[1071] 27-MAR-81 JDS
COJOB messages go to the wrong user after the owner has gone away
especially in 7.01 with dynamic terminal disconnects.
Cure is to make OWNCHK check a bit more rigorous and add
an extra check in CJDSP, and display in .STATUS.
[1072] 2-JUN-81 JDS
'<NOOPERATOR> and '<NOERROR> give [ABORT on fatal error],
that is they dont work.
Cause: we eat the closing > too soon.
Cure: don't.
[1073] 3-JUN-81 JDS
Add the MIC SET TRACE command, this causes each label to be printed out
as it is read, and after thdesired label is found it causes a
CRLF to be o/p.
[1074] 3-jun-81 JDS
Edit 1074 is a composite edit to mic that includes the
changes made to MIC by the Internal Software Support group of Digital's
Corporate Information Services.
These edits have been include because they may be of use to other people
and the comprise several changes to MIC-
a. Remember which MIC is master and keep the Hi-segment Wenabled
for him. This saves a lot of SETUWP UUO's but has the one disadvantage
that bad code could result in a corrupted master process, however
performance is our biggest problem.
b. Add switches which allow COJOBs to select which calss they
will run in, all this code is inside FTCLASS.
c. Include Charge accounting inside FTCHARGE (off by default).
d. Include any other TSG hacks inside FTTSG.
[1075] JDS 8-jun-81
Increase the MIC parameter space from 26*4*5 to 26*8*5 characters.
That is, double it, if the space overhead seems too high this may be
reduced again.
[1076] JDS 8-jun-81
Introduce a new action parameter '<PSHIFT> which performs the
operation-
A:=B,B:=C,C:=D,D:=.....,Y:=Z,Z:=NULL
[1077] JDS 9-JUN-81
Make COJOB's do a /OPTION:COJOB on Login.
[1100] JDS 9-Jun-81/Tommy at QZ.
Remove support for old-style altmodes, but leave them inside
the feature test FTOALT. Reason is that these codes are used for scandinavian
characters.
[1101] JDS 9-Jun-81/Tommy at QZ
Allow <> as synonym for [] in mic filespecs.
[1102] JDS 9-JUN-81/Tommy at QZ
COJOB log files had two problems
a. Log files created with a low protection, not user default.
b. Cannot create a log file on an SFD that doesn't exist on the first
disk in the user's search list.
Fix these.
[1103] JDS 9-Jun-81/Tommy at QZ
Add '<LOGFILE> parameter to display the COJOB log file, also
correct OUTSPEC: to not output sillies if file is null.
[1104] JDS 10-June-1981/bug reported by T.hayes of Middlesex
Constructions such as '<gettab(25,-1,11)> crash MIC.
This is because the 11 is an out of range printing mode,and at some
stage we broke the range checking on numeric modes.
Cure: define valid modes in the appr. table and check them.
[1105] JDS 10-JUNE-81
There is a problem with MIC RETURN, not '<RETURN> tho, which
results in a macro exiting, but leaving the terminal silenced.
The problem is that the slave process sometimes does a MIC SET
after the master has deleted the PDB, because of the EOF flag.
Cure: don't do the MIC SET by calling DOTTY not DOTMIC, and re-arrange
some code to remove the race.
[1106] jds 10-jun-81/tommy at QZ
Change the MIC default sleep time to assume faster terminals than
we had in the old days. This should not really have any effect unless MIC
misses a monitor generated wake.
[1107] jds 10-jun-81/Tommy at QZ
QZ report having File Being Modified Errors and theat this change fixes
them, seems reasonable, tho' i have never seen the problem.
[1110] JDS 12-JUN-81
At last, what the world has been waiting for "MIC INPUT", this
edit adds the oft rummoured MIC INPUT facillity. Syntax is-
MIC INPUT paramete,optional-prompt
[1111] 22-Jul-81 JDS
Add the MIC SET NO SILENCE command which prevents MIC macros from
silencing even if the it issues the appr. commands.
[1112] 23-Jul-81 JDS
Add the '<Pn> function to perform substitution of parameters in
outer nested processes.
[1113]24-jul-81 jds
Add the new system parameters ERRCHR and OPRCHR which return the
error and operator characters. Also LDBMIC and PROFLE which are useful for
debugging.
[1114] 24-Jul-81 JDS
Shrink the parameter space in the PDB slightly so that a PDB
is always less than or equal to one page in size - maybe we can do some
fancy core management some day. Also fix edit [1075] to be efective.
[1115] 13-aug-81 jds
Include various bug fixes to new features.
[1116] 14-aug-81 jds
Finally I hope, fix MIC SLEEP n wher n is small.
******Rename this version of mic as Version 11A and make it available**
[1117] 18-Nov-81 JDS/Code courtesy of DLA (SCHDS)
Add a new parameter '<DAY> which returns the day of the week
for today.
[1120] 27-Nov-81 DLA
Fix 1) Premature termination of feature tests by ">"
2) Corruption of LOWOUT by FNDLAB routine
3) Miscellaneous MIC BATCH things
4) COJOB owner messages on TTY0
5) PDBs getting smashed up on MIC EXIT from nested COJOB macro
6) COJOBs occasionally going to sleep on starting to run
nested macro.
[1121] 27-Nov-81 DLA
Tidy up FTHATF code and add new MIC BATCH features.
[1122] 8-mar-82 jds
Fix ON PROCEED:action error, FL.CB was remaining set up even though
LDL.CB was clear. Thus infinite actions.
[1123] 8-MAR-82 JDS
Fix up so that COJOB logging error messages go to the User as well
as the operator. Gives the user a chance to find he has got ACCESS.USR wrong!
[1124] 8-mar-82 JDS
Fix up IF (TRUE) and IF (FALSE) to work without destroying the
users core image.
[1125] 9-Mar-82 JDS
As a result of the changes for ON:PROCEED in [1122] consider
the case of a macro that is in [BREAK] state and the user has for example
an ON ABORT:GOTO lbl and ON PROCEED:GOTO lbl2. When he types control-a
the abort action takes effect, but there is also an implied proceed.
The descision is that the implied proceed should not teke the
action of the ON statement, but in order that we know what has happened
a new message "[PROCEEDing]" is displayed - this message is controlled
by the same message level bits as [PROCEED].
[1126] 15-mar-82 jds
Edit [1122] and [1125] were not quite right, [BREAK} on
operator resulted in a [PROCEEDing] message. Check if LDL.CB is not in
S before generating message.
[1127] 15-Mar-82 JDS
"<silence> works even if MIC SET NO SILENCE is set.
[1130] 15-mar-82 JDS
While debugging a MIC macro which has ERROR [ set i found it
impossible to use the trace on [BREAK] as they invoked the error code.
Also [BREAK] leaves the terminal not in column 1. Mic should not really
do things like this, so add a few strategic spaces and crlf's.
I wonder how long it will be before someone complains that they
used this bug as a feature!
[1131] 23-mar JDS
Minor bug fixes to recent edits.
[1132] 23-MAR-82 JDS/DLA at Hatfield
Include code to display the COJOB log file name when
the COJOB starts.
[1133] 23-Mar-82 Jds/crtb at nih
Assume faster terminals today and reduce default wait time
to 0.4 sec. from 2sec.
[1134] 23-Mar-82 jds/CRTB at nih
A number of cosmetic changes to error messages.
[1135] 23-Mar-82 jds/CRTb at NIH.
Make MIC always sleep between service cycles.
[1136] 23-Mar-82 Jds/crtb at nih
Do not delete TMPCOR if debugging, and do not print DETACHING
if on FRCLIN.
[1137] 24-Mar-82 JDS
Add '<PROTATE>, just like '<PSHIFT> but z:=a
[1140] 24-Mar-82 JDS
Rework PRVCHK a little bit anclude special NIH check
(FTNIHG).
[1141] 24-Mar-82 jds/crtb of NIH
Smooth up MIC TYPE and MIC DISPLAY a bit, but don't include
NIH code to always add CR and CRLF; this breaks communication with
COJOBs. However add two new system parameters, CR and CRLF which if included at
the end of the line will have the desired effect. Also useful in other
ways.
As part of same edit include new parameters-
ALPHABET returns a thru z
NUMERIC returns 0 thru 9
ASCII returns all ASCII characters.
(nb $ascii.[50] returns ascii character with value 50.)
[1142] 11-MAY-82 JDS/CRTB of NIH
Make Mic scheduling of COJOBs with lots of output a little better.
[1143] 11-may-82 JDS/CRTB of NIH.
Smooth up MIC STATUS o/p.
*nb* not all these edits are marked in the source as they
are almost all cosmetic changes only!
[1144] 11-May-82 Jds/DLA of Hatfield
Change the conditions under which we decide to start up
scheduling a COJOB before it is fully set up.
[1145] 11-May-82 JDS/DLA of Hatfield.
Add some useful debugging code to the MIC STATUS command, now
displays curent level of nesting, and last process no.
[1146] 18-May-82 JDS
Modify the display of parameters in MIC STATUS and COJOB LOGINs
to not display PARAMETERS if none, and to omit the trailing comma.
[1147] 25-may-82 JDS
Edit [1044] was not installed completely, bit missing from the
slave code.
[1150] 25-May-82 JDS
As having MIC as a label and a acro seems to foul up some versions
of macro, bough to the inevitable march of "progress" and rename the
label to be MICBGN.
Also fix up FRCLIN stuff to print message on reenter., also frees a flag
in the master flag word...bound to be useful!
[1151] 25-May-82 JDS
Fix up COJOB information messages to have the new format
[Cojob A(FRED) Started, Log file is .....
where the new bit in () is the name of the cojob and is displayed
in all messages - useful if you are running lots of cojobs!
[1152] 25-May-82 JDS/TE at QZ
Fix typo in 1102, HLRZS should be HLRZS.
[1153] 25-may-82 JDS/TE at QZ
Allow COJOB NUL:= without specifying extension.
[1154] 25-May-82 JDS/TE at QZ
Don't give silly error message after GET STUFFED.
[1155] 26-May-82 JDS
A little bit more tidying up in the MIC STATUS display.
[1156] 26-MAY-82 JDS
Start adding code to modify the type out routines which display
MIC's internal strings, to hansle the Scandinavian character set a bit
better. This edit is NOT complete and may rely on QZ finishing it off!
[1157] 26-May-82 JDS
Replace all occurences of angle brackets with .LT. and .GT. in
strings. (Just to keep macro happy!)
[1160] 26-May-82 JDS/TE @ QZ :: spr 10-30343
Fix when starting COJOB's when way down the SFD chain.
[1161] 26-May-82 jds/TE @ qz
Eat LF after CR in .MIC command.
[1162] 26-May-82 JDS
Fix longstanding obscure case where one of T1-T4 gets corrupted
by the next character getter. It does matter during some goto statements.
[1163] 26-May-82 JDS/TE @ QZ
Increase size of TMPCORE buffer to TMPCBL and fix a small bug.
[1164] 28-may-82 Jds
More of [1155], should really make TTYCHR a bit fancier and cope
with TTY widths etc. New entry to break routine ISBRKC, does not treat
CR as a break.
[1165] 28-May-82 JDS
A little more effort towards cleaning up COJOB output messages
and reduce still further the no. of UUO's the master does.
[1166] 28-May-82 Jds
If the '<parameter> style commands generate a string with a '
character they cause rather obscure substitutions! Fix it.
[1167] 2-jun-82 JDS
A little bit more of [1165].
And a add a contents list and a few new subtitles to MIC.
[1170] 3-Jun-82 JDS
Make some changes to parameter reading stuff with a view to
implementing new code to allow user to specify LOGIN switches for COJOBs.
[1171] 3-Jun-82 Jds
Fix to stop processes being held for ever after MIC EXIT, this
must have been around for a long time but some recent edits have made
it more obvious.
[1172] 4-Jun-82 JDS
More prettiniess in COJOB and STATUS messages.
[1173] 6-Jun-82 JDS
Some bug fixes to the new COJOB output stuff, Forgot to cope
with the owner having gone away.
[1174] 6-JUN-82 JDS
More of the code to handle the new format switches for COJOBs.
[1175] 9-jun-82 jds
Fix up a last small problem with MIC EXIT and COJOB messages.
Package this version of MIC up, and release it as 11B, note that
the new COJOB switches are not yet finished.
************* Release of MIC 11B(1175) *******************************
[1176] 15-Jul-82 JDS
OUTPUT of some long SFD' strings fail, missing indirection when
clearing last word.
[1177] 28-jul-82 jds/reported by EJ @ UCNW
Octal constants are limited to 18 bits because we use the
PPN octal reader, correct this.
Also misspelling inerror message.
[1200] 1-SEP-82 JDS
Still a problem with the output of long strings in COJOB
messages, OWNCHK corrupts T1 which is unfortunately used at this time.
[1201] 3-Nov-82 JDS
%CERR,%ERR,%TERR are not ignored (if no error) unlike BATCON.
MIC should be compatible, but this will probably break a few programs.
[1202] 3-Nov-82 JDS
Add a real Control-C trap for MIC, if the user uses the command
MIC SET CCTRAP
then the ON CANCEL:action
will not be cleared every time it is obeyed.
[1203] 3-Nov-82 JDS
Typo. in the start-up, SETZ Y,Z should be
SETZB Y,Z though inpractice it never mattered.
[1204] 2-DEC-82 JDS
This is a good one.
It is just possible for a job (esp. a batch job) to do a
MIC EXIT then logout and a new job LOGIN on the same job slot and the
new job to attempt to start a new macro before the Master process has
noticed that the original job has gone! This tends to be ambarrasing as
MIC may continue to run the old macro, not the new one.
The cure seems to be stay inside the MIC EXIT code until the
master process has gon away. Also as the problem was introduced by
edits [1171] and [1175] the code just after CRLF: where we decide about
nested processes should be more defensive. And if we find a nested
PDB with no LDBMIC word, we should wait for it to go away!
[1205] 31-DEC-82 JDS/CB of NIH
Miscellaneous small bug fixes and minor changes, as suggested
by Chuck.
1. Make GO command more like GOTO command.
2. TDAGN loop clobbers MIC bits in some cases.
3. BLT X,PDBSIZ(X) inside FTCOSMIC.
4. HIB0 timer is silly (inverted case!)
5. SSIXBP does not print exactly 6 characters.
6. Make ON <event>:EXIT work.
7. Correct error message texts.
[1206] 31-DEC-82 JDS/TE of QZ
Some bug fixes from Tommy.
1. Edit [1153] was incorrect, COJOB NUL:= needs an extension
field.
2. Handle error codes when trying to create unique log files.
3. Minor error in STATUS display.
[1207] 3-Jan-83 JDS
Re-do all COJOB switch handling.
**NB** The /CLASS and /BACGROUND switches - under FTCLASS, and
the /VD and /ZQ switches - under IFE FTGALA have not been
tested (please let me know if they have bugs).
Include the new switch /TAG:lable which like the Batch
/TAG switch performs an implied goto at the beginning of the file.
Also include /LOPTION to specify the LOGIN option (not
completed in this edit!).
[1210] 19-Jan-1983 jds
Redo [1204] a little to cope with the smart-alecs who start MIC
from SWITCh.INI
[1211] 21-Jan-1983 JDS
Add CHKPNT and REQUEUE as interpreted commands, which are
NOOPs, this improves MIC's compatabillity with batch.
[1212] 21-Jan-1983 jds
When a MIC INPUT is used within a COJOB display the prompt on
the COJOB owners terminal.
[1213] 21-Jan-83 jds
Add code to handle SWITCH.INI, for COJOB switches.
Also code to implement /HELP switch, not completed!
[1214] 14-Feb-83 jds
MIC INPUT prompts from COJOBs occasionally apear on the
wrong terminal, or users get propmts they shouldn't -lucky them.
[1215] 15-Feb-83 jds
SWITC.INI is not invoked if the user types no switches at all.
[1216] 16-Feb-83 JDS
Recent edits broke interpreted IF commands.
[1217] 17-FEB-83 JDS
/OPTION:name does not work.
[1220] 31-Mar-83 JDS
SWITCH.INI ain't not quite right - fix it!
[1221] 19-apr-83 JDS
Copy COJOB initiators name to the COJOB LOGIN line
as in batch.
[1222] 20-APR-83 JDS
Reorganise 1221 a bit, fix up default classes,and make this version
of mic be 11C, prior to letting out to other sites.
[1223] 22-Apr-83 JDS
An oops on [1221], also SSIXBP doesn't print sixbit words with spaces,
surprised noone has ever noticed!
.
[1224] 2-May-83 JDS
Edit 1223 to SSIXBP still missed out the case where the space was
the last character in the word.
[1225] 12-May-83 JDS
On lines greater than 80 characters mic seems to loose a character
(the 81st) if we have to copy the line to the PDB then o/p it from there.
This bug must have been about fro a long time!
As in 7.01a the monitor allows command lines to be longer than
80 chars. it is apporpriate to consider changing MIC as well.
So as we fix the BLT's to be ok, introduce a new constant LINSIZ, which
we will set to 80 for now, but when we get time we can increase to 132.
[1226] 13-May-83 JDS
If a user has a LOGIN SWITCH.INI entry which runs a
MIC macro, then COJOB's get stuck in LOGIN state.
Do a bit of extra checking when starting up.
[1227] 19-May-83 JDS
If a user has a statement of the form
.IF (ERROR) .PLEASE Error in my proggie^[
then a CRLF gets typed to the systemby MIC even if there
was no error. This is wrong. Change EATLNE to gobble up to
and including a CRLF, ignoring all other breaks.
[1230] 13-June-83 JDS/Bug reported by Houk of DEC
If when in [BREAK] mode a user types ^c then he gets
[CANCEL] displayed, then
[PROCEEDING] displayed.
This seems to be irritating, so make sure the latter happens not.
[1231] 2-Jan-85
/LC doesn't make it on the LOGIN line. Use /TERMINAL.
[1232] 12-Mar-85
Remove useless CLRBFI from startup code so SYSJOB.INI
will work cleanly.
[1233] 26-Sep-85
Fix up to use the 'ask JOBSTS' bit added by MCO 12426.
At the moment, 'ask JOBSTS' means only that the program
is HIBERing for user-level input, so assume that meaning
until the bit actually gets multiple meanings.
[1234] 1-Feb-87
Fix up the definition of the ASCII special parameter to be
the full 7-bit ASCII character set. "^_" is a control
character, "^^_" was intended.
[1235] 1-Feb-87
Fix up the restriction on maximum line length. SCNSER allows
132 characters, and so should we. This actually finishes edit
1225 by making it symbolic and re-definable. The default will
now be 132.
****** end of edit history ******
|
SUBTTL DEFINITIONS.
SEARCH MACTEN,UUOSYM
SALL ;TIDY UP THE LISTING
ND FTTSG,0 ;[1074]TSG hacks off
ND IDFTIM,^D60 ;DEFAULT RUN TIME FOR COJOBS AT STARTUP TIME
ND IMXTIM,^D600 ;MAXIMUM RUN TIME FOR COJOBS AT STARTUP TIME
ND FTCLASS,FTTSG ;[1074]Class scheduler stuff
ND FTCHARGE,FTTSG ;[1074]Charge accounting stuff
ND FTTASK,FTTSG ;[1074]Charge accounting stuff
;ACCUMULATOR DEFINITIONS
F=0
BP=1
WD=2
CH=3
X=4
Y=5
T1=6
T2=7
T3=10
T4=11
P1=12
L=12
P2=13
S=13
P3=14
N=14
P4=15
N1=15
Z=16
P=17
;LDBMIC DEFINITIONS
LDLCHK==400000 ;SOME BIT SET IN LDBMIC 1-14
LDL.CC==200000 ;^C TYPED
LDL.OP==100000 ;OPERATOR CHAR SEEN IN COLUMN 1
LDL.ER==40000 ;ERROR CHAR SEEN IN COLUMN 1
LDL.CP==20000 ;^P TYPED
LDL.CB==10000 ;^B TYPED
LDL.XX==4000 ;SILENCE THIS LINE
LDL.MM==2000 ;LINE IN MONITOR MODE
LDL.TI==1000 ;LINE REQUIRES INPUT
LDL.TO==400 ;LINE HAS TO AVAILABLE
LDLCL1==400 ;LINE IS IN COL 1
LDL.CA==200 ;SET IF A ^A WAS TYPED
LDL.RS==100 ;LINE REQUIRES REPONSE ON ERROR
LDL.SY==40 ;ERROR CHAR. HAS REACHED INT LEVEL(RESPONSE)
LDL.LG==20 ;LOG FEATURE IS ENABLED
LDL.AJ==10 ;ASK JOBSTS
LDLCLR==LDLCHK!LDL.TO!LDL.TI!LDL.MM!LDL.CP!LDL.CB!LDL.OP!LDL.ER!LDL.CC!LDL.CA!LDL.AJ
LDLCLE==LDLCHK!LDL.TO!LDL.TI!LDL.MM!LDL.ER!LDL.AJ ;ERROR+VOLATILE BITS
LOC 124
MICTAT
LOC 137
VWHO==0 ;PETE & FRED 1 MEANS JS XPERMTL VERSION
VMIC==11
VMINOR==3
VEDIT=1235 ;HATFIELD/YORK PATCH LEVEL
BYTE(3)VWHO(9)VMIC(6)VMINOR(18)VEDIT
RELOC
SUBTTL Some special Hi-Segment Data.
TWOSEG
RELOC 400000
-PCALEN,,PCA ;FACTS ABOUT PROCESS CONTROL AREA FOR
;THE USE OF OPERATOR CONTROL PROGGIE
-PDBSIZ,,PDB ;FOR USE OF OTHER JOBS WANTING TO RUN COJOBS
LDP.OP: POINT 7,S,21 ;BYTE POINTER TO THE OPER CHAR
LDP.ER: POINT 7,S,28 ;BYTE POINTER TO THE ERROR CHAR
LDPMJN: POINT 7,S,35 ;BYTE POINTER TO THE MASTER JOB NO.
LDPF: POINT 7,F,35 ;BYTE POINTER FOR SAVING CHAR. IN F
PEVNTN: POINT 6,T1,17 ;POINTER TO THE EVENT NUMBER
PACTNM: POINT 6,T1,11 ;POINTER TO THE ACTION NUMBER
SUBTTL Flag Definitions.
FL.AST==1 ;SET IF AN ASTERISK SEEN AT START OF LINE
FL.LAB==2 ;SET ON FINDING A COLON
FL.BRK==4 ;SET IF BREAK SEEN
FL.MON==10 ;SET IF FORCING TO MONITOR MODE
FL.SMC==20 ;SET IF A COMMENT LINE WAS SEEN
FL.SAV==40 ;SET IF CHAR IN LOWER 7 BITS OF F
FL.CR==100 ;SET IF CR & LF TO BE IGNORED
FL.CRT==200 ;SET IF CR LAST CHAR TYPED
FL.INP==400 ;SET IF USER HAS AN I/P LINE ALREADY PREPARED IN PDB
FL.CB==1000 ;SET ON FINDING HE TYPED A ^B
FL.CMD==2000 ;SET IF A COMMAND WAS RECOGNISED
FL.XX==4000 ;SET IF WAS SILENCED WHEN BREAK OCCURED
FL.DOT=10000 ;SET IF A DOT WAS SEEN IN COLUMN 1
FL.PCT=20000 ;SET IF A %LABEL WAS READ
FL.CCM=40000 ;SET IF A ^C HAS BEEN ISSUED TO COJOB
FL.KJO=100000 ;SET IF KJOB/B HAS BEEN ISSUED TO COJOB
FL.EXC=400000 ;SET IF AN EXCLAMATION MARK IN COLUMN ONE
; FLAG DEFNS. RIGHT HALF OF MASTER
FR.OWN==400000 ;SET IF A COJOB OWNER HAS GONE AWAY
FR.BAT==200000 ;SET IF THIS IS A BATCH JOB
FR.EOF==100000 ;SET IF EOF DETECTED ON INPUT
FR.CL1== 40000 ;SET IF INPUT FILE IS IN COLUMN ONE
FR.IF== 20000 ;SET IF NEXT I/P LINE IS IF (SOMETHING)
FR.JMP== 10000 ;SET IF NEXT I/P LINE IS GOTO/BACKTO
FR.DIS== 4000 ;SET IF DOING A DISPLAY AS A RESULT OF ".ON <EVENT>:DISPLAY A
FR.TIM== 2000 ;SET IF COJOB HAS HAD XTRA 10% TIME
FR.MLG== 1000 ;WRITING TO LOG FILE FROM MASTER PROCESS
FR.ECH== 400 ;SET IF MIC IS TO ECHO I/P
FR.CHR== 177 ;CHARACTER MASK
;FLAG DEFINITIONS COMMON TO SLAVE AND MASTER
FL.MOP=200000 ;ENABLES MONADIC OPERATORS
;FLAG DEFINITIONS SLAVE REQUEST
FLS.PC==1 ;SET IF CLAIMED PROCESS AREA IN SLAVE REQUEST
FLS.CJ==2 ;SET IF PROCESSING COJOB REQUEST
FLS.BK==4 ;SET IF BREAK CHAR DETECTED ON I/P (NB. ==FL.BRK)
FLS.US==10 ;SET IF OTHER USERS ON SAME LINE
FLS.BR==20 ;SET IF SETTING UP A BATCH JOB
FLS.8==40 ;SET IF READING AN OCTAL NO.
FLS.BC==100 ;SET IF BATCH CONTROL
FLS.CCL==200 ;SET IF CCL ENTRY TO MIC
FLS.GD==400 ;SET IF GODLIKE ([1,2])
FLS.P1==1000 ;SET IF TRIED SUPERVISOR [PROJECT,1] AREA
FLS.BT==2000 ;SET IF PROCESSING A MIC BATCH REQUEST
FLS.NT==4000 ;SET IF PROCESSING A NOT CONDITIONAL
FLS.LG==10000 ;USED BY LOW-LEVEL O/P ROUTINES PROVIDED BY MIC BATCH
FLS.GT==20000 ;SET IF SLAVE PROCESS GETSEG 'ED BY ANOTHER PROGRAM
FLS.ERR==40000 ;SET IF ERROR OCCURS IN SLAVE PROCESS
FLS.UA==100000 ;[1021]SET IF WE WANT "^" CHARACTERS TO BE CONTROLS DURING DISPLAY AND TYPE
FLS.MOP==200000 ;REMEMBER THIS FROM THE PREVIOUS PAGE!
FLS.OA==400000 ;[1031] ADD SUPPORT FOR OCTAL EXPRESSIONS.
SUBTTL Immediate Mode Definitions.
ALT==33
IFDEF FTOALT,<
ALT175==175
ALT176==176
> ;END OF IFN FTOALT
BELL==7
CNTRLC==3
CNTRLB==2
CNTRLP==20
CNTRLZ==^D26
FF==14
LF==12
VT==13
CR==15
.LT.==74 ;[1157] LESS THAN
.GT.==76 ;[1157] GREATER THAN
ND LINSIZ,^D132 ;[1235] NO. OF CHARACTERS IN A LINE
OPDEF PJRST [JRST]
DEFINE MIC(OP,AC)<
IFE AC-L,<
PUSHJ P,M.'OP
>
IFN AC-L,<
IF1,<PRINTX GENERATING MIC'OP CALL USING 'AC>
PUSHJ P,[PUSH P,AC
TRO AC,200000
HRRZM AC,MICBLK+1
MOVEI AC,OP+21
MOVEM AC,MICBLK
MOVEM AC+1,MICBLK+2
MOVE AC,[3,,MICBLK]
TRMOP. AC,
CAIA
AOS -1(P)
IFE <OP-1>,<
MOVE AC+1,MICBLK+2
>
IFE <OP-6>,<
MOVE AC+1,MICBLK+2
>
POP P,AC
POPJ P,]>
>
TYPE==0
GET==1
SET==2
CLEAR==3
DISPLAY==4 ;ARGUMENTS FOR MIC UUO
RESPONSE==5
; LOG==6
ARGNUM==^D26
;OFFSETS INTO FILE SPECIFICATIONS
.DEV==0
.FILE==1
.EXT==2
.PPN==3
SUBTTL Macros.
;MACRO TO O/P A STRING
DEFINE WRITE(TEXT),<
MOVEI BP,[ASCIZ/TEXT/]
PUSHJ P,STROUT
>
;MACRO TO O/P A CHAR
DEFINE OUTSYM(CHAR),<
MOVEI CH,CHAR
PUSHJ P,OUCH
>
;MACRO TO O/P A NEWLINE
DEFINE NEWLINE,<
PUSHJ P,.NEWL
>
;MACRO TO WRITE ENABLE THE HIGH SEGMENT
DEFINE WENABL,<
PUSHJ P,.WENABL
>
;MACRO TO WRITE LOCK HIGH SEGMENT
DEFINE WLOCK,<
PUSHJ P,.WLOCK
>
;MACRO TO O/P AN ERROR MESSAGE
;COULD BE MODIFIED TO DO CLEVER DEC ERROR MSGLVL STUFF
;ARGS ARE:-
; CODE - 3 CHARACTER UNIQUE IDENTIFIER
; TEXT - ERROR MESSAGE
; EXIT - WHERE TO GO AFTER ERROR HAS BEEN PRINTED
; (IF OMMITTED BY DEFAULT SLENDX)
;
DEFINE ERROR. (CODE,TEXT,EXIT<SLENDX>),<
E%%'CODE:
WRITE <?MIC'CODE 'TEXT >
JRST EXIT
;;IF1, <PRINTX (?)MIC'CODE TEXT >
>
;
; THEN FOR ERROR MESSAGES WHICH CANNOT FOLLOW THE ABOVE FORMAT
; THE FOLLOWING MACRO:-
; ERRMS.(CODE,TEXT,AC)
; WHERE:-
; CODE IS AS ABOVE
; TEXT IS AS ABOVE
; AC IS THE ACCUMULATOR IN WHICH THE ADDRESS OF THE ERROR TEXT IS TO BE PUT
; (BY DEFAULT T1).
;
DEFINE ERRMS. (CODE,TEXT,AC<T1>),<
E%%'CODE:
MOVEI AC,[ASCIZ /?MIC'CODE TEXT/]
;;IF1,<PRINTX (?)MIC'CODE TEXT>
>
;[1207]
;[1207] Now a similar thing for warnings.
;[1207]
DEFINE WARN. (CODE,TEXT,EXIT<.+1>),<
W%%'CODE:
JRST [
WRITE <%MIC'CODE 'TEXT>
JRST EXIT
]
;;IF1, <PRINTX (%)MIC'CODE 'TEXT>
>
;[1207]
; then a title
;;if1, <printx * List of MIC Error Messages. *>
;;if1, <printx * (generated during pass 1) *>
;;if1, <printx * * >
SUBTTL Conditionals
; CONDITIONALS
ND FTMBCH,0 ;=-1 IF MIC BATCH
ND FTCOSMIC,0 ;COSMIC-10 EXTENSION
ND FTCJOB,-1 ;-1 IF COJOBS
ND FTGALA,-1 ;INCLUDE SUPPORT FOR GALAXY
ND FTSUPR,0 ;REQUIRE PROJ,1 AS BEING THE USERS SUPERVISOR
ND FTOPR,0 ;-1 IF MIC OPR COMMAND INCLUDED
IFE FTCJOB,<
IF2,<PRINTX MIC WITHOUT COJOBS BEING BUILT>
FTMBCH==0 ;CAN'T HAVE BATCH WITHOUT COJOBS
>
ND FTPSI,-1 ;IF SOFTWARE INTERRUPTS TO BE USED
ND FTPATH,-1 ;SUPPORT FUNNY PATH STUFF
ND SFDLVL,6 ;MAX NESTING FOR SFDS(ONLY IF PATH STUFF SUPPORTED)
ND IMXLVL,^D25 ;INITIAL MAXIMUM NESTING FOR PROCESSES
IFN FTCJOB,< ;COJOB PARAMETERS INITIAL VALUES
IF2,<PRINTX MIC WITH COJOBS BEING BUILT>
ND ICJREQ,4 ;NO. OF COJOBS AVAILABLE AT STARTUP TIME
ND FTCLASS,FTCJOB ;[1074]Class scheduler stuff
ND FTCHARGE,FTCJOB ;[1074]Charge accounting support
IFN FTCLASS,<
IMXCLA==-1 ;[1074]Let them run as slow as they want...
IMNCLA==4 ;[1074]but not so fast
IDFCLA==5 ;[1074]Use batch scheduler class by default
IBBCLA==6 ;[1074]Background batch scheduler class
>
IFE FTCJOB,<FTCLASS==0> ;[1074]Never set FTCLASS without FTCJOB!
>
IFN FTMBCH,<
IF2,<PRINTX INCLUDING SUPPORT FOR MIC BATCH.>
>
ND FTLGNQ,0 ;[1003] IF #0 INCLUDE SUPPORT FOR LOGIN Q
ND FTDDT,0 ;[1024] INCLUDE SOME DDT STUFF WITHIN MIC
IFN FTDDT,<
IF2,<PRINTX MIC for DDT being built>
>
ND FTHATF,0 ;[1025] INCLUDE FEATURE TEST FOR HATFIELD SPECIALS
ND FTBHIV,0 ;[1025] INCLUDE FEATURE TEST FOR BEEHIVE VDU STUFF
ND FTMSFD,-1 ;[1041]SUPPORT FOR [,,MIC] SFD LIBRARY
ND FTCASE,0 ;[1042]SUPPORT FOR INVERTED CASE
IFN FTTSG,< ;[1074]
FTLGNQ==0 ;[1074]This would screw up our LOGIN.
FTTASK==1 ;[1074]So COST:TASK can be got from SWITCH.INI
IDFTIM==^D60*^D60 ;[1074]DEFAULT RUN TIME FOR COJOBS AT STARTUP TIME
IMXTIM==^D600*^D60 ;[1074]MAXIMUM RUN TIME FOR COJOBS AT STARTUP TIME
> ;[1074]
ND FTOALT,0 ;[1100] SUPPORT FOR 175 AND 176 AS ALTMODES
ND FTNIHG,0 ;[1140] SUPPORT FOR NIH SPECIAL PRIV CHECK.
ND ISCNDF,0 ;[1156] INITIAL DO NOT USE SCANDINAVIAN CHARACTER SET
ND TMPCBL,^D512/2 ;[1163] DEFAULT SIZE OF TMPCORE BUFFER
SUBTTL Definitions - Profile word.
;MIC PROFILE WORD BITS
;THERE IS ONE PROFILE WORD IN EACH PDB
;LEFT HALF
PL.CTL==200000 ;IF SET NO CONTROL CHARACTER SUBSTITUTION IS PERFORMED
PL.CL1==100000 ;IF SET NO COLUMN ONE CHECKING IS PERFORMED
PL.PRM==400000 ;IF SET NO PARAMETER SUBSTITUTION IS PERFORMED
PL.NSP==700000 ;TURN'S ALL OF ABOVE OF OR ON
PL.%FN==40000 ;IF SET DOES NOT CAUSE %FIN TO MATCH ANY LABEL
PL.NLC==20000 ;IF SET LITTLE ALPHA CHARS MATCH BIG ALPHA CHARS IN STRING MATCHING
PL.TRL==10000 ;[1073]IF SET TRACE LABELS
PL.NSL==4000 ;[1111] IF SET THE MACRO CANNOT BE SILENCED
PL.INP==2000 ;[1110] SET WHILE WE ARE PROCESSING AN INPUT PROMPT
PL.CCT=1000 ;[1202] REAL CONTROL-C TRAP
PL.CAN==4 ;IF SET INHIBIT [CANCEL] MESSAGES
PL.ABT==1 ;IF SET INHIBIT [ABORT] MESSAGES
PL.PRD==10 ;IF SET INHIBIT [PROCEED] MESSAGES
PL.BRK==2 ;IF SET INHIBIT [BREAK] MESSAGES
PL.ABE==20 ;IF SET INHIBIT [ABORT ON ERROR] MESSAGES
PL.USR==PL.CAN!PL.ABT!PL.PRD!PL.BRK!PL.ABE ;BITS THE USER IS CONCERNED WITH
;RIGHT HALF
PR.TIM==400000 ;IF SET NO TIMESTAMPING IS PERFORMED
PR.LGN==200000 ;IF SET NO LOGGING IS DONE
PR.ALL==177777 ;OPPOSITE OF PR.LGN
IFN FTMBCH,<
;MIC BATCH WORD BITS
;ONE BATCH WORD IN EACH PDB--USED ONLY BY BATCH JOBS
;LEFT HALF
BTL.RQ==400000 ;REQUEST BIT
BTL.RN==200000 ;BATCH JOB RUNNING BIT
BTL.AS==100000 ;SET IF THIS BATCH JOB WAS CREATED BY ASPRIN
BTL.CD==BTL.AS ;SET IF THIS IS A CARD BATCH JOB
BTL.TM==040000 ;SET IF THIS IS A TERMINAL BATCH JOB
;RIGHT HALF
BTR.JB==777 ;MASK FOR BATCH CONTROLLER JOB NUMBER.
BATMST: POINT 9,BATWRD(X),35 ;POINTER TO BATCH CONTROLLER JOB NO.
>;END OF BATCH BITS
SUBTTL Beginning of the Code.
MICBGN: JRST MIC% ;NORMAL ENTRY
JRST CCLENT ;CCL ENTRY
IFN FTMBCH,< JRST CMBENT ;DO A COMBAT STYLE ENTRY >
IFE FTMBCH,< JRST SLENDX >
JRST GTSENT ;GETSEG ENTRY
RESTRT: JRST GO%AGN ;RESTART
MIC%: RESET
;[1070] RESCAN MOVED TO FURTHER ON
SETZM LOKBIT ;SET UP UWP STUFF
MOVE [INCHWL CH]
MOVEM LOWIN ;LOW LEVEL I/P ROUTINE
SETZB F,CH.SAV ;CLLAR FLAG WORD AND CHARACTER BUFFER
PUSHJ P,FRCCHK ;[1150] CHECK IF ON FRCLIN
JRST INITIA ;[1070] GO TO WORK
RESCAN ;[1150][1070] NOW IT IS OK TO RESCAN
MIC%1: MOVE T1,[OUTCHR CH]
MOVEM T1,LOWOUT ;CHAR. OUTPUT LOCATION
SKIPA P,[IOWD SIZ,STACK]
;HERE TO DISPATCH TO DEAL WITH COMMAND THAT INVOKED ME
.MIC: MOVEM CH,CH.SAV
MIC%2: PUSHJ P,FNDCMD ;GET THE USER'S COMMAND
SETO L, ;GET LINE NO.
GETLCH L
ANDI L,3777 ;GET RID OF UNIVERSAL BIT (NB IN 507)
MOVEM L,LLX ;[1073] REMEMBER IT FOR THOSE THAT FOLLOW
MIC GET,L
SETZ S,
MOVE T2,MICTAB(T1) ;GET PROPER COMMAND NAME
MOVEM T2,LOWCMD ;AND REMEMBER FOR POSSIBLE ERROR MSG.
SKIPGE T1,DSPLST(T1) ;IF DISPATCH BIT SET
JUMPE S,LETER3 ;HE MUST BE RUNNING MIC
JRST (T1) ;ELSE DISPATCH
;[1150] Routine to check if on FRCLIN, non-skips if yes
;[1150] skips if no.
FRCCHK: PUSH P,T1 ;[1150] SAVE REGGIE
PUSH P,T2 ;[1150] 'COS WE MAY GET CALLED FROM A FEW PLACES
SETO T1, ;[1150][1070] -1 MEANS US
GETLCH T1 ;[1070] GET OR LINE NO.
JUMPE T1,ON.DET ;[1070] DETACHED IS SIMILAR TO FRCLIN!
ANDI T1,UX.UNT ;[1070] THROW AWAY THE LCH
MOVE T2,[%CNFLN] ;[1070] ASK MONITOR...
GETTAB T2, ;[1070] ...ABOUT FRCLIN
JRST NO.FRC ;[1070] OOOPS, MUST BE PRE-7.01
CAME T1,T2 ;[1070] ARE WE ON FRCLIN?
JRST NO.FRC ;[1070] JUMP ON IF NOT
HRLZS T1 ;[1070] YES, SET UP LINE,,0
ATTACH T1, ;[1070] DETACH US
NO.FRC: AOS -2(P) ;[1150] SKIP RETURN 'COS NOT ON FRCLIN
ON.DET: POP P,T2 ;[1150] GET SAVED ..
POP P,T1 ;[1151] .. BACK
POPJ P,0 ;[1150] RETURN
SUBTTL Command table definitions.
DEFINE CMD,< ;;**NB** THIS TABLE MUST BE IN STRICT ALPHABETICAL ORDER!!!
.. ABORT,MC!CJ!WH!ACT
.. BACKTO,MC!CJ!PRM!ACT!LBL
IFN FTMBCH,< .. BATCH >
.. BREAK,MC!CJ!WH!ACT
.. CANCEL,MC!CJ!WH!ACT
IFN FTCJOB,<.. COJOB >
.. DISPLAY,CJ!PRM!ACT
.. DO,CJ
.. ERROR,MC!CJ!WH!ACT
.. EXIT,CJ!ACT
.. GO,CJ!PRM ;;[1205]
.. GOTO,CJ!PRM!ACT!LBL
.. IF,MC!CJ
.. INPUT,MC
.. LET,MC!CJ
.. MIC,CJ
.. NOERROR,MC!CJ
.. NOOPERATOR,MC!CJ
.. ON,MC!CJ
.. OPERATOR,MC!CJ!WH!ACT
IFN FTOPR&FTCJOB,< .. OPR,MC >
.. PLEASE,MC!CJ
.. PROCEED,MC!CJ!WH!ACT
.. R
.. RESPONSE,MC
.. RETURN,MC!CJ!ACT
.. REVIVE,MC!CJ!ACT
.. RUN
.. SET,CJ
.. SILENCE,MC!CJ!ACT
.. SLEEP,MC
.. START
.. STATUS
.. TYPE,MC!CJ!PRM!ACT
.. WH
.. WHAT,MC!CJ
.. WHENEVER,MC!CJ
>
IFN FTCJOB,< ;COJOB STUFF
COMMENT |
Each switch is defined thus
.. NAME,SELECT,<INSTR>
where
NAME is the switch name,
SELECT is a dummy word
INSTR is the instruction to be executed to move the data from the
switch processor temporary storage to the PDB (via AC T1).
Note if an INSTR is defined a pair of storage words labelled
$$NAME are set up
|
DEFINE SWTCH(SELECT),< ;;**NB** THIS TABLE MUST BE IN STRICT ALPHABETICAL ORDER
..SW..=0
IFN FTCLASS,<.. BACKGR,SELECT,<MOVEM T1,CLASS(X)> > ;;[1207][1074]He isn't in any hurry, obviously
IFN FTCLASS,<.. CLASS,SELECT > ;;[1207][1074][1121]Scheduler class
.. HELP,SELECT ;;[1207] HELP SWITCH
.. LOPTION,SELECT,<MOVEM T1,LOPTION(X)> ;;[1207] LOGIN OPTION
.. NOLOPTION,SELECT ;;[1207] NO LOGIN OPTION
.. NOOPTION,SELECT ;;[1207] NO SWITCH.INI OPTION
.. OPTION,SELECT,<JFCL> ;;[1207] SWITCH.INI OPTION (JFCL CAUSES $$OPTION TO BE DEFINED!)
.. TAG,SELECT,<MOVEM T1,LAB(X)> ;;[1207] START LABEL
.. TIME,SELECT,<MOVEM T1,TIME(X)> ;;[1207] RUN TIME
IFE FTGALA,<.. VD,SELECT,<MOVEM T1,VD(X)> > ;;[1207]DISPOSAL OF LOG FILE
IFE FTGALA,<.. ZQ,SELECT,<MOVEM T1,ZQ(X)> > ;;[1207]DEGREE OF QUEING FOR LOG FILE
>
>
DEFINE ..(A,B),<<SIXBIT/'A/>>
IFWD: SIXBIT/IF/ ;FOR USE IN IF CHECKING
MICTAB: CMD
CMDSIZ=.-MICTAB
SIXBIT @/@ ;FOR USE BY ERROR MSG STUFF.
IFN FTCJOB,< ;MORE COJOB STUFF
;SWITCHES FOR COJOB REQUESTS
DEFINE ..(A,S,I),<<SIXBIT/'A/>>
SWTAB: SWTCH()
TABSWT=.-SWTAB
>
.....==0 ;SOMETHING TO MAKE MACRO DEFINITION MORE UNDERSTANDABLE
;DISPATCH BITS FOR COMMAND DECODE
MC==400000 ;MUST BE RUNNING MIC
CJ==200000 ;LEGAL IN OWNER COJOB CONTROL
WH==100000 ;WHENEVER EVENT
ACT==40000 ;ACTION ON EVENT
PRM==20000 ;REQUIRES PARAMETERS IF USED AS AN EVENT
LBL==10000 ;IF PARAMETER IS A LABEL OTHERWISE A VARIABLE
EVNTNM==0 ;FIRST EVENT IS EVENT ZERO
ACTNUM==0 ;FIRST ACTION IS ACTION ZERO
DEFINE ..(...,....<.....>),<
......==....
IFN ......&WH,<......=......!EVNTNM
EVNTNM=EVNTNM+1>
IFN ......&ACT,<......=......!<<ACTNUM>B29>
ACTNUM=ACTNUM+1>
......,,.'...>
DSPLST: CMD
;HERE ON "/" AND "@" COMMANDS
JRST SLASH ;LET HIM INTRODUCE HIS COMMAND
IFN FTCJOB,< ;YET MORE COJOB STUFF
;[1213][1207] (WHOLE PAGE EDITED)
;
; COJOB SWITCHES - DISPATCH TABLE
DEFINE ..(....,S,I),<
L..(\..SW..)
..SW..=..SW..+1
>
DEFINE L..(N),<0,,$.'N>
DSPSWT: ;DISPATCH TABLE FOR SWITCHES
SWTCH()
>
;MAKE UP A DEFAULT ACTION TABLE USED FOR WHENEVER EVENTS
;THIS DEFAULT TABLE IS PRELOADED INTO EVERYBODIES PDB
;ON THEIR STARTING TO RUN A MIC PROCESS.
;THE DEFAULT SETTINGS MAY BE MODIFIED BY USING A WHENEVER
;OR ON COMMAND
DEFINE .. (....,...<.....>),<
......==...
IFN ......&WH,<
JRST '....
BLOCK 1
> ;END OF MACRO TO DEF TABLE
>
DEFVNT: CMD ;HERE STARTETH THE TABLE
;MAKE UP A DISPATCH TABLE FOR ALL ACTIONS
;I.E WHEN AN ACTION IS TO BE PRFORMED THIS TABLE TELLS
;US WHERE TO GO.
DEFINE .. (....,...<.....>),<
......=...
IFN ......&ACT,<
IFE ......&PRM,<
JRST %.'....
>
IFN ......&PRM,<
PUSHJ P,%.'....
> > >
DSPACT: CMD ;DISPATCH TABLE FOR ALL ACTIONS
SUBTTL Slave processor - record user command: COJOB.
IFN FTCJOB,< ;COJOBS
IFE FTMBCH,<XLIST>
IFN FTMBCH,< ;MIC BATCH FEATURE
.BATCH: TLO F,FLS.BT ;SAY WE IS BATCH
MOVE T1,[ASCII/BATCH/]
MOVEM T1,BUFFER ;STORE COMMAND IN Q'S INPUT BUFFER
MOVE T1,[POINT 7,BUFFER+1]
MOVEM T1,BUFBP ;SET UP POINTER TO THE INPUT BUFFER
JRST BCJOB ;THEN PRETEND TO BE COJOB
> ;END OF MIC BATCH CONDITIONAL
LIST
.COJOB:
SETZ F,
BCNTL: SETO T1,
GETLCH T1
TDNE T1,WHONOT ;DECIDE WHO MAY HAVE COJOB
JRST CJNOTU
BCJOB: TLO F,FLS.CJ ;SAY WE ARE PROCESSING A COJOB RQST.
MOVEM CH,CH.SAV
PUSHJ P,WDREAD
CAIN CH,"-" ;IF ITS A COJOB CONTROL
JRST CJCNTL ;MAY BE COJOB CONTROL
MOVN N,COJOBN ;HOW MANY COJOBS AVAILABLE
SUB N,CJUP ;LESS HOW MANY IN USE
IFN FTMBCH,< ;IF BATCH
TLNN F,FLS.BT ;ARE WE BATCH REQUEST
> ;END OF BATCH
JUMPLE N,NOCJBS ;ARE THERE ANY LEFT
MOVSI T1,'DSK'
MOVEM T1,LDEV ;INITIALLISE DEVICE
HRLOI T1,'L00'
MOVEM T1,LEXT
IFE FTPATH,<
GETPPN T1,
JFCL
>
IFN FTPATH,< SETZ T1, >
IFN FTMBCH,<
TLNE F,FLS.BT ;A BATCH REQUEST
MOVE T1,QUEPPN ;YES -LOG DEFAULT IS QUE DEVICE
> ;END OF BATCH BIT
MOVEM T1,LPPN
; MOVEM CH,CH.SAV ;MAY BE A "="
PUSHJ P,INSPC0 ;READ LOGFILE/DEV SPEC.
JRST LGFERR ;NOTA NICE ONE
SETZM CH.SAV
CAIE CH,76 ;[1101] THIS MEANS ...
CAIN CH,"]" ;HE MAY HAVE SUPPLIED A LOGPPN
PUSHJ P,CHARIN
IFN FTMBCH,<
TLNE F,FLS.BT ;BATCH REQUEST?
JRST BCHJOB ;YES
>
PUSHJ P,RDSWCH ;[1215] PROCESS SWITCHES AND SWITCH.INI
JFCL ;[1121] NOW HAS TWO RETURNS
CAIE CH,"=" ;MACRO NAME YET!
JRST SWTERR ;NO---ERROR
JRST SLASH ;DO THE NORMAL MIC STUFF
> ;END OF COJOB CONDITIONAL
IFN FTMBCH,<
;HERE TO DEAL WITH JOBSPEC,LOGSPEC, AND SWITCHES FOR
;MIC BATCH JOBS
BCHJOB: PUSHJ P,JBSPEC ;CHECK UP ON THE JOBSPEC,LOGSPEC
CAIE CH,"/" ;ANY SWITCHES
JRST BCHJB0 ;NO
BCHSWT:
PUSHJ P,RDSWCH ;[1121] PROCESS THE SWITCHES
JRST CALLQX ;[1121] HERE IF WE GOT TO A BREAK CHARACTER
CAIE CH,"=" ;JUST GOBBLE UNTIL THIS OCCURS
JRST BCHSWT ;HASNT YET
MOVEI CH," " ;GET SPACE CHAR.
IDPB CH,BUFBP ;AND OUTPUT IT
MOVEI CH,"=" ;GET THE EQUALS BACK
BCHJB0: CAIE CH,"=" ;HAVE WE REACHEDTHE END OF THE Q SPEC
JRST CALLQX ;NO,DONT UNNERSTAND!
JRST SLASH ;YES, DEAL WITH MIC STUFF
> ;END OF BATCH JOB BIT
SUBTTL Slave processor - record user command: DO.
;HERE TO PROCESS COMMANDS WHICH START A MIC MACRO OFF
;ON THE GUY'S TERMINAL
.DO: ;AS FAVOURED BY DEC
SLASH: ;HATFIELD
AT: ;OTHER PEOPLES
SKIPN MASTNO ;IS THE MASTER RUNNING?
JRST NOMSTR
MOVNI X,PDB ;[1170] GET THE ADDRESS OF THE REAL (PROTOTYPE) PDB
ADDI X,DUMPDB ;[1170] AND CORRECT IT FOR THE DUMMY
MOVEI T1,CHRMAX ;[1170] GET THE MAX. CHARACTER COUNT
MOVEM T1,CHRCNT ;[1170] AND REMEMBER IT
MOVSI T1,(POINT 7,0) ;[1170] MAKE UP A POINTER TO..
ADDI T1,ARG(X) ;[1170] THE ARGUMENT SPACE
MOVEM T1,CHRPTR ;[1170] AND REMEMBER IT
JRST OKPDB
IFE FTMBCH,<XLIST>
IFN FTMBCH,< ;BATCH BIT
IFE FTCOSMIC,<
;SPECIAL ENTRY HANDLING STUFF FOR COMBAT
CMBENT: MOVE P,P..SAV ;USE COMBAT'S STACK
POP P,F
TDZ F,[XWD ^-<FLS.BR!FLS.BC>,-1] ;[1120] CLEAR SPURIOUS FLAGS
TLNN F,FLS.BR ;IS IT BATCH
JRST SLENDX ;NO
TLNE F,FLS.BC ;BATCH CONTROL
JRST [RESCAN
SETZB CH,CH.SAV
PUSHJ P,WDREAD
CAIE CH,"-"
JRST [PUSH P,[EXP .MIC+2]
JRST FNDCMD+1]
TLO F,FLS.CJ
JRST CJCNTL
]
SETO T1,
HRRI T1,.GTPRG ;GETTAB TABLE
GETTAB T1,
SETZ T1, ;DEFENSIVE
CAME T1,[SIXBIT/COMBAT/]
JRST SLENDX
WENABL ;OPEN HI SEG
MOVNI X,PDB ;SET UP DUMMY X
ADDI X,DUMPDB
MOVE T1,BATOPR ;BATCH OPERATOR
MOVEM T1,LINE(X) ;AND PRETEND HE IS THE OWNER
MOVSI T1,DEFVNT ;FIX UP DEFAULT ACTIONS
HRRI T1,FSTVNT(X)
BLT T1,LSTVNT(X) ;MUST BE DONE HERE AS MIC MAY HAVE CHANGED
SETOM LINE(X) ;DEFENSIVE
JRST OK3 ;SET UP A BATCH JOB
> ;END OF NON-COSMIC STUFF
IFN FTCOSMIC,<
;COMBAT - the COSMIC batch job controller calls MIC
;via a PUSHJ P,<start addr. of MIC>+3
;with the ac's set up as follows
;
; p = stack
; z =required action
; x =data block addr. (action dependant)
; y =pdb start time (used for security)
;
cmbent: seto t1,
hrri t1,.gtprg
gettab t1,
setz t1,
came t1,[sixbit/combat/]
popj p,0
movsi f,fls.br ;note batch call
skipge z ;any action specified
caige z,cosact ;yes valid?
popj p,0 ;no fail
movem p,p..sav ;save the current stack pointer
pjrst cosdsp(z) ;dispatch as appropriate
;dispatch table for COSMIC entry
cosdsp: popj p,0 ;no action 0 you are confused
pjrst cosinf ;info. call
pjrst cossts ;status (of job) call
popj p,0 ;get pdb call
popj p,0 ;run job call
pjrst cosgo ;get pdb/runjob call
pjrst cosctl ;control job call
cosact==.-cosdsp
;get information on the current status of MIC
;regarding BATCH
cosinf: movsi t1,batblk ;from here
hrr t1,x ;to here
blt t1,batsiz(x) ;this much
aos (p) ;good return
popj p,0
;
;get status of a job
;
cossts: came y,strtim(x) ;are we us
jrst cpopj ;no
movss x
PUSH P,T1 ;[1205]
MOVEI T1,PDBSIZ(X) ;[1205]
BLT X,(T1) ;[1205] get copy
POP P,T1 ;[1205]
aos (p) ;good return
popj p,0
;
;here to get a pdb and run a job
;
cosgo: wenabl
movni x,pdb ;set up dummy x
addi x,dumpdb
move t1,batopr ;get batch operator line no.
movem t1,line(x) ;and pretend he is the owner
movsi t1,defvnt
hrri t1,fstvnt(x) ;setting up the default actions must be done
blt t1,lstvnt(x) ;here, as MIC may have changed
setom line(x) ;defensive
jrst ok3 ;fall into common for all modes stuff
;
;HERE TOO CONTROL A COSMIC JOB
;
COSCTL==CJCNTL
> ;END OF FTCOSMIC
;Here to deal with the JOBspec/LOGFILEspec
;of a MIC batch request.
JBSPEC: MOVEM CH,CH.SAV ;SAVE CHARACTER
PUSH P,LOWOUT ;SAVE LOW LEVEL O/P ROUTINE
MOVE T1,[IDPB CH,BUFBP] ;REPLACE IT
MOVEM T1,LOWOUT
SKIPE WD,LFILE ;GET THE JOB NAME
PUSHJ P,SIXBP ;AND PRINT IT IF ANY
MOVE WD,LPPN ;GET THE JOBPPN
CAMN WD,QUEPPN ;CHANGED
JRST JBSPC0 ;NO
MOVE CH,CH.SAV ;RESTORE CHAR.
CAIN CH,"," ;WAS THERE A JOB SPEC
PUSHJ P,PPNOUT ;YES
JBSPC0: POP P,LOWOUT ;RESTORE OLD O/P ROUTINE
MOVE CH,CH.SAV ;GET CURRENT CHAR. BACK
SETZM CH.SAV ;AND CLEAR MEMORY
CAIE CH,"," ;DID WE HAVE A JOB SPEC
JRST JBSPC1 ;NO
HRLZI T1,'DSK' ;RE-INIT I/P
MOVEM T1,LDEV
HRLOI T1,'L00'
MOVEM T1,LEXT
SETZM LPPN
PUSHJ P,CHK ;READ THE LOG FILE
JRST E%%ELF ;ERROR
JBSPC1: SETZM CH.SAV ;CLEAR THE REMEMBERED CHARACTER
PUSH P,CH ;REMEMBER
MOVEI CH,"=" ;GENERATE THE EQUALS SIGN
IDPB CH,BUFBP ;FOR Q
POP P,CH ;RESTORE
POPJ P,0
> ;END OF BATCH BIT
LIST
;HERE TO PERFORM A CCL STYLE ENTRY ON MIC
;IE READ I/P FROM TMPCOR OR FROM nnnMIC.TMP
;INSTEAD OF FROM TTY
CCLENT: MOVE P,[IOWD SIZ,STACK]
PUSH P,[OUTCHR CH]
POP P,LOWOUT
MOVSI T2,'MIC' ;NAME OF TMPCOR FILE
MOVE T3,[IOWD TMPCBL,TMPCBF] ;[1163] TMPCOR BUFFER
MOVE T1,[.TCRDF,,T2] ;[1020]OPERATION CODE IS READ AND DELETE
TMPCOR T1, ;DO IT
SKIPA ;NUFFIN
JRST GOTTMP ;GOT IT
MOVEI T1,17 ;DUMP MODE
MOVSI T2,'DSK' ;DEVICE
SETZB T3,T4 ;DBUFFER SPACE ETC.
OPEN 1,T1 ;GET THE DEV.
JRST CCLERR ;OOOOOOPS!!
PJOB T1, ;GET JOB NO.
PUSHJ P,.MKPJN ;MAKE A FUNNY FILE (nnnMIC)
HRRI T1,'MIC'
MOVSI T2,'TMP' ;WIF THIS EXTENSION
SETZB T3,T4
LOOKUP 1,T1 ;IS IT THERE?
JRST CCLERR ;NO!!!!
MOVE T1,[IOWD TMPCBL,TMPCBF] ;[1163] READ IT
SETZ T2,
INPUT 1,T1
SKIPA ;SUCCESS
JRST CCLERR ;FAILURE
SETZB T1,T2 ;[1020]SET UP A NULL...
SETZB T3,T4 ;[1020]...ARGUMENT BLOCK...
RENAME 1,T1 ;[1020]..AND DELETE THE TMP FILE
JFCL ;[1020] DON'T CARE
RELEASE 1,
GOTTMP: MOVE T1,[PUSHJ P,CCLIN]
MOVEM T1,LOWIN ;SET UP SPECIAL LOW LEVEL I/P ROUTINE
SETZB F,CH.SAV ;CLEAR FLAG WORD AND CHAR BUFFER
TLO F,FLS.CCL ;AND REMEMBER CCL STYLE ENTRY
MOVE T1,[POINT 7,TMPCBF] ;VIRGIN POINTER
MOVEM T1,TMPCPT ;FOR I/P ROUTINE
SETZM TMPCPT-1 ;MAKE SURE BUFFER ENDS WITH ZERO BYTE
JRST MIC%1 ;AND BACK TO COMMON STUFF
;LOW LEVEL I/P ROUTINE USED BY CCL ENTRIES
;IF MODIFIED WATCH YOU DON'T CLOBBER BATCH I/P ROUTINE
CCLIN: ILDB CH,TMPCPT ;GET A CHAR
JUMPN CH,CPOPJ ;NICE ONE
MOVEI CH,ALT ;FORCE BREAK ON ZERO BYTE
POPJ P,0
CCLERR: ERROR. NTF,<No TMPfile for input>,FALSE
;HERE TO DEAL WITH GETSEG STYLE ENTRY
GTSENT: HRRZS F ;JUST THE RIGHT HALF
CAILE F,ELDATA ;ENUFF SPACE?
POPJ P,0 ;NO, FAIL RETURN
SKIPN T1,1 ;IF NO I/P ROUTINE USE
MOVE T1,[INCHWL CH] ;DEFAULT
MOVEM T1,LOWIN ;LOW LEVEL I/P ROUTINE
SKIPN T1,2 ;IF NO O/P ROUTINE USE
MOVE T1,[OUTCHR CH] ;DEFAULT
MOVEM T1,LOWOUT
SETZB F,CH ;NO FLAGS
TLO F,FLS.GT ;CEPT THIS ONE
MOVEM P,P..SAV ;SAVE THE CURRENT STACK POINTER
JRST MIC%2 ;FALL INTO STANDARD STUFF
;HERE TO RETURN WHEN WE HAVE BEEN GETSEGED
GTSRTN: MOVE P,P..SAV ;RESTORE STACK POINTER
TLNE F,FLS.ER ;IS ERROR FLAG SET?
AOS (P) ;NO, SKIP
POPJ P,0 ;RETURN TO CALLER
IFE FTCJOB,<XLIST>
IFN FTCJOB,<
; A ROUTINE TO READ THE SWITCHES FOR A COJOB REQUEST
;[1121] RDSWCH CHANGED TO HAVE 2 RETURNS
RDSWCH: SETZ X,0 ;[1215][1207] FLAG READING REAL SWITCHES
CAIE CH,"/" ;[1215] ANY SWITCHES?
JRST RDSWC0 ;[1215] NO, JUST PROCESS SWITCH.INI
SETZB CH,CH.SAV ;GET RID OF /
PUSHJ P,RDSWC1 ;[1207] DO IT
POPJ P,0 ;[1207] HE GOT IT RONG
SETO T1,0 ;[1217] NOOPTION FLAG IS -1
CAMN T1,$$OPTION(X) ;[1217][1207] DID HE SPECIFY /NOOPTION
JRST CPOPJ1 ;[1207] YES, DON'T EVEN LOOK AT SWITCH.INI
RDSWC0: ADDI X,1 ;[1207] PROCESSING SWITCH.INI SWITCHES
JRST SWTINI ;[1213] DO IT (CALLS RDSWC1)
RDSWC1: PUSHJ P,WDREAD ;READ SWITCH NAME
PUSHJ P,SWCHK ;CHECK IT
IFE FTMBCH, JRST SWTERR ;[1121] ERROR IF NO BATCH
IFN FTMBCH, JRST RDSWC2 ;[1121] POSSIBLY A SWITCH TO Q
PUSHJ P,SWTARG ;GET SWITCH ARGUMENT
CAIN CH,"/" ;ANY MORE
JRST RDSWC1 ;YEA
JRST CPOPJ1
IFN FTMBCH,< ;[1121]
RDSWC2: TLNN F,FLS.BT ;BATCH REQUEST?
JRST SWTERR ;NO
MOVEM CH,CH.SAV ;SAVE THE CHARACTER WE GOT
MOVEI CH,"/" ;GET A SLASH
IDPB CH,BUFBP ;GIVE IT TO Q
PUSHJ P,QSW ;GIVE THE SWITCH NAME TOO
RDSWC3: PUSHJ P,CHARIN ;GET THE NEXT CHARACTER
PUSHJ P,ISBRK ;CHECK FOR BREAK CHARACTERS
POPJ P,0 ;YES SO RETURN
CAIN CH,"/" ;ANOTHER SWITCH?
JRST RDSWCH ;YES - GO AND PROCESS THAT
CAIN CH,"=" ;END OF SWITCHES?
JRST CPOPJ1 ;YES SO HANDLE THAT
IDPB CH,BUFBP ;NO - OUTPUT THIS ONE
JRST RDSWC3 ;GO ROUND AGAIN
;HERE WITH A SIXBIT SWITCH IN WD TO SEND
;AS ASCII TEXT TO Q BUFFER
QSW: MOVE T1,[POINT 6,WD] ;SET PU THE BYTE POINTER TO GET THE CHARACTERS
QSW1: ILDB CH,T1 ;GET A CHARACTER
TLNE T1,770000 ;IF AT END OF WD OR
SKIPN CH ;IF NULL ITS THE END
POPJ P,0 ;RETURN
ADDI CH,40 ;CHANGE TO ASCII
IDPB CH,BUFBP ;SEND IT TO Q
JRST QSW1 ;GO ROUND AGAIN
NUMBR: TLNN F,FLS.BT ;BATCH REQUEST?
JRST TIMAR1 ;NO
MOVEM CH,CH.SAV ;SAVE CHAR. WE GOT
MOVEI CH,"/" ;GET A SLASH
IDPB CH,BUFBP ;GIVE IT TO Q
PUSHJ P,QSW ;AND THE SWITCH NAME
PUSHJ P,CHARIN ;GET THE ":"
IDPB CH,BUFBP ;OUTPUT THAT TOO
TIMAR1: PUSHJ P,NUMBR1 ;GET THE TIME LIMIT
POPJ P,0 ;NONE GIVEN
TLNN F,FLS.BT ;ARE WE BATCH?
POPJ P,0 ;NO FORGET IT
PUSH P,CH ;SAVE CH
PUSH P,LOWOUT ;SAVE OUTPUT ROUTINE
MOVE T1,[IDPB CH,BUFBP] ;GET NEW OUTPUT
MOVEM T1,LOWOUT ;SET UP ROUTINE
PUSHJ P,TIMOUT ;GIVE QUEUE THE TIME
POP P,LOWOUT ;RESTORE OUTPUT ROUTINE
POP P,CH ;GET CH BACK
POPJ P,0 ;RETURN
TIMOUT: IMULI N,^D1000 ;MAKE SECONDS INTO MI.LLISECS
IDIV N,[15567200] ;GET HOURS
PUSH P,N1 ;SAVE LOW RESULT
PUSHJ P,DECPR2 ;OUTPUT HOURS
PUSHJ P,COLON ;AND A COLON
MOVE N,(P) ;GET REMAINDER BACK
IDIVI N,165140 ;GET MINUTES
MOVEM N1,(P) ;SAVE REMAINDER FOR LATER
PUSHJ P,DECPR2 ;OUTPUT MINUTES
PUSHJ P,COLON ;AND A COLON
POP P,N ;GET BACK REMAINDER
IDIVI N,^D1000 ;MAKE INTO SECONDS
PUSHJ P,DECPR2 ;OUTPUT IT
POPJ P,0 ;RETURN
>;END IFN FTMBCH
;A ROUTINE TO READ IN A NUMBER IN THE FORM
; N
;OR NK (N*1000)
;OR N:N:N (IE (N*60)+N)*60+N
IFE FTMBCH,<NUMBR:>
NUMBR1: PUSHJ P,INTIN ;GET A NO.
SKIPN N1 ;WE DID?
POPJ P,0 ;NOOO
PUSHJ P,LOWUP ;change lower case to upper if neccc.
CAIN CH,"K" ;TERMINATED BY A K
JRST M1000 ;YES NO.*1000
CAIN CH,":" ;TERMINATED BY A:
PUSHJ P,M60 ;YES NO.*60
JRST CPOPJ1 ;ANYTHING ELSE FINISH
M1000: IMULI N,^D1000
PUSHJ P,CHARIN ;[1207] READ NEXT CHARACTER
JRST CPOPJ1 ;[1207] AND SUCCESS
M60: IMULI N,^D60
PUSH P,N ;SAVE VALUE UP TO KNOW
PUSHJ P,DECIN ;GET ANOTHER NO.
ADDM N,(P) ;[1001]
CAIE CH,":" ;AGAIN?
JRST [POP P,N
POPJ P,0]
;[1001] DELET 1 LINE
POP P,N
PUSHJ P,M60 ;DO IT
JRST CPOPJ1 ;[1207] SUCCESS
POPJ P,0
; A ROUTINE TO READ A SINGLE CHARACTER AND STORE IT IN T4
; THEN READ THE NEXT AND STORE IT IN CH
CHRCTR: PUSHJ P,CHARIN ;GET THE CHARACTER
MOVEM CH,T4 ;PUT IT IN ITS PLACE
PJRST CHARIN ;AND DO THE REST
SUBTTL Slave processor - Handle COJOB switches.
;
; ALL SWITCHES EDITED BY CHANGE # 1207 AND 1213
;
DEFINE ..(NAME,SELECT,I),<
IFIDN <NAME>,<SELECT>,< L..(\..SW..) >
..SW..=..SW..+1
>
DEFINE L..(N),<$.'N:>
IFN FTCLASS,<
SWTCH(BACKGROUND)
MOVE N,BBCLA ;[1074]Use the background-batch scheduler class
MOVEM N,$$CLASS(X) ;[1074]
POPJ P, ;[1074][??]
SWTCH(CLASS)
PUSHJ P,NUMBR1 ;GET DESIRED SCHEDULAR CLASS
JRST SWTERR ;ERROR
HLRE T4,LIMCLA ;GET THE HIGHEST ALLOWED CLASS
JUMPL T4,CLA..0 ;AND IF -1 NO CHECKING
CAML N,T4 ;IS THIS CLASS OK
JRST CLA..0 ;YES
MOVE N,T4 ;NO, RESET TO OK ONE
WARN. CAE,<CLASS argument exceeds maximum - reduced>
CLA..0: HRRE T4,LIMCLA ;GET THE LOWEST ALLOWED CLASS
JUMPL T4,CLA..1 ;JUMP OUT IF NO LIMIT
CAML N,T4 ;IS HE WITHIN LIMITS
JRST CLA..1 ;YES
MOVE N,T4 ;RESET LIMIT
WARN. CAL,<CLASS argument is too small - increased>
CLA..1: MOVEM N,$$CLASS(X) ;REMEMBER WHAT HE SAID
POPJ P,0 ;AND DONE
>
IFE FTGALA,<
SWTCH(VD)
PUSHJ P,CHRCTR ;GET DISPOSITION OF LOG FILE
MOVEM T4,$$VD(X) ;REMEMBER IT
POPJ P,0 ;DONE
SWTCH(ZQ)
PUSHJ P,NUMBR1 ;GET DEGREE OF QUEING
JFCL ;EH?
MOVEM N,$$ZQ(X) ;REMEMBER IT
POPJ P,0 ;AND RETURN
>
; Here to handle the /TIME:nnnn switch
;
SWTCH(TIME)
PUSHJ P,NUMBR1 ;GET THE RUNTIME
JRST SWTERR ;ERROR
PUSHJ P,PRVCHK ;IS HE GODLY
TLNE F,FLS.BT ;OR BATCH REQUEST?
JRST TIM..0 ;YES TO EITHER
HLRE T4,LIMTIM ;GET MAX. TIME LIMIT
JUMPL T4,TIM..0 ;JUMP IF NONE
CAML T4,N ;IS HE ALLOWED WHAT HE ASKED FOR?
JRST TIM..0 ;JUMP IF YES
MOVE N,T4 ;NO, RESET TO MAXIMUM
WARN. TAE,<TIME argument exceeds current maximum - reduced to maximum.>
TIM..0: MOVEM N,$$TIME(X) ;REMEMBER WHAT HE SAID
POPJ P,0 ;AND AWAY WE GO
;[1207] here to handle the /TAG:lable switch
;
SWTCH(TAG)
PUSHJ P,WDREAD ;READ A SIXBIT WORD
MOVEM WD,$$TAG(X) ;PREPARE THE WAY
POPJ P,0 ;AND RETURN
;[1207] here to handle the /LOPTION:option switch.
;
SWTCH(LOPTION)
PUSHJ P,WDREAD ;READ A SIXBIT OPTION NAME
MOVEM WD,$$LOPTION(X) ;REMEMBER IT FOR LOGIN
POPJ P,0 ;AND RETURN
;[1207] here to handle the /NOLOPTION switch
;
SWTCH(NOLOPTION)
SETOM $$LOPTION(X) ;FLAG WE WANT NO LOGIN OPTION
POPJ P,0 ;AND RETURN
;[1207] here to handle the /OPTION switch
;
SWTCH(OPTION)
JUMPE X,OPT..0 ;ONLY ALLOWED AS REAL SWITCH
WARN. ONS,<OPTION switch not allowed in SWITCH.INI - ignored.>
POPJ P,0 ;IGNORE IF NOT
OPT..0: PUSHJ P,WDREAD ;READ THE OPTION NAME
MOVEM WD,$$OPTION(X) ;STORE IT
POPJ P,0 ;AND DONE
;[1207] here to handle the /NOOPTION switch
;
SWTCH(NOOPTION)
JUMPE X,NOP..0 ;ONLY ALLOWED AS REAL SWITCH
WARN. NNS,<NOOPTION switch not allowed in SWITCH.INI - ignored.>
POPJ P,0 ;IGNORE IF NOT
NOP..0: SETOM $$OPTION(X) ;FLAG NOOPTIONS
POPJ P,0 ;AND DONE
;[1213] Here to deal with /HELP switch
;
SWTCH(HELP)
WARN. HNA,<HELP switch not implemented, use HELP <subject> instead.>
SKIPE X ;[1215] PROCESSING SWITCH.INI?
PUSHJ P,SWIDUN ;SNEAKY WAY
JRST EXIT1 ;OUT
; A ROUTINE TO CHECK FOR VALID SWITCHES
SWCHK: MOVE T1,[-TABSWT,,SWTAB] ;ARG FOR SEARCH
PUSHJ P,FNDNAM ;SEARCH
POPJ P,0 ;[1121] GIVE 1ST RETURN
HRRZ T1,T1 ;JUST WANT INDEX
JRST CPOPJ1 ;[1121] GIVE 2ND RETURN
;[1207] Aroutine to process SWITCH arguments.
; On entry switch table index is in T1
SWTARG: JRST @DSPSWT(T1) ;DISPATCH TO PROCESS SWITCH
;[1207] SWTARG is pretty simple at the moment
;[1207] a routine to set up to process SWITCH.INI switches.
;[1213] This code was added by edit [1213]
; only the end of the edit is marked
SWTINI: MOVSI T3,'DSK' ;GET THE DEVICE
MOVEI T2,.IODMP ;GOOD OLD DUMP MODE
SETZ T4,0 ;SO NO BUFFERS
OPEN 1,T2 ;TRY FOR THE DEVICE
JRST [ERROR. <SID>,<SWITCH.INI device error>]
MOVE T1,[SIXBIT/SWITCH/] ;FILENAME
MOVSI T2,'INI' ;EXTENSION
SETZ T3,0 ;NO DATES ETC
GETPPN T4, ;USERS PPN
JFCL ;DEFENSIVE
LOOKUP 1,T1 ;OPEN THE FILE FOR READING
JRST CPOPJ1 ;[1213] WELL IF THERE IS NOT ONE. THATS OK
MOVE T1,LOWIN ;GET CURRENT LOW LEVEL INPUTTER
MOVEM T1,SINLIN ;SAVE IT
MOVEM CH,SINICH ;REMEMBER IT
MOVE T1,[PUSHJ P,SWTICH] ;GET LOW-LEVEL INPUTTER
MOVEM T1,LOWIN ;AND SET IT UP
MOVE T1,[POINT 7,SWIBLK] ;POINTER TO THE SWITCH.INI BLOCK
MOVEM T1,SWIPTR ;REMEMBER THE INITED POINTER
;
; Now we have opened SWITCH.INI lets see if there is an option for us
;
SWTI.1: PUSHJ P,ALPHI ;READ A NAME
CAME WD,LOWCMD ;IS IT THE ONE WE WANT
JRST SWTI.0 ;NO
CAIE CH,":" ;IS IT A NAMED OPTION?
JRST SWTI.2 ;NO
PUSHJ P,ALPHI ;GET THE OPTION NAME
CAME WD,$$OPTION ;IS IT THE ONE WE WANT?
JRST SWTI.0 ;NO
SWTI.3: PUSHJ P,CHARSG ;YES, WE HAVE FOUND A SWITCH.INI LINE
JRST RDSWIN ;SO GO AND READ IT
SWTI.0: PUSHJ P,ISBRKC ;IS THIS A BREAK CHARACTER?
JRST [ ;YES
CAIN CH,CNTRLZ ;IS IR EOF?
JRST SWIDUN ;YES
JRST SWTI.1 ;TRY FOR ANOTHER
] ;LINE
PUSHJ P,CHARIN ;READ NEXT
JRST SWTI.0 ;AND READ TILL WE ARE DONE
;
; Here when it is not a named option we have found
;
SWTI.2: SKIPE $$OPTION ;DID WE WANT A NAMED OPTION?
JRST SWTI.0 ;YES
JRST SWTI.3 ;NO, THIS ONE WILL DO
;
; Here when we have finished wit SWITCH.INI
;
SWIDUN: MOVE T1,SINLIN ;GET THE OLD LOW-LEVEL BACK
MOVEM T1,LOWIN ;AND RESET IT
MOVE CH,SINICH ;GET THE SAVED TERMINATOR
JRST CPOPJ1 ;AND ON YER BIKE
;
; Here to process the SWITCH.INI line
;
RDSWIN: PUSHJ P,RDSWC1 ;PROCESS THE SWITCHES
JFCL ;SOMAT WRONG
JRST SWIDUN ;ALL DONE
;
;SWTICH - Read a single character from SWITCH.INI, ignoring
; line numbers etc.
;
SWTICH: ILDB CH,SWIPTR ;GET A CHARACTER
JUMPE CH,SWTNXB ;DONE, GO TO NEXT BLOCK
SWTALB: POPJ P,0 ;RETURN THE CHARACTER
;
SWTNXB: HRRZ T1,SWIPTR ;GET THE BUFFER WORD ADDRESS
JUMPE T1,NOSWIB ;NOT GOT A BYTE YET
CAIE T1,SWIBLK+SWIBSZ ;AT END OF THIS BLOCK?
JRST SWTICH ;NOT YET
NOSWIB: MOVE T1,[-SWIBSZ,,SWIBLK-1] ;SET UP IOWD..
SETZ T2,0 ;CHAIN
IN 1,T1 ;READ A BLOCK
SKIPA T1,[POINT 7,SWIBLK] ;[1220] GOT IT, USE THIS BYTE POINTER
JRST [
RELEASE 1, ;FREE THE CHANNEL
MOVEI CH,CNTRLZ ;HALLUCINATE A CONTROL-Z (SORT OF EOF!)
JRST SWTALB ;FINISHED READING SWITCH.INI
]
MOVEM T1,SWIPTR ;SET UP THE BYTE POINTR
MOVE T1,[^D-128,SWIBLK] ;SET UP AN AOBJN THINGY
NOSWB2: MOVE T2,T1 ;GET A WORD
TRNE T2,1 ;IS IT A LINE NUMNER?
PUSHJ P,NOSWB3 ;YES
AOBJN T1,NOSWB3 ;CHECK OUT WHOLE OF BUFFER
JRST SWTICH ;NOW GO GET CHARACTERS
;
; Here to delete the line number
;
NOSWB3: SETZB T2,(T1) ;THAT DISPOSES OF THE NUMBER
DPB T2,[POINT 7,1(T1),6] ;AND THAT DISPOSES OF THE FOLLOWING SPACE OR TAB
POPJ P,0 ;CHECK OUT REST
;
; End of Code installed by [1213]
;[1207]
SUBTTL Slave processor - Check COJOB logfile specification.
; A ROUTINE TO CHECK IF A LOG SPEC IS LEGAL
CHKFIL: MOVE T3,LDEV ;WHATS THE LOG DEV.
MOVEI T2,17 ;MODE
SETZ T4,
MOVEI BP,LGDERR ;PREPARE THE ERROR MESG.
OPEN 1,T2
JRST CPOPJ ;OOPS
MOVE T4,LPPN ;AND PPN
MOVE T1,LFILE ;GET FILE NAME
MOVE N,LEXT ;GET CURRENT EXTENSION
DEVCHR T3, ;[1206][1153] MUST CHECK IF NUL:
HLRZS T3 ;[1206][1153] BITS TO CHECK
CAIE T3,<-1-<(DV.TTA)>> ;[1206][1153] SKIP IF NUL:
TRNN N,-1 ;[1153] DID HE SAY EXTENSION
JRST HESAID ;YES-DONT MAKE UP UNIQUE
HLRZS N
MOVEI BP,LFLERR ;ERROR MESS.
L00PLS: TRZE N,10 ;CHECK FOR SIXBIT 8
ADDI N,100 ;CAUSE IT'S NOT ALLOWED
TRZE N,1000 ;CHECK FOR SIXBIT 80
JRST CPOPJ ;CAUSE THATS AN ERROR!
SETZ T3,
MOVE T4,LPPN ;RESET THE PPN
MOVS T2,N
LOOKUP 1,T1 ;DOES IT EXIST
SKIPA ;PROBABLY NOT
AOJA N,L00PLS ;TRY NEXT
HRRZ T3,T2 ;[1206] ISOLATE THE ERROR CODE
CAIN T3,ERPRT% ;[1206] IF PROTECTION FAILURE?
AOJA N,L00PLS ;[1206] TRY FOR ANOTHER FILE.
JUMPN T3,CPOPJ ;[1206] ANYTHING ELSE IS A REAL ERROR!
MOVE T4,LPPN ;AND SET UP THE APPR. AC
SKIPA
HESAID: HLRZS N
;[1102] REMOVE 1 LINE
HRLZ T2,N
SETZ T3, ;[1102] STD. PROTECTION FOR LOG FILES
MOVEI BP,LFEERR ;ERROR MESS
ENTER 1,T1 ;SEE IF WE CAN ENTER THE FILE
JRST CPOPJ ;OH DEAR
HRLZM N,LEXT ;STORE THE EXT.
;[1102] Monitor will say that path to device NUL: is DSK: so this fix
;[1102] is neccesary.
MOVE T1,LDEV ;[1102]GET HIS DEVICE
DEVCHR T1, ;[1102] AND ITS CHARACTERISTICS
HLRZS T1 ;[1152][1102] ISOLATE IMPORTANT BITS
CAIN T1,<-1-<(DV.TTA)>> ;[1102] ALL THESE BITS ARE ON FOR NUL:
JRST HESA.0 ;[1102] YES!
MOVEI T1,1 ;[1102] NO, GET CHANNEL 1
PUSHJ P,FILPTC ;[1102] READ ACTUAL PATH OF FILE IN T1
MOVE T1,.PTFCN(T1) ;[1102] MONITOR RETURNS ACTUAL STRUCTURE HERE
MOVEM T1,LGSPEC(X) ;[1102] AND LET THE MASTER KNOW
HESA.0: ;[1102]
CLOSE 1,20 ;UNCLE PETER SAYS THIS IS A CLEVER WAY TO CLOSE
AOS (P)
POPJ P,0 ;ALL WELL
LIST
> ;END OF FTCJOB
OKPDB: MOVNI X,PDB ;SET UP SLAVE X
ADDI X,DUMPDB
IFN FTCJOB,<
TLNN F,FLS.CJ ;IS WE A COJOB
JRST OKPDB1
MOVEI T1,LGSPEC(X) ;PREPARE TO MOVE LOGFILE SPEC TO PDB
HRLI T1,LDEV ;FROM HERE
BLT T1,ENDSWT(X) ;DO IT IT TO HERE
HRRZM L,CJOWNR(X) ;BUT REMEMBER WHO DID THIS ANYWAY
SETOB L,LINE(X) ;-1 SO OTHUSR DOES NOT GET CONFUSED DURING COJOB LOGIN
SETOM COJOB(X) ;COJOB FLAG
SKIPA
>;END OF COJOB BIT
OKPDB1: MOVEM L,LINE(X) ;STORE OWNERS LINE NO.
PJOB N1,
GETPPN N,
JFCL
SETZM LPPN ;TEMP STORAGE FOR DEV FILE SPEC
MOVEM N,OPPN(X)
MOVEM N1,JOB(X) ;JS BIT
MOVEM N1,OJOB(X) ;IN CASE COJOB
IFN FTPATH,<
PUSHJ P,GETPTH ;GET THE OWNER'S PATH
MOVSI T1,PTHBLK ;FROM HERE
HRRI T1,OPATH(X) ;TO HERE IN HIS PDB
BLT T1,OPATH+SFDLVL+2(X) ;THIS MUCH
>
IFN FTMBCH,< ;IF BATCH
;WE INSIST THAT ALL BATCH JOBS MUST SPECIFY A CONTROL FILE
;I.E BATCH=<BREAK> IS ASSUMED TO BE QUEUE CONTROL
TLNN F,FLS.BT ;IS THIS A BATCH REQUEST
JRST OKPDB4 ;NO
MOVSI WD,'DSK' ;YES-DEFAULT DEVICE IS DISK
MOVEM WD,LDEV
MOVSI WD,'MIC' ;DEFAULT EXTENSION IS MIC
MOVEM WD,LEXT
SETZM LFILE ;NO DEFAULT FILE!
PUSHJ P,WDREAD ;GET FILENAM (IF ANY)
JUMPE WD,OKPD1A ;[1121]
PUSHJ P,INSPC0 ;READ WHAT HE SAID
JRST ERR ;HE GOT IT RONG
SKIPN LFILE ;DID HE SAY A FILE
JRST OKPD1A ;[1121] NO LET QUEUE DEAL WIF IT
JRST OKPDB5 ;YES
;HERE IF NO MIC FILE NAME SPECIFIED - CHECK FOR SWITCHES
OKPD1A: CAIN CH,"/" ;[1121] DID WE GET A SWITCH?
PUSHJ P,RDSWCH ;[1121] YES - READ IT
JFCL ;[1121] BREAK CHAR FOUND
JRST CALLQ3 ;[1121] GO AND CALL QUEUE
OKPDB4: > ;END OF BATCH CONDITIONAL
PUSHJ P,INSPEC
JRST ERR
OKPDB5: MOVEI T1,DEV(X) ;PUT DEV:MACRO.EXT[PPN] IN PDB
HRLI T1,LDEV ;FROM LOW SHARED AREA
BLT T1,PPN(X)
IFN FTPATH,<
SKIPE T1,LPPN ;GET THE PPN
TLNE T1,-1 ;IS IT A PATH?
JRST OKPD5A ;NO
MOVSI T1,PTHBLK ;GET THE ADDRESS OF THE PATH
HRRI T1,PATH(X) ;AND LIKEWISE FOR THE PDB
BLT T1,PATH+SFDLVL+2(X) ;AND COPY THE PATH INTO THE PDB
MOVEI T1,PATH(X) ;GET THE ADDRESS OF THE PDB PATH BLOCK
MOVEM T1,PPN(X) ;AND FIX IT UP
OKPD5A: > ;END OF FTPATH
PUSHJ P,CHARIN ;GET NEXT SIGNIFICANT CHARACTER....
MOVEM CH,CH.SAV ;...AND SAVE IT FOR PARAMETER DECODE
SUBTTL SLAVE PROCESSOR - LOOKUP FILE
;
; [1041] THIS EDIT SUBSTANTIALLY CHANGED THIS SECTION
;
FINDFL: PUSHJ P,.FNDFL ;RY TO LOOKUP THE FILE
JRST FFOUND ;SUCCESS
MOVS T2,DEV(X) ;WE FAILED, WERE WE TRYING MIC
CAMN T2,MICDEV ;IF YES
JRST NOTFIL ;THEN GIVE UP
SKIPE PPN(X) ;WAS HE SPECIFIC ABOUT THE PPN?
JRST NOTFIL ;IF YES, THEN DO NOT DO ANY MORE
IFN FTMSFD,<
;[1041] PERHAPS WE SHOULD TRY HIS [,,MIC] LIBRARY
MOVEI T3,PATH(X) ;MAKE THIS A PATH INSTEAD OF A PPN
MOVEM T3,PPN(X)
MOVE T3,OPPN(X) ; - BELONGING TO THIS PPN
MOVEM T3,PATH+2(X)
MOVEI T3,1 ; "1" IS FOR NO SCAN
MOVEM T3,PATH+1(X)
HRLZI T3,'MIC' ;NAME OF SFD IS MIC
MOVEM T3,PATH+3(X)
SETZM T3,PATH+4(X) ;ENSURE NO SECOND SFD NAME
PUSHJ P,.FNDFL ;OK TRY THAT
JRST FFOUND ;WE GOT LUCKY
>;IFN FTMSFD
SETZM PPN(X) ;CLEAN UP
IFN FTSUPR,< ;NOW TRY HIS [PROJ,1] NUMBER
HLLZ T3,OPPN(X) ;GET PROJECT
HRRI T3,1 ;... SUPERVISOR PPN
TLNN T3,777776 ;CHECK FOR [1,1]
JRST FNDFLX ;AS THIS SAVES A LOOKUP
MOVEM T3,PPN(X) ;[1057] AND STORE THE PPN AWAY
PUSHJ P,.FNDFL ;TRY THAT
JRST FFOUND ;SUCCESS
FNDFLX: >; IFN FTSUPR
; AND LASTLY WE TRY THE MIC DEVICE
;
MOVS T2,MICDEV ;GET THE MIC DEVICE
MOVEM T2,DEV(X) ;SET THAT UP
SETZM PPN(X) ;CLEAN UP THE PPN
JRST FINDFL ;AND TRY THAT
.FNDFL: MOVE T3,DEV(X) ;GET DEVICE
FNDFL0: MOVEI T2,17 ;BINARY MODE
SETZ T4,
OPEN T2 ;AND OPEN IT
JRST [ POP P,(P) ;CLEAN THE STACK
JRST NOTDEV ;HARD LUCK.
]
MOVE T1,PPN(X)
IFN FTPATH,<
MOVSI T3,'DSK' ;WAS THE OPEN ON DSK?
CAME T3,DEV(X) ;EH?
JRST FNDFLP ;NO
TLNN T1,-1 ;YES, TRY FOR A PATH
PUSHJ P,CPYPTH ;[763] get path
FNDFLP: >
MOVEM T1,ELKBLK+1
MOVEI T1,32 ;NO OF ARGS FOR EXTENDED LOOKUP
MOVEM T1,ELKBLK
MOVE T1,FILE(X)
MOVEM T1,ELKBLK+2
MOVE T1,EXT(X)
MOVEM T1,ELKBLK+3
LOOKUP ELKBLK ;AT LAST WE GET TO TRY FOR A FILE
AOS (P) ;SKIP (ON FAILURE!)...
POPJ P,0 ;RETURN
FFOUND: ;END OF CHANGES INTRODUCED BY [1041]
IFE FTPATH,< MOVE T1,ELKBLK+1>
IFN FTPATH,<
SKIPN T1,PPN(X) ;DID WE USE THE DEFAULT PATH?
PUSHJ P,FILPTH ;YES, FIND WHERE WE FOUND THE FILE
TLNE T1,-1 ;IS IT A PATH
JRST FNDFL3 ;JUMP IF NO
HRLZS T1 ;POSITION ADDRESS OF PATH PROPERLY
HRRI T1,PATH(X) ;GET ADDRESS OF REAL PATH BLOCK
BLT T1,PATH+SFDLVL+2(X) ;AND MOVE PATH INTO THE PDB
MOVEI T1,PATH(X) ;REMEMBER BLT'S ARE INTERRUPTIBLE
FNDFL3: >
MOVEM T1,PPN(X) ;NOW COPY ARGS BACK
MOVE T1,ELKBLK+16
MOVEM T1,DEV(X) ;WHAT UNIT FILE IS ON.
IFN FTCJOB,<
TLNE F,FLS.CJ
TDZA S,S ;NOT NESTED IF COJOB
>;END OF COJOB BIT
MOVEM S,LDBMIC(X) ;STORE HIS OLD LDBMIC
TLZ S,LDLCLR ;CLEAR VOLATILE BITS
JUMPN S,STLDBM ;JUMP IF HE IS MESTED
MOVEI T3,"?" ;GET DEFAULT ERROR CHAR.
MOVS T2,OJOB(X) ;GET THE OWNERS JOB NO. AS INDEX
HRRI T2,.GTLIM ;INTO THIS TABLE
GETTAB T2, ;GET THE GUYS PARAMETERS
SETZ T2, ;EHHHHHHHH?
TXNE T2,JB.LBT ;IS HE A BATCH JOB?
DPB T3,LDP.ER ;IF YES SET UP HIS ERROR CHAR.
STLDBM: TDO S,MASTNO
LDB T2,[POINT 2,ELKBLK+4,2] ;[1023] pick up l.s. 2 bits of owner digit
CAIN T2,2
TLO S,LDL.XX ;[1023]IF PROTECTION IS 2?? or 6?? SILENCE
IFN FTCJOB,< ;COJOB BIT
IFN FTMBCH,< TLNN F,FLS.BT ;IF BATCH REQUEST?>
TLNN F,FLS.CJ ;COJOB?
JRST RDPAR ;NO
;JUST CHECK IF HIS LOG SPEC IS OK
;[1102] REMOVE 11 LINES (9 OF CODE)
SKIPN T1,LGSPEC(X) ;[1102] USE HIS LOG DEVICE
MOVSI T1,'DSK' ;[1102] OR THE SIMPLEST
MOVEM T1,LDEV
DEVCHR T1, ;[770] WHAT TYPE OF DEVICE IS LOG DEVICE
JUMPE T1,E%%LDM ;[770] DON'T KNOW!
TXNN T1,DV.DSK ;[770] BUT IT SHOULD BE A DISK?
JRST E%%LDM ;[770] BUT IT ISN'T
SKIPE T1,LGSPEC+1(X) ;DID HE SPECIFY LOG FILE
JRST OKPDB3 ;YES
MOVE T1,LFILE ;NO-THEN USE MACROFILENAME
MOVEM T1,LGSPEC+1(X) ;AS DEFAULT
SKIPA
OKPDB3: MOVEM T1,LFILE
MOVE T1,LGSPEC+2(X) ;GET HIS LOG EXT. (DEFAULT SET BEFORE)
MOVEM T1,LEXT
MOVE T1,LGSPEC+3(X) ;GET LOGPPN
IFN FTPATH,<
SKIPN T1 ;[763] ANYTHING SPECIFIED?
MOVEI T1,OPATH(X) ;[763] NO, USE THE GUY'S DEFAULT PATH
TLNN T1,-1 ;IS IT A PATH?
PUSHJ P,CPYPTH ;[763] yes, get path
>
MOVEM T1,LPPN
PUSHJ P,CHKFIL ;CHECK IT
JRST (BP) ;NOT GOOD
MOVE N,LEXT ;GET THE (POSS. CHANGED) EXTENSION
MOVEM N,LGSPEC+2(X) ;PUT IT WHERE APPR.
IFN FTPATH,<
MOVE T1,LPPN ;GET THE PPN
TLNE T1,-1 ;IS IT A PATH?
JRST OKPDB4 ;[1222] NO
MOVSI T1,PTHBLK ;GET THE PATH ADDR.
HRRI T1,LGSPEC+4(X) ;AND WHERE TO STORE THE PATH
BLT T1,LGSPEC+4+SFDLVL+2(X) ;END STORE THE PATH
MOVEI T1,LGSPEC+4(X) ;GET NEW ADDRESS OF THE PATH
MOVEM T1,LGSPEC+3(X) ;AND FIX UP FINGS PROPER
> ;END OF FTPATH
OKPDB4: HRROI T1,.GTNM1 ;[1222][1221] FIRST HALF OF USER NAME
GETTAB T1, ;[1221] GET IT
MOVE T1,['NONAME'] ;[1221] EHHH!
MOVEM T1,USRNM1(X) ;[1221] SAVE IT
HRROI T1,.GTNM2 ;[1221] 2ND HALF OF USER NAME
GETTAB T1, ;[1221] GET IT
MOVE T1,['NOBODY'] ;[1221] EH!
MOVEM T1,USRNM2(X) ;[1221] SAVE IT
IFN FTCLASS,< ;[1222]
MOVE T1,DEFCLA ;[1222][1074]Set up default sched class
MOVEM T1,CLASS(X) ;[1222][1207][1074]
> ;IFN FTCLASS
SUBTTL Slave Processor - Store COJOB switches.
;
; [1207] this page added by edit [1207]
;
DEFINE ..(NAME,SELECT,INSTR),<
IFNB <INSTR>,<
MOVE T1,$$'NAME+1 ;;GET SWITCH.INI VALUE
SKIPE $$'NAME ;;DID HE OVERRIDE IT?
MOVE T1,$$'NAME ;; YES, GET WHAT HE SAID
INSTR ;; AND GO STORE IT
> ;;IFNB <INSTR>
>
;
; Generate the code to store the switches in the PDB.
;
SWTCH()
>;END OF COJOB BIT
SUBTTL SLAVE PROCESSOR - READ ARGUMENTS
CHCNT==P3
BRKCNT==T2
PARCNT==T3
RDPAR: CLEAR BRKCNT, ;CLEAR BRACKET COUNT
MOVE CHCNT,CHRCNT ;[1170] GET THE CHARACTER COUNT
MOVE BP,CHRPTR ;[1170] AND THE PUTTER
MOVEI T4,ARGBP(X) ;AND PARAMETER TABLE POINTER
CLEAR PARCNT, ;CLEAR PARAMETER COUNT
NXTPAR: MOVEM BP,(T4) ;STORE BYTE POINTER
ADDI T4,1 ;AND INCREMENT
SETZ T1, ;NO OF CHARS / PAR.
NXTCHR: SOJLE CHCNT,OFLOW ;TOO MANY CHARS ON LINE?
PUSHJ P,PINCH
CAIN CH,"," ;COMMA?
JRST COMMA ;YES - GO DEAL
CAIN CH,.LT. ;[1157] BRACKET?
JRST OANBRK ;YES
CAIN CH,"["
JRST OPBRK
CAIN CH,"("
JRST OPBRK
CAIN CH,.GT. ;[1157][1120] CLOSE BRACKET?
JRST CANBRK ;YES
CAIN CH,"]"
JRST CLBRK
CAIN CH,")"
JRST CLBRK
PUSHJ P,ISBRK ;BREAK CHAR?
JRST CRLF ;YES
SKIPA ;NORMAL CHARACTER - SKIP
OPBRK: AOJ BRKCNT, ;BUMP BRACKET COUNT
IDPB CH,BP ;STORE CHAR
AOJA T1,NXTCHR ;AND READ NEXT
CLBRK: SOJGE BRKCNT,OPBRK+1 ;DECREMENT BRKCNT & STORE IF GE ZERO
JRST BRKMIS ;OTHER WISE ERROR
COMMA: JUMPN BRKCNT,OPBRK+1 ;IGNORE IF WITHIN BRACKETS
CLEAR CH, ;LOAD A NULL
IDPB CH,BP
AOJ PARCNT, ;INCREMENT THE PARAMETER NUMBER
CAILE PARCNT,ARGNUM-1
JRST TOOMNY ;TOO MANY PARAMETERS
JUMPN T1,NXTPAR ;GO READ NEXT PARAMETER IF NOT NULL
SETZM -1(T4) ;OTHERWISE CLEAR THE BYTE POINTER
JRST NXTPAR ;OTHERWISE CLEAR THE POINTER FIRST
OANBRK: JUMPN BRKCNT,OPBRK ;NOT FIRST ONE TREAT AS NORMAL
AOJA BRKCNT,NXTCHR ;OTHERWISE BUMP COUNT & IGNORE CHAR
CANBRK: SOJG BRKCNT,OPBRK+1 ;NOT LAST BRACKET TREAT AS NORMAL
JUMPE BRKCNT,NXTCHR ;LAST ONE - IGNORE CHAR
JRST BRKMIS ;OTHERWISE MISMATCH OF BRACKETS.
CRLF: JUMPN T1,.+2 ;WAS THE LAST PARAMETER NULL?
SETZM -1(T4) ;YES - CLEAR IT DOWN
IFN FTCASE,< ;[1042] IF INVERTED CASE PRESET THE BIT!
MOVSI T3,PL.NLC ;GET THE NO LOWER CASE BIT
IORM T3,PROFLE(X) ;SET IT
;[1042] NB THIS WILL BE OVERWRITTEN IF WE ARE A NESTED MACRO
>;END OF IF FTCASE
IFN FTCJOB,<
CAIN CH,CR ;WAS EOL CHAR A <CR>
PUSHJ P,CHARIN ;THEN GOBBLE THE <LF>
TLNE F,FLS.CJ
JRST OK2 > ;IF COJOB NO OTHER PROCESS
PUSHJ P,CLRTTI ;CLEAR THE INPUT BUFFER
NTYTOK: PUSHJ P,OTHUSR ;[1210] SUSPEND OTHER PROCESSES WITH SAME LINE
JRST OK2 ;NO OTHER USERS
SKIPN LDBMIC(X) ;[1204][1175][1171] DID WE HAVE AN LDBMIC WORD?
SKIPA ;[1204] NO, THAT IS NOT A NICE THING
JRST YESHLD ;[1204] THATS FINE
IFN FTCJOB,< ;[1210]
HRRZ T1,COJOB(T2) ;[1226][1210] GET OTHER PROCESS'S COJOB STATUS
CAIN T1,-2 ;[1226][1210] IS IT A COJOB IN LOGIN?
JRST [ ;[1210] JUMP IF YES
MOVEM S,LDBMIC(X) ;[1226] SET UP FOR FIN: TO USE
JRST YESHLD ;[1226] AND HOLD THE COJOB FROM STARTING
] ;[1226] UNTIL THE LOGIN MACRO HAS RUN!
> ;[1210]
PUSHJ P,HIBER2 ;[1226][1210][1204] WAIT TWO SECS. FOR IT TO GO AWAY
JRST NTYTOK ;[1210][1204] TRY AGAIN
YESHLD: HLRZ T3,LAST(T2) ;[1204] GET HIS LEVEL
HRLZM T3,LAST(X)
SUB T3,MAXLVL ;COMPARE WITH MAX
SKIPL MAXLVL ;-VE LEVEL MEANS INFINITY
JUMPG T3,E%%LVL ;TOO DEEP
MOVE T1,PROFLE(T2)
MOVEM T1,PROFLE(X) ;CARRY DOWN PROFILE STUFF
MOVE T1,RS(T2)
MOVEM T1,RS(X) ;CARRY DOWN RESPONSE STUFF
MOVSI T1,OPPN(T2) ;CARRY DOWN THE OWNER'S ENVERIONMENT
HRRI T1,OPPN(X) ;IN CASE COJOB
BLT T1,OJOB(X) ;ALL OF THIS
IFN FTCJOB,<
MOVE T1,CJOWNR(T2)
MOVEM T1,CJOWNR(X)
MOVE T1,COJOB(T2)
MOVEM T1,COJOB(X) ;NESTED COJOB
IFN FTMBCH,<
MOVE T1,BATWRD(T2) ;IN CASE WE ARE BATCH
MOVEM T1,BATWRD(X) ;CARRY DOWN THE BATCH WORD
MOVE T1,JOBNAM(T2) ;AND THE JOBNAME
MOVEM T1,JOBNAM(X) ;TOOO
>
HRRZ T1,YZWORD(T2) ;AND CARRY DOWN PONTER TO LOGGING AREA
HRRZM T1,YZWORD(X)
> ;END OF FTCJOB
MOVSI T1,FSTVNT(T2) ;CARRY DOWN WHENEVER STUFF
ADDI T2,1
HRRM T2,LAST(X) ;HOLD OTHER PROCESSES
MOVSI T2,1
ADDM T2,LAST(X) ;INCREMENT LEVEL COUNT
SKIPA
OK2: MOVSI T1,DEFVNT ;USE WHENEVER DEFAULTS
HRRI T1,FSTVNT(X) ;AND PUT IN HIS PDB
BLT T1,LSTVNT(X) ;THIS WAY
MOVE T1,[SIXBIT/OPR/]
WHERE T1,
SETZ T1,
HRRM T1,STATIN(X) ;STORE USER'S STATION NO.
OK3:
IFN FTCJOB,<
TLNE F,FLS.BT!FLS.CJ ;BATCH OR COJOB?
MOVEM S,LDBMIC(X) ;SAVE S (SILENCE FLAGS ETC.)
>
SETZM LOKBIT ;LOK BIT
IFN FTMBCH,<
TLNE F,FLS.BT ;IF BATCH
JRST BCHENT
> ;END OF BATCH BIT
SETOM FLAG(X) ;INDICATE END OF SETUP PROCESS
;AS THIS IS LAST WORD IN REAL PDB
;IT WILL BE SET BY BLT
IFN FTMBCH,<
TLNN F,FLS.BR ;IS THIS A BATCH RUN
JFCL ;NO
> ; END OF BATCH BIT
SLOB1: PUSH P,X ;SAVE DUMMY X
SLOB: MOVE T1,[4,,CCTRP] ;SET US UP TO TRAP CONTRO-C
MOVEM T1,INTBLK
MOVEI T1,2
MOVEM T1,INTBLK+1
SETZM INTBLK+2
SETZM INTBLK+3
MOVE T1,.JBINT## ;GET OLD CC TRAP
MOVEM T1,GTLOCK ;AND REMEMBER IT
MOVEI T1,INTBLK
MOVEM T1,.JBINT## ;ENABLE TRAP
WENABL ;OPEN HI SEG
SLOB2: SKIPN MASTNO ;MIC STILL RUNNING
JRST NOMSTR ;NO
AOSE LOCK ;CAN WE CLAIM A PDB
JRST .-1 ;NO TRY AGAIN
PUSHJ P,SETX ;CLAIM A PDB
;AND SET UP A REAL X
JRST NOPDB ;NONE FREE LET DADDY SORT IT OUT
MOVEI T1,2 ;WE GOT ONE
MOVEM T1,FLAG(X) ;SAY WE ARE USING IT TO PROCESS A REQUEST
SETOM LOCK ;RESET THE LOCK
SLOB3: PUSHJ P,OUTPNG ;[1147] IS HE STILL OUTPUTTING
JRST SLOB4 ;[1147] NO
MOVEI T1,^D400 ;[1147] SUITABLE SHORT TIME
HIBER T1, ;[1147] TO DOZE
JFCL ;[1147]
JRST SLOB3 ;[1043] AND SEE IF DONE
SLOB4: ;[1147]
MOVEI T1,1 ;PREPARE TO HOLD LAST PROCESS
MOVE T2,(P) ;GET COPY OF ADDRES OF DUMMY PDB
SKIPE T2,LAST(T2) ;GET ADDRESS OF LAST PROCESS
MOVEM T1,FLAG-1(T2) ;HOLD IT
WLOCK ;CLOSE HI SEG
HLLZS F,F
IOR F,[FLS.PC,,FAIL] ;IN CASE HE CONTROL C'S
POP P,T2 ;DUMMY X
;**********TEMPORARY*************
IFN FTPATH,<
MOVE T1,PPN(T2) ;GET PPN/PATH WORD
TLNN T1,-1 ;IS IT A PPN?
MOVEI T1,PATH(X) ;NO, SO FIX UP PATH WORD
MOVEM T1,PPN(T2) ;AND RESET IT
>
MOVEI T3,ARGBP(T2) ;ADDR. OF DUMMY PARAMETER PONTERS
MOVN T2,T3
ADDI T2,ARGBP(X) ;CORRECTION TO PARAMETER POINTERS
IFN FTMBCH,<
MOVSI T4,BTL.AS ;NEED AN ASPRIN
TDNE T4,DUMPDB+<BATWRD-PDB> ;WAS THIS PDB CREATED BY ASPRIN
ADDI T2,DUMPDB ;YES - NEED AN EXTRA CORRECTING FACTOR.
ANDCAM T4,DUMPDB+<BATWRD-PDB> ;CLEAR THE ASP BIT IN CASE NESTED PROCESSES
>
MOVE T4,[-ARGNUM,,0] ;LOOP CONTROL
PUSH P,T3 ;SAVE START OF POINTERS
BPXFIX: HRRZ T3,(P) ;GET ADDR.
ADDI T3,(T4) ;+ INDEX
HRRZS T3 ;GET RID OF NASTY BITS
SKIPE (T3) ;ANYFING
ADDM T2,(T3)
AOBJN T4,BPXFIX ;AND AGAIN
POP P,(P) ;A CLEAN STACK IS A HAPPY STACK
;**********END OF TEMPORARY***********
WENABL ;OPEN HI SEG
IFN FTMBCH,<
TLNE F,FLS.BR ;IS WE BATCH
SETZM BATACT ;SET COMBAT/MIC INTERLOCK
>
MOVSI T1,DUMPDB ;ADDRESS OF THE DUMMY PDB
HRRI T1,PDB(X) ;ADDRESS OF THE REAL PDB
PUSH P,T1 ;SAVE THE BLT ARG.
MOVEI T2,DUMPDB ;[1111] GET ADDRESS OF PDB
MOVSI T1,PL.NSL ;[1111] GET THE "NO SILENCE" BIT
TDNE T1,PROFLE-PDB(T2) ;[1111] AND ENSURE WE DONT SET SILENCE IN ANY
TLZ S,LDL.XX ;[1111] WAY
TLNE F,FLS.BR!FLS.CJ ;IS WE BATCH RUN OR COJOB
SKIPA ;YEAH!
PUSHJ P,TOWAIT ;DO THE MIC SET,L
POP P,T1 ;RESTORE THE BLT ARG.
BLT T1,FLAG(X) ;AND SET UP THE PDB
MOVE T1,GTLOCK ;GET THE OLD CC TRAP
MOVEM T1,.JBINT## ;AND RESTORE IT
MOVE T1,MASTNO
WAKE T1, ;WAKE UP DADDY
JFCL ;WHO CARES
IFN FTMBCH,< ;FOR BATCH
TLNN F,FLS.BR ;BATCH RUN?
>;END OF BATCH BIT
JRST SLEND ;CLOSE DOWN
IFN FTMBCH,<
BATCOM:
IFE FTCOSMIC,<
MOVE P,P..SAV ;RESTORE STACK
TLNE F,FLS.ER ;ERROR?
AOS (P) ;NO
TLNE F,FLS.BC ;BATCH CONTROL
JRST COMBAT ;YES
>
IFN FTCOSMIC,<
TLNE F,FLS.BC ;BATCH CONTROL
POPJ P,0 ;YES, RETURN NOW
>
WENABL ;OPEN HI SEG
BATWAT: SKIPN BATACT ;CHECK ACTION WORD
JRST SLEEPY ;NOT READY YET
SKIPL BATACT ;SUCCESS?
AOS BATTOT ;YES
MOVE T1,BATACT ;GET ACTION
MOVEM T1,LWACTN ;AND PASS TO COMBAT
WLOCK ;CLOSE HI SEG
IFE FTCOSMIC,< JRST COMBAT>
IFN FTCOSMIC,< POPJ P,0>
SLEEPY: MOVE T1,^D5 ;SLEEP TIME IF HIBER FAILS
SETZ T2, ;SLEEP UNTIL WOKEN
HIBER T2, ;THIS IS WHERE COMBAT SLEEPS WHEN WAITING ON MIC
SLEEP T1,
JRST BATWAT ;SEE IF DUN!
WLOCK ;CLOSE HI SEG
JRST COMBAT
> ;END OF BATCH BIT
IFN FTMBCH,<
;HERE TO PROCESS A MIC BATCH REQUEST
QUEPPN: 3,,3 ;AREA TO MAKE ENTRIES ON
BCHENT: MOVSI T2,'DSK' ;Q DEVICE
SETZ T3,
MOVEI T1,17 ;DUMP MODE
OPEN T1 ;GRAB DEVICE
JRST BCHQDE
SETO T2, ;-1 TO RETURN FIRST STRUCTURE
SETZB T3,T4
MOVE T1,[3,,T2] ;ARG. BLOCK
JOBSTR T1,
JRST BCHQDP ;OOOOOPS
HLRZ T1,T2 ;JUST LEFT HALF
CAIE T1,'DSK' ;IS IT A PUBLIC DSK
JRST BCHQDP ;NO-ERROR
MOVEI N,'M00' ;FIRST MIC BATCH EXT.
MOVE T1,FILE(X) ;MACRO FILE NAME
NXTEXT: TRZE N,10 ;CHECK FOR SIXBIT 8
ADDI N,100 ;CAUSE IT'S NOT ALLOWED
TRZE N,1000 ;CHECK FOR SIXBIT 80
MOVEI N,'N00' ;***WOT WOULD U DO?
MOVS T2,N
SETZ T3,
MOVE T4,QUEPPN
LOOKUP T1 ;SEE IF ALREADY EXISTS
SKIPA ;NOT YET
AOJA N,NXTEXT ;TRY NEXT EXTENSION
TRNE T2,-1 ;FAILED FOR RIGHT REASON?
JRST BCHLFQ ;NO
HRLZI T3,255000 ;[1121] USE HIGH PROTECTION
ENTER T1 ;OPEN THE FILE
JRST BCHEFQ
MOVE T1,[IOWD PDBSIZ,DUMPDB]
SETZ T2,
OUTPUT T1
SKIPA
JRST BCHOFQ
MOVE T1,FILE(X)
MOVEM T1,LFILE ;STORE MOO FILE NAME
MOVE T4,QUEPPN ;GET
MOVEM T4,LPPN ;AND STORE MOO PPN
HRLZM N,LEXT ;STORE MOO EXTENSION
RELEASE ;GET RID OF THE CHANNEL
NEWLINE
WRITE <MIC BATCH request for - >
MOVEI T1,DEV(X)
PUSHJ P,OUTSPEC ;O/P THE DEVICE FILE SPEC
WRITE < - created>
PUSH P,LOWOUT
MOVE T1,[IDPB CH,BUFBP]
MOVEM T1,LOWOUT ;NEW LOW-LEVEL O/P ROUTINE
SKIPN LFILE
JRST CALLQ2
IFN FTMBCH,<
MOVEI T1,DEV(X) ;MIC FILE
PUSHJ P,OUTSPEC
OUTSYM <",">
MOVE T1,['L00',,-1] ;UNUSED EXT LOOKS LIKE THIS
SKIPE WD,LGSPEC+.FILE(X) ;IS A LOG FILE SPECIFIED?
CAMN T1,LGSPEC+.EXT(X) ;HAS HE SPECIFIED A LOG SPEC?
JRST [ PUSHJ P,SIXBP ;NOTE THE MICFILE NAME
JRST CALLQ1 ]
MOVEI T1,LGSPEC(X) ;LOG FILE
PUSHJ P,OUTSPEC
CALLQ1: OUTSYM <",">
>
MOVEI T1,LDEV ;MOO FILE
PUSHJ P,OUTSPEC
CALLQ2: NEWLINE
SETZ CH,
XCT LOWOUT
POP P,LOWOUT ;REPLACE LOW-LEVEL O/P
JRST CALQ3A
;HERE TO DEAL WITH BATCH COMMAND WHICH ARE NOT JOB SUBMISSION
;COMMANDS
;NB!!!!
;THIS IS A REALLY HORRIBLE BOIT OF CODE THAT I LOOSE SLEEP
;OVER - HOWEVER I SEEM TO HAVE DUG MYSELF A HOLE, AND
;CANNOT THINK OF A WAY ROUND IT FOR THE MOMENT; I WILL
;REMOVE THIS COMMENT WHEN I DO
CALLQX: PUSHJ P,ISBRK ;HAVE WE HAD A BREAK CHAR YET?
JRST CALQX0 ;YES
PUSHJ P,CHARIN ;NO - TRY NEXT
IDPB CH,BUFBP ;AND REMEBER IT
JRST CALLQX ;IS IT THE LAST
CALQX0: CAIN CH,CR ;[1121] WAS BREAK CHAR A CR?
PUSHJ P,CHARIN ;[1121] YES - GOBBLE LF
MOVE T1,[POINT 7,BUFFER] ;RESET BUFFER POINTER
MOVEM T1,BUFBP ;IN THE WORK AREA
LDB CH,BUFBP ;AND REREAD THE COMMAND LINE
CAIE CH,"=" ;IGNORING EQUALS (NB!!!!!)
IDPB CH,BUFBP ;AND REWRITING IT OUT
JUMPN CH,CALQX0 ;UNTIL WE REACH THE END
JRST CALQ3A ;THEN WE TROLL OF TO Q
;END OF REALLY HORRIBLE BIT!!!!
;HERE TO RUN QUEUE
;MUST DO IT THIS WAY CAUSE ALL QUEUE'S LIST ROUTINES ARE IN
;ITS LOW SEGMENT.
CALLQ3: RESET
PUSHJ P,ISBRK ;BREAK YET?
JRST CALQ3A ;YES
PUSHJ P,CHARIN ;READ A CHAR
JRST .-3 ;AND LOOP
CALQ3A: CAIN CH,CR ;[1121] WAS LAST CHAR CR?
PUSHJ P,CHARIN ;[1121] YES - GOBBLE LF
MOVE T1,[ASCII/MIC: /] ;PREPARE THE COMMAND LINE
MOVEM T1,BUFFER
SKIPE T1,LPPN ;[1121] PPN GIVEN?
CAMN T1,QUEPPN ;[1121] AND NOT QUEPPN
JRST CAQ3A1 ;[1121] NO, TRY FOR LOGPPN
TLNN T1,-1 ;[1121] IS IT A PATH?
MOVE T1,LPATH ;[1121] YES - GET THE PPN FROM THE PATH
JRST CAQ3A2 ;[1121] GO OUTPUT IT FOR MQUEUE
CAQ3A1: SKIPN X ;[1121] ONLY IF X IS SET UP
JRST CAQ3A3 ;[1121] ITS NOT SO FORGET IT
SKIPE T1,LGSPEC+3(X) ;[1121] WHAT ABOUT LOGPPN THEN
CAMN T1,QUEPPN ;[1121] NOT THE QUEPPN
JRST CAQ3A3 ;[1121] YES - WE DON'T MEAN THIS
TLNN T1,-1 ;[1121] IS THIS A PATH?
MOVE T1,LGSPEC+4(X) ;[1121] YES - GET THE PPN
CAQ3A2: MOVE T2,[POINT 7,BUFFER+1] ;[1121] GET A BYTE POINTER
MOVEM T2,BUFBP ;[1121] PUT IT WHERE WE CAN USE IT
PUSH P,LOWOUT ;[1121] SAVE LOW LEVEL O/P ROUTINE
MOVE T2,[IDPB CH,BUFBP] ;[1121] REPLACE IT
MOVEM T2,LOWOUT ;[1121] IN THE O/P ROUTINE
MOVEM T1,WD ;[1121] PUT PPN WHERE WE CAN OUTPUT IT
PUSHJ P,PPNOUT ;[1121] PUT PPN IN BUFFER
PUSHJ P,.NEWL ;[1121] AND THE CARIAGE RETURN
POP P,LOWOUT ;[1121] RESET O/P ROUTINE
CAQ3A3:
HRRZ T2,BUFBP ;GET POINTER WORD
ADDI T2,1 ;ROUND UP
SUBI T2,BUFFER ;GET ITS SIZE
MOVNS T2
HRLZS T2 ;MAKE -BUFLEN,,0
HRRI T2,BUFFER-1 ;-SIZE,,ADDR-1 (JUST LIKE IOWD DOES)
PUSH P,T2 ;SAVE IN CASE TMPCOR UUO FAILS
MOVSI T1,'QUE' ;FILE NAME
MOVE T3,[.TCRWF,,T1] ;WRITE FILE,,CONTROL BLOCK
TMPCOR T3, ;WRITE A TMPCOR FILE
JRST NO.TMP ;NO TMPCOR TRY nnnQUE.TMP FILE.
CALQ3B: WENABL ;OPEN HI SEG
AOS CMDTOT ;UP THE COMMANDS TOTAL
AOS BRQTOT ;ONE MORE BATCH REQUEST
WLOCK ;CLOSE HI SEG
MOVSI 0,'SYS' ;TO RUN SYS:QUEUE
IFE FTHATF,<
MOVE 1,[SIXBIT/QUEUE/]
>
IFN FTHATF,<
MOVE 1,[SIXBIT/MQUEUE/] ;[1121]
>
SETZB 2,3
SETZB 4,5
MOVSI 6,1 ;CCL ENTRY TO QUEUE
RUN 6, ;RUNN IT
HALT
HALT
> ;END OF IF FTMBCH
;.MKPJN--SUBROUTINE TO MAKE A CCL JOB NUMBER
;CALL: MOVE T1,JOBB NUMBER
; PUSHJ P,.MKPJN
;RETURNS VALUE IN LH(T1)
;CHANGES T1,T2,T3,T4
.MKPJN: MOVEI T4,3 ;MAKE TEMP FILE NAME
MAKPJ1: IDIVI T1,^D10 ; BY TRIED AND
ADDI T2,'0' ; TRUE CCL
LSHC T2,-6 ; TECHNIQUE <SIC>
SOJG T4,MAKPJ1 ; ..
HLLZ T1,T3 ;POSITION ANSWER
POPJ P,0 ;AND RETURN
IFN FTMBCH,< ;BATCH STUFF
;HERE WHEN TMPCOR UUO FAILS MUST TRY TO WRITE A FILE
;OF THE FORM nnnQUE.TMP WHER nnn IS THE USERS JOB NUMBER
NO.TMP: MOVEI T1,17 ;DUMP MODE
MOVSI T2,'DSK' ;ON DSK
SETZ T3, ;NO BUFFERS
OPEN 1,T1 ;ON CHANNEL 1
JRST MICTMP ;FAILED
MOVE T1,JOB(X) ;GET USERS JOB NUMBER
PUSHJ P,.MKPJN ;MAK IT INTO SIXBIT
HRRI T1,'QUE' ;MAKE THE FILE NAME
MOVSI T2,'TMP' ;AND THE EXTENSION
SETZB T3,T4 ;NO OTHER ARGS
ENTER 1,T1 ;ENTER nnn QUE.TMP
JRST MICTMP ;FAILED
POP P,T1 ;GET THE IOWD BACK
SETZ T2,
OUTPUT 1,T1 ;WRITE THE COMMAND LINE
SKIPA ;DONE IT
JRST MICTMP ;OOOOOOPS!
RELEASE 1, ;CLOSE DOWN
JRST CALQ3B ;AND BACK TO RUN QUEUE
MICTMP: ERROR. FWT,<Failed to write TMPFIL for QUEUE>
;HERE ON BATCH REQUEST ERRORS
BCHQDE: ERROR. QDE,< System queue device error>
BCHLFQ: ERROR. LFQ,<System LOOKUP failure on queue entry>
BCHEFQ: ERROR. EFQ,<System ENTER failure on queue entry>
BCHOFQ: ERROR. OFQ,<System OUTPUT failure on queue entry>
BCHQDP: ERROR. QDP,<System queue device must be public DSK!>
> ;END OF FTMBCH
;HERE IF A USER TYPES CONTROL C WHILE WE ARE READING HIS COMMAND LINE
CCTRP: PUSH P,INTBLK+2 ;SAVE THE RETURN ADDRESS
SETZM INTBLK+2 ;RE-ENABLE TRAP
TLZE F,FLS.PC ;IF WE HAVE CLAIMED A PROCESS
HRRZM F,(P) ;ARRANGE TO POPJ TO FAIL
POPJ P,0 ;AND RETURN TO INLINE CODE
SUBTTL SLAVE PROCESSOR - ERROR MESSAGES
NOTDEV: ERROR. CID,<Cannot INIT device >,NOTDV0
NOTDV0: MOVE WD,DEV(X)
PUSHJ P,SIXBP ;O/P DEV NAME
OUTSYM <":">
JRST SLENDX
OFLOW: ERROR. TMC,<Too many characters in argument>
ERR: ERROR. DFS,<Error in device file specification>
BRKMIS: ERROR. BMP,<Brackets mismatch in parameter>
TOOMNY: ERROR. TMP,<Too many parameters - max = 26>
IFN FTCJOB,<
LGFERR: ERROR. ELF,<Error in log file specification>
LGDERR: ERROR. CIL,<Cannot INIT LOG device>
LFLERR: ERROR. CLL,<Cannot LOOKUP LOG file>
LFEERR: ERROR. CEL,<Cannot ENTER LOG file>
SWTERR: ERROR. SWE,<Switch error>
CJNOTU: ERROR. CNA,<COJOBS not available at this time>
NOCJBS: ERROR. NCA,<No COJOBS available>
ERROR. LDM,<Log device must be a DSK>
> ;END OF COJOB BIT
NOMSTR: ERROR. MNR,<MIC not running. Please try again.>,NOMST0 ;;[1134]
NOMST0: MOVEI S,[ASCIZ/NOMSTR MIC not running please initialise/]
PUSHJ P,MSTOPR
JRST SLENDX
;HERE WHEN HE HAS NESTED HIS PROCESSES TOO DEEPLY
E%%LVL: ERROR. CNP,<Cannot nest processes this deep. Max = >,ECND.0 ;;[1134]
ECND.0: MOVE N,MAXLVL
PUSHJ P,DECPRT
JRST SLENDX
FAIL: WENABL ;OPEN HI SEG
SKIPE T3,LAST(X) ;HAVE WE HELD A PROCESS?
SKIPN S,LDBMIC(X) ;HAVE WE SET UP NEW LDBMIC WORD?
JRST FAILC ;HAVE NOT REALLY HELD A PROCESS
CAME L,LINE-1(T3) ;DOUBLE CHECK FOR HELD PROCESSES
JRST FAILC ;THIS SHOULD NOT HAPPEN
TLO S,LDL.CC ;REMEMBER WE WERE CONTROL-C'ED
PUSHJ P,TOWAIT ;RESET OLD LDBMIC WORD
MOVE T3,LAST(X) ;GET ADDRESS OF HELD PROCESS
SETOM FLAG-1(T3) ;ACTIVATE HELD PROCESS
FAILC: SETZM PDB(X) ;PREPARE
HRLI T1,PDB(X) ;TO CLEAR DOWN
HRRI T1,PDB+1(X) ;THE
BLT T1,FLAG(X) ;PDB
IFN FTCJOB,<
TLZ F,FLS.CJ ;CLEAR DOWN THE COJOB FLAG
>;END OF COJOB BIT
TLO F,FLS.ERR ;NOTE ERROR
SLEND:
IFN FTMBCH,<
WENABL ;OPEN HI SEG
>;END
AOS CMDTOT ;ONE MORE COMMAND
IFN FTCJOB,<
TLNE F,FLS.CJ ;COJOB?
AOSA CJBTOT ;SAY THAT WE DUN 1 MORE
>;END OF COJOB BIT
FAILED: PUSHJ P,CLRTTI
MOVE T1,GTLOCK ;GET OLD CC TRAP
MOVEM T1,.JBINT## ;AND RESET IT
SETZM CH ;[1161] DON'T TRY TO READ MORE
EXIT1:
CAIN CH,CR ;[1161] WAS LAST CHAR A CR?
PUSHJ P,PINCH ;[1161] YES, EAT LF
IFN FTMBCH,< ;IF MIC BATCH
TLNE F,FLS.BR
JRST BATCOM
>;END OF BATCH BIT
TLNE F,FLS.GT ;WAS WE GETSEGED
JRST GTSRTN ;YES
EGRESS: EXIT 1,
EXIT
SLENDX: TLO F,FLS.ER ;NOTE ERROR.
SKIPN WD,LOWCMD ;GET CURRENT COMMAND NAME
JRST FAILED ;[1073]NONE
WRITE < - in ">
PUSHJ P,SIXBP ;O/P IT
WRITE <" command>
JRST FAILED ;[1073]
; A ROUTINE TO DO MIC SET UUO'S AFTER WAITING FOR THE TTY TO COMPLETE ANY CURRENT O/P
TOWAIZ: SKIPA Y,[SETZB S,(P)] ;[765]IF CURRENT LDBMIC WORD =0 THEN ERROR
TOWAIT: MOVE Y,[SETZ S,0] ;[765]SET UP TO IGNORE FACT THAT CURRENT LDBMIC WORD MAY BE ZERO
TOWAI0: MOVEI T1,^D400 ;[1011][1133]SHORTEST MESSAGE
PUSHJ P,OUTPNG ;HAS HE DONE
JRST TOWAID ;O.K.
HIBER T1, ;NO-SLEEP TIGHT
JRST CPOPJ ;DONE
JRST TOWAI0 ;CHECK AGN
;
TOWAID: PUSH P,S ;SAVE LDBMIC WORD
MIC GET,L ;GET OLD ONE-DEFENSIVE AGAINST SOMAT CHANGING
XCT Y ;[765]DO AS APPROPRIATE!
AND S,[LDL.CC!LDL.CA,,0] ;CHECK FOR POSS. CHANGES
IORM S,(P) ;AND SET EM UP
POP P,S ;GET S BAK
MIC SET,L ;SET IT
JFCL
POPJ P,0 ;AND UP UP AND AWAY
;HERE WHEN MACRO FILE COULD NOT BE FOUND
NOTFIL: ERROR. COF,<Cannot open file>,nofil0
nofil0: MOVEI T1,DEV(X)
PUSHJ P,OUTSPEC ;OUTPUT ERROR DEVICE
JRST SLENDX
SUBTTL SLAVE PROCESSOR - SUBROUTINES
;A ROUTINE TO FIND IF THERE ARE ANY OTHER USERS ON THIS LINE
OTHUSR: JUMPL L,CPOPJ ;TOP LEVEL
HRLZ T1,PROCNO ;TRY FOR THIS MANY
SETZ T2, ;CLEAR X
OTHUS2: CAMN L,LINE(T2) ;THE SAME LINE?
JRST OTHUS3 ;YES
OTHUS4: ADDI T2,PDBSIZ ;NO - UPDATE T2
OTHUS5: AOBJN T1,OTHUS2 ;TRY FOR NEXT
POPJ P, ;NO MORE FAIL EXIT
OTHUS3: SKIPL T4,FLAG(T2) ;IS HE RUNNING?
JRST OTHUS4 ;NO - FURTHER CHECKING
JRST CPOPJ1 ;GO SUSPEND IT ETC.
;A ROUTINE TO SET UP X FOR THE SLAVE PROCESS
SETX: HRLZ T1,PROCNO ;TRY THIS MANY
CLEARB X,Y
JRST SETX2 ;FIRST TIME IN
SETX1: ADDI X,PDBSIZ ;NEXT AREA
SETX2: SKIPN FLAG(X) ;FREE?
AOSA (P) ;YES
AOBJN T1,SETX1 ;NO - TRY NEXT
POPJ P,0
;HERE WHEN THE SLAVE NEEDS A PROCESS AREA AND THERE
;IS NOT ONE AVAILABLE.
NOPDB: SETOM LOCK ;CLEAR THE INTERLOCK
SETZM .JBINT## ;LET HIM CC OUT
AOS T2,COMCNT ;TELL THE MASTER ABOUT IT
NOPDB1: MOVE T1,MASTNO
WAKE T1,
JFCL ;WHO CARES!
SLEEP T2, ;GO TO SLEEP FOR AN APPROPRIATE PERIOD
SKIPN T2,COMCNT
JRST SLOB ;THE MASTER HAS FIXED US UP
JRST NOPDB1 ;GO TO SLEEP AGAIN
SUBTTL SLAVE PROCESSOR - READ FILE SPEC
;A ROUTINE TO GET A FILE SPEC OF THE FORM DEV:FILE.EXT[P,P]
;FILL IN THE DEFAULTS
INSPEC: MOVSI WD,(SIXBIT/MIC/)
MOVEM WD,LEXT
MOVEM WD,LFILE
MOVSI WD,(SIXBIT/DSK/)
MOVEM WD,LDEV
;NOW READ IN USERS ATTEMPT
CHK: PUSHJ P,WDREAD
INSPC0: CAIN CH,":"
JRST DEVICE ;THAT WAS A DEVICE
CHK1: CAIN CH,"."
JRST FILNAM ;THAT WAS A FILENAME
SKIPE WD
MOVEM WD,LFILE
CHK2: CAIE CH,.LT. ;[1157][1101] THIS IS SAME AS [
CAIN CH,"[" ;[1101]
JRST PROJECT ;HE IS INTRODUCING A PPN
MOVEM CH,CH.SAV ;PUT BACK THE UNUSED CHAR
JRST CPOPJ1 ;GOT IT ALL-EXIT
;HERE TO STORE DEVICE
DEVICE: JUMPE WD,CPOPJ ;HE TYPED : BUT NO DEVICE
MOVEM WD,LDEV
PUSHJ P,WDREAD
JUMPE WD,CHK2 ;HE TYPED DEV: BUT NO FILE
JRST CHK1
;HERE TO GRAB A FILENAME
FILNAM: MOVEM WD,LFILE
PUSHJ P,WDREAD
TRNE WD,-1
POPJ P,0 ;HE TYPED .AAA???
MOVEM WD,LEXT
JRST CHK2
;HERE TO GRAB A PPN
PROJEC:
GETPPN N, ;[1120] GET DEFAULT PPN
JFCL ;[1120]
MOVEM N,LPPN ;SET UP DEFAULTS
PUSHJ P,OCTIN
PUSHJ P,ISBRK ;TERMINATED BY A BREAK
JRST .+3 ;YES
IFN FTPATH,<
CAIN CH,"-" ;DOES HE WANT JUST HIS DEFAULT PATH
JRST DEFPTH ;YES
>
CAIE CH,"," ;OR A COMMA
POPJ P,0 ;NEITHER I.E. ERROR
SKIPE N1 ;DID WE READ ANYFING
HRLM N,LPPN ;YES STORE IT (OTHERWISE USE DEFAULT)
SETZ N1,
CAIN CH,"," ;IF NOT A BREAK CHAR
PUSHJ P,OCTIN ;READ SECOND PART
SKIPE N1
HRRM N,LPPN ;STORE THAT ATTEMPT
;[1006] 4lines of code removed
IFN FTPATH,<
CAIN CH,"," ;HAS HE GOT AN SFD
JRST PTHCHK ;MAYBE CHECK UP ON IT
>
PROJE1: PUSHJ P,ISBRK
JRST PROJE2 ;[1101] LIKE IT
CAIE CH,.GT. ;[1157][1101][1120] GOOD ONE?
CAIN CH,"]" ;WAS IT PROPERLY DELIMETED?
PROJE2: AOS (P) ;YES-GOOD EXIT
POPJ P,0 ;EXIT FROM INSPEC
;HERE TO GRAB AN OCTAL NO.
OCTIN: SETZB N,N1
PUSHJ P,CHARIU ;GET NEXT SIGNIFICANT CHARACTER AND SKIP
OCTIN1: PUSHJ P,PINCH
OCTIN2: CAIL CH,"0"
CAILE CH,"7"
POPJ P,
SETO N1, ;FLAG THAT A NO. WAS READ
TLZ F,FL.MOP ;CLEAR MONADIC OPS FLAG
TLNE N,700000 ;[1177][1006] HAVE WE READ 12 FIGURES?
POPJ P,0 ;[1006] YES, MUST BE DONE
LSH N,3
ADDI N,-"0"(CH)
;[1006] 2 lines of code moved to 2 lines above
JRST OCTIN1
;A ROUTINE TO READ A SIXBIT WORD
WDREAD: MOVE BP,[XWD 440600,WD]
MOVEI WD,0
PUSHJ P,CHARIU ;GET NEXT SIGNIFICANT CHARACTER AND SKIP
WDRD3: PUSHJ P,PINCH
PUSHJ P,LOWUP ;CONVERT LOWER CASE TO UPPER
CAIN CH,"%"
JRST WDRD2
CAIL CH,"0"
CAILE CH,"Z"
POPJ P,
CAIGE CH,"A"
CAIG CH,"9"
JRST WDRD2
POPJ P,
WDRD2: SUBI CH," "
TLNE BP,770000
IDPB CH,BP
JRST WDRD3
;HERE TO DEAL WITH THE PATH STUFF
IFN FTPATH,<
PTHCHK: MOVEI T1,LPATH+1
MOVEM T1,LPATH ;SET UP POINTERS
MOVSI N,-SFDLVL ;MAX NO. OF SFD'S
PTHCH1: PUSHJ P,WDREAD ;READ SFD NAME
JUMPE WD,CPOPJ ;BLANK IS WRONG
MOVEM WD,@LPATH
AOS LPATH ;[1160]
PUSHJ P,CHARSG ;SKIP TRAILING SPACES
PUSHJ P,ISBRK
JRST PTHCH2 ;[1101]
CAIN CH,"]"
JRST PTHCH2
CAIN CH,"," ;COMMA
AOBJN N,PTHCH1 ;ONTO NEXT IF NOT HAD SIX
POPJ P,0 ;NO ERROR
PTHCH2: MOVE N,LPPN
SETZM @LPATH ;[1176][1160] TERMINATE PATH (NOT TO PICK UP FROM
;[1160] OWNERS DEFAULT
MOVEM N,LPATH ;SAVE PPN AS START OF PATH
MOVEI N,LPATH
MOVEM N,LPPN ;SAVE ADDR. OF PATH
JRST PROJE1
; * still inside ftpath conditional
;
; HERE TO SET UP A GUY'S PATH AFTER A [-] IN THE SFILE SPEC.
;
DEFPTH: SKIPE N1 ;DID WE READ ANYFING YET
JRST CPOPJ ;THATS BAD
IFE FTMBCH, PUSHJ P,SETPTH ;[1120] SET UP THE PATH
IFN FTMBCH, PUSHJ P,GETPTH ;[1120] MAY NEED TO DO PATH. UUO
MOVEM T1,LPPN ;REMMEBER THE POINTER
PUSHJ P,CHARIN ;AND GET THE NEXT CHARACTER
CAIE CH,"]" ;IF IT IS THIS
CAIN CH,.GT. ;[1157][1101][1120] OR THIS
SKIPA ;[1101]
PUSHJ P,ISBRK ;OR A BREAK CHAR.
AOS (P) ;HE GETS A GOOD RETURN
POPJ P,0 ;JUST RETURN
; * still inside ftpath conditional
;
; HERE TO GET A GUY'S DEFAULT PATH
;
; ENTER AT FILPTH TO GET THE PATH FOR CHANNEL 0
; ENTER AT GETPTH TO GET THE PATH FOR THIS JOB
;[1102] ENTER AT FILPTC TO GET THE PATH FOR A FILE WHOSE CHANNEL IS IN T1
;
FILPTH: TDZA T1,T1 ;CHANNEL 0
GETPTH: MOVEI T1,.PTFRD ;READ PATH FUNCTION
FILPTC: MOVEM T1,PTHBLK ;[1102]SET THAT IN THE PATH. ARG BLOCK
MOVE T1,[SFDLVL+3,,PTHBLK] ;ARGS. FOR THE UUO
SETZM .PTSWT(T1) ;NO SWITCHES
PATH. T1, ;READ THE PATH
JRST E%%PUF ;ERROR
MOVEI T1,PTHBLK ;GET THE ADDRES OF THE PATH BLOCK
POPJ P,0 ; ALL DONE
ERROR. PUF,<PATH. UUO failed>
;
; HERE TO SET LOW PATH AREA TO THE PATH SPECIFIED BY T1
; OR IF T1=0 THE GUY'S DEFAULT PATH
;
CPYPTH: SETZM PTHBLK.+.PTFCN ;CLEAR FUNCTION WORD AND
PUSH P,T2 ;SAVE AN AC
MOVSI T2,PTHBLK+.PTFCN ;GET FIRST WORD OF PATH
HRRI T2,PTHBLK+.PTFCN+1 ;AND SECOND WORD
BLT T2,PTHBLK+SFDLVL+2 ;AND CLEAR DOWN THE PATH BLOCK
POP P,T2 ;RESTORE THE AC
JUMPE T1,CPOPJ ;T1=0?
HRLZS T1
SKIPA ;PREPARE
;
; HERE TO SET LOW PATH AREA TO A GUY'S DEFAULT PATH
;
SETPTH: MOVSI T1,OPATH(X) ;GET ADDRESS OF DEFAULT PATH
HRRI T1,PTHBLK ;GET ADDR. OF LOW AREA
BLT T1,PTHBLK+SFDLVL+2 ;DO IT
SDFPTH: MOVEI T1,PTHBLK ;RETURN NEW PATH ADDRESS
POPJ P,0
; * still inside ftpath conditional
; * still inside ftpath conditional
;
; here to output a guy's path
; on entry address of path is in WD
;
PTHOUT: TLNE WD,-1 ;IS IT A PATH OR A PPN?
PJRST PPNOUT ;JUST A PPN
ADDI WD,2 ;ADVANCE OVER THE SWITCH STUFF
HRRZ T1,WD ;GET THE ADDRESS OF THE PATH
MOVEI CH,"[" ;OPEN BRACKET
PUSHJ P,OUCH ;PRINT IT
MOVE WD,(T1) ;GET THE PPN
PUSHJ P,PRJPRG ;OUTPUT PROJ,PROG
PTHOU0: AOS T1 ;ADAVNCE DOWN THE PATH
SKIPN WD,(T1) ;GET NEXT IF ANY
PJRST .CLSBRK ;OUTPUT A CLOSING BRACKET
PUSHJ P,.COMMA ;OUTPUT A COMMA
PUSHJ P,SIXBP ;OUTPUT NAME OF SFD
JRST PTHOU0 ;AND TRY FOR NEXT
> ;END OF FTPATH
SUBTTL SLAVE PROCESSOR - OUTPUT A FILE SPEC.
;Here to output a device:filespecification
;enter with address of specification in t1.
OUTSPEC:
MOVE WD,.DEV(T1) ;GET DEVICE NAME
JUMPE WD,OUTSP0 ;DONT PRINT NUFFIN
PUSHJ P,SIXBP ;PRINT IT
PUSHJ P,COLON
OUTSP0: SKIPN WD,.FILE(T1) ;[1103]FILENAME
POPJ P,0 ;[1103]
PUSHJ P,SIXBP
PUSHJ P,DOT
MOVE WD,.EXT(T1) ;EXTENSION
PUSHJ P,SIXBP
HLRZ WD,.DEV(T1) ;GET DEVICE NAME AGAIN
CAMN WD,MICDEV ;IF IT WAS DEVICE MIC DONT PTINT PPN
POPJ P,0
SKIPE WD,.PPN(T1) ;PPN
IFE FTPATH,< PJRST PPNOUT >
IFN FTPATH,< PJRST PTHOUT >
POPJ P,0 ;DONT PRINT NULL PPN'S
SUBTTL PLEASE COMMAND
;HERE ON A PLEASE COMMAND
.PLEASE:
PUSHJ P,OTHUSR ;GET IN CONTEXT
JRST LETER3 ;MAY BE WE DO SOMETHING HERE SOME DAY
MOVE X,T2 ;[771]REMEMBER POINTER TO HIS PDB
PUSHJ P,LININ ;READ IN THE PLEASE LINE
TLZN S,LDL.XX ;[765]IF I AM SILENCED
JRST .PLE1 ;[765] NO NEED TO RE DISPLAY
PUSHJ P,TOWAIZ ;[765]DO EXTRA CHECK THEN MIC SET
OUTSTR [ASCIZ/
[/]
OUTSTR BUFFER
OUTSTR [ASCIZ/]
/]
TLO S,LDL.XX ;[772] HE WAS SILENCED
.PLE1: TLNN S,LDL.CB ;[772] IF HE IS NOT ALREADY IN BREAK MODE
TLOA S,LDL.CB ;[772] HE MAY NEED A BREAK
JRST .PLE1A ;[772] THO' PERHAPS NOT
CAIN CH,ALT ;ANY FLAVOUR OF ALTMODE
TLZ S,LDL.CB ;WILL SCRAP A BREAK
IFN FTOALT,<
CAIE CH,ALT175
CAIN CH,ALT176
TLZ S,LDL.CB
> ;END OF IFN FTOALT
.PLE1A: PUSHJ P,TOWAIZ ;[772]WAIT FOR O/P TO COMPLETE THEN RESET SILENCE AND PERHAPS BREAK
PUSHJ P,OTHUSR ;[767]EXTRA CHECK ON NOT RUNNING MIC NOW
JRST .EXIT ;[767]THE BAD THING HAS HAPPENED
IFN FTCJOB,< ;[765]
MOVE X,T2 ;[771] SET UP POINTER TO HIS PDB
MOVE T2,CJOWNR(X) ;[765]IS HE A COJOB...
JUMPG T2,PLCJOB ;[765]...JUMP IF YES
> ;[765]END OF IFN FTCJOB
JRST DOTTY ;[765]AND UP, UP AND AWAY
IFN FTCJOB,<
;HERE TO TELL THE OWNER OF A COJOB ABOUT A PLEASE COMMAND
PLCJOB: MOVE L,T2 ;[771] POSITION THE COJOB OWNER'S LINE NO.
PUSHJ P,OWNCHK ;[765]IS OWNER AROUND
JRST EXIT1 ;NO
MIC GET,L ;GET OWNERS STATUS
JRST .PLE2 ;HE IS NOT RUNNING MIC
TLZE S,LDL.XX ;MAKE SURE HE SEES IT
MIC SET,L
JFCL
.PLE2: PUSH P,LOWOUT ;[1165] SAVE CURRENT LOW-LEVEL OUTPUTTER
PUSHJ P,CJDSP ;[771]
MOVEI BP,[ASCIZ/.PLEASE /] ;[1165]
.TELLX: PUSHJ P,STROUT ;[1165] DISPLAY STRING
MOVEI BP,BUFFER ;[1165]
.PLE5: PUSHJ P,STROUT ;[1165]
MOVEI CH,"]" ;[1165] GET THE CLOSING BRACKET
PUSHJ P,OUCH ;[1165] AND OUTPUT THAT
PUSHJ P,.NEWL ;[1165] NEWLINE
POP P,LOWOUT ;[1165] REPLACE OLD PUTTER
JRST EXIT1
> ;END OF COJO CONDITIONAL
IFE FTCJOB,<
JRST EXIT1
JRST PLWAIT
>;END OF IF NOT
;A SUBROUTINE TO GET A PLEASE LINE IN
LININ: MOVSI BP,440700
HRRI BP,BUFFER
.PLE4: PUSHJ P,ISBRK ;GOT A BREAK ALREADY?
JRST .PLE3
SPLIDG: IDPB CH,BP
PUSHJ P,PINCH ;GET THE NEXT CHARACTER IN
JRST .PLE4
.PLE3: SETZ T1,
IDPB T1,BP
POPJ P,0
SUBTTL MIC OPR COMMAND - COJOB/SYSTEM OPERATOR COMMUNICATIONS
IFN FTOPR&FTCJOB,<
.OPR: PUSHJ P,OTHUSR ;GET IN CONTEXT
JRST LETER3 ;WOT TO DO I DO NOT KNOW
SKIPN CJOWNR(T2) ;IS WE A COJOB
JRST EXIT1 ;NO--REGARD COMMAND AS A NO-OP
PUSHJ P,LININ ;GET THE MESSAGE IN
PUSH P,S ;SAVE S
MOVEI S,BUFFER ;LINE IS SAVED IN BUFFER
PUSHJ P,TELOPR ;LET THE OPERATOR KNOW
POP P,S ;RESTORE S
TLO S,LDL.CB ;MAY NEED A BREAK
CAIN CH,ALT ;BUT NOT IF THE LINE TERMINATED IN AN ALTMODE
TLZ S,LDL.CB ;OF ANY VALUE
IFN FTOALT,<
CAIE CH,ALT175 ;EVEN THIS
CAIN CH,ALT176 ;OR THIS
TLZA S,LDL.CB ;SO DO AWAY WIF THE BREAK
SKIPA
> ;END OF IFN FTOALT
JRST EXIT1 ;AND AWAY
PUSH P,S ;LET OPR KNOW THAT WE ARE WAITING
MOVEI S,[ASCIZ/[BREAK]/]
PUSHJ P,TELOPR ;ON TO OPR DEVICE
POP P,S ;COME BACK S ALL IS FORGIVEN
MIC SET,L ;BREAK
HALT ;DON'T KNOW WOT TO DO
JRST EXIT1 ;DONE!
>
SUBTTL SLAVE PROCESS - SLEEP COMMAND
;
;
; This command has the format -
; MIC SLEEP n
; where n is the number of seconds this macro is to sleep for.
;
.SLEEP: PUSHJ P,ATOM ;GET NO. OF SECONDS TO SLEEP FOR
JUMPGE N1,E%%IAS ;ERROR IF NO NUMBER
IMULI N,^D1000 ;CONVERT SECONS TO MILLISECONDS
MSTIME T2, ;GET THE TIME OF DAY
ADD N,T2 ;CALCULATE WHEN HE IS TO WAKE UP
PUSHJ P,OTHUSR ;SEE IF HE HAS A PDB
JRST E%%NRM ;SILLY BOY
WENABL
MOVEM N,SLPTIM(T2) ;SAY WHEN HE IS NXT TO BE SCHEDULED AFTER
WLOCK
MOVE T1,MASTNO ;[1067] GET THE JOB NO. OF THE MASTER
WAKE T1, ;[1067] CAUSE HIM TO WAKE
JFCL ;[1067] OH DEAR, OH DEAR
JRST DOTTY ;AND SEE WHAT WE CAN C
;
ERROR. IAS,<Invalid argument>
SUBTTL SILENCE,REVIVE,ABORT,PROCEED,BREAK,NO/OPERATOR,NO/ERROR,DISPLAY,TYPE
;HERE ON SILENCE AND REVIVE
.SILENCE:
PUSHJ P,OTHUSR ;[1111] GET PDB ADDRESS
JRST E%%NRM ;[1111] OOOOOPPPPSSSS
MOVSI T1,PL.NSL ;[1111] GET THE NO SILENCE FLAG
TDNN T1,PROFLE(T2) ;[1111] AND DONT SILENCE IF IT IS SET
TLOA S,LDL.XX ;SHUT HIM UP
.REVIVE:TLZ S,LDL.XX ;KISS OF LIFE
JRST DOTMIC
;HERE ON MIC ABORT
.ABORT: TLO S,LDL.CA
IFN FTCJOB,< ;[1000]
SKIPE CJOWNR(X) ;[1000]SKIP IF NOT A COJOB
PUSHJ P,FRCMON ;[1000]OTHERWISE GIVE HIM A ^C
> ;[1000] END OF IFN FTCJOB
JRST DOTMIC
;HERE ON MIC PROCEED
.PROCEED:
TLO S,LDL.CP
JRST DOTMIC
;HERE ON MIC BREAK
.BREAK: TLO S,LDL.CB
JRST DOTMIC
;HERE ON MIC RETURN - PRETEND THAT MASTER HAS SEEN EOF
.RETURN:
PUSHJ P,OTHUSR ;GET IN CONTEXT
JRST LETER3 ;COULDN'T
MOVE T4,LAST(T2) ;[1105] GET ADDRESS OF LAST IF ANY
MOVEI T1,FR.EOF ;EOF FLAG
WENABL ;OPEN HI SEG
IORM T1,FSAV(T2)
PUSHJ P,CHARSG ;GET SIGN. CHAR.
PUSHJ P,ISBRK ;IS IT A BREAK CHAR.
JRST DOTTY ;[1105]YES - UP AND AWAY
WLOCK ;CLOSE HI SEG
JUMPE T4,DOTTY ;[1105] THATS ALL IF WE HAVE NOT HELD A PROCESS
RTRN0: SKIPG FLAG-1(T4) ;IS IT AWAKE
JRST DOTTY ;[1105]
PUSHJ P,HIBER2 ;[1204] SLEEP FOR TWO SECS.
JRST RTRN0
;[1204] Routine to hiber for two seconds.
;
HIBER2: MOVE T1,MASTNO ;[1204] GET THE MASTER NO.
WAKE T1, ;[1204] WAKE DADDY UP
JRST CPOPJ ;[1204] [1105]FAILED
MOVEI T1,2*^D1000 ;[1204] HIBER TIME
HIBER T1, ;[1204]
POPJ P,0 ;[1204] AND RETURN
POPJ P,0 ;[1204] DITTO
;[1041] This page has Bbeen modified by edit [1041]
;[1041] ** Not all lines are marked**
;HERE ON A MIC TYPE
.TYPE: TDZA T1,T1
;HERE ON MIC DISPLAY
.DISPLAY:SETO T1,
TLO F,FLS.UA ;[1021] SAY WE WANT UP ARROW CONTROL CHARACTERS
TDAGN: MOVEM L,LLX ;SAVE LINE NO.
MIC GET,L ;GET HIS LDBMIC WORD
SETZ S, ;EH!
TLZE S,LDL.XX
MIC SET,L
JRST TDAGN1
TLO F,FL.XX
JUMPN T1,TDAGN1 ;JUMP IF DOING DISPLAY
TLNN S,LDL.MM ;IF NOT IN MONITOR MODE
JRST TDAGN ;DON'T DISPLAY A .
MOVEI S,[ASCIZ/./] ;OTHERWISE A .
MIC DISPLAY,L ;HELPS TO AVOID CONFUSION
JFCL
TDAGN1: SETOM LLP
PUSHJ P,CHARIN ;GET NEXT SIGNF. CHAR.
CAIE CH,"$" ;IS IT
CAIN CH,42 ;OR "
JRST TDAG1
MOVEM CH,CH.SAV ;PUT BACK THAT WHICH WE DO NOT WANT YET
MOVEI CH,"$" ;PRETEND STRING
TDAG1: PUSH P,T1 ;SAVE T1
MIC GET,L ;[1205] RESET THE MIC BITS
SETZ S, ;[1205] THIS IS SILLY!
PUSHJ P,LETSTR ;[1021] CLEAN UP
MOVE L,LLX
POP P,T1
HRRZI S,FIRST
MOVE L,LLX ;RESTORE LINE NO.
XCT TYPDIS(T1) ;DO APPROPRIATE FING.
JFCL
TDAG2: PUSHJ P,CHARIN ;SIGNIFICANT CHARS.
CAIN CH,"," ;ONE OF THESE?
JRST TDAGN1 ;PLAY IT AGAIN SAM
TLZN F,FL.XX
JRST TDAG5
MIC GET,L ;GET THE LINES CURRENT MIC STATUS
SETZ S, ;EH!!!
TLO S,LDL.XX
PUSHJ P,TOWAIZ ;[765] MODIFY MIC WORD
TDAG5: TLZ F,FLS.UA ;[1021]CLEAR THE UP-ARROW CHARACTER FLAG
PUSHJ P,OTHUSR ;[767]EXTRA CHECK AGAINST NOT RUNNING MIC NOW
JRST .EXIT ;[767]THE BAD THING HAS HAPPENED
JRST DOTTY
MIC DISPLAY,L
TYPDIS: MIC TYPE,L
;HERE ON OPERATOR & NOOPERATOR
.NOOPERATOR:
SETZ CH, ;CLEAR OP CHAR
JRST .NOOP1
.OPERATOR:
PUSHJ P,GETARG ;GET HIS ARG
IFN FTHATF,<
MOVEI CH,"$" ;DEFAULT IS $
>
IFE FTHATF,<
MOVEI CH,"?" ;DEFAULT IS ?
>
.NOOP1: DPB CH,LDP.OP ;AND STORE IT
JRST DOTMIC ;RESET FLAGS AND FIND NEXT DOT
;HERE ON ERROR AND NOERROR
.NOERROR:
SETZ CH, ;CLEAR ERROR CHAR
JRST .NOER1
.ERROR: PUSHJ P,GETARG
MOVEI CH,"?" ;DEFAULT IS ?
.NOER1: DPB CH,LDP.ER ;STORE IT
JRST DOTMIC ;RESET FLAGS AND FIND NEXT DOT
GETARG: PUSHJ P,ISBRK ;IS IT A BREAK?
MOVEM CH,CH.SAV ;YES-MAKE SURE WE DO NOT MISS IT
PUSHJ P,CHARIN ;GET NEXT CHAR
PUSHJ P,ISBRK ;IS THIS A BREAK?
SKIPA ;YES-LOAD UP DEFAULT
JRST CPOPJ1 ;NO-THIS IS THE ARG
MOVEM CH,CH.SAV ;SAVE THE CHAR THAT WAS THE BREAK
POPJ P,0
SUBTTL INPUT Command - read a line into a parameter.
;
; This code implements the MIC INPUT command (Edit 1110) which has
; the syntax-
; MIC INPUT param
; or
; MIC INPUT param,prompt
;
; where
; param - is any MIC parameter(including one in an outer process)
; prompt - is a string (constant or variable) displayed as a prompt to the user
;
; After displaying the prompt, a single line of input is read from the user
; and stored in prameter "param".
.INPUT: MOVEM L,LLX ;SAVE USER LINE NO.
PUSHJ P,PRMIN ;READ A PARAMETER IN
MOVEM CH,CH.SAV ;SAVE THE TERMINATOR
PUSH P,LOWOUT ;SAVE CURRENT LO-LEVWL O/P
MOVE T1,[IDPB CH,T1] ;SET UP NEW ONE
MOVEM T1,LOWOUT ; "
MOVE T1,[POINT 7,FIRST] ;WITH THIS POINTER
MOVEI BP,[ASCIZ/Enter parameter /]
PUSHJ P,STROUT ;START OF DEFAULT PROMPT
MOVE CH,LLP ;THEN THE PARAMETER NAME
PUSHJ P,OUCH ;AS NEXT PART OF PROMPT
SKIPE N,LEVEL ;DIS HE SPECEIFY A LEVEL?
PUSHJ P,DECPRT ;PROMPT THAT AS WELL
PUSHJ P,SPACE ;SEPEERATOR
SETZ CH, ;END FOR ASCIZ
PUSHJ P,OUCH ;O/P IT
POP P,LOWOUT ;RESTORE OLD LOW-LEVEL
MOVE CH,CH.SAV ;GET SAVED CHAR BACK
SETZM CH.SAV ;AND FORGET MEMORY OF SAME
INPUT2: PUSHJ P,ISBRK ;REACHED EOL YET?
JRST [
CAIE CH,CR ;AND WAS THAT BREAK A <CARRIAGE-RETURN>
JRST INPUT0 ;N0, LET HIM HAVE THE STD. PROMPT
PUSHJ P,PINCH ;GET PROBABLE LINE FEED
JRST INPUT2 ;AND CHECK IT OUT
]
INPUT1: CAIE CH,"," ;INTRODUCING A PROMPT?
JRST LETER1 ;NO, SYNTAX ERROR
PUSHJ P,CHARIN ;GET NEXT CHAR.
CAIE CH,"$" ;IS IT A STRING CONSTANT INTRODUCTION
CAIN CH,"""" ;OR A STRING CONSTANT
SKIPA ;BRANCH IF YES TO ONE OF THESE
JRST E%%IPS ;OTHERWISE ERROR
MOVEI A,FIRST ;WHERE TO STORE THE PROMPT STRING
PUSHJ P,INSTR ;READ THE PROMPT IN
SETZM CH.SAV ;CLEAR THE SAVE CHAR.
PUSHJ P,ISBRK ;DID WE GET A BREAK CHAR?
JRST [ CAIN CH,CR ;AND WAS IT A CARRIAGE RETURN
PUSHJ P,CHARIN ;IF YES, GOBBLE THE LINE FEED
JRST INPUT0 ;AND THATS FINE
]
JRST E%%EIP ;EXCESS ARGUMENTS
INPUT0: MOVE L,LLX ;GET LINE NO. AGAIN
PUSHJ P,OTHUSR ;GET ADDR. OF PDB
JRST E%%NRM ;FUNNY!
WENABL ;OPEN THE HI-SEG
MOVSI T1,PL.INP ;GET THE "DOING AN INPUT COMMAND" FLAG
IORM T1,PROFLE(T2) ;SET IT IN THE PROFILE WORD
PUSH P,A.BREAK(T2) ;SAVE USER SPECIAL BREAK OPTION
MOVE T1,[JRST %.BREAK] ;AND GET STD. ONE
MOVEM T1,A.BREAK(T2) ;AND SET THAT
PUSH P,A.PROCEED(T2) ;SAVE USER SPECIAL PROCEED OPTION
MOVE T1,[JRST %.PROCEED] ;AND GET STD. ONE
MOVEM T1,A.PROCEED(T2) ;AND SET THAT
WLOCK ;CLOSE THE HI SEG
MOVE L,LLX ;GET LINE NO. BACK
MIC GET,L ;GET S RITE
JRST E%%NRM ;OOOPS
PUSH P,S ;SAVE THE CURRENT FLAG WORD
TLZ S,LDL.XX ;AND ENSURE SILENCE IS NOT SET
TLO S,LDL.CB ;SET THE ^B FLAG
MIC SET,L ;RESET LDBMIC
JRST LETER1 ;OOOPS
OUTSTR FIRST ;GIVE HIM A PROMPT
IFN FTCJOB,< ;[1212]
MOVE T2,CJOWNR(T2) ;[1214][1212] GET THE STATE WORD
JUMPLE T2,INPUT3 ;[1212] JUMP IF NOT A COJOB
MOVE X,T2 ;[1214] POSITION THE INDEX FOR OWNCHK
PUSHJ P,OWNCHK ;[1212] IS THE OWNER STILL AROUND?
JRST [
SETZ CH,0 ;[1212] NO, TERMINATE A NULL STRING
JRST INPUT4 ;[1212] AND PROCEED
] ;[1212]
MIC GET,L ;[1212] GET HIS STATUS
JRST INPUT5 ;[1212] NOT RUNNING MIC
TLZE S,LDL.XX ;[1212] UNSILENCE HIM IF NECC.
MIC SET,L ;[1212] AND DO IT
JFCL ;[1212] HMMM
INPUT5: PUSH P,LOWOUT ;[1212] SAVE THE CURRENT LOW LEVEL O/P
PUSHJ P,CJDSP ;[1212] DISPLAY THE STD. BIT
MOVEI BP,FIRST ;[1212] THEN THE USER'S TEXT
PUSHJ P,STROUT ;[1212] DISPLAY THAT
MOVEI CH,"]" ;[1212] CLOSING WHATSIT
PUSHJ P,OUCH ;[1212] O/P IT
PUSHJ P,.NEWL ;[1212] AND A NEW LINE
POP P,LOWOUT ;[1212] RESTORE OUTPUTTER
> ;[1212] IFN FTCJOB
INPUT3: MOVEI A,FIRST ;ADDR. OF WHERE TO STORE WHAT HE SAYS
PUSHJ P,LINEIN ;READ IT IN
INPUT4: MOVEM CH,CH.SAV ;SAVE THE TERMINATING BREAK CHAR.
SETZ CH, ;END ON ..
IDPB CH,T1 ;..A NULL
PUSHJ P,PRMFIX ;STORE IT AWAY
MOVE L,LLX ;GET LINE BACK
MIC GET,L ;GET S AGAIN
JFCL ;OK
POP P,T1 ;GET OLD FLAG WORD BACK
TLNE T1,LDL.XX ;WAS SILENCE SET?
TLO S,LDL.XX ;IF YES, RESET IT
TLZ S,LDL.CB ;CLEAR [BREAK]
MIC SET,L ;AND UNSET IT
JFCL ;OOOO
; *NB* When master notices proceed it will clear PL.INP
POP P,A.PROCEED(T2) ;AND SPECIAL OPTIONS FOR PROCEED..
POP P,A.BREAK(T2) ;..AND BREAK
MOVE T1,MASTNO ;GET THE JOB NO. OF THE MASTER
WAKE T1, ;AND ENSURE HE KNOWS ABOUT US
JFCL ;EH?
JRST DOTTY ;AND ALL DONE
;
; LINEIN -input a single line
;
LINEIN: HRLZI T1,440700!A ;SET UP BYTE POINTER
INLIN0: PUSHJ P,PINCH ;GET A CHAR.
PUSHJ P,ISBRK ;IS IT THE END
POPJ P,0 ;YES
IDPB CH,T1 ;STORE IT IN THE BUFFER
JRST INLIN0 ;AND TRY FOR NEXT
;
;
ERROR. IPS,<INPUT prompt must be string>
ERROR. EIP,<INPUT has excess arguments>
SUBTTL CLEAR COMMAND - TO CLEAR A LINES MIC WORD
REPEAT 0,< ;MAY NOT WANT
TOTLIN==^D512
.CLEAR: PUSHJ P,PRVCHK ;IS HE PRIVILEDGED
JRST UNPRV ;NO-CAN ONLY CLEAR OWN LINE
PUSHJ P,WDREAD ;GET ARG
SKIPE WD ;MAY HAVE BEEN NUMERIC
JRST MAYBAL ;MAY BE ALL
CAIE CH,"%" ;MIC OCTAL
CAIN CH,"#" ;COMPATABILITY WIF SYSTAT LINE NO.S
JRST LINOCT
PUSHJ P,ISBRK ;BREAK ?
JRST EXIT1 ;NO TUF!
UNPRV: MIC CLEAR,L ;CLEAR THIS LINE ONLY
JFCL ;WOT WUD U DU
JRST EXIT1 ;AND AWAY
MAYBAL: CAME WD,[SIXBIT/ALL/]
JRST CLRER1 ;IF NOT ALL - NOOT ALLOWED
HRLZI T1,-TOTLIN ;HOW MANY LINES
HRRZ T2,T1
MIC CLEAR,T2
JFCL
AOBJN T1,.-3
JRST EXIT1 ;AND AWAY
LINOCT: PUSHJ P,RDOCTL ;GET THE LINE NO.
SKIPN N1,
JRST CLRER2 ;NOT NICE
MOVE L,N ;PUT IT IN LINE AC
JRST UNPRV ;DO IT
E%%UAA:
CLRER1: OUTSTR [ASCIZ/
?MICUAA Unknown alpha argument/]
JRST SLENDX
E%%INA:
CLRER2: OUTSTR [ASCIZ/
?MICINA Improper numeric argument/]
JRST SLENDX
> ;END OF REPEAT
SUBTTL FNDCMD A ROUTINE TO SEARCH THE COMMAND TABLE
FNDCMD: PUSHJ P,WDREAD ;READ THE COMMAND
JUMPE WD,FNDCM1 ;NONE THERE
MOVE T1,[-CMDSIZ,,MICTAB]
PUSHJ P,FNDNAM
JRST EXIT1
POPJ P,0
FNDCM1: CAIN CH,"/" ;MAYBE THIS
JRST .+3 ;YES
CAIE CH,"@" ;OR THIS
JRST EXIT1 ;NO!!!!
MOVEI T1,CMDSIZ ;DUMMY UP THE APPROPRIATE INDEX
POPJ P,0
;FNDNAM--ROUTINE TO SEARCH FOR AN ABREV. NAME IN AN ALPHABETICALLY
;ORDERED TABLE
;CALL
; MOVE T1,AOBJN POINTER TO LIST OF NAMES
; MOVE WD,SIXBIT ABBREVIATION
; PUSHJ P,FNDNAM
;NON-SKIP RETURN IF NOT FOUND(T1=0) OR DUPLICATE (T1>1)
;SKIP RETURN IF FOUND WITH T1=INDEX IN TABLE
FNDNAM: SETZB N1,T4 ;CLEAR MATCH MASK AND POINTER
MOVSI T2,(77B5) ;START AT LEFT END
FNDNM1: TDNE WD,T2 ;SEE IF SPACE
IOR N1,T2 ;NO IMPROVE MASK
LSH T2,-6 ;MOVE RIGHT ONE CHAR.
JUMPN T2,FNDNM1 ;LOOP FOR SIX CHARS.
SETO T2, ;SET ABBREV COUNTER
HRRZ N,T1 ;SAVE POINTER
FNDNM2: MOVE T3,(T1) ;GET NEXT CANDIDATE
XOR T3,WD ;COMPARE
JUMPE T3,FNDNMW ;EXACT MATCH--WIN
AND T3,N1 ;MASK IT
JUMPN T3,FNDNM3 ;LOSE
MOVE T4,T1 ;CONDITIONAL WIN-SAVE POINTER
ADD T1,[1,,1] ;LOOK AT NEXT
JUMPGE T1,[SUB T1,[1,,1]
JRST FNDNMW] ;WIN ON LAST
MOVE T3,(T1) ;GET THE ONE
XOR T3,WD ;COMPARE
JUMPE T3,FNDNMW ;EXACT MATCH?
AND T3,N1 ;MASK IT
JUMPE T3,FNDNM4 ;NOT UNIQUE
SKIPA
FNDNM3: AOBJN T1,FNDNM2 ;LOOP FOR ALL ENTRIES
JUMPGE T1,FNDNM4
MOVE T1,T4 ;RESTORE POSSIBLE WINNER
FNDNMW: TLZ T1,-1 ;REMOVE JUNK
SUB T1,N ;COMPUTE INDEX
JRST CPOPJ1 ;SKIP RETURN
FNDNM4: MOVEI T1,1 ;TWO'S A CROWD
JRST CPOPJ ;FAIL RETURN
SUBTTL SLAVE PROCESS WHENEVER OR ON COMMAND
REPEAT 0,<
A WHENEVER OR ON COMMAND HAS THE FORMAT:-
WHENEVER EVENT:ACTION
ON EVENT:ACTION
WHICH ENABLES THE USER TO OVERRIDE THE DEFAULT PROCESSING
OF CERTAIN EVENTS
TO RESTORE DEFAULTS USE
WHENEVER EVENT:EVENT
ON EVENT:EVENT
>
.WHENEVER:
.ON: PUSHJ P,WDREAD ;READ THE COMMAND
MOVE T1,[-CMDSIZ,,MICTAB]
PUSHJ P,FNDNAM ;CHECK IT
JRST WHNER2
MOVE T1,DSPLST(T1) ;GET THE APPROPRIATE DISPATCH BITS
TLNN T1,WH ;IS IT ALEGAL EVENT
JRST WHNER1 ;NO
LDB N,PEVNTN ;GET EVENT NUMBER
PUSHJ P,CHARSG ;GET NEXT SIGNIF. CHAR.
LSH N,1 ;*2 TO ALLOW FOR ARGS.
PUSH P,N ;SAVE N (USED IN FNDNAM)
CAIE CH,":" ;LEGAL TERMINATOR ?
JRST WHNER2 ;NO
PUSHJ P,WDREAD ;GET THE ACTION COMMAND
MOVE T1,[-CMDSIZ,,MICTAB]
PUSHJ P,FNDNAM ;CHECK IT
JRST WHNER2 ;WRONG!
MOVE T1,DSPLST(T1) ;GET THE DISPATCH BITS
TLNN T1,ACT ;IS IT A LEGAL ACTION
JRST WHNER2 ;NO
LDB T3,PACTNM ;GET THE ACTION NUMBER
PUSH P,T1 ;SAVE T1
PUSHJ P,OTHUSR ;SET UP X AND Y
HALT ;GORN AND NEVER CALLED ME MOTHER
MOVE T3,DSPACT(T3) ;GET ACTION
POP P,T1 ;RESTORE T1
POP P,N ;GET N BACK
ADD T2,N ;POINT AT EVENT
TLNE T1,PRM ;ACTION REQUIRES ARG.
JRST ACTPRM ;YES DEAL WIF IT
WENABL ;OPEN HI SEG
ACTFIN: MOVEM T3,FSTVNT(T2) ;STORE IN HIS PDB
PUSHJ P,CHARSG ;GET NEXT SIGN. CHAR.
CAIN CH,"," ;IS IT A COMMA
JRST .ON ;YES DO SOME MORE WHENEVER STUFF
JRST DOTTY ;ANTHEM AND CLOSE DOWN
ACTPRM: ;HERE IF AN ACTION REQUIRES A PARAMETER
PUSHJ P,WDREAD ;READ IT
JUMPE WD,WHNER3 ;IF NONE DIE
TLNE T1,LBL ;LABEL?
JRST PRMLBL ;YES
MOVEM L,LLX ;SAVE LINE NO.
MOVEM CH,CH.SAV ;NO-MUST BE A-Z TYPE ARG
ROT WD,6 ;GET IN RITE PLACE
MOVEI CH," "(WD) ;BACK TO ASCII
CAIL CH,"A" ;CHECK IT
CAILE CH,"Z" ;MUST BE A-Z
JRST WHNER4 ;ITS NOT!
PUSH P,T3 ;SAVE
PUSH P,T2 ;SAVE
PUSHJ P,REFBP ;MAKE UP BYTE POINTER TO THAT PARAMETER
HRRZ WD,T3 ;AND IGNORE IT 'COS IN T3 IS THE ADDR. OF
;WHERE THE PARAMETER WILL BE PUT
;THIS ALLOWS HIM TO SPECIFY THE STRING LATER
HRLI WD,-1 ;FLAG
POP P,T2 ;UNSAVE
POP P,T3 ;UNSAVE
PRMLBL: WENABL ;OPEN HI SEG
MOVEM WD,FSTVNT+1(T2) ;STORE THE ARG
JRST ACTFIN ;BACK TO MAINSTREAM
WHNER1: ERROR. NAE,<Not an event>
WHNER2: ERROR. ILF,<Illegal format>
WHNER3: ERROR. NOA,<No argument>
WHNER4: ERROR. ANA,<Argument is not an A-Z parameter>
SUBTTL SLAVE PROCESS - MIC SET COMMAND
;THIS COMMAND IS USED TO SET AND UNSET VARIOUS
;CONTROLS TO THE BEHAVIOR OF A MIC PROCESS
;E.G. CONTROL OF O/P IN COJOBS
;FIRST THE TABLES
;EACH ENTRY IS DEFINED BY A MACRO .SS.
;WHICH MAY HAVE UP TO FIVE ARGUMENTS
;1-NAME OF THE COMMAND
;2-LEFT HALF BIT SETTINGS---OR DEFAULT VALUE
;3-RIGHT HALF BIT SETTINGS---OR ADDRESS TO BE SET
;4-PRIVILEGE BITS---SIGN BIT MEANS [1,2] ONLY
;5-DSPATCH ROUTINE ADDRESS-BY DEFAULT SETPRF
GODBIT==400000 ;[1,2]ONLY
OCTNUM==200000 ;OCTAL ARG
NEGBIT==100000 ;IF YOU READ A +VE NO. MAKE IT -VE BEFORE U STORE IT
BMPBIT==040000 ;ADD 1 TO COMCNT IN ORDER TO FORCE MIC TO RECOMPUTE CORE
DEFINE SETS,< ;;**NB** THIS TABLE MUST BE IN STRICT ALPHABETICAL ORDER!!
IFN FTMBCH,<.SS. BATOPR,1,BATOPR,GODBIT!OCTNUM,SETVAL>
IFN FTCJOB&FTCLASS,<
.SS. BACKCL,IBBCLA,BBCLA,GODBIT,SETVAL
>
IFN FTMBCH,<.SS. BCHREQ,0,BCHREQ,GODBIT!NEGBIT!BMPBIT,SETVAL>
IFN FTCASE,<.SS. CASE,PL.NLC>
.SS. CCTRAP,PL.CCT ;;[1202]
IFN FTCJOB,<.SS. CJREQ,ICJREQ,CJREQ,GODBIT!NEGBIT!BMPBIT,SETVAL>
IFN FTCJOB,<.SS. CJTIM,IDFTIM,DEFTIM,GODBIT,SETVLR>
IFN FTCJOB,<.SS. COJOBS,777777,WHONOT,GODBIT,SETLBT>
.SS. COLUMN1,PL.CL1
.SS. CONTROL,PL.CTL
IFN FTCJOB,<.SS. DATASET,GL.DSL,WHONOT,GODBIT,SETLBT>
IFN FTCJOB&FTCLASS,<
.SS. DEFCLA,IDFCLA,DEFCLA,GODBIT,SETVAL
>
IFN FTCJOB,<.SS. DEFTIM,IDFTIM,DEFTIM,GODBIT,SETVLR>
.SS. FINMATCH,PL.%FN
.SS. LC,PL.NLC
.SS. LOGALL,,PR.ALL
.SS. LOGNONE,,PR.LGN!PR.TIM
IFN FTCJOB&FTCLASS,<
.SS. MAXCLA,IMXCLA,LIMCLA,GODBIT,SETVLL
>
.SS. MAXLVL,IMXLVL,MAXLVL,GODBIT,SETVAL
IFN FTCJOB,<.SS. MAXTIM,IMXTIM,LIMTIM,GODBIT,SETVLL>
IFN FTCJOB&FTCLASS,<
.SS. MINCLA,IMNCLA,LIMCLA,GODBIT,SETVLR
>
.SS. MSGLVL,0,0,0,SETMSG
IFN FTOPR!FTCJOB,<.SS. MICOPR,1,MICOPR,GODBIT!OCTNUM,SETVAL>
.SS. NO,,,,UNSET
.SS. PARAMETER,PL.PRM
IFN FTCJOB,<.SS. PTYCJB,GL.ITY,WHONOT,GODBIT,SETLBT>
IFN FTCJOB,<.SS. REMOTE,GL.REM,WHONOT,GODBIT,SETLBT>
IFN FTCJOB,<.SS. REMSTA,GL.RBS,WHONOT,GODBIT,SETLBT>
.SS. SILENCE,PL.NSL ;;[1111]
.SS. SPECIAL,PL.NSP
.SS. TIMESTAMP,,PR.TIM
.SS. TRACE,PL.TRL,,,USTPRF ;;[1073]
>
DEFINE .SS. (NAME,LBIT,RBIT,PRVBIT,DSP),<
<SIXBIT/NAME/>
>
SETTBL: SETS
SETLEN==.-SETTBL
DEFINE .SS. (NAME,LBIT<0>,RBIT<0>,PRVBIT,DSP),<
IFB <LBIT>,<XBIT=0>
IFNB <LBIT>,<
IFN <LBIT&777777000000>,<
XBIT=<LBIT>_<-^D18>
>
IFE <LBIT&777777000000>,<
XBIT==LBIT
>
>
<XBIT,,RBIT>
>
SETBIT: SETS
DEFINE .SS. (NAME,LBIT,RBIT,PRVBIT<.....>,DSP<SETPRF>),<
XWD PRVBIT,DSP
>
DSPSET: SETS
UNSET: TDZA N,N ;SET NO <COMMAND>
.SET: SETO N, ;HERE ON A MIC SET COMMAND
PUSHJ P,WDREAD ;GET THE ARG
PUSH P,N ;SAVE N OVER CALL TO FNDNAM
MOVE T1,[-SETLEN,,SETTBL]
PUSHJ P,FNDNAM
JRST SETRNG
POP P,N ;UNSAVE
MOVE T2,DSPSET(T1) ;GET THE DISPATCH BITS
SKIPL T2
JRST (T2) ;DISPATCH
PUSHJ P,PRVCHK ;IS HE GOD LIKE
JRST SETNPV ;NO
JRST (T2) ;YES
;
USTPRF: SETCA N,0 ;;[1073] SET MEANS TURN BIT ON
SETPRF: JUMPE S,LETER3 ;MUST BE RUNNING MIC
MOVE T3,SETBIT(T1) ;YES - GET ITS BITS
SETPR3: PUSHJ P,OTHUSR ;GET IN CONTEXT
JRST LETER3 ;[773]NOT RUNNING MIC!
SKIPL N ;SET OR UNSET
SKIPA T1,[IORM T3,PROFLE(T2)] ;SET
MOVE T1,[ANDCAM T3,PROFLE(T2)] ;UNSET
SETPR2: WENABL ;OPEN HI SEG
XCT T1
PUSHJ P,CHARSG ;GET NEXT SIGN. CHAR.
CAIN CH,"," ;IS IT A COMMA
JRST .SET ;YES SET SOME MOR THINGS
JRST DOTTY ;DUN
SETRNG: ERROR. UKA,<Unknown argument>
SETNPV: ERROR. NPV,<Privilege violation on MIC SET Command> ;[1205][1134]
; HERE TO SET MSGLEVEL
;
SETMSG: PUSH P,N ;SAVE SET/NOSET STATUS
PUSHJ P,OCTIN ;READ AN OCTAL NO.
SKIPN N1 ;DID WE READ ANYTHING?
SETO N, ;NO SET EVERYTHING
ANDI N,PL.USR ;JUST MEANINGFUL BITS
HRLZ T3,N ;GET IN CONTEXT
POP P,N ;GETSET/NOSET BACK
JRST SETPR3 ;AND FALL INTO SET PROFILE STUFF
;HERE ON A SET COMMAND TO SET A MIC PARAMETER
SETVLL: PUSH P,[HRLM N,(T1)] ;SET THE LEFT HALF
JRST .+4
SETVAL: PUSH P,[MOVEM N,(T1)] ;SET THE WHOLE WORD
SKIPA
SETVLR: PUSH P,[HRRM N,(T1)] ;SET THE RIGHT HALF
JUMPE N,DFLTST
TLNN T2,OCTNUM ;IN OCTAL?
SKIPA T3,[PUSHJ P,INTIN] ;NO
MOVE T3,[PUSHJ P,OCTIN] ;YES
XCT T3
SKIPN N1 ;ANYTHING READ
DFLTST: HLRZ N,SETBIT(T1) ;NO-- USE DEFAULT
HRRZ T1,SETBIT(T1) ;WOT R WE 2 SET
WENABL ;OPEN HI SEG
TLNN T2,NEGBIT ;DO WE WANT TO FIX -VE
JRST .+3 ;NO
SKIPL N ;YES IS IT -VE ALREADY
MOVNS N ;NO--FIX IT
POP P,T3 ;GET THE SET ROUTINE
XCT T3 ;OBEY IT
TLNN T2,BMPBIT ;DO WE WANT TO RECOMPUTE CORE
JRST DOTTY ;UP AND AWAY
AOS COMCNT ;YES
MOVE T1,MASTNO ;GET THE MASTER'S JOB NO.
WAKE T1, ;WAKE HIM UP
JFCL
JRST DOTTY ;AND ON OUR WAY
;PRVCHK - CHECK IF GODLIKE [1,2]
PRVCHK: TLNE F,FLS.GD ;[1140] DO WE KNOW ALREADY?
JRST CPOPJ1 ;[1140] IF YES, EXIT
IFE FTNIHG,< ;[1140]
SETZ T3,
GETPPN T3, ;GET HIS PPN
JFCL
CAME T3,[1,,2] ;IS HE ??
> ;[1140]
IFN FTNIHG,< ;[1140]
HRROI T3,.GTPRV ;[1140] GET PRIV WORD
GETTAB T3, ;[1140] FROM THE MONITOR
POPJ P,0 ;[1140] OOOOHHH
TRNN T3,200000 ;[1140] IS THE SPECIAL NIH BIT SET?
> ;[1140]
POPJ P,0 ;[1140] NO
TLO F,FLS.GD
JRST CPOPJ1 ;[1140] HE IS THE ONE
;HERE TO SET BITS IN A WORD SPECIFIED BY THE COMMAND
SETLBT: HLLZ T3,SETBIT(T1) ;SET THE BIT IN THE L.H.
SKIPA
SETRBT: HLRZ T3,SETBIT(T1) ;SET THE BIT IN THE R.H.
HRRZ T2,SETBIT(T1) ;GET THE WORD
SKIPL N ;DID HE SAY SET OR UNSET
SKIPA T1,[IORM T3,(T2)] ;SET
MOVE T1,[ANDCAM T3,(T2)] ;UNSET
JRST SETPR2 ;AND FALL INTO SET PROFILE STUFF
SUBTTL SLAVE PROCESS - GOTO COMMAND
.BACK: TDZA P4,P4 ;BACK TO
.GO: MOVEI P4,1 ;GO TO
PUSHJ P,WDREAD ;GO/BACK ??????
CAME WD,[SIXBIT/TO/] ;GOT TO BE "TO"
JRST NOLAB ;[1205]
JRST .BACKTO(P4) ;THE REST AS BACKTO/GOTO
.BACKTO:TDZA P4,P4 ;READY FOR BLAB
.GOTO: MOVEI P4,1 ;READY FOR LAB
JUMPE S,.GT1 ;NOT RUNNING MIC
PUSHJ P,WDREAD ;GET THE LABEL
JUMPE WD,NOLAB ;NONE THERE
WENABL ;OPEN HI SEG
PUSHJ P,OTHUSR ;SET UP TEMP X & Y
HALT ;HE'S NOT THERE!
ADD T2,P4 ;BLAB OR LAB
MOVEM WD,BLAB(T2) ;STORE THE LABEL
JRST DOTTY ;STOP NICELY
NOLAB: ERROR. NAL,<No argument for label>
.GT1: PUSHJ P,WDREAD ;GET LABEL
CAME WD,[SIXBIT/HELL/];[776]DID HE TYPE GOTO HELL
JRST E%%NRM ;[776]NO, NOT RUNNING MIC
OUTSTR [ASCIZ/Get stuffed/] ;YES - TELL HIM OFF!
JRST FAILED ;[1154]AND DIE
;HERE WHEN USER TYPES CANCEL
.CANCEL:TLO S,LDL.CC ;FLAG A ^C
IFN FTCJOB,< ;[1000]
SKIPE CJOWNR(X) ;[1000]SKIP IF HE IS NOT A COJOB
PUSHJ P,FRCMON ;[1000]OTHERWISE GIVE HIM A ^C
> ;[1000]END OF IFN FTCJOB
MIC SET,L
;HERE ON MIC EXIT
.EXIT: MIC CLEAR,L ;HE'S NOT RUNNING MIC NOW
JFCL ;[1204] OOOOOPS
EXIT00: PUSHJ P,OTHUSR ;[1204] IS MASTER STILL AROUND?
JRST DOTTY ;[1204] EXIT IF NOT
SKIPE CJOWNR(T2) ;[1204] OR ARE WE A COJOB?
JRST DOTTY ;[1204] EXIT IF YES
PUSHJ P,HIBER2 ;[1204] WAIT TWO SECONDS
JRST EXIT00 ;[1204] AND TRY AGAIN
SUBTTL LET COMMAND
;DECODE CONSTRUCTION OF THE FORM
;LET <PARAMETER REFERENCE NAME><= OR _><STRING OR INT EXPRESION>
.LET: MOVEM L,LLX ;SAVE THE LINE NO.
PUSHJ P,CHARIT ;CHECK LEGAL TERMIN
JRST LETERR ;NOT A LEGAL TERMINATOR
MOVEM CH,CH.SAV
.LET1: PUSHJ P,PRMINT ;[1031] INTRODICE THE PARAMETER
PUSHJ P,PRMIN ;GET THE PARAMETER NAMED IN
CAIE CH,"="
CAIN CH,"_" ;= OR _ OK HERE
PUSHJ P,CHARIU
JRST LETER2 ;SYNTAX ERROR
CAIE CH,"$" ;COULD BE STRING REF
CAIN CH,42 ;QUOTE?
.LET3: JRST LETSTR ;MUST BE A STRING
MOVEM CH,CH.SAV ;PUT BACK THAT WHICH WE SHOULD NOT HAVE EATEN
;HERE TO DECODE INTEGER EXPRESSION AND PRODUCE STRING AS DECIMAL RESULT
PUSHJ P,INIVAL ;PREPARE TO READ INTEGER EXPRESSION
PUSHJ P,PPOLISH ;GO DECODE INTEGER EXPRESSION
JRST SLENDX ;SYNTAX ERROR GIVE UP
MOVE N,N1
MOVEI A,FIRST
HRLZI T1,440700!A
PUSH P,LOWOUT
MOVE T2,SPLODG
MOVEM T2,LOWOUT ;PREPARE TO WRITE DECIMAL RESULT TO FIRST
MOVEI T2,DECPRT ;[1031] DEFAULT IS DECIMAL
TLNE F,FLS.OA ;[1031] BUT WERE WE DOING OCTAL?
MOVEI T2,OCTPRT ;[1031] YES
PUSHJ P,(T2) ;[1031] DO APPROPRIATE
SETZ CH,
SPLODG: IDPB CH,T1 ;MAKE ASCIZ
POP P,LOWOUT
;HERE WITH STRING IN FIRST .....NOW FIND SOME SPACE FOR IT
.LET2: SKIPGE LLP
POPJ P,0
PUSHJ P,PRMFIX ;COPY UP PARAMETER
WLOCK ;CLOSE HI SEG
PUSHJ P,CHARIN ;GET NEXT SIGNIFICANT CHARACTER
CAIE CH,"," ;IF NEXT CHAR IS A COMMA
JRST DOTTY
JRST .LET1 ;....GET NEXT ASSIGNMENT
;HERE TO DECODE STRING ASSIGNMENT
;LET <PARAMETER NAME><= OR _>"<STRING>"
LETSTR: TLNE F,FLS.OA ;[1031] DID HE SAY OCTAL?
JRST LETERR ;[1031] YES, THE FOOL!
MOVEI A,FIRST
PUSHJ P,INSTR
JRST .LET2 ;GO FIND SOME SPACE
;
; Here to check up on expressions of the form
; .LET <ich><parameter>=expression
; and allow the introductory character <ich> to be
; % - means octal
; $ - means string (noop)
;
PRMINT: PUSHJ P,PINCH ;[1031] GET NEXT CHARACTER
TLZ F,FLS.OA ;[1031] CLEAN UP IN ADAVANCE
CAIE CH,"%" ;[1031]C IS IT PERCENT
CAIN CH,"$" ;[1031] OR A DOLLAR
SKIPA ;[1031] ONE OF DESE
MOVEM CH,CH.SAV ;[1031] STORE THAT WHICH WE SHOULD NOT HAVE EATEN
CAIN CH,"%" ;[1031] WAS IT A PERCENT?
TLO F,FLS.OA ;[1031] YES, MEANS HE IS DELVING INTO OCTAL
POPJ P,0 ;[1031] THATS ALL FOLKS
PRMIN: PUSHJ P,CHARIN ;GET NEXT SIG CHAR
PUSHJ P,LOWUP ;CONVERT LOWER CASE TO UPPER
CAIL CH,"A"
CAILE CH,"A"+ARGNUM-1 ;CHECK PARAMETER NO.
JRST LETER1 ;OUT OF RANGE
MOVEM CH,LLP ;SAVE PARAMETER NAME
PUSHJ P,DECIN ;GET QUALIFIER TO PARAMETER
MOVEM N,LEVEL ;IT REFERS TO OUTER PROCESS
POPJ P,0
PRMFIX: MOVE L,LLX ;FIND APPROPRIATE PDB
PUSHJ P,OTHUSR
JRST LETER3 ;NONE THERE ....FATAL
MOVE P2,T2 ;PRESERVE X .ER
SKIPE N,LEVEL ;DID HE REFER TO OUTER LEVEL?
PUSHJ P,UP ;YES-FIX UP
PUSHJ P,DELETE ;DELETE OLD PARAMETER & SETUP LLP
PUSHJ P,HOLE ;FIND SPACE FOR PARAMETER
JRST LETER4 ;NONE THERE
PUSH P,P1 ;PRESERVE .ER TO NEW SPACE
MOVEI T1,FIRST
HRLI T1,440700 ;PREPARE TO COPY GENERATED STRING
WENABL ;OPEN HI SEG
COPY: ILDB CH,T1 ;FROM FIRST ...
IDPB CH,P1 ;... TO NEW SPACE
JUMPN CH,COPY ;UNTIL END OF STRING IN FIRST
MOVE T1,LLP ;OFFSET TO NEW PARAMETER BYTE .ER
POP P,(T1) ;& INITIALIZE TO NEW PARAMETER
POPJ P,0
;ROUTINE TO READ NEXT SIGNIFICANT CHARACTER I.E. IGNORE SP. AND TAB
CHARIT: CAIE CH," "
CAIN CH," "
CHARIU: AOS (P)
CHARIN: PUSHJ P,PINCH
CHARSG: CAIN CH," "
JRST CHARIN
CAIN CH," "
JRST CHARIN
POPJ P,0
;A ROUTINE TO DELETE EXISTING PARAMETER IF ANY AND FIX UP PARAMETER NAME
DELETE: MOVEI T3,ARGBP(P2) ;P2 POINTS TO PDB
SUBI T3,"A"
ADDB T3,LLP ;C(LLP)=NEW PARAMETER NO.!
SKIPN T4,(T3) ;IF THERE IS NO OLD PARAMETER
POPJ P,0 ;...EXIT NOW
WENABL ;OPEN HI SEG
PUSHJ P,LOSE1
WLOCK ;CLOSE HI SEG
POPJ P,0
LOSE1: ILDB CH,T4 ;PICK UP
TDZN CH,CH ;IF IT WAS ZERO ALREADY
POPJ P,0 ;THEN EXIT
DPB CH,T4 ;ELSE HAVING ZEROED IT
JRST LOSE1 ;GO LOSE THE NEXT BYTE
;HERE TO ADJUST POINTER TO AN OUTER LEVEL
UP1: MOVEI T2,-1(P2)
UP: SKIPN P2,LAST(T2) ;SUSPENDED OUTER PROCESS?
JRST UPERR ;NO SUCH PROCESS
SOJG N,UP1 ;NEDD TO GO UP SOME?
SOJA P2,CPOPJ ;NO WE ARE THERE
UPERR: ERROR. PNP,<Attempted reference to parameter in nonexistent outer process>
;A ROUTINE TO FIND SPACE IN PDB PARAMETER AREA FOR THE STRING
;HELD IN FIRST P2 POINTS TO PDB
HOLE: HRLI T1,440700
HRRI T1,ARG(P2) ;C(T1):= BYTE .ER TO PARAMETER SPACE
HRLI P3,440700
HRRI P3,FIRST ;C(P3):= BYTE .ER TO NEW PARAMETER STRING
MOVSI T4,-ARGSIZ*5+2 ;[1114] NO. OF BYTES AVAILABLE IN PDB
MOVE T3,P3
SETZ P1, ;THIS IS A BYTE POINTER TO A NULL STRING!
ILDB CH,T3 ;QUICK LOOK AT FIRST BYTE
JUMPE CH,CPOPJ1 ;NO NEED TO FIND A HOLE FOR A NULL STRING
HOLE1: MOVE T3,P3 ;STARTING AT FIRST
HOLE2: ILDB CH,T1 ;LOAD A CHAR FROM PARAMETER AREA
AOBJP T4,CPOPJ ;IF WE HAVE EXHAUSTED THE AREA
JUMPN CH,HOLE2 ;SEARCH FOR NULL BYTE
;HERE WHEN WE HAVE FOUND A NULL BYTE IN RANGE IN THE PARAMETER AREA
MOVE P1,T1 ;REMEMBER WHERE WE FOUND IT
HOLE3: ILDB CH,T1 ;PICK UP NEXT BYTE IN THE PARAMETER AREA
AOBJP T4,CPOPJ ;IF IT IS NOT IN RANGE EXIT
JUMPN CH,HOLE1 ;IF IT IS NOT NULL START AGAIN
;YES-WE HAVE SPACE FOR A BYTE
ILDB CH,T3 ;IS THERE A BYTE FROM FIRST TO PUT THERE?
JUMPN CH,HOLE3 ;YES-GO FIND SPACE FOR NEXT BYTE
;NO-WE HAVE ALL THE SPACE WE NEED
AOS (P)
POPJ P,0
;LET COMMAND ERROR MESSAGES
BUNGLE:
LETERR: ERROR. ILC,<Illegal character >,CHTYP
LETERX: PUSHJ P,POLTYP
JRST CHTYP
LETER1: ERROR. PMB,<Parameter must be A-Z, not >,CHTYP ;[1134]
LETER2: ERROR. ASS,<Assignment symbol should be = or _, not >,CHTYP ;[1205][1134]
LETER3: ERROR. NRM,<Not running MIC>
LETER4: ERROR. PSE,<Parameter space exhausted>
SUBTTL RESPONSE COMMAND - READ ERROR LINE FEATURE
;MIC RESPONSE AN(N1)
; AN=PARMETER AND QUALIFIER TO GET ERROR LINE
; N1=NO OF CHARS SPACE TO BE RESERVED FOR ERROR LINES
.RESPO: MOVEM L,LLX
PUSHJ P,PRMIN ;READ PARAMETER PLUS QUALIFIER
CAIE CH,"("
JRST E%%RCL
PUSHJ P,DECIN
CAIE CH,")" ;MUST BE AN(N1)
CAIG N,^D79
CAIG N,0
JRST E%%MRC ;[1030] CLEAN UP
MOVEI BP,FIRST ;WHERE THE ROUTINES EXPECT THE PARAMETER TO BE
HRLI BP,440700
MOVEI CH," " ;FILL WITH SPACES
IDPB CH,BP
SOJG N,.-1
SETZ CH,
IDPB CH,BP ;MAKE ASCIZ
PUSHJ P,PRMFIX ;COPY UP PARAMETER
MOVEM T1,RS(P2) ;REMEMBER WHERE HE WANTS RESPONSE TO GO
WENABL ;OPEN HI SEG
MOVE L,LLX
MIC GET,L ;GET THE LINE CHARACTERISTICS AGAIN
HALT
TLO S,LDL.RS
JRST DOTMIC ;SET FLAG TO REQUEST FEATURE AND EXIT
ERROR. MRC,<Max RESPONSE is 79 characters>
ERROR. RCL,<RESPONSE command must specify response length>
SUBTTL IF COMMAND
;HERE ON FINDING IF COMMAND --- DECODE THE CONTENTS OF ()
.IF: MOVEM L,LLX ;SAVE LINE NUMBER FOR OTHUSR
PUSHJ P,CHARSG ;GET NEXT SIG. CHAR
CAIE CH,"(" ;HAVE WE GOT A ( ?
JRST E%%NCD ;[1061] NO - ERROR
PUSHJ P,ALPHI ;GET ALPHA WORD
JUMPE WD,EXPRES ;MUST BE SOME OTHER FLAVOUR OF CONDITIONAL EXPRESSION
CAIE CH,")" ;THE CONTENTS OF () IN WD WAS THAT A )
JRST AXPRSN ;[1061] NO
MOVE T1,[-PROSIZ,,PROTAB] ;TABLE INFO.
PUSHJ P,FNDNAM ;SEARCH IT
JRST E%%CDN ;[1061] FAILED
JRST @PRODSP(T1) ;AND DISPATCH REGARDLESS
ERROR. NCD,<No conditional>,CHTYP
DEFINE IF.COND,<
.IF. BATCH
.IF. COJOB
IFN FTMBCH,< .IF. CBATCH>
.IF. ERROR
.IF. NOERROR
.IF. ONLINE
IFN FTMBCH,< .IF. TBATCH>
.IF. TERMINAL
.IF. SUBJOB
>
DEFINE .IF. (NAME),<
<SIXBIT/NAME/>
>
PROTAB: IF.COND
PROSIZ==.-PROTAB
DEFINE .IF. (NAME),<
XWD 0,<%'NAME>
>
PRODSP: IF.COND
;HERE TO DECIDE WHETHER IT WAS A STRING OR AN INTEGER CONDITIONAL EXPRESSION IN ()
EXPRES: SETZM CH.SAV ;CLEAR THE CHAR BUFFER
CAIE CH,"$" ;REFSTRING?
CAIN CH,42 ;QUOTE?
JRST STRING
MOVEM CH,CH.SAV ;MUST HAVE EATEN BIT OF INTEGER EXPRESSION
JRST POLISH ;GO DECODE IT
IFERR2: PUSHJ P,BUNGLE
CHTYP: CAIGE CH," "
JRST ILCH2
OUTSTR [ASCIZ/ "/]
OUTCHR CH
OUTSTR [ASCIZ/"/]
ILCH2: OUTSTR [ASCIZ/ octal /]
MOVE N,CH
PUSHJ P,OCTPRT
JRST SLENDX
;THAT WAS A FUNNY CONDITIONAL
AXPRSN: TLZ F,FLS.8 ;[1061] MAKE SURE THE OCTAL FLAG IS CLEAR
MOVEM CH,CH.SAV ;[1061] SAVE THE TERMINATOR
PUSHJ P,INIVAL ;[1061] EXPESSION INITIALLISE
PUSH P,[AXPRTN] ;[1061] SET UP A SPECIAL RETURN
PUSH P,STK ;[1061] AND SET THE STACK UP PROPER
PJRST ATOM3 ;[1061] SORT OF PUSHJ!
AXPRTN: ;[1061] WHIC WILL RETURN HERE!
PUSHJ P,PPOL1 ;AND READ IN THE REST OF THE CONDITIONAL
JRST FAILED ;SYNTAX ERROR MAKES FALSE
JRST POL1
IFERX: ERRMS. CDN,<Conditional ">
PUSHJ P,POLTYP
PUSHJ P,SIXBP
OUTSTR [ASCIZ/" not defined/]
JRST SLENDX
;JS BIT TO O/P ERROR MESSAGES FOR BAD GETTABS
IFERR4: PUSHJ P,POLTYP ;ON ERROR EXIT FROM GETTAB
;T1 HOLDS ADDRESS OF ERROR MESSAGE
JRST SLENDX
;END OF THIS JS BIT
IFN FTCJOB,<
;HERE ON CONDITION COJOB
%COJOB: PUSHJ P,OTHUSR
JRST FAILED
SKIPE CJOWNR(T2)
JRST TRUE
JRST FALSE ;PROVIDE A METHOD THAT ALLOWS A USER TO DETECT IF COJOB
> ;END OF CONDITION COJOB
IFN FTMBCH,<
;HERE ON CONDITION BATCH
;[1120] %TBATCH AND %CBATCH CHANGED SINCE NO-ONE EVER SET BTL.CD
%TBATCH:
SKIPA T1,[TLNN T2,BTL.TM] ;GET TEST FOR TBATCH
%CBATCH:
MOVE T1,[TLNE T2,BTL.TM] ;TEST FOR CBATCH
SKIPA
%BATCH: MOVE T1,[SKIPA] ;BATCH DOESN'T TEST
SETO T3, ;ANY BIT
PUSH P,T1
PUSHJ P,OTHUSR ;GET IN CONTEXT
JRST [POP P,T1
JRST FAILED]
POP P,T1
MOVE T2,BATWRD(T2) ;GET BATCH WORD
TDNE T3,T2 ;IS IT A BATCH JOB?
XCT T1 ;YES DO SPECIFIC TEST
JRST FALSE ;FAILED
JRST TRUE ;ALL OK
;PROVIDES A MEANS TO ALLOW THE USER TO DETECT IF BATCH JOB
>;END OF IFN FTMBCH
IFE FTCJOB,<
%COJOB: JRST FALSE
>
IFE FTMBCH,<
;IF WE DONT SUPPORT MIC BATCH, CHECK FOR NORMAL BATCH
%BATCH: PUSHJ P,GTBOSS ;FIND OUT WHO IS BOSS
JRST FAILED ;NONE
CAME T1,['BATCON'] ;IS DADDY BATCH
JRST FAILED ;NO
JRST TRUE ;YEP
>
;HERE TO FIND IF WE ARE A SUBJOB OF OPSER
%SUBJOB:
PUSHJ P,GTBOSS ;GET THE BOSS
JRST FAILED ;NONE
CAME T1,['OPSER'] ;IS IT?
JRST FAILED
JRST TRUE ;YEP
;HERE TO FIND OUT IF WE ARE ON A TTY?
%ONLINE:
%TERMINAL:
PUSHJ P,GTBOSS ;GET THE BOSS
JRST TRUE ;NONE, THUS WE ON TTY
JRST FAILED ;MUST BE ON PTY
;HERE TO FIND OUT WHO (IF ANYONE) CONTROLS OUR TTY
GTBOSS: SETO T1, ;ARG FOR
GTBOSM:: CTLJOB T1, ;THIS UUO
POPJ P,0
SKIPG T1 ;WHICH GET THE JOB NO.
POPJ P,0 ;IF ANY
HRLZS T1 ;OF OUR OWNER, FROM WHICH
HRRI T1,.GTPRG ;WE GET THE OWNERS PROGRAM NAME
GETTAB T1,
POPJ P,0
AOS (P)
POPJ P,0 ;AND RETURN
;HERE ON CONDITION (ERROR)
%NOERROR:TLC S,LDL.ER
%ERROR: TLNN S,LDL.ER ;IS THAT TRUE?
PUSHJ P,FNDEOL ;JUST EAT THE REST OF THE LINE
TLZ S,LDLCHK!LDL.ER!LDL.TI!LDL.AJ!LDL.MM ;[1115]
MIC SET,L ;CLEAR ERROR BITS
JFCL
JRST TRUE
;
DOTMIC: TLZ S,LDLCHK!LDL.ER!LDL.TI!LDL.AJ!LDL.MM ;[1115]
MIC SET,L ;[1115]CLEAR VOLATILE BITS
JFCL ;[1115] HMMM
DOTTY:
CAIN CH,"\" ;E.O.L CHAR. (BY DEFN.)
JRST DOTTY1 ;LET COMCON EAT THE REST OF THE LINE
CAIN CH,"." ;IF THIS IS A DOT
JRST EXIT1 ;LET COMCON EAT WHAT FOLLOWS
PUSHJ P,ISBRK ;IF IT IS A BREAK
JRST [CAIE CH,CR ;CARRIAGE RETURN?
JRST EXIT1
JRST .+1]
DOTTY1: PUSHJ P,CHARIN
JRST DOTTY ;ELSE GO ROUND
FNDEOL: PUSHJ P,ISBRK ;BREAK ALREADY?
POPJ P,0 ;YES
PUSHJ P,CHARIN ;NO-GET THE NEXT CHAR
JRST FNDEOL ;AND SEE IF THAT IS A BREAK
TRUE: PUSHJ P,TRUFLS ;[1073] DISPLAY THE [TRUE] TEXT
OUTSTR [ASCIZ /
[TRUE]
/] ;[1073][1130]
JRST DOTTY
FALSE: PUSHJ P,TRUFLS ;[1073] DISPLAY THE [FALSE] TEXT
OUTSTR [ASCIZ /
[FALSE]
/] ;[1073][1130]
JRST FAILED
;
; Display the string at called address+1
;
TRUFLS: MOVE L,LLX ;[1073] GET THE SAME LINE NO.
PUSHJ P,OTHUSR ;[1073] GET IN CONTEXT
JRST E%%NRM ;[1073] NOT RUNNING MIC
MOVSI T1,PL.TRL ;[1073] GET THE TRACE FLAG
TDNN T1,PROFLE(T2) ;[1073] SEE IF IT IS SET
AOS (P) ;[1073] IF NOT SKIP OVER THE MESSAGE AND RETURN
POPJ P,0 ;[1073] AND DO THE RETURN
;HERE TO DEAL WITH CONSTRUCTIONS OF THE FORM
;<STRING>"<CONDITIONAL OPERATOR>"<STRING>"
STRING: MOVEI A,FIRST ;GET IN THE FIRST STRING
PUSHJ P,INSTR
PUSHJ P,LEGREQ ;GET IN THE CONDITIONAL OPERATOR
JRST STRER1 ;WOT!
PUSHJ P,CHARIN
CAIN CH,"$" ;COULD BE REF STRING PARAM
JRST STRIN2 ;IT WAS
CAIE CH,42 ;GET DELIMETER TO THE NEXT STRING
JRST STRER2 ;ILLEGAL
STRIN2: MOVEI A,SECOND ;GET IN THE SECOND STRING
PUSHJ P,INSTR
;HERE TO CHECK STRINGS AGREE WITH THE CONDITION IN BOOL
MOVE A,STRP1
MOVE B,STRP2
PUSH P,L ;SAVE L
MOVE L,LLX ;GET LINE NO.
PUSHJ P,OTHUSR ;SET UP PDB ADDRESS.
JRST E%%NRM ;NOT RUNNING MIC?????
POP P,L ;RESTORE L
STRLUP: ILDB N,A
ILDB N1,B ;PICK UP CORRESPONDING BYTES
MOVSI T1,PL.NLC ;GET THE NO LOWER CASE BIT
TDNN T1,PROFLE(T2) ;DOES HE WANT LOWER CASE?
JRST STRLP0 ;JUMP IF YES
CAIL N,141 ;CHECK IF THIS IS
CAILE N,172 ;A LOWER CASE CHAR
SKIPA ; IT ISNT
TRZ N,40 ;IT IS, MAKE IT UPPER CASE
CAIL N1,141 ;IS THIS LOWER CASE
CAILE N1,172 ;EH?
SKIPA ;NO
TRZ N1,40 ;YES, MAKE IT UPPER
STRLP0: CAME N,N1 ;IF THEY ARE NOT THE SAME TEST NOW
JRST STRCHK
JUMPE N,STRCHK
JUMPN N1,STRLUP ;CHECK ALSO IF EITHER STRING EXHAUSTED
STRCHK: XCT BOOL ;TEST THE CONDITIONAL
JRST FALSE
JRST TRUE
STRP1: POINT 7,FIRST
STRP2: POINT 7,SECOND
STRER1:ERROR. UCO,<Unknown conditional operator >,CHTYP
STRER2:ERROR. MOT,<Mismatch of types>
;A ROUTINE TO READ A STRING DELIMETED BY A QUOTE
INSTR: CAIE CH,"$" ;REF STRING PARAM?
JRST INSTR0 ;NO TWAS STRING CONSTANT
PUSHJ P,ALPHI ;GET IT'S NAME
MOVSI T3,-SYMSIZ ;WOT IS IT?
CAME WD,SYMTAB(T3) ;IS IIT ONE OF THESE?
AOBJN T3,.-1
JUMPLE T3,IFNPRM ;IF T1 #0 IT IS!
TLNE WD,7777 ;WE SHOULD BE LEFT WITH 1 SIXBIT CHAR.
JRST IFERR2 ;BUT WE HAD MORE!
LSH WD,-36 ;MAYBE IT'S A THRO' Z
CAIL WD,'A'
CAILE WD,'A'+ARGNUM-1
JRST IFERR2 ;IT'S NOT!!
MOVEM CH,CH.SAV ;JUST IN CASE WE HAVE BEEN GREEDY
MOVEI CH," "(WD) ;IT IS!!!
PUSH P,A ;SAVE THE IMPORTANT AC
PUSHJ P,REFBP ;COMPUTE POINTER TO PARAMETER
POP P,A ;RESTORE AC
INSTR5: HRLZI T1,440700!A ;MAKE BYTE POINTER TO STRING CONSTRUCTION SPACE
INST5A: ILDB CH,BP
TLNE F,FLS.UA ;[1021] DOES HE WANT UP-ARROW STUFF?
CAIE CH,"^" ;[1021] YES, IS THIS AN UP-ARROW?
SKIPA ;[1021] NO TO EITHER
PUSHJ P,[ ILDB CH,BP ;[1021] GET NEXT CHARACTER
JRST STRARW ] ;[1021] GO DEAL WITH POSS. UP-ARROW
IDPB CH,T1 ;SHOVEL PARAMETER INTO SCRATCH SPACE
JUMPN CH,INST5A
JRST INSTR3 ;GO DO SUBSCRIPT OR CON CATONATION
STRARW: CAIN CH,"^" ;[1021] IS IT ANOTHER ARROW?
POPJ P,0 ;[1021] IF YES HE MEANT "^"
PUSHJ P,LOWUP ;[1021] CONVERT LOWER CASE TO UPPER IF REQD.
SUBI CH,100 ;[1021] CONTROLLISE THE CHRACTER
JUMPL CH,E%%ICA ;[1021][1030] OOOH NASTY
POPJ P,0 ;[1021] ALL DONE
ERROR. ICA,<Invalid character follows caret ("^")>
INSTR0: CAIE CH,42
JRST IFERR2
HRLZI T1,440700!A ;A. NOW POINTS TO STRING
INSTR1: PUSHJ P,PINCH ;GET A CHARACTER
CAIN CH,42 ;QUOTE?
JRST QUOTED ;YES
CAIN CH,LF
OUTSTR [ASCIZ/--/]
INSTR2: TLNE F,FLS.UA ;[1021] DOS HE WANT UP-ARROW CONVERSIONS?
CAIE CH,"^" ;[1021] YES AND IS THIS ONE?
SKIPA ;[1021] NO TO EITHER
PUSHJ P,[ PUSHJ P,PINCH ;[1021] GET THE NEXT CHARACTER
JRST STRARW ] ;[1021] AND GO DO THE ARROW STUFF
IDPB CH,T1 ;NO - JUST DEPOSIT THAT CHAR
JRST INSTR1 ;AND GET NEXT
QUOTED: PUSHJ P,PINCH ;GET NEXT CHAR
CAIN CH,42 ;QUOTE?
JRST INSTR2 ;YES - LET HIM HAVE THAT ONE FREE
EXCH CH,CH.SAV ;NO - NOTHING TO DO WITH US PUT IT BACK
IDPB CH,T1 ;MAKE ASCIZ
INSTR3: PUSHJ P,CHARIN ;GET NEXT SIGNIFICANT CHAR
INSTR4: CAIN CH,"." ;STRING DELIMETED BY .?
JRST SUBSCR ;YES-MUST BE SUBSCRIPTED
CAIN CH,"+" ;CONCATONATION
JRST CONCAT
MOVEM CH,CH.SAV ;NO-PUT IT BACK AGAIN
POPJ P,
IFNPRM: MOVEM CH,CH.SAV ;SAVE THE TERMINATOR-THIS WILL NOT BE CORRECT IN
; ;THE CASE OF GETTABS
PUSH P,L ;SAVE A (IN DISGUISE!)
MOVE L,LLX ;GET HIS LINE NO.
PUSHJ P,OTHUSR ;SET UP X (JOBNAME ETC NEED IT)
JFCL ;BUT IGNORE POSS. ERROR RETURN
MOVE X,T2 ;GET IN CONTEXT
POP P,L ;GET A BACK !!!
PUSHJ P,SYMGET
JRST IFERR4
JRST INSTR5
;HERE WHEN HAVING READ AN DECODED A STRING PLUS ANY SUBSCRIPTS A + IS FOUND
CONCAT: PUSH P,A ;SAVE A
ADDI A,1(T1) ;POINT PAST EXISTING STRING
PUSHJ P,CHARIN;GET $ OR "
PUSHJ P,INSTR ;AND GET IN THE STRING EXPRESSION U WISH TACKED ON
;HER WHEN A POINTS TO STRING U WISH TACKED ON
MOVE T2,A ;PRESERVE IT
HRLI T2,440700
;AND MAKE BYTE POINTER TO IT IN T2
POP P,A ;NOW T1 IS A BYTE POINTER TO NULL BYTE OF LAST STRING
MOVSI T1,440700!A
ILDB CH,T1
JUMPN CH,.-1 ;SYNC ON LAST BYTE OF CONSTRUCTED STRING
ILDB CH,T2 ;LOADING A BYTE FROM SECOND STRING
DPB CH,T1 ;OVERWRITE NULL BYTE IN FIRST STRING
JUMPE CH,CPOPJ;GIVE UP IF THE STRING WANTED CONCATONATED WAS NULL
ILDB CH,T2
IDPB CH,T1 ;ELSE KEEP SHOVELLING
JUMPN CH,.-2 ;UNTIL TACKED ON ALL OF SECOND STRING
POPJ P,0 ;THEN EXIT
;A ROUTINE TO ADJUST STRING POINTED TO BY C(A) TO REFLECT SUBSCRIPTS
;T1 POINTS TO TERMINATING BYTE IN STRING
;CONSTRUCTION COULD BE "<STRING>".[<STRING OR INT EXPRESSION>,<DITTO>]
;SECOND SUBSCRIPT MAY BE OMMITTED
SUBSCR: PUSHJ P,CHARIN ;GET NEXT SIG. CHAR
CAIE CH,"[" ;GOT TO BE THIS
JRST SUBERR
PUSH P,A ;SAVE A
PUSH P,T1 ;&T1
PUSHJ P,CHARIN
CAIE CH,"$" ;REFSTRING PARAM?
CAIN CH,42 ;QUOTE?
JRST SUBS1 ;YES THIS IS A STRING EXPPRESSION
MOVEM CH,CH.SAV ;NO-REPLACE IT
PUSHJ P,INIVAL ;GET FIRST SUBSCRIPT IN N1
PUSHJ P,PPOLISH
JRST SLENDX ;BAD INTEGER EXPPRESSION
;HERE TO LEFT SHIFT THE STRING ACCORDING TO THE FIRST SUBSCRIPT
SUBSCX: MOVE A,-1(P) ;RESTORE A
MOVSI T1,440700!A
MOVE T2,T1 ;START AT THE BEGGING OF THE STRING
JUMPG N1,SUBSC1 ;ARG POSITIVE PROCEED
TDZA N,N ;CLEAR COUNT AND SKIP
ADDI N,1 ;BUMP STRING LENGTH
ILDB CH,T1 ;LOAD CHAR FROM STRING
JUMPN CH,.-2 ;BUMP COUNT IF SIGNIFICANT
JUMPE N,Z2SUB ;THIS IS A NULL STRING
ADDI N1,1(N) ;ADD ON STRING LENGTH TO NEGATIVE SUBSCRIPT
JUMPLE N1,SUBSC3 ;STILL OUT OF RANGE
MOVE T1,T2 ;RESTORE ORIGINAL BYTE POINTER
SUBSC1: SOJLE N1,SUBSC2 ;COUNT THE SUBSCRIPT DOWN
ILDB CH,T1 ;CHECK THE CHAR.
JUMPE CH,SUBSC3 ;WE HAVE EXHAUSTED THE STRING...
JRST SUBSC1 ;KEEP COUNTING AND CHECKING
;HERE WHEN WE HAVE REACHED THE CORRECT BYTE NUMBER
SUBSC2: ILDB CH,T1 ;MOVE BYTES FROM HERE ON DOWN
SUBSC3: IDPB CH,T2 ;TO THE TOP OF THE STRING ONWARDS
JUMPN CH,SUBSC2 ;KEEP SHIFTING UNTIL MOVED ALL
;HERE WHEN LEFT SHIFTED STRING AFTER FIRST SUBSCIPT
Z2SUB: PUSHJ P,CHARIN ;GET THE NEXT CHAR
CAIE CH,"]" ;END OF SUBSCRIPT?
JRST Z2SUB1 ;NO-CHECK SOME MORE
MOVEI N1,1 ;YES-PRETEND SECOND ARG 1
MOVEM CH,CH.SAV ;FOOL THE REDUNDANT CHECK
JRST Z2SUB3
Z2SUB1: CAIN CH,"," ;GOT TO BE A COMMA
JRST Z2SUB2 ;AND IT IS
SUBERR: ERROR. SIC,<String subscript illegal character >,CHTYP
Z2SUB2: PUSHJ P,CHARIN ;GET THE NEXT CHAR
CAIE CH,"$" ;REF STRING PARAM?
CAIN CH,42 ;QUOTE?
JRST SUBS2 ;YES THIS IS A STRING EXPRESSION
MOVEM CH,CH.SAV ;NO-PUT CHAR BACK
PUSHJ P,INIVAL ;PREPARE TO READ INTEGER EXPPRESSION
PUSHJ P,PPOLISH
JRST SLENDX
;HERE TO TRUNCATE STRING ACCORDING TO THE CONTENTS OF N1 FOR SECOND SUBSCRIPT
Z2SUB3: MOVE A,-1(P) ;RESTORE A
MOVSI T1,440700!A ;POINT TO IT
Z2SUB6: ILDB CH,T1
JUMPE CH,Z2SUB5 ;THIS STRING TOO SHORT ALREADY
SOJG N1,Z2SUB6 ;ELSE COUNT DOWN SECOND SUBSCRIPT
Z2SUB4: SETZ CH,
IDPB CH,T1 ;TRUNCATE THE STRING
Z2SUB5: POP P,T1
POP P,A
PUSHJ P,CHARIN ;MAKE SURE GOOD TERMINATOR
CAIE CH,"]" ;GOT TO BE THIS
JRST SUBERR
PUSHJ P,CHARIN ;GET POTENTIAL . OR +
JRST INSTR4 ;AND CHECK FOR IT
;HERE WHEN FIRST SUBSCRIPT IS A STRING EXPRESSION
SUBS1: PUSHJ P,SCRPTI ;TRY AND FIND MATCH FOR IT
JRST SUBS12 ;NO MATCH FOUND
LDB CH,T1
MOVSI T2,440700!B
JRST SUBSC3
SUBS12: SETZM (B) ;NO MATCH
JRST Z2SUB ;GET NEXT SUBSCRIPT
;HERE WHEN SECOND SUBSCRIPT IS A STRING EXPRESSION
SUBS2: PUSHJ P,SCRPTI ;TRY AND FIND MATCH FOR IT
JRST Z2SUB5 ;NO MATCH DO NOT TRUNCATE
DPB T3,T4
JRST Z2SUB5 ;TRUNCATE
;A ROUTINE TO GET A STRING SUBSCRIPT IN AND FIND MATCH IN OBJECT STRING
SCRPTI: MOVE T1,-1(P) ;RESTORE T1
MOVE A,-2(P) ;AND A
ADDI A,1(T1) ;POINT PAST EXISTING STRING
PUSHJ P,INSTR ;AND GET STRING SUBSCRIPT IN
MOVE B,-2(P) ;B POINTS TO OBJECT STRING
MOVSI T1,440700!B
LDB T4,[POINT 7,(A),6]
JUMPE T4,CPOPJ ;NULL SEARCH STRING
PUSH P,L ;[1040]SAVE L
MOVE L,LLX ;[1040]GET LINE NO.
PUSH P,T1
PUSH P,T4
PUSHJ P,OTHUSR ;[1040]SET UP PDB ADDRESS.
JRST E%%NRM ;[1040]NOT RUNNING MIC?????
POP P,T4
POP P,T1
POP P,L ;[1040]RESTORE L
HLRZ N,PROFLE(T2) ;[1040]GET THE USERS PROFILE
ANDI N,PL.NLC ;[1040]JUST THE NO LOWER CASE BIT
NOMAT2: MOVSI T2,440700!A
ILDB CH,T1 ;PICK UP BYTE FROM OBJECT STRING
SKIPA T4,T1 ;REMEMBER WHERE WE ARE
MAT2: ILDB CH,T1 ;GET NEXT BYTE AFTER LAST BYTE MATCHED
ILDB T3,T2 ;GET NEXT BYTE FROM SEARCH STRING
JUMPE T3,CPOPJ1 ;WE HAVE EXHAUSTED SEARCH STRING --SUCCESS
JUMPE CH,CPOPJ ;NO NEED TO TRUNCATE-TOO SHORT ALREADY
JUMPE N,MAT0 ;[1040] DO WE WANT LOWER CASE?
EXCH T3,CH ;[1040] NO SO
PUSHJ P,LOWUP ;[1040] FIX UP T3
EXCH T3,CH ;[1040] AND
PUSHJ P,LOWUP ;[1040] CH
MAT0:
CAMN T3,CH ;THIS BYTE MATCH?
JRST MAT2 ;YES TRY NEXT
;NO
MOVE T1,T4 ;BACK UP OBJECT STRING TO A GOOD PLACE
JRST NOMAT2 ;AND START SEARCH AGAIN
;AC DEFINITIONS FOR THE EXPRESSION EVALUATING STUFF
STK=1 ;REVERSE POLISH STYLE STACK
A==P1 ;OPERATION CODE
B==P2 ;THUNK HEADER ADDRESS
C==P3 ;PRIORITY
D==P4 ;STACKED PRIORITY
E==Z ;LOW ORDER RESULT IN EXP EVALUATION
H==X ;OUTPUT HEAP . WORKS LIKE STACK
;HERE TO DEAL WITH CONTRUCTIONS OF THE FORM
;<INTEGER EXPRESSION><CONDITIONAL OPERATOR><INTEGER EXPRESSION>)
POLISH: PUSHJ P,INIVAL ;PREPARE TO READ INTEGER EXPRESSION
PUSHJ P,PPOLISH ;EVALUATE EXPRESION
JRST FAILED ;SYNTAX ERROR MAKES IT FALSE
POL1: PUSH P,N1 ;SAVE THE INTEGER RESULT ON PERM. STACK
PUSHJ P,LEGREQ ;GET CONDITIONAL EXPRESSION
JRST STRER1
PUSHJ P,INIVAL ;PREPARE TO READ INTEGER EXPPRESSION
PUSH STK,.OB ;PRETEND WE SAW AN OPEN BRACKET
PUSHJ P,PPOLISH ;EVALUATE EXPRESION
JRST FAILED ;SYNTAX ERROR MAKES IT FALSE
POP P,N ;RESTORE FIRST INTEGER FROM PERM STACK
JRST STRCHK
;A ROUTINE TO INITIALIZE EXPRESSION READ
INIVAL: MOVE STK,SSS
MOVE H,HHH ;SET UP HEAP AND STACK
PUSH STK,.EOS ;MARK THE END OF THE STACK
TLO F,FL.MOP ;ENABLE MONADIC OPERATOR SCAN
POPJ P,0
SSS: IOWD 100,SS
HHH: IOWD 100,HH
;A ROUTINE TO GET THE ARITHMETIC CONDITION IN BOOL
;CAN ONLY BE > >= = <= #
LEGREQ: PUSHJ P,CHARIN ;GET THE NEXT CHAR
CAIN CH,"#" ;IS IT?
JRST NOTEQ ;YES
CAIN CH,"=" ;IS IT?
JRST EQ ;YES
CAIN CH,74 ; IS IT <
JRST LESS ;YES-BUT COULD BE <=
CAIN CH,76 ; IS IT >
JRST GREAT ;YES-BUT COULD BE >=
CAIN CH,"."
JRST LOGICL
POPJ P, ;NONE OF THOSE GIVE UP
NOTEQ: MOVSI T1,6000 ;CAMN
JRST LEGRE1
EQ: MOVSI T1,2000 ;CAME
JRST LEGRE1
LESS: PUSHJ P,PINCH ;MAY BE < OR <= SO CHECK NEXT CHAR.
MOVSI T1,3000 ;MAY BE CAMLE
CAIN CH,"=" ;IS IT?
JRST LEGRE1 ;YES
MOVSI T1,1000 ;NO MUST BE CAML
MOVEM CH,CH.SAV ;REPLACE THE DIVITS
JRST LEGRE1
GREAT: PUSHJ P,PINCH
MOVSI T1,5000 ;CAMGE?
CAIN CH,"="
JRST LEGRE1 ;YES
MOVSI T1,7000 ;NO MUST BE CAMG
MOVEM CH,CH.SAV
LEGRE1: MOVE A,[CAM N,N1]
ADD A,T1 ;FILL IN CORRECT FLAVOUR OF CAM
LEGRE2: MOVEM A,BOOL
AOS (P)
POPJ P,
;HERE TO CHECK UP ON LOGICAL CONDITIONALS
;(E.G. .AND. OR .OR. )
LOGICL: PUSHJ P,WDREAD ;GET THE OPERATION
PUSHJ P,CHARSG ;AND THE TERMINATOR
CAIE CH,"." ;CHECK IT
POPJ P,0 ;FAILED?
CAMN WD,[SIXBIT/AND/]
JRST ANDAND
CAMN WD,[SIXBIT/OR/]
JRST OROR
POPJ P,0
ANDAND: SKIPA A,[PUSHJ P,AND%IT]
OROR: MOVE A,[PUSHJ P,OR%IT]
JRST LEGRE2
AND%IT: AND N,N1
SKIPA
OR%IT: OR N,N1
SKIPE N
AOS (P)
POPJ P,0
PPOLISH:
NUMBER: PUSHJ P,ATOM ;READ INTEGER OR DECODE REF INT PARAM
PPOL1: PUSH H,.VALUE
PUSH H,N ;PASS NUMBER TO HEAP
OPDISP: MOVEI A,%PRI ;REQUEST POTENTIALLY
MOVSI T2,-OPLEN
TLZE F,FL.MOP ;JUMP IF MONADIC OPERATORS NOT LEGAL
SUBI T2,MADICN ;ENABLE SCAN OF MONADIC OPERATORS
OPCHK: HLRZ T1,OP(T2)
CAME T1,CH ;FIND A MATCH IN TABLE
AOBJN T2,OPCHK ;THERE IS A CATCHALL IF NOTHING
HRRZ T1,OP(T2)
JRST (T1) ;DISPATCH ON CHAR. TERMINATOR
MADIC: "-",,MMINUS ;MONADIC OPERATORS
MADICN==.-MADIC
OP: "]",,SEXIT
CR,,SEXIT
LF,,SEXIT
ALT,,SEXIT
IFN FTOALT,<
ALT175,,SEXIT
ALT176,,SEXIT
> ;END OF IFN FTOALT
".",,SEXIT
"#",,SEXIT
"=",,SEXIT
"(",,OB ;OPEN BRACKETS
074,,SEXIT
")",,CB ;CLOSE BRACKETS
",",,SEXIT
76,,SEXIT
"+",,PLUS
"-",,MINUS
"*",,TIMES
"/",,DIVIDE
"^",,EXPO
"&",,ANDED
"!",,ORED
"\",,SEXIT ;E.O.L. BY DEFN.
REPEAT MADICN,<IFERR2>
OPLEN=.-OP
IFERR2 ;CATCH ALL
;FUNNY ATOM INPUT DISPATCH ROUTINE
SEXIT: MOVEM CH,CH.SAV
JRST .END.
JUNK: POP STK,(STK) ;LOSE OPEN BRACKET FROM STACK
PUSHJ P,ATOM ;READ NEXT INT OR DECODE REFINT PARAM
JUMPN N1,PERR1 ;HE DID SOMETHING LIKE )NNN
SOJA N1,OPDISP ;SET FLAG TO SAY OK FOR NEXT OPERATOR AT DUBLOP: AND DISPATCH ON NEXT CHAR
OB: TLO F,FL.MOP ;(- ALLOWED
PUSH STK,.OB ;STACK OPEN BRACKET THUNK HEADER
POP H,N ;WE THOUGHT WE READ A NUMBER
POP H,(H) ;SO JUNK IT AND THUNK HEADER
JUMPN N1,PERR2 ;TUT-HE DID SOMETHING LIKE NNN(
;WITH NO INTERVENING OPERATOR
JRST NUMBER ;AND READ NEXT NO.
;HERE ON ENCOUNTERING CLOSED BRACKET INP
CB: JUMPE N1,PERR3 ;HE SAID NOTHING IN THOSE BRACKETS
MOVEI A,%OB ;SEARCH FOR CORRESPONDING
JRST @(STK) ;OPEN BRACKET ON STACK
;HERE ON ENCOUTERING ; INPUT ATOM
.END.: MOVEI A,%FIN ;TO FINISH WITH COPY
;EVERYTHING FROM STACK
JRST DUBLOP ;TO HEAP HAVING CHECKED SOMETHING IS THERE
;END OF FUNNY INPUT DISPATCH ROUTINES
;HERE TO PLACE ITEM ON STACK
STAK: PUSH STK,(B) ;STACK THUNK HEADER WORD
JRST NUMBER
;HERE TO OUTPUT ITEM TO HEAP
HEEP: PUSH H,(STK) ;PUT ITEM ON HEAP
POP STK,(STK) ;UPDATE
JRST @(STK) ;AND CARRY ON
;HERE TO CHECK ITEM PRIORITY
COMPAR: XCT (B) ;D:=INPUT ATOM PRIORITY
;C=STACKED CONSTITUENT PRIORITY
CAMG D,C
JRST HEEP ;LESS THAN INPUT CONSTITUENT
JRST STAK ;INPUT PRIORITY-STACK INPUT
;ITEM
;HERE TO CHECK THAT A NUMBER DID COME BETWEEN TWO ATOMS
DUBLOP: JUMPE N1,PERR4
JRST @(STK) ;GO DO ACCORDING TO CONTENTS OF A
;HERE WHEN A THUNK DECIDES ON A % EX
;OPERATION THAT THIS IS AN OPERATOR
;THAT CAN BE APPLIED TO THE TOP
;OF THE STACK USING THE STATEMENT
;CONTAINED IN AC D
DOIT: ADDI H,1 ;UPDATE HEAP POINTER
POP STK,C ;RESTORE TOP OF STACK
EXCH C,(STK)
XCT D ;DO OPERATOR (RESULT BACK ON STACK)
JRST @ (H) ;DO NEXT ATOM ON HEAP
;SAME AS DOIT BUT OPERATOR TOO COMPLEX
;TO BE EXECUTED IN D
;EXPONENTIATION X^N=X'*X2
DOEXP: ADDI H,1 ;UPDATE HEAP POINTER
POP STK,D ;RESTORE TOP OF STACK
MOVE C,(STK) ;EXPONENT IN C
;ACCUMULATE RESULT IN B
MOVEI B,1
DOEXP2: LSHC D,-1 ;BIT FROM EXPONENT
SKIPGE E ;IF THERE IS NO BIT HERE DO NOT.....
IMUL B,C ;INCLUDE IT IN RESULT
IMUL C,C ;SQUARE FOR NEXT BIT FROM EXPONENT
MOVEM B,(STK) ;STORE POTENTIAL RESULT
JUMPE D,@(H) ;IF EXPONENT CLEARED WE HAVE FINISHED
JRST DOEXP2 ;ELSE STORE RESULT AND GO ROUND
;THE EXPRESSION IS TRANSLATED TO REVERSE POLISH
;USING THE USUAL PRIORITY SCHEME FOR EACH ATOM
;ENCOUNTERED.
;OUTPUT FROM THE STACK IS COPIED TO THE HEAP
;NUMBERS ARE PASSED FROM INPUT DIRECTLY TO THE
;HEAP AS TWO ATOMS (A VARIABLE THUNK HEADER AND
;THE NUMBER ITSELF)
;A THUNK IS A SET OF VARIABLES ASSOCIATED
;WITH EACH ATOM (PRIORITY, DISPATCH ADDRESSES ETC)
;THE REVERSE POLISH EXPRESSION ON THE HEAP
;IS EXECUTED AGAIN USING THE STACK
;EACH OPERATION IS TABLE DRIVEN FROM THE
;THUNKS - AN OPERATION CODE IS LOADED
;IN AC A AND INITIATED BY DISPATCHING
;INDIRECTLY THROUGH THE APPROPRIATE THUNK
;HEADER WORD
;OPERATION CODES (COMPILE)
%PRI==0 ;TAKE ACTION DEPENDING ON INPUT ATOM
;PRIORITY
;C(B) = POINTER TO INPUT ATOM THUNK
%OB==2 ;ENCOUNTERED CLOSED BRACKET INPUT ATOM
;COPY STACK TO HEAP UNTIL OPEN BRACKET
;THUNK HEADER ENCOUNTERED ON STACK
%FIN==3 ;ENCOUNTERED ;INPUT ATOM COPY
;EVERYTHING TO HEAP (UNLESS WRONG
;THUNK HEADER FOUND ON STACK)
;FINISHED COMPILATION WHEN FOUND
;END-OF-STACK THUNK HEADER ON
;STACK
;OPERATION CODES (EXECUTE)
%EX==4 ;COLLAPSE HEAP TO STACK UNTIL
;OPERATION CODE THUNK HEADER
;ENCOUNTERED - THEN APPLY
;OPERATOR TO TOP TWO ATOMS (NUMBERS)
;ON STACK LEAVING ONE RESULT
;THUNK FOR OPERATOR DIVIDE /
DIVIDE: JSP B,DUBLOP
.DIVIDE:HRRZ D,.+1(A)
MOVEI C,3 ;%PRI
JRST COMPAR
JRST HEEP ;%OB
JRST HEEP ;%FIN
MOVE D,[IDIVM C,(STK)] ;%EX
JRST DOIT
;THUNK FOR EXPONENTIAL OPERATOR ^
EXPO: JSP B,DUBLOP
.EXPO: HRRZ D,.+1(A)
MOVEI C,4 ;%PRI
JRST COMPAR
JRST HEEP ;%OB
JRST HEEP ;%FIN
JRST DOEXP ;%EX - NO SINGLE INSTR.!
;THUNK FOR OPERATOR PLUS +
PLUS: JSP B,DUBLOP
.PLUS: HRRZ D,.+1(A)
MOVEI C,2 ;%PRI
JRST COMPAR
JRST HEEP ;%OB
JRST HEEP ;%FIN
MOVE D,[ADDM C,(STK)] ;%EX
JRST DOIT
;THUNK FOR OPERATOR *
TIMES: JSP B,DUBLOP
.TIMES: HRRZ D,.+1(A)
MOVEI C,3 ;%PRI
JRST COMPAR
JRST HEEP ;%OB
JRST HEEP ;%FIN
MOVE D,[IMULM C,(STK)]
JRST DOIT
;THUNK FOOR OPERATOR ! (.OR.)
ORED: JSP B,DUBLOP
.ORED: HRRZ D,.+1(A)
MOVEI C,3 ;%PRI
JRST COMPAR
JRST HEEP ;%OB
JRST HEEP ;%FIN
MOVE D,[ORM C,(STK)]
JRST DOIT
;THUNK FOR OPERATOR & (.AND.)
ANDED: JSP B,DUBLOP
.ANDED: HRRZ D,.+1(A)
MOVEI C,3 ;%PRI
JRST COMPAR
JRST HEEP ;%OB
JRST HEEP ;%FIN
MOVE D,[ANDM C,(STK)]
JRST DOIT
MINUS: JSP B,DUBLOP
.MINUS: HRRZ D,.+1(A)
MOVEI C,2 ;%PRI
JRST COMPAR
JRST HEEP ;%OB
JRST HEEP ;%FIN
MOVE D,[SUBM C,(STK)] ;%EX
JRST DOIT
;THUNK FOR OPERATOR MONADIC MINUS -
MMINUS: JSP B,@(STK) ;WE KNOW WE CAN ONLY GET HERE AFTER ( OR START
.MMINUS: HRRZ D,.+1(A)
MOVEI C,5 ;%PRI
JRST COMPAR
JRST HEEP ;%OB
JRST HEEP ;%FIN
MOVE D,[SUBM C,(STK)] ;%EX
JRST DOIT
;THUNK TO MARK END-OF-STACK
.EOS: HRRZ D,.+1(A)
MOVEI C,0 ;%PRI - NO PRIORITY
JRST STAK ;SO JUST STACK INPUT ATOM
JRST PERR5 ;%OB - OOPS BRACKETS MISMATCH
; JRST COMPIL ;%FIN - FINISHED COMPILING
COMPIL: PUSH H,.EOH ;MARK END OF HEAP WITH THUNK
MOVE STK,SSS
MOVEI H,HEAP ;AND START AT TOP OF HEAP
MOVEI A,%EX ;EXECUTE REVERSE POLISH
JRST @(H)
;THUNK FOR OPEN BRACKET
.OB: HRRZ D,.+1(A)
MOVEI C,0 ;%PRI - NO PRIORITY
JRST STAK ;SO JUST STACK INPUT ATOM
JRST JUNK ;%OB - FOUND ONE! JUNK IT
JRST PERR6 ;%FIN - BRACKETS MISMATCH
;THUNK FOR A VALUE
.VALUE: .-3(A)
; JRST EVAL ;%EX
EVAL: PUSH STK,1(H) ;STACK NO FROM HEAP
ADDI H,2 ;DISCARD THUNK HEADER & NO.
JRST @(H) ;EXECUTE NEXT ITEM ON HEAP
;THUNK TO MARK END-OF-HEAP
.EOH: .-3(A)
; JRST DONE ;%EX
DONE: POP STK,N1 ;RETURN LAST VALUE
AOS (P)
POPJ P,0
;A ROUTINE TO YIELD A DECIMAL INTEGER IN N HAVING DECODED POSS REF INT PARAM
ATOM: TLZ F,FLS.8 ;CLEAR THE OCTAL FLAG
ATOM1C: PUSH P,STK ;[1050]SAVE THE STK AS WD=STK
ATOM1B: PUSHJ P,ALPHI ;GET THE CHAR/WORD
MOVEM CH,CH.SAV ;MAYBE WE SHOULD NOT HAVE EATEN THE TERMINATOR
;(A NON ALPHA CHAR).
JUMPN WD,ATOM3 ;IF WD IS 0 IT S NOT A LETTER OR A FUNCTION
ATOM4:
CAIN CH,"%" ;INTRODUCING AN OCTAL ?
JRST [TLO F,FLS.8
SETZM CH.SAV
JRST ATOM1B ] ;YES
CAIL CH,"0"
CAILE CH,"9"
JFCL ;ITS NOT A LETTER OR A NO. BUT LET IT PAST
POP P,STK
TLZE F,FLS.8 ;OCTAL
JRST RDOCTL ;YES
JRST DECIN
ATOM3:
MOVSI T3,-SYMSIZ
CAME WD,SYMTAB(T3) ;IS IT ASYMBOL WE KNOW ABOUT
AOBJN T3,.-1
JUMPLE T3,ATOM2
ERRMS. UFN,<Unknown function>
TLNE WD,7777
JRST IFERR4 ;INVALID FUNCTION
LSH WD,-36 ;MUST BES A LETTER
MOVEI CH," "(WD) ;MAKE IT ASCII
JRST ATOM1A ;IT'S A LETTER PROBABLY A PARAMETER
ATOM2: MOVE CH,CH.SAV ;[1061]
PUSH P,F ;SAVE THE FLAGS AS WE SHALL RECURSE
PUSHJ P,SYMGET ;IT'S A RECOGNISED SYMBOL
JRST IFERR4 ;BUT NOT O.K.
POP P,F ;RESTORE THE FLAGS
TLNN F,FLS.8 ;OCTAL NO.
JRST ATOM2A ;NO
CAIE T2,M..OCT ;[1062] IS THE RESULT OCTAL?
CAIN T2,M..OC2 ;[1062] OR OCTAL WITH NO LEADING ZEROES?
SKIPA ;[1062] YES TO ONE OF THESE
JRST REFER2
JRST ATOM2B
ATOM2A: CAIE T2,4 ;DID IT GET A DECIMAL NO.
JRST REFER2 ;NO
ATOM2B: POP P,STK
MOVE T2,SYMPNT
MOVE CH,[ILDB CH,T2]
PUSHJ P,SVLOWN ;SAVE AND CHANGE LOW LEVEL I/P ROUTINE
PUSH P,CH.SAV ;SAVE NXT CH ON LINE
SETZM CH.SAV ;DON'T READ IT JUST YET
TLZE F,FLS.8 ;OCTAL
JRST [PUSHJ P,RDOCTL
JUMPE N1,REFERR
JRST ATOM2C]
PUSHJ P,INTIN ;SHOULD READ AN INTEGER
JUMPE N1,REFERR ;OOPS DIDN'T
ATOM2C: POP P,CH.SAV
JRST CHARIN
ATOM1: PUSH P,STK
ATOM1A: PUSH P,P1
PUSH P,P2
PUSHJ P,REFBP ;PRODUCE BYTE POINTER TO ACTUAL PARAMETER
POP P,P2
POP P,P1
PUSH P,CH.SAV ;SAVE THE TERMINATING CHAR
SETZM CH.SAV
MOVE CH,[ILDB CH,BP]
PUSHJ P,SVLOWN ;SAVE AND CHANGE LOW LEVEL I/P ROUTINE
PUSHJ P,[
TLZE F,FLS.8 ;[1033][1065]OCTAL?
PJRST RDOCTL ;YES GO READ A POS.. OCTAL PARAM.
PJRST INTIN ;NO GO READ POSS INTEGER DECIMAL.
]
JUMPE N1,REFERR
POP P,T3
POP P,T4 ;SVLOWN PUT A NO. ON STACK
POP P,CH.SAV
POP P,STK
PUSH P,T4
PUSH P,T3
JRST CHARIN
;A ROUTINE TO PRODUCE BYTE POINTER TO ACTUAL PARAMETER IN BP
;FROM PARAMETER NAME IN CH
REFBP: PUSH P,CH ;SAVE PARAMETER NAME
MOVE WD,CH ;SAVE FOR ERROR MESSAGE IF REQUIRED
MOVE L,LLX
PUSHJ P,OTHUSR ;GET THE PDB
JRST LETER3 ;NOT FOUND
MOVE P2,T2 ;SAVE PDB ADDRESS
PUSHJ P,DECIN ;GET THE QULIFIER
MOVEM CH,CH.SAV ;SAVE THAT CHAR
SKIPE N
PUSHJ P,UP ;GO UP AS REQUIRED
POP P,CH ;RESTORE THE PARAM NAME
MOVEI T3,ARGBP(P2) ;ADDRESS OF START OF POINTER BLOCK
ADDI T3,-"A"(CH) ;OFFSET TO CORRECT PARAM
MOVE BP,(T3) ;&PICK UP POINTER TO PARAMETER
POPJ P,0
E%%PNN:
;;IF1,<PRINTX (?)MICPNN Parameter "xx" is not a number/is null>
REFERR: OUTSTR [ASCIZ/?MICPNN Parameter /] ;[1134]
OUTCHR WD
MOVE BP,(T3) ;REINTIALIZE BYTE POINTER
ILDB CH,BP
JUMPE CH,REFER1 ;NULL PARAM
OUTSTR [ASCIZ/ ="/]
REFER3: OUTCHR CH
ILDB CH,BP
JUMPN CH,REFER3 ;SHOVEL OUT OFFENDING PARAMETER
OUTSTR [ASCIZ/" is not a number/]
JRST SLENDX
REFER1: OUTSTR [ASCIZ/" is null/]
JRST SLENDX
REFER2: ERROR. SPR,<System Parameter result is not in correct numeric mode>
INTIN: SETZB N,N1
PUSHJ P,CHARIN
INTIN2: CAIN CH,"+" ;MONADIC PLUS ALLOWED IN REF INT
JRST DECIN ;JUST IGNORE
CAIE CH,"-" ;MAY BE MOADIC MINUS
JRST DECIN1 ;NO
PUSHJ P,DECIN ;YES READ IT IN
MOVN N,N ;AND NEGATE IT
POPJ P,0 ;AND EXIT
DECIN: SETZB N,N1 ;N1 USED AS FLAG
PUSHJ P,CHARIN
DECIN1: CAIL CH,"0"
CAILE CH,"9"
JRST CHARSG
SETO N1, ;FLAG THAT A NUMBER WAS READ
TLZ F,FL.MOP ;CLEAR MONADIC OPERATORS ALLOWED FLAG
IMULI N,^D10
ADDI N,-"0"(CH)
DECIN2: PUSHJ P,PINCH
JRST DECIN1
;HERE TO READ AN OCTAL NO.
RDOCTL: SETZB N,N1
PUSHJ P,CHARIN
CAIN CH,"+"
JRST RDOCT1
CAIE CH,"-"
JRST RDOCT1
PUSHJ P,OCTIN
MOVN N,N
POPJ P,0
RDOCT1: PUSHJ P,OCTIN2
POPJ P,0
PINCH: SETZ CH,
SKIPN CH,CH.SAV
JRST PINCH2
SETZM CH.SAV
POPJ P,0
PINCH2: XCT LOWIN
POPJ P,0
;A ROUTINE TO GET ALPHA WORD IN WD
ALPHI: MOVE BP,[440600,,WD]
SETZ WD,
PUSHJ P,CHARIU
ALPHI1: PUSHJ P,PINCH
PUSHJ P,LOWUP
CAIL CH,"A"
CAILE CH,"Z"
POPJ P,0
SUBI CH," "
TLNE BP,770000
IDPB CH,BP
JRST ALPHI1
;HERE TO CONVERT LOWER CASE LETTERS TO UPPER IF REQUIRED
LOWUP: CAIL CH,141 ;LITTLE A
CAILE CH,172 ;THRU' LITTLE Z INCLUSIVE?
POPJ P,0 ;NO
TRZ CH,40 ;YEP - CHANGE TO BIG A-Z
POPJ P,0
;I/P ROTINE USED BY THE FUNCTION CALLS STUFF(FROM MASTER)
;GETS A SINGLE CHAR. FROM I/P FILE AND HANDLES PARAMETERS
;RETURNS A ZERO IF EOF OR ERROR.
GETTB1: PUSHJ P,FETCHR ;GET A CHARACTER
SETZ CH, ;EOF ERROR
CAIE CH,"'" ;ONE OF THESE
POPJ P,0 ;NO
PUSHJ P,PARAM ;YES DO PARAMETER STUFF
SETZ CH, ;EOF ERROR
POPJ P,0
PERR1: ERROR. OBN,<Operator missing between ) & number>
PERR2: ERROR. ONB,<Operator missing between number & (>
PERR3: ERROR. NMB,<Number missing between brackets>
PERR4: ERROR. NMO,<Number missing between two operators>
PERR5:
PERR6: ERROR. BRM,<Brackets mismatch>
POLTYP: MOVE BP,T1 ;GET MESSAGE ADDRESS
PJRST STROUT ;AND O/P IT
SUBTTL MASTER PROCESS INITIALIZATION
.START:
.R:
.RUN:
MASTER: SETZM F ;FLAG ITS A NORMAL START-UP
SKIPN MASTNO ;ALREADY RUNNING?
JRST INITIA ;NO DO THE START UP STUFF
OUTSTR [ASCIZ/%MIC is running/]
JRST SLENDX ;KILL US OFF
;[1074]Back here from once-only startup code
MSTR0: SETZB F,X ;[1074]CLEAR F & X 1ST TIME IN
SETZB Y,Z ;[1203]
SETOM GOD ;[1074][ISSG]
IFN FTCLASS,< ;[1074]Find Background batch, if any
MOVE T1,[1,,T2] ;[1074]Len,,Addr for SCHED. UUO
MOVE T2,[.SCRBB,,T1] ;[1074]Read Background batch class...
SCHED. T1, ;[1074]Get from system
CAIA ;[1074]Nope
JUMPL T1,LOOP ;[1074]Is there any?
WENABL ;[1074]Write-Enable hiseg
MOVEM T1,BBCLA ;[1074]Save it away
WLOCK ;[1074]Write-Lock hiseg again
>;[1074]END IFN FTCLASS
JRST LOOP
GO%AGN: SETOM F ;FLAG ITS A RESTART
MOVEI S,[ASCIZ/is restarting/]
PUSHJ P,MSTOPR ;AND LET OPR KNOW
JRST INITIA
SUBTTL MASTER PROCESS - CRASH CONTROL
;HERE AFTER THE PSI SYSTEM HAS DETECTED A FATAL ERROR
;CLEAN UP- FORCE A NEW COPY OF MIC.EXE ONTO TH SWAPPER
;AND START IT RUNNING
IFN FTPSI,<
..DIE: MOVE P,[IOWD SIZ,STACK] ;RESET THE STACK
SETZ T1,
SETUWP T1,
HALT
SETOM LOKBIT ;W/E THE HI SEG (THE HARD WAY JUST IN CASE)
SETZM MASTNO ;SAY WE ARE NOT RUNNING SO NO NEW USERS START UP
MOVEI S,[ASCIZ/is crashing - /]
MOVE N,INTBLK+.PSVIS ;GET THE CONDITIONS STUFF
PUSHJ P,PRPOPR ;PREPARE THE SAD NEWS
PUSHJ P,MSTOPR ;LET THE OPR KNOW
..DIE1: RESET ;STOP ALL I/O
MOVEI T1,17
MOVSI T2,'SYS'
SETZB T3,T4
OPEN T1
JRST ..DIE0
MOVSI T1,'MIC'
MOVSI T2,'EXE'
SETZB T3,T4
LOOKUP T1 ;FIND SYS:MIC.EXE
JRST ..DIE0
RENAME T1 ;RENAME IT TO ISTSELF
JRST ..DIE0
CLOSE 20
MOVSI 0,'SYS'
MOVSI 1,'MIC'
MOVSI 2,'EXE'
SETZB 3,4
SETZ 5,
MOVSI 6,<RESTRT-MICBGN>
RUN 6, ;START MIC UP AGAIN
..DIE0: MOVEI S,[ASCIZ/can't restart!!!/]
PUSHJ P,MSTOPR ;LET OPR KNOW WE FAILED
EXIT 1,
EXIT
>
SUBTTL MASTER PROCESS - CORE MANAGEMENT
;HERE TO DO CORE MANAGEMENT TO CHANGE
;THE NUMBER OF PROCESSES AVAILABLE
;COMCNT - INCREMENTED WHEN A SLAVE CANNOT FIND A PROCESS
;PROCNO - NEGATIVE NUMBER OF PROCESSES
;LOWCNT - INCREMENTED WHEN THE MASTER CANNOT FIND A FREE LOW PROCESS
;LWPRNO - NEGATIVE NO. OF LOW PROCESSES
LOOP:
SETZM ACTIVE ;NO ACTIVE PROCESSES
SCHED2: MOVE T1,COMCNT ;ANY COMPLAINTS FROM SLAVES
SKIPN LOWCNT ;HI OR LOW?
JUMPE T1,SHUFFLE ;NO GO SHRINK IF NEEDED
LOOP2: MOVN T2,PROCNO ;THIS MANY HIGH PROCESS AREAS
ADD T2,COMCNT ;AND WE HAVE REQUESTS FOR THIS MANY
MOVN T3,LWPRNO ;THIS MANY LOW PROCESS AREAS
ADD T3,LOWCNT ;AND WE HAVE REQUESTS FOR THIS MANY
IMULI T2,PDBSIZ ;HIGH SEGMENT PROCESSES AREA THIS BIG
IMULI T3,LOWSIZ ;LOW " " " " "
ADDI T2,FLAG+1 ;HIGH SEGMENT LARGE ADDRESS
ADDI T3,ELWPDB+1 ;LOW " " "
HRL T3,T2 ;HIGH,,LOW
SETZ X, ;CLEAR AWAY X
CORE T3,
JRST [AOSG TRYCORE ;NO. OF TIMES TO TRY FOR CORE BETWEEN ERROR MESSAGES
JRST SHUFFLE ;COULDN'T GET THE CORE - SEE IF WE CAN DO ANYTHING ELSE
JRST CORERR] ;O/P ERROR MESSAGE THIS TIME THEN AS ABOVE
;GOT THE CORE
CAME T1,COMCNT
JRST SCHED2 ;SLAVES HAVE MOVED IT
WENABL ;OPEN HI SEG
MOVNS T1 ;NEGATE
ADDM T1,PROCNO ;UPDATE NO OF PROCESSES
MOVN T1,LOWCNT ;NNW NO. OF LOW PROCESSES
ADDM T1,LWPRNO
SETZM LOWCNT
SETZM COMCNT ;AND TELL THE SLAVES
WLOCK ;CLOSE HI SEG
JRST SCHED1
;HERE TO SHRINK CORE IF POSS.
SHUFFLE:
WENABL
SETZM LOWCNT ;NO. OF LOW PROCESSES REQD. IS RECALCULATED ON EACH PASS
WLOCK
JRST SCHED1 ;DUMMY FOR NOW
SUBTTL MASTER PROCESS - SCHEDULE SLAVE REQUEST
SCHED1: HRLZ P4,PROCNO ;TRY FOR THIS NO.
SCHED3: ADDI X,PDBSIZ
MOVN T2,PROCNO
IMULI T2,PDBSIZ
CAML X,T2
PUSHJ P,SCHED0 ;WRAP ROUND TO THE FIRST PROCESS
MOVE F,FSAV(X) ;SET UP FLAG WORD
HLRZ Y,YZWORD(X) ;SET UP POINTER TO LOW PDB
IFN FTCJOB,<
HRRZ Z,YZWORD(X) ;AND TO COJOB LOGGING AREA - IF APPLICABLE
>
SKIPE T1,FLAG(X) ;TO BE PROCESSED?
JRST SCHED5 ;GO SERVICE IF REQUIRED
SCHED4: TRZE F,FR.EOF ;EOF DETECTED YET?
JRST FIN1 ;YES!
CAMN F,FSAV(X) ;HAS ANY FLAG BITS CHANGED
JRST SCHD4A ;NO
WENABL ;OPEN HI SEG
MOVEI T2,FR.EOF ;HAS SLAVE MAYBE SAID EOF
TDNE T2,FSAV(X)
TRO F,FR.EOF ;YES-DON'T FORGET!
MOVEM F,FSAV(X) ;PRESERVE FLAG WORD
WLOCK ;CLOSE HI SEG
SCHD4A: AOBJN P4,SCHED3 ;NO TRY NEXT
JRST HIB ;HIBER (RESETTING CORE IF APPR.) UNTIL NEXT SCHEDULE
SCHED0: SETZB X,Y
POPJ P,0
SCHED6: MOVEI P3,5 ;PRETEND SHORT LINE FOR QUICK SLEEP
PUSHJ P,SETHB1 ;SET IT UP
JRST SCHED4 ;NEXT PLEASE
;
SCHD4B: SKIPGE HIBTIM ;[1067] HAS A VERY SHORT SLEEP BEEN SPECIFIED ALREADY?
JRST SCHED4 ;[1067] OK, NOTHING MORE TO DO IF YES
SKIPE HIBTIM ;[1116] ASSUME WHAT HE WANTS IS OK (HIB WILL CHECK)
CAMG T1,HIBTIM ;[1054][1067] IS THIS SLEEP TIME LESS THAN PROPOSED
MOVEM T1,HIBTIM ;[1054][1067] YES, MAKE THAT THE NEW PROPSED SLEEP TIME
JRST SCHED4 ;[1054] AND LOOP AROUND
IFN FTCJOB,<
SCHED7: SKIPN COJOB(X) ;IS HE A COJOB?
JRST SCHED4 ;NO. NEXT....
TLNN F,FL.CB ;IS IT IN CONTROL B WAIT
JRST SCHED4 ;NO
MSTIME T1,
CAMG T1,LTIME(Y) ;IS IT TIME
JRST SCHED4 ;TIME IS NOT YET?
PUSHJ P,OWNCHK ;IS HE STILL AROUND
JRST PROCEED ;NO...PROCEED
PUSH P,S ;YES...
MOVEI S,[ASCIZ/ waiting..../] ;REMIND HIM OF OUR PRESCENCE
PUSHJ P,TELBTH
POP P,S ;COME BACK S
JRST STWAIT ;AND WAIT AGAIN
>
;HERE TO SEE IF WE CAN DEAL WITH A USER
GO: MOVE L,LINE(X) ;GET HIS LINE NO.
MIC GET,L ;AND HIS STATUS
JRST FIN1 ;HE'S NOT RUNNING MIC NOW
MOVE T1,FLAG(X) ;GET HIS STATE
JUMPG T1,SCHED4 ;HE'S HELD IGNORE HIM
SKIPN T1,SLPTIM(X) ;[1054]HAS THE USER A SLEEP TIME SET UP?
JRST TAL ;[1054]JUMP IF NO
CAMLE T1,CURTIM ;[1054]IS IT LESS THAN OR NOW!
jrst SCHD4B ;[1054]NO, IGNORE HIM FOR NOW
WENABL
SETZM SLPTIM(X) ;[1054] CLEAR MEMORY OF SLEEP
WLOCK
TAL:
JUMPGE S,SCHED4 ;NOTHING INTERESTING
TRNE F,FR.EOF ;HAS HE HAD AN EOF
JRST FIN1 ;YES
TLNE S,LDL.CB ;^B?
TLNE F,FL.CB ;DID WE KNOW?
SKIPA ;YES
JRST A.BREAK(X) ;NO ITS A NEW ONE!
TLZE S,LDL.CA ;DID HE TYPE ^A?
JRST A.ABORT(X) ;YES - JUST ABORT THIS PROCESS
TLZE S,LDL.CC ;^C
JRST %.CANCEL ;YES
; [764] REARRANGE ORDER OF ^P AN RESPONSE PROCESSING
TLZE S,LDL.CP ;^P
JRST A.PROCEED(X) ;YES
TLNE S,LDL.RS!LDL.SY ;IS HE DABBLING IN RESPONSE STUFF
JRST RSPOND ;YUP-CHECK IT OUT
TAL1: TLNN S,LDL.TI!LDL.AJ ;TI WAIT OR MM
JRST SCHED4 ;NO - FORGET HIM
TLZE S,LDL.OP ;OPERATOR CHAR?
JRST A.OPERATOR(X) ;YES
TLZE S,LDL.ER ;ERROR?
IFN FTCJOB,< JRST ANERROR ;YES >
IFE FTCJOB,<JRST A.ERROR(X) >
TLNE S,LDL.CB ;IN ^B WAIT? (USE S 'COS DON'T TRUST F!)
IFE FTCJOB,< JRST SCHED4 ;YES - FORGET HIM >
IFN FTCJOB,< JRST SCHED7 ;CHECK COJOB STUFF THEN FORGET HIM >
TLZE F,FL.CB ;[1122]THIS IS DEFENSIVE AGAINST SOMEONE PLAYING WITH
JRST A.PROCEED(X) ;[1122] THE LDL.CB BIT AND NOT USING LDL.CP!
REPEAT 1,< ;CODE WHICH SLOWS MIC DOWN
;BUT GETS "!" COMMAND RIGHT
;[1034] REMOVE 1 INSTRUCTION
PUSHJ P,OUTPNG ;NO-IS HE DOING O/P
JRST TAL3 ;NO-THEN HE MAY BE SCHEDULED
JRST SCHED6 ;DON'T SCHEDULE UNTIL LATER
>
TAL3: TLZE F,FL.INP ;HAVE WE ALREADY SET UP AN I/P LINE
JRST TAL4A ;YES
SKIPE ERRWRD(X) ;HAS A MASTER DETECTED ERROR OCCURED
JRST ERRTYP ;YES
SKIPE DISWRD(X) ;WANT A DISPLAY DUN
JRST MSTDIS ;YES DISPLAY THEN
SKIPE TYPWRD(X) ;WANT A TYPE DUN
JRST MSTTYP ;YES TYPE THEN
TRNE F,FR.JMP ;WAS LAST O/P A JUMP
TLNE F,FL.BRK ;DID WE FINISH LINE OFF?
SKIPA ;YES
JRST TAL6 ;IGNORE JUMP FOR A MOMENT
SKIPE BLAB(X)
JRST FNBLAB ;BACKTO LABEL
SKIPE LAB(X) ;DO WE WANT TO SEARCH FOR A LABEL?
JRST FNDLAB ;YES GO FIND IT
TAL6: PUSHJ P,IPLINE ;GO READ A LINE
JRST TAL8
TLNE F,FL.PCT ;[1201] HAVE WE HAD A % LABEL?
JRST [ ;[1201] YES
MOVE WD,LABWD ;[1201] GET THE LABEL
CAME WD,['%ERR '] ;[1201] IS IT ERROR
CAMN WD,['%CERR '] ;[1201] OR CUSP ERROR
SKIPA ;[1201] YES TO ONE OF THESE
CAMN WD,['%TERR '] ;[1201] OR IS IT TIME ERROR?
SKIPA ;[1201] ONE OF THE THREE
JRST .+1 ;[1201] NONE OF THE ABOVE
MOVE WD,['%FIN '] ;[1201] IF WE FOUD ONE OF THE SPECIALS
;[1201] MUST IGNORE EVERYTHING TILL A %FIN
MOVEM WD,LAB(X) ;[1201] SO REMEMBER IT
JRST FNDLAB ;[1201] AND LOOK FOR IT
] ;[1201]
TAL2: PUSHJ P,LDBCLE ;AND CLEAR HIS ERROR BITS
TAL4: TLZE F,FL.EXC ;WAS THAT A COMMENT
JRST TAL5 ;THEN DO NOT TYPE IT
TLZE F,FL.XX ;DID HE OUGHT TO BE SILENCED
TLON S,LDL.XX ;YES SHUT HIM UP
MIC SET,L
JFCL
TLNE S,LDL.MM ;IS WE IN MONITOR MODE?
TLNN F,FL.AST ;YES - IS THIS AN ASTERISK LINE
SKIPA ;NO - TO BOTH OR EITHER
JRST TAL5A ;DO DISPLAY NOT TYPE (NEED TO BECAUSE IN 507 "*"
;IS AN ILLEGAL COMMAND
TLNN F,FL.SMC ;IS THIS A SEMI-COLON COMMENT
TRNE F,FR.IF!FR.JMP ;WAS IT A GOTO/BACKTO OR IF(ERROR)/IF(NOERROR)
JRST TAL5A ;YES DO NOT TYPE IT.
SETZ CH, ;MAKE ASCIZ
IDPB CH,BUFBP
HRRI S,BUFFER
TAL4C: TLNN S,LDL.MM ;IN MONITOR MODE?
TLZN F,FL.MON ;REQUIRES MONITOR MODE?
JRST TAL4B ;DO THE LINE NOW
TLNN S,LDL.TI ;REALLY WANT INPUT?
TLOA F,FL.MON ;NO, REMEMBER HAS MONITOR LINE
PUSHJ P,FRCMON ;YES, FORCE HIM BACK TO MONITOR MODE
TLO F,FL.INP ;AND REMEMBER A LINE IS ALREADY PREPARED
JRST SCHED4 ;AND PRINT IT NEXT TIME AROUND
TAL4A: HRRI S,INLINE(X) ;THIS IS THE REMEMBERED LINE
JRST TAL4C ;MAKE SURE WE WANT TO TYPE THIS LINE
TAL4B: PUSHJ P,TYPER2
; PUSHJ P,TYPER
JRST SCHED4 ;GO LOOK AT NEXT GUY
;HERE TO DISH OUT A COMMENT TO A LINE
TAL5: PUSHJ P,SETHIB ;MUST NOT SILENCE TOO SOON
TAL5A: CAIE CH,CR ;RETURN?
TAL7: TDZA CH,CH ;NO MAKE ASCIZ
MOVEI CH,LF ;YES DUMMY UP LINE FEED
IDPB CH,BUFBP
JUMPN CH,TAL7 ;AND MAKE ASCIZ
TDNE F,[FL.AST!FL.SMC,,FR.IF!FR.JMP] ;ONE OF THESE
JRST TAL7A ;YEP
TLO S,LDLCL1 ;INSIST ON EXCLAMATION MARKS BEING IN COLUMN 1!!!
TLZE S,LDL.XX ;SILENCED?
TLO F,FL.XX ;REMEMBER THAT FACT AND...
MIC SET,L ;THEN WAKE UP
JFCL
TAL7A: HRRI S,BUFFER
MIC DISPLAY,L
JRST SCHED4
JRST SCHED4 ;SAY IT AND RESCHEDULE
;HERE WHEN WE HAVE REACHED EOF WE MUST CHECK IF ANTHING
;IN THE BUFFER AND IF SO DEAL WITH IT.
;THIS GETS OVER A PROBLEM WITH -
; !TEXT<EOF>
;
TAL8: MOVE T1,LINTOT ;GET HOW MANY CHARS IN THE BUFFER
CAIN T1,LINSIZ+1 ;[1235] IS THE BUFFER EMPTY
JRST FIN1 ;YES - THEN WE ARE DONE
TRO F,FR.EOF ;REMEMBER THE EOF
JRST TAL2 ;AND DEAL WIF THE BUFFER
;HERE ON CANCEL TO TYPE [CANCEL]
CANCEL:
STOP:
CANCL1: PUSH P,S ;save the guy`s ldbmic word
MOVE S,[PL.CAN,,[ASCIZ/[CANCEL]/]]
PUSHJ P,TELBT2 ;INFORM ON US
POP P,S ;restore the ldbmic word
%.EXIT: TLZ S,LDL.XX ;[1205][775] COULD HAVE BEEN DONE BY A TELBT2
TLZ F,FL.CB ;[1230] ENSURE WE DO NOT DISPLAY [PROCEEDing] message
PUSHJ P,LDBCLR ;CLEAR ERROR BITS ETC!
TLO S,LDL.CC ;FOR HIGHER PROCESSESSSS
JRST FIN1B ;AND FINISH THIS PROCESS
;HERE ON ABORT TO TYPE [ABORT] ETC.
%.ABORT:
ABORT: PUSH P,S ;save the ldbmic word
MOVE S,[PL.ABT,,[ASCIZ/[ABORT]/]]
PUSHJ P,TELBT2 ;SORT OUT SILENCE ETC. AND LET EVERYONE KNOW
POP P,S ;restore the ldbmic word
TLZ S,LDL.XX ;[775] COULD HAVE BEEN DONE BY A TELBT2
PUSHJ P,LDBCLR ;CLEAR NAST BITS
JRST FIN1B ;AND FINISH
;HERE TO SORT OUT SILENCE BITS ETC. BEFORE SENDING OUT A MESSAGE
;TO A USER AND HIS OWNER IF APPLICABLE
TELBT2: PUSH P,S ;SAVE THE MESSAGE
MIC GET,L ;GET HIS LDBMIC WORD
SETZ S, ;HASN'T GOT ONE - VERY ODD!
TLZE S,LDL.XX ;IF HE IS SILENCED
TLOA F,LDL.XX ;REMEMBER
SKIPA ;SAVE A UUO
MIC SET,L ;AND UNSILENCE HIM
JFCL
POP P,S ;UNSAVE THE MESSAGE
;AND FALL INTO TELBTH
;HERE TO SEND A MESSAGE TO A USER AND HIS OWNER
TELBTH:
IFN FTCJOB,< ;COJOB BIT
SKIPE COJOB(X) ;ARE WE A COJOB
PUSHJ P,CJMESG ;YES - LET THE OWNER KNOW
>
MOVEI P3,5 ;[774]PREPARE FOR POSSIBLE SHORT SLEEP
HLLZ T1,S ;GET MESSAGE TYPE FLAG
TDNE T1,PROFLE(X) ;ARE WE TO DO THIS TYPE?
PJRST SETHB1 ;[774] NO, SET SHORT SLEEP THEN CONTINUE
PUSH P,S
MOVEI S,[ASCIZ/
/] ;[1130]
MIC DISPLAY,L ;**** PUT CRLF IN LOG FILE
JFCL
POP P,S
MIC DISPLAY,L ;SEND THE MESSAGE
JFCL
MOVEI S,[ASCIZ/
/] ;[1030] MAKE SURE WE ARE ON A NEW LINE
MIC DISPLAY,L ;[1030][1031]
POPJ P,0 ;[1030]
POPJ P,0 ;AND AWAY....
;HERE ON ERROR
IFN FTCJOB,<
ANERROR:
PUSHJ P,TYMCHK ;TIME LIMIT ERRORS ARE SPECIAL
JRST IFC3 ;KILL BOY KILL (HE'S HAD TIME+10%)
JRST [MOVE T1,[SIXBIT/%TERR/]
JRST IFC2A]
PUSHJ P,LDBCLE ;CLEAR THE ERROR BITS ETC. (DO WE WANT THIS?)
JRST A.ERROR(X) ;DO WHAT HE SAYS
>
ERROR:
%.ERROR:
IFCHK: TLNE F,FL.CB ;IN ^B WAIT?
JRST SCHED4 ;YES - FORGET IT.
TLO S,LDL.ER ;SET ERROR BIT
IFC1: PUSHJ P,SYSERR ;ERROR IN SYSTEM PROGRAM
SKIPA T1,[SIXBIT/%CERR/] ;YES
MOVE T1,[SIXBIT/%ERR/] ;NO
IFC1B: PUSH P,T1 ;REMEMBER
IFC1C: PUSHJ P,IPLINF ;READ A LINE FROM THE FILE
JRST IFC3 ;EOF
JUMPE CH,IFC1C ;MAKE SURE WE GOT SOMETHING.
TLZE F,FL.PCT ;%LABEL?
JRST [
MOVE T1,LABWD ;GET USER LABEL
CAME T1,[SIXBIT/%FIN/] ;THIS
CAMN T1,(P) ;OOR WHAT WE DECIDED ABOVE?
JRST [ ;YES
POP P,(P) ;CLEAN THE STACK
PUSHJ P,LDBCLR ;CLEAR THE ERROR BITS
JRST TAL6 ;AND ON OUR WAY
]
JRST IFC1A ;KEEP TRYING
]
IFC1A: TLZN F,FL.DOT ;A MONITOR COMMAND?
JRST IFC1C ;NO - KEEP LOOKING
TRNN F,FR.IF ;IS IT AN IF COMMAND
JRST IFC2 ;NO.
POP P,(P) ;CLEAN THE STACK
PUSHJ P,LDBCLR ;CLEAR THE ERROR BITS
JRST TAL6
IFC2: POP P,T1 ;GET THE LABEL
IFC2A: WENABL ;OPEN HI SEG
MOVEM T1,LAB(X) ;SEARCH FOR THIS
WLOCK ;CLOSE HI SEG
PUSHJ P,LDBCLE ;CLEAR THE ERROR BITS
SETOM HIBTIM ;FLAG NO SLEEP
JRST SCHED4
IFC3: POP P,(P) ;CLEAN THE STACK
MOVE S,[PL.ABE,,[ASCIZ/[ABORT on ERROR]/]]
PUSHJ P,TELBT2 ;TELL ALL
MIC GET,L ;GET CURRENT STATUS
TDZA S,S ;OOOOOOOPS
TLO S,LDL.ER ;SET ERROR BIT FOR HIGHER UPS
JRST FIN1B
;HERE TO WORK OUT IF A USER'S CURRENT PROGRAM IS A SYTEM
;PROGRAM OR A USER PROGRAM
SYSERR: HRLZ T1,JOB(X) ;GET HIS JOB NO.
HRRI T1,.GTLIM ;THIS TABLE
GETTAB T1,
SKIPA ;FAILED ASSUME USER PROGRAM
TXNN T1,JB.LSY ;DID PROGRAM COME FROM SYS
AOS (P) ;NO
POPJ P,0
FRCMON: PUSH P,S ;PRESERVE S
HRRI S,[BYTE(7)3] ;^C
MIC TYPE,L
JFCL
; PUSHJ P,TYPER
POP P,S ;RESTORE S
TLO S,LDL.MM ;AND SAY WE ARE NOW IN MONITOR MODE
POPJ P, ;RETURN
CLRTTI: PUSHJ P,FRCCHK ;ARE WE ON FRCLIN?
POPJ P, ;YES, DON'T DO THIS
CLRBFI ;NO, WIPE HIS NOSE
POPJ P, ;RETURN
IFN FTCJOB,< ;IF COJOBS
;A ROUTINE TO CALCULATE IF TIME LIMIT HAS BEEN EXCEEDED
;AND IF THIS IS THE FIRST TIME -GIVE THE JOB AN EXTRA 10%
TYMCHK: SKIPN COJOB(X) ;ARE WE A COJOB
JRST CPOPJ2 ;NO FORGET ALL THIS
MOVEI T1,.GTLIM ;TABLE NO.
HRL T1,JOB(X) ;INDEX NO.
GETTAB T1, ;GET THE TIME LIMIT
JFCL ;RUBBISH!!!
LDB CH,[POINT 24,T1,35] ;GET THE IMPORTANT BIT
JUMPN CH,CPOPJ2 ;EXIT IF ALL OK
SKIPLE TIME(X) ;[1207] DOUBLE CHECK TO SEE IF
TRCE F,FR.TIM ;HAS HE HAD AN EXTRA 10%
POPJ P,0 ;YES-KILL HIM
MIC GET,L ;GET HIS MIC BITS
SETZ S, ;ODD!!!
TLNE S,LDL.XX ;HAS HE SEEN THIS ERROR MESSAGE?
SKIPA T3,[EXP TELBT2] ;NO, MAKE SURE HE DOES
MOVEI T3,CJMESG
PUSH P,S
MOVEI S,[ASCIZ/?Time limit exceeded/] ;HELPFUL MESSAGE
PUSHJ P,(T3) ;FOR COJOB OWNERS
POP P,S ;RESTORE IT
HRRZ T3,TIME(X) ;[1207] GET HOW LONG HE RAN FOR
IDIVI T3,^D10 ;10% IS-
SKIPN T3
MOVEI T3,1 ;AT LEAST 1 SECOND
;[1207] HRLI T3,.STTLM ;SET TIME LIMIT FUNCTION
HRRZ T2,JOB(X) ;GET JOB NO.
MOVE T1,[2,,T2] ;SET UP JBSET ARGS
JBSET. T1, ;SET NEW TIME LLIMIT
JFCL ;EH!!!
WENABL ;[1207]
SETOM TIME(X) ;[1207] EXTRA REMINDER!
WLOCK ;[1207]
JRST CPOPJ1 ;AND LOOK FOR WOT TO DO
> ;END OF COJOB BIT
CPOPJ2: AOS (P) ;DOUBLE SKIP RETURN
AOS (P)
POPJ P,0
;HERE TO GET RESPONSE LINE ON ERROR CONDITION
RSPOND: TLNN S,LDL.ER ;HAS HE GOT AN ERROR?
JRST TAL1 ;NO-CARRY ON AS NORMAL
TLNN S,LDL.SY ;HAS THE ERROR CHAR REACHED INT LEVEL?
JRST SCHED4 ;NO-JUST IGNORE FOR TIME BEING
TLNE S,LDL.TI ;TTY INPUT WAIT?
JRST RSPND ;YES-GET HIS RESPONSE STUFF
TLNE S,LDL.RS ;TTY WAIT OF ANY SORT?
JRST SCHED4 ;NO-JUST IGNORE FOR TIME BEING
;HERE WHEN IN "TI" OR "TO" WAIT AN ERROR HAS OCCURED
;WHEN THE USER HAD ENABLED FOR RESPONSE STUFF AND
;THE ERROR CHARACTER HAS REACHED INTERUPPT LEVEL
;THEREFORE-UUO LEVEL OUTPUT STATIC SAFE TO DO RESPONSE UUO
RSPND: TLZ S,LDL.SY!LDL.RS
PUSH P,S
MOVEI S,BUFFER
SKIPE T2,RS(X) ;MUST BE A PLACE FOR IT
MIC RESPONSE,L
JRST RSPND2 ;NOPE
MOVE T2,(T2)
WENABL ;OPEN HI SEG
MOVE T1,[POINT 7,BUFFER]
RSPND0: ILDB CH,T2 ;WHERE TO PUT RESPONSE
JUMPE CH,RSPND1 ;IF WE REACHED THE END OF THE PARAMETER
ILDB CH,T1
DPB CH,T2 ;ELSE COPY UP RESPONSE
JUMPN CH,RSPND0 ;UNLESS WE RUN OUT LOOP
SETZ T1,
JRST RSPND0 ;ZERO DOWN REST OF PARAMETER
RSPND1: WLOCK ;CLOSE HI SEG
RSPND2: POP P,S
MIC SET,L ;RESET THE GUY'S LDB MIC WORD
JFCL ;OOOOPS
JRST TAL1 ;CARRY ON AS NORMAL
;HERE ON ^B
BREAK:
%.BREAK:
OBREAK: TLZ S,LDLCLR ;CLEAR ALL VOLATILE BITS AND OTHER NASTIES
TLO S,LDL.CB ;MAKE SURE THE BREAK FLAG IS SET
TLZE S,LDL.XX ;WAS HE SILENCED?
TLO F,FL.XX ;THEN REMEMBER
PUSHJ P,LDBCR1 ;CLEAR HIS ERROR BITS
MOVE S,[PL.BRK!PL.INP,,[ASCIZ/[BREAK]/]] ;[1110]
TLO F,FL.CB ;IN ^B WAIT
PUSHJ P,TELBTH ;LET EVERBODY KNOW
IFN FTCJOB<SKIPN COJOB(X) ;IS WE A COJOB
>
JRST SCHED4
IFN FTCJOB,<
STWAIT: MSTIME T1, ;GET THE TIME
ADDI T1,^D60*^D1000*^D2 ;WAIT THIS LONG
MOVEM T1,LTIME(Y) ;AND THEN REMIND
JRST SCHED4 ;AND RESCHEDULE
>
;HERE ON ^P
PROCEED:
%.PROCEED:
PROCED: PUSH P,S ;PRESERVE S
IFN FTCJOB,< SETZM LTIME(Y) ;CLEAR WAITING TIME
>
MOVE S,[PL.PRD!PL.INP,,[ASCIZ/[PROCEED]/]] ;[1110]
PUSHJ P,TELBTH ;TO WHOM IT MAY CONCERN
MOVSI S,PL.INP ;[1110] GET INPUT COMMAND FLAG
WENABL ;[1110] MAKE SURE HI IS OPEN
ANDCAM S,PROFLE(X) ;[1110] CLEAR FLAG
WLOCK ;[1110] AND CLOSE HI
PROCD1: POP P,S ;RESTORE S
TLZ F,FL.CB ;NO LONGER IN ^B WAIT
PUSHJ P,LDBCLR ;;SET IT
JRST SCHED4
LDBCLE: TLZA S,LDLCLE ;CLEAR THE ERROR FLAGS
LDBCLR: TLZ S,LDLCLR ;CLEAR ERROR FLAGS+ACTION FLAGS
LDBCR1: MIC SET,L
JFCL
MIC GET,L
JFCL
TLNN S,LDL.CB ;[1126][1131] STILL IN ^B?
TLZN F,FL.CB ;[1125] NO,WAS INTERNAL FLAG STILL SET?
POPJ P,
MOVE S,[PL.PRD,,[ASCIZ/[PROCEEDing]/]] ;[1125]LET HIM KNOW WE HAVE CONTINUED
PJRST TELBTH ;[1125]TELL HIM
;HERE WHEN OPERATOR CHAR FOUND
OPERATOR:
%.OPERATOR:
OPRCHR: TLCN F,FL.CB ;ARE WE PAUSED?
JRST OBREAK ;NO BREAK
JRST PROCED ;YES PROCEED
;HERE TO FIND A LABEL
FNBLAB: SETZM POINTR(Y)
SETZM BLKNO(Y) ;SO WE WILL READ FROM START OF FILE
PUSH P,LOWOUT ;[1120] DON'T CORRUPT THIS
PUSH P,P4 ;KEEP P4
MOVE P4,BLAB(X) ;GET LABEL
JRST FNDLB1
FNDLAB: PUSH P,LOWOUT ;[1120] DON'T CORRUPT THIS
PUSH P,P4 ;PRESERVE P4
MOVE P4,LAB(X) ;GET THE LABEL
FNDLB1: PUSH P,P4 ;GOT TO SAVE LABEL AS GETTABS APPEAR TO GROT IT(******)
FNDLBA: PUSHJ P,IPLINL ;[1073]READ NEXT LINE
JRST NOTLAB ;COULDN'T FIND LABEL
SKIPN LABWD ;[1073] DID WE GET A LABEL?
JRST FNDLBA ;[1073] TRY AGAIN IF NOT
MOVE P4,[IDPB CH,BUFBP] ;[1073] LOW-LEVEL OUTPUTTER
MOVEM P4,LOWOUT ;[1073] SET THAT AS CURRENT LOW OUT
PUSHJ P,BUFINI ;[1073] INIT. THE BUFFER
POP P,P4 ;GET LABEL BACK
MOVEI BP,[ASCIZ/ [/] ;[1073][1130] SPACE, OPENING BRACKET
PUSHJ P,STROUT ;[1073][1130] OUTPUT IT
MOVE WD,LABWD ;[1073] GET THE LABEL
PUSHJ P,SIXBP ;[1073] O/P THAT
MOVEI CH,":" ;[1073] INDICATE THAT IT IS A LABEL
PUSHJ P,OUCH ;[1073] BY O/P THAT
MOVE T1,LABWD ;GET THE LABEL
MOVSI T2,PL.%FN ;%FIN MATCHING BIT
CAME T1,P4 ;THE RIGHT ONE?
JRST [TDNN T2,PROFLE(X) ;HAS HE SUPPRESSED %FIN MATCHING
CAME T1,[SIXBIT/%FIN/] ;NO IS THIS %FIN
JRST FNDLB3 ;[1073]NO MATCH
MOVEI BP,[ASCIZ /found while searching for /]
PUSHJ P,STROUT ;[1073] O/P HELPFUL COMMENT
MOVE WD,P4 ;[1073] GET TARGET
PUSHJ P,SIXBP ;[1073] O/P THAT
MOVEI CH,":" ;[1073] LABEL INDICATION
PUSHJ P,OUCH ;[1073] O/P THAT
JRST FNDLB2 ;[1073]
]
JRST FNDLB2 ;SUCCESS
FNDLB3: MOVEI CH,"]" ;[1073] CLOSING BRACKET
PUSHJ P,OUCH ;[1073] O/P THAT
PUSHJ P,DPYLAB ;[1073] DISPLAY THE LABEL
JRST FNDLB1 ;NO - KEEP LOOKING
FNDLB2: POP P,P4 ;YES - RESTORE P4
WENABL ;OPEN HI SEG
SETZM BLAB(X) ;CLEAR BLABEL
SETZM LAB(X) ;CLEAR LABEL
WLOCK ;CLOSE HI SEG
SETOM HIBTIM ;FLAG NO SLEEP FOR US
MOVEI CH,"]" ;[1073] CLOSING WHATSIT
PUSHJ P,OUCH ;[1073] O/P
PUSHJ P,.NEWL ;[1073] AND A NEW LINE
PUSHJ P,DPYLAB ;[1073] DISPALY THE LABEL
POP P,LOWOUT ;[1120] RESTORE
JRST SCHED4 ;AND TYPE THE LINE FOR HIM
NOTLAB: POP P,P4 ;GET WHAT HE SAID
POP P,(P) ;[1120] POP OLD OLD P4 (STACK GETS RESET SOON)
POP P,LOWOUT ;[1120] RESTORE
CAME P4,[SIXBIT/%TERR/]
CAMN P4,[SIXBIT/%FIN/]
JRST IFC3
CAME P4,[SIXBIT/%ERR/]
CAMN P4,[SIXBIT/%CERR/]
JRST IFC3
ERRMS. CFL,<Cannot find Label - >,S
MOVE WD,P4 ;GET WHAT LABEL WE TRIED FOR
PUSHJ P,PRPMWD ;PREPARE A MESSAGE
MOVEI S,BUFFER ;GET ITS ADDRESS
JRST MSG ;AND O/P IT
;
; Here to display the contents of BUFFER if tracing.
;
DPYLAB: SETZ CH, ;[1073] A NULL
PUSHJ P,OUCH ;[1073] TO END IT ALL
MOVEI S,BUFFER ;[1073] GET THE BUFFER ADDRESS
HRLZI T1,PL.TRL ;[1073] GET THE TRACE FLAG
TDNE T1,PROFLE(X) ;[1073] AND CHECK IT AGAINST HIS PROFLE
MIC DISPLAY,L ;[1073] IF YES, DISPLAY
POPJ P,0 ;[1073] IF NO....DONT
POPJ P,0 ;[1073] ALL DONE
;HERE TO PERFORM TYPE/DISPLAY
ERRTYP: MOVEI T2,2 ;INDEX
JRST .+3
MSTTYP: TDZA T2,T2
MSTDIS: MOVEI T2,1
MOVE T3,T2 ;COPY
ADD T2,X ;INDEX INTO PDB
MOVE S,TYPWRD(T2) ;GET THE ADDR.
WENABL ;OPEN HI SEG
SETZM TYPWRD(T2) ;CLEAR THE WORD
WLOCK ;CLOSE HI SEG
TLZN S,-1 ;L.H. IS USED AS A FLAG
JRST MSTDS0
MOVE S,(S) ;THAT (S)=[STRING]
JUMPE S,SCHED4 ;FUNNY
JUMPE T3,TYPFIX ;SPECIAL TREATMENT FOR TYPE
CAIN T3,1
JRST DISFIX ;AND DISPLAY
MOVE BP,[POINT 7,BUFFER]
ILDB CH,S ;GET THE STRING
IDPB CH,BP ;AND PUT IT IN THE I/P BUFFER
JUMPN CH,.-2
MOVEI S,BUFFER ;AND SET UP S
MSTDS0: MOVE L,LINE(X) ;GET HIS LINE NO.
XCT DISTYP(T3) ;DO TYPE OR DISPLAY AS APPROPRIATE
JFCL
JRST SCHED4 ;AND NEXT....
DISTYP: MIC TYPE,L
MIC DISPLAY,L
MIC TYPE,L
DISFIX: TRO F,FR.DIS ;SAY ITS ONE OF DESE
TYPFIX: TRO F,FR.CL1 ;AND INSIST ON BEING IN COLUMN 1.
MOVSI CH,-NESTY ;SPECIAL TREATMENT - PRETEND TYPE IS A PARAMETER
HRRI CH,CURBP(Y)
EXCH S,(CH)
JUMPE S,SCHED4 ;STACKED IT
AOBJN CH,.-2
JRST MACER ;NO ROOM
HIB: WENABL ;OPEN HI SEG
IFN FTCJOB,<
PUSHJ P,CMPREQ ;COMPUTE REQD. NO. OF COJOBS (AND BATCH JOBS)
MOVEM N,COJOBN ;STORE NEW NO. OF COJOBS WE ARE CONFIGURED FOR.
IFN FTMBCH,<
MOVEM N1,BCJOBN ; " BATCH JOBS " "
>
>
SKIPE ACTIVE ;ANY ACTIVE PROCESSES?
JRST HIB0 ;YES - DO NOT RESET CORE
MOVEI T1,PROCNU
MOVNM T1,PROCNO ;RESET TO ORIGINAL NO. OF PROCESSES
MOVNM T1,LWPRNO ;RESET NO. OF LOW PROCESSES
SETOM ACTIVE ;NOBODY WANTS US
HIB0: WLOCK ;CLOSE HI SEG
MOVE T1,HIBTIM ;GET TIME LIMIT
JUMPL T1,[ MOVEI T1,^D33 ;[1135] AT LEAST TWO TICKS
JRST HIB2 ] ;[1135]
SKIPE T1 ;IS THERE A TIME LIMIT
PUSHJ P,GETHIB
MOVEI T1,^D20*^D1000 ;NO,WAKE EVERY 20 SECS.
CAILE T1,^D20*^D1000 ;[1205][1116] WE MUSTN'T SLEEP FOR TOO LONG!
MOVEI T1,^D20*^D1000 ;[1116] 20 SECS IS THE MAX.
TXO T1,HB.RPT
HIB2: MOVEI T2,5 ;5 SECS F HIBER FAILS
HIBER T1, ;HIBER ..
SLEEP T2, ;.. OR SLEEP
MOVE T1,HIBTIM ;[1054] REMEMBER WHAT WE CALCULATED
HIB1: MSTIME T2, ;[1054] GET THE TIME OF DAY
MOVEM T2,CURTIM ;[1054] REMEMBER IT
SUB T1,T2 ;[1054] HAVE WE REACHED THEN YET?
JUMPG T1,LOOP ;[1054] LOOP IF WE ARE NOT TO SLEEP
SETZM HIBTIM ;[1054] FORGET LAST INSTRUCTION
JRST LOOP ;[1054] AND DO A SCHEDULAR LOOP
GETHIB: MSTIME T2,
SUB T1,T2
JUMPG T1,GETHI1
MOVEI T1,^D1000
GETHI1: CAILE T1,5*^D1000
MOVEI T1,1*^D1000
JRST CPOPJ1
IFN FTCJOB,<
CMPREQ: HRRE T1,CJREQ ;RESET TO REQUESTED NUMBER OF COJOB AREAS
SKIPLE T1 ;ALLOW FOR -VE OR +VE NO.S(DEFENSIVE)
MOVNS T1
CAMG T1,[EXP -^D15]
HRREI T1,-^D15 ;AT THE MOMENT CAN ONLY HAVE 15 COJOBS
MOVEM T1,N
IFN FTMBCH,< ;BATCH STUFF
HRRE T1,BCHREQ ;SIMILARILY FOR BATCH
SKIPLE T1
MOVNS T1
PUSH P,T1 ;SAVE IT
ADD T1,N ;GET TOTAL NO. OF BATCH JOBS AND COJOBS
CAMLE T1,[EXP -^D15] ;IS IT 15 OR LESS
JRST CMPRQ0 ;YES
POP P,(P) ;THROW WOT HE SAID AWAY
HRREI T1,-^D15 ;AND SEE HOW MANY LEFT
SUB T1,N ;I.E. 15-NO. OF COJOBS
SKIPA
CMPRQ0: POP P,T1 ;RESTORE
MOVEM T1,N1
>
POPJ P,0
>;END OF COJOB BIT
;HERE WHEN WE HAVE FINISHED WITH A USER
FIN: SETZ CH, ;MAKE ASCIZ
IDPB CH,BUFBP
MOVEI S,BUFFER ;PREPARE TO TYPE LINE
PUSHJ P,TYPER
FIN1: MIC GET,L ;GET OUR STATUS WORD
FIN1A: SETZ S, ;WE FAILED!??
FIN1B: MOVE P,[IOWD SIZ,STACK] ;RESET STACK
WENABL ;OPEN HI SEG
SETZ T2,
SKIPE T3,LAST(X) ;GET PREVIOUS PROCESS ADDRESS IF ANY
SKIPN T2,LDBMIC(X) ;IS THERE A PREVIOUS PROCESS?
JRST FIN4 ;NO
CAME L,LINE-1(T3) ;EXTRA(NEUROTIC) CHECK THAT PREVIOUS PROCESS BELONGS TO US
JRST FIN4 ;NO!!!!! THIS SHOULD NOT HAPPEN
SETOM FLAG-1(T3) ;START LAST PROCESS
SETOM HIBTIM ;CAUSE PREVIOUS PROCESS TO BE SERVICED QUICKER
TRZ F,FR.EOF ;MAY NOT HAVE REACHED EOF FOR NEXT LEVEL
JUMPE S,FIN3 ;NOT RUNNING MIC ANY MORE
TLNN S,LDL.CC ;YES - WAS THERE A ^C TYPED?
JRST .+2 ;YES - OK
TLO T2,LDL.CC!LDLCHK;NO - SAY SO FOR PREVIOUS PROCESS
TLNN S,LDL.ER ;[1066]WAS THERE AN ERROR IN THIS PROCESS?
JRST FIN2 ;[1066] NO SO NO NEED TO PROPOGATE IT
TLO T2,LDL.ER!LDLCHK;YES - SAY SO FOR PREVIOUS PROCESS
TLZ T2,LDL.SY!LDL.RS ;[1066] MUST NOT RESET RESPONSE AFTER ERROR
FIN2: MOVE S,T2 ;MOVE NEW WORD FOR...
LDB T1,LDP.ER ;GET THE ERROR CHAR
SKIPN T1
TLZ S,LDL.ER ;CLEAR THE ERROR BIT IN CASE SET BUT NO ERROR CHAR
MIC SET,L ;... SETTING UP
JFCL
FIN3: SETZM PDB(X)
HRLI T1,PDB(X)
HRRI T1,PDB+1(X)
BLT T1,FLAG(X) ;CLEAR DOWN PROCESS AREA
SKIPE COMCNT ;ANY SLAVES WAITING?
SOS COMCNT ;YES - WELL SAY 1 FREE PROCESS NOW
WLOCK ;CLOSE HI SEG
SETZM LPDB(Y) ;NOW CLEAR DOWN LOW SEG
HRLZI T1,LPDB(Y)
HRRI T1,LPDB+1(Y)
BLT T1,POINTR(Y)
SETZ F,
JRST SCHED4 ;GO DO NEXT PROCESS
FIN4: SETZ T2,
IFN FTCJOB,< ;COJOB BIT
SKIPN T1,COJOB(X) ;COJOB ACTIVE?
JRST FIN5 ;NO
TLZ F,FL.CCM!FL.KJO ;BETTER CHACK MON MODE AND ISSUE KJOB
MOVEM F,FSAV(X)
WENABL ;OPEN HI SEG
HRRZI T1,KJOB ;ASK FOR KJOB MONITORING
HRRM T1,COJOB(X) ;IN COJOB FLAG WORD
JRST LOOP ;AND GO SERVICE THE OTHERS
>;END OF COJOB BIT
FIN5: TLZE S,LDL.XX ;SILENCED?
JRST FIN5A
TLNN F,FL.XX ;OR MEMORY OF SAME (CAN HAPPEN AFTER A TELBT2)
JRST FIN2 ;NO
FIN5A: PUSHJ P,LDBCLR ;CLEAR DOWN BITS
TLNN S,LDL.MM ;MONITOR MODE?
SKIPA S,[[ASCIZ/*/]] ;NO
MOVEI S,[ASCIZ/./] ;YES
MIC DISPLAY,L ;GIVE HIM NICE CHAR.
JRST FIN2
JRST FIN2
SUBTTL MASTER PROCESS - HANDLE NON-DEFAULT ACTIONS
%.BACKTO: TDZA T3,T3 ;HERE IF <EVENT> BACKTO ARG
%.GOTO: ;HERE IF <EVENT> GOTO ARG
MOVEI T3,1 ;FLAG
ADD T3,X
POP P,T2 ;GET ADDR. OF ARG
MOVE T2,(T2) ;GET ARG
WENABL ;OPEN HI SEG
MOVEM T2,BLAB(T3) ;PUT IN HIS PDB
WLOCK ;CLOSE HI SEG
TRO F,FR.JMP ;DUMMY UP - LAST O/P WAS A JUMP
PUSHJ P,LDBCLR ;CLEAR NASTY BITS
JRST TAL3
;HERE ON <EVENT>:RETURN
%.RETURN:
TRO F,FR.EOF ;SET EOF
PUSHJ P,LDBCLR ;BUT CLEAN ERROR BITS NOW
SETOM HIBTIM ;FLAG A SHORT SLEEP
JRST SCHED4 ;AND CLEAN UP NEXT TIME
%.SILENCE:
MOVSI T1,FL.XX ;HERE ON <EVENT> SILENCE
MOVSI T2,PL.NSL ;[1111] GET THE NO SILENCE FLAG
TDNN T2,PROFLE(X) ;[1111] AND ENSURE WE DONT SILENCE IF SET
SKIPA
%.REVIVE:
SETZ T1, ;HERE ON <EVENT> REVIVE
TLZ F,FL.XX ;CLEAR THE BIT
IOR F,T1 ;SET/NO-OP
TLZ S,LDLCLR ;CLEAR BITS
SKIPE T1 ;WHAT WAS THIS?
TLOA S,LDL.XX ;HE WANTS SILENCE
TLZ S,LDL.XX ;HE WANTS TO C US
MIC SET,L
JFCL
JRST GO ;AND RESCHEDULE
%.TYPE: TDZA T3,T3 ;HERE ON <EVENT> TYPE
%.DISPLAY: ;HERE ON <EVENT> DISPLAY
MOVEI T3,1
ADD T3,X ;POINT TO TYPWRD OR DISWRD
POP P,T2 ;GET ADDR. OF ARG
MOVE T2,(T2)
JUMPE T2,TAL3 ;NOT AN ARG IN SIGHT
WENABL ;OPEN HI SEG
MOVEM T2,TYPWRD(T3) ;STORE IN HIS PDB
WLOCK ;CLOSE HI SEG
PUSHJ P,LDBCLR ;CLEAR THE BITS
JRST TAL3
;THIS IS WHERE WE HANDLE THE USER'S CANCEL TRAPPING
;NOTE - THAT UNLIKE ALL THE OTHER TRAPS THIS TRAP IS UNSET EVERY TIME IT IS USED
;BUT MAY OF COURSE BE RESET
%.CANCEL:
MOVE T2,[JRST CANCEL] ;DEFAULT
CAMN T2,A.CANCEL(X) ;IS WE USING THE DEFAULT
JRST STOP ;YES-(SAVES A BIT OF CODE)
PUSHJ P,LDBCLR ;CLEAR ERROR BITS
MOVE T3,A.CANCEL(X) ;GET HIS SETTING
MOVE T4,A.CANCEL+1(X) ;+ POSS. ARG.
MOVE T1,PROFLE(X) ;[1202] IS HE ENABLED FOR REAL CC'S
TLNE T1,PL.CCT ;[1202] BY THE APPR. SET COMMAND
JRST T3 ;[1202] IF SO, DON'T UNSET ACTION
WENABL ;OPEN HI SEG
MOVEM T2,A.CANCEL(X) ;RESTORE DEFAULT
SETZM A.CANCEL+1(X) ;CLEAR ARG SPACE
WLOCK ;CLOSE HI SEG
JRST T3 ;AND DO IT NOW
SUBTTL MASTER PROCESS - READ A LINE FROM THE FILE
IPLINF: SETO T1, ;ONLY INTERPRET IF COMMANDS
JRST IPLIN0
IPLINE: TDZA T1,T1 ; ALLOW INTERPRETED COMMANDS
IPLINL: MOVEI T1,1 ;DON'T ALLOW ANY
IPLIN0: MOVEM T1,ARGTYP ;REMEMBER
SKIPE T1
TLZ F,FL.MON
PUSHJ P,CLRIBF ;CLEAN THE INPUT BUFFER
PUSH P,[EXP STRIBF] ;TO FORCE AUTOMATIC STORAGE OF I/P LINE
;IN USERS HI PDB
; SKIPE BLKNO(Y) ;IS THIS THE FIRST TIME
; TLNE F,FL.BRK ;HAVE WE HAD A BREAK CHAR.
TDZ F,[FL.DOT!FL.PCT!FL.SMC!FL.AST!FL.CMD!FL.LAB!FL.EXC,,FR.IF!FR.JMP]
;CLEAR UNWANTED BITS
TLZE F,FL.MON ;IF WE HAVE JUST FORCED TO MON MOD
TLO F,FL.DOT ;HE MUST HAVE HAD A DOT
SETZM LABWD ;CLEAR LABEL
IPLIN3: PUSHJ P,BUFINI ;INIT. THE TYPE BUFFER
SETZ WD,
MOVE BP,[440600,,WD] ;SET UP BYTE POINTER FOR SIXBIT COMMAND
IPLIN1: PUSHJ P,INFILE ;READ CHAR
POPJ P, ;NON-SKIP RETURN ON EOF
IDPB CH,BUFBP ;STORE IT
SOSG LINTOT ;DECREMENT COUNT
JRST CPOPJ1 ;YES - SUCCESS RETURN
TLZE F,FL.LAB ;A LABEL?
JRST LABEL ;YES - GO DEAL WITH IT
TLNE F,FL.BRK ;IS THIS A BREAK CHAR?
JRST CMDCHK ;YES - GO CHECK COMMAND
TLNE F,FL.CMD!FL.AST!FL.CR!FL.SMC!FL.EXC
;NO COMMAND OR LABEL CAN COME AFTER A * = ! ; OR ANOTHER COMMAND
JRST IPLIN4
TLNN BP,-1 ;PAST END OF BP?
JRST IPLIN6 ;YES
TLNN BP,770000 ;IF BYTE POINTER EXHAUSTED
JRST [ TLZ BP,-1 ;NOTE IT
JRST .+1 ;AND TRY TO DEAL WITH LABELS > 6 CHARS
]
IPLIN6: CAIE CH," " ;SPACE?
CAIN CH," " ;OR TAB?
JRST IGNORE ;YES MAY WANT TO IGNORE IT
IPLIN7: CAIN CH,"%"
JRST IPLIN2
PUSHJ P,LOWUP ;change lower case to upper if necc.
CAIL CH,"0" ;IS IT A LETTER?
CAILE CH,"Z"
JRST CMDEND ;NO TERMINATE COMMAND
CAIGE CH,"A"
CAIG CH,"9"
JRST IPLIN2
JRST CMDEND
IPLIN2: SUBI CH," " ;CONVERT TO SIXBIT
IDPB CH,BP ;OTHERWISE PUT IT IN COMMAND WORD
JRST IPLIN1 ;AND GO READ NEXT CHAR
;HERE TO CLEAN THE INPUT BUFFER
CLRIBF: SETZM BUFFER
MOVE T1,[BUFFER,,BUFFER+1]
BLT T1,BUFFER+<LINSIZ/5> ;[1225]
POPJ P,0
;HERE TO STORE THE I/P LINE IN THE USER'S PDB
STRIBF: SKIPA
AOS (P) ;CALLED AUTOMATICALLY
STRIB0: PUSH P,T1
WENABL ;OPEN HI SEG
MOVSI T1,BUFFER ;ADDRESS OF COMMON BUFFER
HRRI T1,INLINE(X) ;ADDRESS OF USERS BUFFER
BLT T1,INLINE+<LINSIZ/5>(X) ;[1225] TO HERE
WLOCK ;CLOSE HI SEG
POP P,T1
POPJ P,0
;HERE TO INITIALLISE THE INPUT BUFFER
BUFINI: MOVEI WD,LINSIZ+1 ;[1235] COUNT
MOVEM WD,LINTOT
MOVE WD,[POINT 7,BUFFER]
MOVEM WD,BUFBP ;STORE VIRGIN BUFFER POINTER
POPJ P,0
;HERE TO DEAL WITH SOME INTERPRETED COMMANDS
IPLIN4: TRNN F,FR.IF!FR.JMP ;DOING AN INTERPRETED COMMAND
JRST IPLIN1 ;NO
MOVSI T1,770000
TDNN T1,ARGPNT ;ARGUMENT POINTER EXHAUSTED
JRST ARGEND ;YES
CAIE CH," " ;SPACE
CAIN CH," " ;OR TAB?
JRST IPLIN1 ;YES-IGNORE.
TRNE F,FR.IF ;DOING AN "IF"
JRST [CAIE CH,"(" ;YES-CHECK FOR OPENING BRACKET
JRST .+1 ;THIS ISN'T ONE
SKIPN ARGWRD ;HAVE WE READ ANFING YET?
JRST IPLIN1 ;NO-ALLOW 1 OPENING BRACKET
JRST .+1]
CAIN CH,"%" ;IS IT A %
JRST [SKIPN ARGWRD ;YES-ONLY ALLOWED AS FIRST CHAR.
JRST IPLIN5 ;OK
JRST ARGEND] ;TERMINATE THE ARGUMENT
PUSHJ P,LOWUP ;[762]CONVERT LC TO UC IF REQUIRED
CAIL CH,"0"
CAILE CH,"Z" ;IS IT ALPHA-NUMERIC
JRST ARGEND ;NO-TERMINATE THE ARG
CAIGE CH,"A" ;[762]
CAIG CH,"9"
SKIPA
JRST ARGEND ;NO-TERMINATE THE ARG.
IPLIN5: SUBI CH," " ;MAKE IT SIXBIT
IDPB CH,ARGPNT ;STORE IT
JRST IPLIN1 ;AND READ NEXT CHAR.
;HERE AT THE END OF AN INTERPRETED COMMANDS ARGUMENT
ARGEND: TRZN F,FR.IF ;END OF AN IF?
JRST ARGJMP ;NO
MOVE T1,ARGWRD ;YES GET THE ARG.
CAME T1,[SIXBIT/ERROR/] ;CHECK
CAMN T1,[SIXBIT/NOERROR/] ;FOR VALIDITY
JRST ARGND1 ;ITS A NICE ONE.
CAME T1,[SIXBIT/TRUE/] ;[1124]THIS MEANS WHAT IT SAYS
CAMN T1,[SIXBIT/FALSE/] ;[1124] DITTO
JRST ARGND1 ;[1124]THESE ARE ALLOWED
ARGND0: ;NOT AN IF(ERROR)/IF (NOERROR)
TRZ F,FR.IF!FR.JMP ;HERE WHEN WE HAVE FAILED
SETZM ARGWRD ;SO CLEAR UP
SETZM ARGPNT
JRST IPLIN1 ;AND LET SLAVE SORT IT OUT
ARGND1: CAIN CH,")" ;TERMINATOR ALREADY?
JRST ARGDUN ;YES-GOOD BOY!
ARGND2: PUSHJ P,INFILE ;READ A CHARACTER
JRST IPLIN1+1 ;EOF?
IDPB CH,BUFBP ;STORE IT
SOS LINTOT ;DECREMENT COUNT
TLNE F,FL.BRK ;BREAK CHARACTER
JRST CMDCHK ;YES!
CAIN CH,"R" ;FOR "NOERROR"
JRST ARGND3 ;YES
CAIE CH," " ;SPACE
CAIN CH," " ;OR TAB?
JRST ARGND3 ;YES IGNORE
ARGDUN: CAIE CH,")" ;MUST BE THIS
JRST ARGND0 ;SO SAD!
CAMN T1,[SIXBIT/TRUE/] ;[1124] IS IT ONE OF THESE
JRST ARGTRU ;[1124] YES
CAMN T1,[SIXBIT/FALSE/] ;[1124] OR THIS?
JRST ARGFLS ;[1124] YES
MOVE T1,ARGWRD ;GET ERROR/NOERROR
CAME T1,[SIXBIT/ERROR/]
TLC S,LDL.ER
TLNN S,LDL.ER ;IS IT TRUE?
ARGFLS: PUSHJ P,[PUSHJ P,EATLNE ;[1073][1124] EAT THE REST OF THE LINE
MOVEI T1,[ASCIZ/
[FALSE]
/] ;[1073][1030] AND DISPLAY THE DESCISION
JRST CPOPJ1 ;[1073] AND THATS ALL
]
ARGTRU: MOVEI T1,[ASCIZ/
[TRUE]
/] ;[1073][1030] DESCISIONS DESCISIONS ALL THE TIME
WENABL ;[1073]
MOVSI T2,PL.TRL ;[1073] IS TRACING ON?
TDNE T2,PROFLE(X) ;[1073] DO NOTHING IF NOT
MOVEM T1,DISWRD(X) ;[1073] IF ON DISPLAY THE CHOICE
WLOCK ;[1073]
TLZ S,LDLCHK!LDL.ER!LDL.TI!LDL.MM
MIC SET,L
JFCL
MIC GET,L
JFCL
;AT THIS POINT WE HAVE HANDLED THE STATEMEMT
;AND WE MUST NOW RETURN SO THAT IT WILL BE SHOWN TO THE USER
;(NB. FR.IF!FR.JMP IMPLY DISPLAY NOT TYPE)
TRO F,FR.IF!FR.CL1 ;RESET FLAGS (AND PRETEND IN COLUMN ONE)
ARGFN0: TLZ F,FL.MON!FL.SMC!FL.AST!FL.CMD
TLO F,FL.DOT!FL.BRK ;PRETEND DOT AND BREAK!
JRST CPOPJ1 ;RETURN
ARGND3: SKIPG LINTOT ;ANY ROOM
JRST ARGND0 ;NO
JRST ARGND2
;HERE TO INTERPRET JUMP STATEMENTS
ARGJMP: SETZ T1,
CAMN WD,[SIXBIT/GOTO/] ;GOTO STATEMENT
MOVEI T1,1 ;YES
ADD T1,X ;WORK OUT WHERE TO PUT LABEL
MOVE T2,ARGWRD ;GET THE ARG.
WENABL ;OPEN HI SEG
MOVEM T2,BLAB(T1) ;STORE
WLOCK ;CLOSE HI SEG
ARGJM1: TLNE F,FL.BRK ;BREAK ALREADY
JRST ARGJM4 ;YES
CAIE CH," " ;SPACE?
CAIN CH," " ;OR TAB?
SKIPA ;YES
JRST ARGJM2
PUSHJ P,INFILE ;READ A CHARACTER
POPJ P,0 ;EOF?
IDPB CH,BUFBP ;STORE CHAR.
SOSE LINTOT
JRST ARGJM1 ;LOOP FOR MORE
JRST ARGND0
ARGJM2: CAIE CH,"." ;DOT
CAIN CH,"*" ;OR ASTERISK
JRST ARGJM3 ;YES
CAIN CH,"\" ;MAYBE A EOL
JRST [TRO F,FR.CL1 ;YES
JRST ARGJM4]
PUSHJ P,EATLNE ;EAT REST OF LINE
JRST ARGFIN
ARGJM3: DPB CH,LDPF ;SAVE CHAR
TDO F,[FL.SAV,,FR.CL1] ;AND REMEMBER
ARGJM4: TLZ F,FL.DOT!FL.MON!FL.SMC!FL.AST!FL.CMD
JRST ARGFIN
EATLNE: ;ROUTINE TO EAT EVERYTHING UP TO AND INCLUDING A BREAK
PUSHJ P,INFILE ;READ A CHAR
POPJ P,0 ;EOF?
EATLN1: IDPB CH,BUFBP ;STORE IT
SOSG LINTOT ;DECREMENT COUNT
POPJ P,0 ;GET OUT OF THAT- IF U CAN
TLNN F,FL.BRK ;IS IT A BREAK?
JRST EATLNE ;TRY AGAIN
CAIN CH,LF ;[1227] IS IT AN LF?
POPJ P,0 ;[1227] IF SO, JUST RETURN, ALL DONE
CAIE CH,CR ;CARRIAGE RETURN
JRST EATLNE ;[1227] NO, JUST IGNORE OTHER SORTS OF BREAK
MOVEI CH,LF ;LET HIM HAVE A LINE FEED
JRST EATLN1
LABEL: MOVEM WD,LABWD
TRO F,FR.CL1 ;SAY WE ARE NOW IN COL 1
LDB CH,[POINT 6,WD,5] ;GET THE 1ST CHAR
CAIN CH,'%' ;"%"?
TLO F,FL.PCT ;YES - SET FLAG
PUSHJ P,CLRIBF ;CLEAR THE INPUT BUFFER
PUSHJ P,FETCHR ;LOOK AT NEXT CHAR.
POPJ P,0 ;ERROR
PUSHJ P,ISBRK ;BREAK CHAR.?
TLO F,FL.BRK ;YES
CAIN CH,CR ;CARRIAGE RETURN?
TLOA F,FL.CRT ;YES, NOTE THAT
TLO F,FL.SAV ;SAVED CHAR.
DPB CH,LDPF ;SAVE IT
;HERE WE SHOULD REALLY ARRANGE THAT WE LOOK FOR A ,.! OR OTHER COL1 CHAR
;BUT FOR HISTORICAL REASONS THIS IS NOT CURRENTLY DONE - MUST THINK ABOUT IT
TLNE F,FL.PCT ;[1201] % LABEL
JRST CPOPJ1 ;[1201] IF YES, KEEP LOOKING
SKIPN ARGTYP ;WHAT INTERPS ALLOWED?
JRST IPLIN3 ;ALL
JRST CPOPJ1 ;JUST "IF" OR NONE
;HERE AT END OF A COMMAND TO SEE IF IT IS ONE OF THESE WHICH WE MAY INTERPRET
CMDEND: PUSHJ P,CHKITP ;[1211] CHECK UP ONINTERPRETED COMMANDS
JRST IPLIN1 ;[1211] NOT ONE, OR PARTLY PROCESSED
ENDITP: PUSHJ P,EATLNE ;[1211] EAT UP WHAT FOLLOWS THE PROCESSED COMMAND
PJRST CPOPJ1 ;[1211] AND ONWARDS
;
;[1211] HERE TO DEAL WITH THE INTERPRETING OF COMMANDS
;
CHKITP: TLZ BP,-1 ;[1211] FLAG EOL
TLO F,FL.CMD ;READ A COMMAND
SKIPLE ARGTYP ;ANY INTERPS ALLOWED?
POPJ P,0 ;[1211] NO
CAME WD,[SIXBIT/REQUEUE/] ;[1211] IS THIS A REQUE COMMAND?
CAMN WD,[SIXBIT/CHKPNT/] ;[1211] OR A CHECKPOINT COMMAND?
JRST [ ;[1211] YES TO ONE OF THESE
TRO F,FR.JMP;[1211] I KNOW ITS NOT A JUMP!
JRST CPOPJ1 ;[1211] AND DUN
] ;[1211]
CAMN WD,IFWD ;IS THIS AN IF COMMAND?
TROA F,FR.IF ;[1035]YES
SKIPE ARGTYP ;GOTO/BACKTO TO BE INTERPRETED?
JRST CMDND1 ;NO
CAME WD,[SIXBIT/GOTO/]
CAMN WD,[SIXBIT/BACKTO/]
TRO F,FR.JMP ;ITS A GOTO/BACKTO COMMAND
CMDND1: TRNE F,FR.IF!FR.JMP ;ARE WE DOING AN INTERPRET
PJRST argstp ;[1211] YES-PREPARE THE GROUND
ARGSTP: SETZM ARGWRD ;CLEAR ARGUMENT SPACE
MOVE T1,[POINT 6,ARGWRD]
MOVEM T1,ARGPNT ;INITIALLISE POINTER
POPJ P,0
CMDCHK:
TLNN F,FL.CMD!FL.AST!FL.CR!FL.SMC!FL.EXC
;[1216][1211] CANNOT HAVE A COMMAND IF WE HAVE
;[1211] HAD ONE OF COMMAND,!,;,::,* ALREADY
PUSHJ P,CHKITP ;[1211] BUT WE MAY HAVE A COMAND<CRLF>
SKIPA ;[1211] NO, WE DO NOT
JRST ENDITP ;[1211] DEAL WITH END OF INTERPRETED COMMAND
TRNE F,FR.IF!FR.JMP ;DID WE INTERPRET
JRST ARGEND
TLZ F,FL.CMD!FL.LAB
ARGFIN: JRST CPOPJ1 ;SUCCESS EXIT
IGNORE: SKIPN WD ;DON'T IGNORE SEPERATORS AFTER A COMMAND
TLNE F,FL.DOT ;OR AFTER A DOT IN COL 1
JRST CMDEND
JRST IPLIN7 ;AND GO READ THE NEXT CHAR.
INFILE: TLZ F,FL.BRK ;CLEAR THE BREAK FLAG
RCH1: PUSHJ P,FETCHR ;GET THE NEXT CHARACTER
POPJ P, ;ERROR OR END OF FILE - EXIT
COL2: CAIN CH,"'" ;IS IT A PARAMETER CALL?
JRST PARAM ;YES - GO & DEAL WITH IT
TRZE F,FR.CL1 ;COLUMN 1?
JRST COL1 ;YES - SPECIAL TREATMENT
CAIN CH,"^" ;CONTROL CHARACTER?
JRST CONTRL ;YES
CAIN CH,15 ;CARRIAGE RETURN?
JRST CRET ;YES
CAIN CH,12 ;LINEFEED?
JRST LFEED ;YES
CAIN CH,":" ;IS IT A COLON
JRST LABL ;YES SPECIAL HANDLING
RCH2: PUSHJ P,ISBRK ;IS IT A BREAK CHAR?
RCH3: TLO F,FL.BRK ;YES SET FLAG
JRST CPOPJ1 ;AND NORMAL EXIT
COL1: MOVSI T1,PL.CL1 ;CHECK IF HE WANTS COLUMN ONE STUFF
TRNE F,FR.DIS ;ARE WE DOING AN <EVENT>:DISPLAY
TLOA F,FL.EXC ;YES-- DUMMY UP A COMMENT
TDNE T1,PROFLE(X) ;DOES HE?
JRST CPOPJ1 ;NOPE
CAIE CH," " ;IGNORE TABS AND
CAIN CH," " ;SPACES IN COL. 1
JRST CL1SPT ;AND SAY WE ARE STILL IN COL. 1
CAIN CH,";" ;OR THIS
JRST COMNT2 ;IS A COMENT TOO!
CAIN CH,"!"
JRST COMENT
CAIN CH,"." ;Wants monitor mode?
JRST MONMD ;Yes
CAIN CH,"=" ;IGNORE CR & LF?
JRST EQUALS ;YES
CAIE CH,"*" ;User mode?
JRST COL2 ;No - O.K. continue
PUSHJ P,FETCHR ;YES - GET NEXT CHAR
POPJ P, ;ERROR RETURN - EXIT
CAIN CH,"*" ;ANOTHER ASTERISK?
JRST CPOPJ1 ;YES OK - EXIT
TLO F,FL.AST ;SAY U HAVE SEEN AN ASTERISK
TLNN S,LDL.MM ;IN MONITOR MODE?
JRST COL2 ;NO - O.K. CHECK COL2
TLO F,FL.SAV ;YES - SET FLAG
DPB CH,LDPF ;AND SAVE CHAR
MOVEI CH,"*" ;FORCE ASTERISK
JRST CPOPJ1 ;AND SUCCESS RETURN
COMENT: PUSHJ P,FETCHR ;DID HE MEAN A COMMENT
POPJ P,0 ;NO HE GOT AN EOF
CAIN CH,"!"
JRST CPOPJ1 ;HE MEANT !
TLO F,FL.EXC ;REMEMBER U WISH DISPLAY NOT TYPE
JRST COL2
;HERE ON A ";" IN COLUMN ONE
COMNT2: PUSHJ P,FETCHR ;GET NEXT CHARACTER
POPJ P,0 ;WE GOT AN EOF
CAIN CH,";" ;IS IT ?
JRST CPOPJ1 ;HE MEANT ";" NOT A COMMENT
TLO F,FL.SMC!FL.SAV
DPB CH,LDPF ;SAVE THE COL2 CHAR.
MOVEI CH,";" ;MAKE SURE HE SEES THE ";"
JRST COL2
; HERE ON A SPACE OR TAB IN COL. 1
;
CL1SPT: TRO F,FR.CL1 ;RESET COL. 1 FLAG
JRST RCH1 ;AND READ ANOTHER CHAR.
CRET: TLNE F,FL.CR ;IGNORE IT?
JRST RCH1 ;YES
TLO F,FL.CRT ;SET TO SHOW CR TYPED
JRST RCH2 ;NO
LFEED: TLZN F,FL.CR ;IGNORE IT?
JRST LFEED2 ;NO
LFEED3: TDO F,[FL.BRK,,FR.CL1] ;SET BREAK FLAG
SETZ CH,
;[1205] AOS (P)
PUSHJ P,SETHIB ;SET HIBER TIME LIMIT
JRST CPOPJ1 ;EXIT TO AVOID TYPING PSEUDO BREAK
LFEED2: TLZN F,FL.CRT ;WAS CR TYPED LAST?
JRST RCH2 ;NO - SEND IT DOWN
TRO F,FR.CL1 ;YES - SET COLUMN 1 FLAG
JRST RCH1 ;AND READ NEXT CHAR
EQUALS: PUSHJ P,FETCHR ;READ NEXT CHARACTER
POPJ P, ;ERROR RETURN - EXIT
CAIE CH,"=" ;ANOTHER?
TLO F,FL.CR ;NO - SET FLAG
JRST COL2 ;IN ANY CASE EXIT
CONTRL: MOVSI T1,PL.CTL ;CHECK IF HE WANTS CONTROL CHARACTER STUFF
TDNE T1,PROFLE(X) ;DOES HE
JRST CPOPJ1 ;NOPE
PUSHJ P,FETCHR ;Read next character
POPJ P, ;Error return - exit
CAIN CH,"^" ;Another ^ ?
JRST CPOPJ1 ;Yes - O.K. Exit
PUSHJ P,LOWUP ;convert lower case to upper if necc.
SUBI CH,100 ;No - convert to control character
JUMPG CH,RCH2 ;O.K. If positive
JRST RCH1 ;Otherwise ignore
MONMD: PUSHJ P,FETCHR ;GET NEXT CHAR.
POPJ P, ;ERROR RETURN - EXIT
CAIN CH,"." ;ANOTHER DOT?
JRST CPOPJ1 ;YES - O.K. EXIT
TLO F,FL.DOT ;SET THE FLAG
TLNE S,LDL.MM ;MONITOR MODE?
JRST COL2 ;YES - SUCCESSFUL RETURN
TLO F,FL.MON
JRST COL2
;IF YOU HAVE SEEN A COMMAND,*,.,!,= YOU CANNOT HAVE A LABEL
LABL: TLNE F,FL.CMD!FL.AST!FL.DOT!FL.SMC!FL.CR!FL.EXC
JRST RCH2 ;YES NO MORE CHECKING
PUSHJ P,FETCHR ;GET NEXT CHARACTER
POPJ P,0 ;ERROR - RETURN
CAIN CH,":" ;2ND COLON?
JRST LABL2 ;YES - MUST BE A LABEL
CAIN CH,CR ;<CR>?
JRST LABL3 ;THAT COULD BE A LABEL TOO
LABL4: TLO F,FL.SAV ;OTHERWISE NOT A LABEL
DPB CH,LDPF ;SO SAVE THE SECOND CHAR.
MOVEI CH,":" ;AND RESTORE THE FIRST COLON
JRST CPOPJ1 ;AND SUCCESS RETURN.
LABL3: PUSHJ P,FETCHR ;<CR> - GET THE <LF>
POPJ P,0 ;ERROR - RETURN
CAIE CH,LF ;MAKE SURE IT IS
JRST LABL4 ;ITS NOT - TOUGH
;FALL INTO LABL2
LABL2: TLO F,FL.LAB ;WE HAVE SEEN A LABEL
JRST CPOPJ1 ;SUCCESS RETURN
PARAM: MOVSI T1,PL.PRM ;CHECK IF PARAMETTERS WANTED
TDNE T1,PROFLE(X) ;LOOK AND SEE
JRST CPOPJ1 ;NO
PUSHJ P,FETCHR ;GET NEXT CHAR
POPJ P, ;Error return - Exit
CAIN CH,"'" ;Another PRIME?
JRST PAR2 ;Yes - Exit
PUSHJ P,LOWUP
CAIGE CH,"A" ;MUST BE A LETTER
JRST NOTALF ;IT'S NOT A LETTER
SUBI CH,"A"-1 ;Convert to digit
CAILE CH,ARGNUM ;Within range?
JRST NOTNUM ;ITS NOT A LETTER OR ANUMBER
JUMPE CH,PARERR ; "
ADDI CH,ARGBP-1(X) ;Add base pointer
PARAM1: MOVE T1,@CH ;Get the byte pointer
JUMPE T1,PARAM2 ;[552] TEST FOR NULL PARAMETERS
PAR5: MOVSI CH,-NESTY ;U CAN NEST PARAMETERS THIS DEEP
HRRI CH,CURBP(Y)
PAR4: EXCH T1,(CH) ;SHOVE A ANOTHER
JUMPE T1,RCH1 ;ON THE STACK
AOBJN CH,PAR4 ;IF U HAVE THE ROOM
JRST MACER
PARAM2: JRST INFILE ;LOOP TO GET A CHAR.
PAR2: TRZ F,FR.CL1 ;NO LONGER IN COL1
JRST CPOPJ1 ;AND EXIT
PAR3: PUSHJ P,SYMB1
JRST PARER2
JRST PAR5 ;IT WAS AN OK SYMBOL
NOTALF: CAIL CH,"0" ;HERE TO SEE IF IT'S A NUMBER OR A SYMBOL
CAILE CH,"9"
JUMPA NOTNM2 ;MUST BE A SYMBOL
JRST PARERR ;IT'S A DIGIT BUT THERE NOT ALLOWED YET
NOTNUM: ADDI CH,"A"-1 ;MAKE IT ASCII
NOTNM2: CAIN CH,.LT. ;[1157]
JRST PAR3 ; .GT. ARE OK
CAIN CH,"[" ; [ ARE OK
JRST PAR3
CAIN CH,"("
JRST PAR3 ; ( ARE OK
CAIN CH,173 ;UPPER CASE PARENTHISIS
JRST PAR3
JRST PARERR ;ANYTHING ELSE YEUGHHHH!
OPFIL: MOVE T3,DEV(X)
MOVEI T2,17
SETZ T4,
OPEN T2 ;Open the channel
JRST NODEV ;ERROR!!
MOVE T1,FILE(X) ;MOVE FILE SPEC TO AC'S
MOVE T2,EXT(X)
SETZ T3,
MOVE T4,PPN(X) ;And his PPN
IFN FTPATH,<
TLNE T4,-1 ;is it a path or a PPN
JRST OPFIL0 ;A PPN
MOVSI T4,PATH(X) ;get the path addres
HRRI T4,PTHBLK ;and the work space address
BLT T4,PTHBLK+SFDLVL+2 ;and copy the path
MOVEI T4,PTHBLK ;and reset the addr.
OPFIL0: >
LOOKUP T1 ;And LOOKUP his file
JRST NOFILE ;FILE WASN'T THERE
SKIPN BLKNO(Y) ;First time?
TRO F,FR.CL1 ;Yes - set column 1 flag.
PJRST CPOPJ1 ;AND EXIT
RDACTP: ILDB CH,CURBP(Y) ;GET NEXT CHAR.
JUMPN CH,CPOPJ1 ;EXIT IF NON-BLANK
MOVSI CH,CURBP+1(Y)
HRRI CH,CURBP(Y)
BLT CH,CURBP+NESTY-1(Y) ;POP NEXT PARAMETER
TRZ F,FR.DIS ;CLEAR EVENT:DISPLAY BIT
SETZM CURBP+NESTY-1(Y)
;FALL THROUGH
FETCHR: TLZE F,FL.SAV ;IS THERE A CHAR IN THE BUFFER?
JRST FETCH2 ;YES - GO AND GET IT
SKIPE CURBP(Y)
JRST RDACTP ;YES GO AND GET CHAR FROM IT.
PUSHJ P,GETCHR ;READ CHAR FORM DISK
POPJ P, ;ERROR RETURN - EXIT
JRST CPOPJ1 ;:OTHERWISE NORMAL RETURN
FETCH2: LDB CH,LDPF ;RESTORE CHAR
JRST CPOPJ1 ;AND EXIT
; here to check if a char. is a break char.
;
ISBRKC: CAIN CH,CR ;[1164] IS IT A CARRIAGE RETURN
PJRST CPOPJ1 ;[1164] YES, THEN PRETEND ITS NOT A BREAK
ISBRK: CAIL CH,LF ;IS IT ONE OF LF,VT,FF OR
CAILE CH,CR ;CR
SKIPA ;NO
POPJ P,0 ;YES
CAIE CH,CNTRLB ;IS IT CONTROL -B
CAIN CH,CNTRLC ;OR CONTROL C
POPJ P,0 ;YES, ONE OF THESE
CAIE CH,ALT ;IS IT ESCAPE
CAIN CH,BELL ;OR BELL
POPJ P,0 ;YES, ONE OF
IFN FTOALT,< ;[1100]
CAIE CH,ALT175 ;THIS ALTMODE
CAIN CH,ALT176 ;OR THAT ONE?
POPJ P,0 ;YES, ONE OFF
> ;[1100] END OF IFN FTOALT
CAIE CH,CNTRLZ ;OR CONTROL Z
AOS (P) ;NO
POPJ P,0
NODEV: ERRms. CNI,<Cannot INIT device>,S
PJRST MSG
NOFILE: ERRMS. MFN,<Macro file not found.>,S
PJRST MSG
PARERR: ERRMS. ICF,<Illegal character follows apostrophe>,S
PJRST MSG
PARER2: MOVE S,T1 ;ON ERROR EXIT FROM GETTAB HANDLER
; ERORR MSG. ADDRESS IS IN T1
PJRST MSG
MACER: ERRMS. CPC,<Cannot nest parameter calls this deep>,S
MSG: PUSH P,S ;PRESERVE S
MIC GET,L ;GET CURRENT STATUS
JFCL
TLNN S,LDL.MM ;IS HE IN MONITOR MODE?
PUSHJ P,FRCMON ;NO-HELL SOON WILL BE THO'
TLZE S,LDL.XX ;IS HE SILENCED
TLO F,FL.XX ;YES
TLZ S,LDL.XX!LDL.TI!LDL.MM
MIC SET,L ;TURN OFF SILENCE AND NON-PERMANENT BITS
JFCL
MOVEI S,[ASCIZ/[ABORT on fatal error]/]
PUSHJ P,TELBTH
PUSHJ P,MCRLF ;GIVE HIM A CR LF
POP P,S ;RESTORE MSG POINTER
MSG2: MIC DISPLAY,L
JFCL
PUSHJ P,PCRLF ;GIVE HIM A <CR><LF>PERIOD.
JRST FIN1
MCRLF: MOVEI S,[ASCIZ/
/]
MIC DISPLAY,L
POPJ P,0
POPJ P,0
PCRLF: MOVEI S,[ASCIZ/
./]
MIC DISPLAY,L
POPJ P,0
POPJ P,0
SETHIB: MOVN P3,LINTOT
ADDI P3,LINSIZ ;[1235] GET COUNT REMAINING
SETHB1: MSTIME T1, ;NOW
IMULI P3,^D50 ;[1106]ESTIMATE OF TIME TAKEN TO DISPLAY
ADD T1,P3 ;+NOW=THEN
SKIPE HIBTIM ;IF NOBODY USING IT LET US
CAMGE T1,HIBTIM ;SOMEBODY SAID WAKE UP SOONER
MOVEM T1,HIBTIM
MOVEM T1,LTIME(Y) ;PUT THAT IN THE PROCESS
POPJ P,0
OUTPNG: MOVEI T3,.TOSOP ;THIS ROUTINE SKIP RETURNS IF LINE IS STILL DOING O/P
MOVEI T4,.UXTRM(L) ;UNIVERSAL TERMINAL STUFF
MOVE T2,[2,,T3]
TRMOP. T2,
POPJ P,0 ;NON SKIP RETURN
JRST CPOPJ1 ;SKIP
;A routine to read a char.
;BLKNO(Y) = Block no. within file
;FILBLK(Y) = Dump area for one block of file
;POINTR(Y) = 7 Bit pointer to dump area
GETCHR: ILDB CH,POINTR(Y) ;Get a char
JUMPN CH,CPOPJ1 ;[1162] GOT ONE
PUSHJ P,SAVTMP ;[1162] SAVE T1 TRU T4 (WITH AUTO-RESTORE)
SKIPA ;[1162] AND TRY FOR MORE BLOCKS
GETCH0: ILDB CH,POINTR(Y) ;[1162] GET A CHARACTER
JUMPE CH,NOBYT1 ;Out of chars in this block
CPOPJ1: AOS (P) ;Skip return for success
CPOPJ: POPJ P,
NOBYT1: HRRZ T1,POINTR(Y)
JUMPE T1,NOBYT
CAIE T1,FILBLK+200
JRST GETCH0 ;[1162]
NOBYT: PUSHJ P,OPFIL ;Open the file
POPJ P, ;Not there
AOS T1,BLKNO(Y) ;Look at next block
USETI (T1) ;Of file
MOVEI T1,FILBLK-1(Y) ;Set up IOWD
HRLI T1,-^D128
SETZ T2,
IN T1 ;Grab the block
SKIPA T1,[XWD 440700,FILBLK(Y)]
JRST [ RELEAS ;[1107]
POPJ P,0 ;[1107] MUST BE END OF FILE
] ;[1107]
RELEAS
MOVEM T1,POINTR(Y)
HRLI T1,^D-128
HRRI T1,FILBLK(Y)
NOBYT2: MOVE T2,(T1) ;GET WORD OF BUFFER
TRNE T2,1 ;IS IT A LINE NO?
PUSHJ P,NOBYT3 ;YES-ITS NOT NOW
AOBJN T1,NOBYT2 ;DO THE WHOLE BUFFER
JRST GETCH0 ;[1162] Go grab next char.
;HERE TO DELETE LINE NUMBER TEXT POINTED TO BY T1
NOBYT3: SETZB T2,(T1) ;THAT TAKES CARE OF NNNNN
DPB T2,[POINT 7,1(T1),6]
;AND THAT TAKES CARE OF SPACE OR TAB IN NEXT WORD
POPJ P,0
SUBTTL FUNCTION SERVICE ROUTINE
;THIS ROUTINE HANDLES FUNCTIONS SUCH AS GETTAB JOB ETC.
;EACH FUNCTION IS SPECIFED BY 6 ARGUMENTS:-
; A - NAME
; B - TYPE-OUT MODE (A NUMERIC VALUE)
; C - CODE TO GET FUNCTION VALUE (IF CALLED IN MASTER)
; D - CODE TO GET FUNCTION VALUE (IF CALLED IN SLAVE)
; E - ADDR. FOR MASTER CALL TO DISPATCH TO.
; F - ADDR. FOR SLAVE CALL TO DISPATCH TO
DEFINE FUNCTN,< ;;TABLE OF FUNCTIONS
.FF. DATE,M..DAT,<DATE T1,>,<DATE T1,>
.FF. TIME,M..MSE,<MSTIME T1,>,<MSTIME T1,>
.FF. PPN,M..PPN,<MOVE T1,OPPN(X)>,<GETPPN T1,>
.FF. PROGRAMMER,M..OC2,<HRRZ T1,OPPN(X)>,<GETPPN T1,>,SYMOUT,SYMPG0
.FF. PROJECT,M..OC2,<HLRZ T1,OPPN(X)>,<GETPPN T1,>,SYMOUT,SYMPJ0
.FF. TTY,M..OC2,<HRRZ T1,LINE(X)>,<SETO T1,>,SYMOUT,SYMTY0
.FF. JOB,M..DEC,<HRRZ T1,JOB(X)>,<PJOB T1,>
.FF. GETTAB,M..BIN,,,SYMGTX,SYMGT0
.FF. LENGTH,M..DEC,,,MLENGT,SLENGT
.FF. ABORT,0,<TLO S,LDL.CA>,,ACTCDE,ACTERR
.FF. BREAK,0,<TLO S,LDL.CB>,,ACTCDE,ACTERR
.FF. CANCEL,0,<TLO S,LDL.CC>,,ACTCDE,ACTERR
.FF. EXIT,0,<SETZ S,>,,ACTCDE,ACTERR
.FF. PROCEED,0,<TLO S,LDL.CP>,,ACTCDE,ACTERR
.FF. RETURN,0,<TRO F,FR.EOF>,,ACTXCT,ACTERR ;;[1043]
REPEAT 0,<
.FF. OCTAL,M..OC2,,,PRTCDM,PRTCDS
.FF. DECIMAL,M..DEC,,,PRTCDM,PRTCDS
.FF. BINARY,M..BIN,,,PRTCDM,PRTCDS
.FF. OCTALZ,M..OCT,,,PRTCDM,PRTCDS
>
.FF. SILENCE,0,<TLO S,LDL.XX>,,ACTSIL,ACTERR ;;[1127]
.FF. REVIVE,0,<TLZ S,LDL.XX>,,ACTCDE,ACTERR
.FF. ERROR,0,<MOVE T1,LDP.ER>,,ACTSET,ACTERR
.FF. OPERATOR,0,<MOVE T1,LDP.OP>,,ACTSET,ACTERR
.FF. NOERROR,-1,<MOVE T1,LDP.ER>,,ACTSET,ACTERR
.FF. NOOPERATOR,-1,<MOVE T1,LDP.OP>,,ACTSET,ACTERR
.FF. MICFILE,M..FIL,<MOVEI T1,DEV(X)>,<MOVEI T1,DEV(X)>
.FF. PATH,M..PTH,,,MPATH,SPATH
.FF. SLEEP,-1,,,SYMSLP,ACTERR
.FF. PTHPPN,M..PPN,,,MPTHPN,SPTHPN
IFN FTMBCH,<
.FF. JOBNAME,M..SSX,<MOVE T1,JOBNAM(X)>,<MOVE T1,JOBNAM(X)>
>
.FF. PSHIFT,0,,,PSHIFT ;;[1075]
.FF. PROTATE,0,,,PROTATE ;;[1137]
IFN FTCJOB,<
.FF. LOGFILE,M..FIL,<MOVEI T1,LOGDEV(Z)> ;;[1103]
> ;END OF IFN FTCJOB
.FF. ERRCHR,M..CHR,<LDB T1,LDP.ER>,<LDB T1,LDP.ER> ;;[1113]
.FF. OPRCHR,M..CHR,<LDB T1,LDP.OP>,<LDB T1,LDP.OP> ;;[1113]
.FF. LDBMIC,M..OCT,<MOVE T1,S>,<MOVE T1,S> ;;[1113]
.FF. PROFLE,M..OCT,<MOVE T1,PROFLE(X)>,<MOVE T1,PROFLE(X)> ;;[1113]
.FF. DAY,0,,,MSYDAY,SSYDAY ;;[1117]
.FF. CR,M..STR,<MOVEI T1,[064000,,0]>,<MOVEI T1,[064000,,0]> ;;[1141]
.FF. CRLF,M..STR,<MOVEI T1,[064240,,0]>,<MOVEI T1,[064240,,0]> ;;[1141]
.FF. ALPHABET,M..STR,<MOVEI T1,.ALPHA>,<MOVEI T1,.ALPHA> ;;[1141]
.FF. NUMERIC,M..STR,<MOVEI T1,.NUMERIC>,<MOVEI T1,.NUMERIC> ;;[1141]
.FF. ASCII,M..STR,<MOVEI T1,.ASCII>,<MOVEI T1,.ASCII> ;;[1141]
>
DEFINE .FF.(A,B,C,D,E,F),<<SIXBIT/'A/>>
SYMTAB: FUNCTN
SYMSIZ==.-SYMTAB
;MASTER SYMBOL DISPATCH
DEFINE .FF.(A,B,C,D,E<SYMOUT>,F),<B,,E>
MSTDSP: FUNCTN
;SLAVE SYMBOL DISPATCH
DEFINE .FF.(A,B,C,D,E,F<SYMOUT>),<B,,F>
SLVSDP: FUNCTN
;MASTER ACTION
DEFINE .FF.(A,B,C<JFCL>,D,E,F),<
IFB <C>,<
JFCL
>
IFNB <C>,<
C
>
>
MSTACT: FUNCTN
;SLAVE ACTION
DEFINE .FF.(A,B,C,D<JFCL>,E,F),<
IFB <D>,<
JFCL
>
IFNB <D>,<
D
>
>
SLVACT: FUNCTN
;HERE TO DEAL WITH ACTION PARAMETERS
;E.G. '<EXIT> etc.
ACTSIL: MOVSI T2,PL.NSL ;[1127] GET THE NO SILENCE BIT
TDNN T2,PROFLE(X) ;[1127] IS IT SET
TLO S,LDL.XX ;[1127] NO, ALLOW HIM TO SHUTUP
ACTCDE: MIC SET,L ;DO THE SET
JFCL
ACTCDF: MIC GET,L ;RESET S
SETZ S,
ACTXCT: WENABL ;[1045][1063]
SETZM SYMBFX(X) ;[1045]MAKE SURE NOWT FOR US TO O/P
WLOCK ;[1045]
JRST SYMDUN ;ALL DONE
;ILLEGALL IN SLAVE MODE
ACTERR: ERROR. IAP,<Illegal action parameter>
;HERE TO DEAL WITH ACTON PARAMETERS OF THE FORM
; ERROR/NOERROR OPERATOR/NOOPERATOR
ACTSET: SETOM GTLOCK ;MASTER FLAG
;[1072] 1 LINE REMOVED
PUSH P,[0] ;PREPARATION
JUMPN T2,ACTST0 ;IT WAS A NO?????
PUSHJ P,CHARIN ;[1072] EAT AS REQD.
CAIE CH,"(" ;VALID OPENING?
JRST SYMERR ;NO
PUSHJ P,CHARIN ;GET THE CHAR
EXCH CH,(P) ;NOTE IT
PUSHJ P,CHARIN ;GET THE CLOSE
CAIE CH,")" ;VALID?
JRST SYMERR ;NO
ACTST0: POP P,CH ;RESTORE
DPB CH,T1 ;SET UP S
JRST ACTCDE ;AND AWAY U GO
;HERE TO HANDEL PRINTS FOR ALTERNATE MODES
;E.G. OCTAL,BINARY
PRTCDM: SETOM GTLOCK ;HERE FROM MASTER
PRTCDS: SETZM CH.SAV ;HERE FROM SLAVE
CAIE CH,"(" ;OPEN
JRST SYMERR ;ILLEGAL
PUSHJ P,SYMPRM ;GET THE PARAMETER
JRST SYMERR ;SOMAT NOT RITE!
CAIE CH,")" ;CLOSE?
JRST SYMERR ;ILLEGAL
MOVE T1,N ;POSITION
JRST SYMOUT ;OUTPUT IT
; Code to handle the LENGTH function as implemented by NIH
; Included in MIC as part of EDIT [1047]
;
MLENGT: JRST E%%MLN ;**TEMP** MASTER LENGTH NOT ALLOWED
SKIPE GTLOCK ;PROHIBIT RECURSIVE USE OF LENGTH
JRST E%%LER ;APPROPRIATE SLAP OF WRIST
SETOM GTLOCK ;FOR THE NEXT TIME
SLENGT: PUSHJ P,CHARIN ;GET THE LEFT PAREN.
CAIE CH,"(" ;IS IT A "("????
JRST E%%LLP ;NO - SYNTAX ERROR
PUSHJ P,CHARIN ;PEPARE TO CALL INSTR
CAIE CH,"$" ;IS HE INTODUCING A STRIN PARAMETER?
CAIN CH,42 ;OR A STRING CONSTANT
JRST LENGT1 ;YES
MOVEM CH,CH.SAV ;REMEMBER WHAT HE SAID
MOVEI CH,"$" ;AND ASSUME HE MEANT A STRING PARAMETER
LENGT1: PUSH P,A ;SAVE A IN CASE WE ARE CONCATENATING
MOVEI A,FIRST+ARGNUM*4 ;USE UPPER HALF OF FIRST
PUSHJ P,INSTR ;COPY THE STRING THERE
PUSHJ P,CHARIN ;HOPE WE GET A CLOSING PAREN.
CAIE CH,")" ;WAS IT?
JRST E%%LRP ;NO, SYNTAX ERROR
MOVSI N,440700!A ; N := POINT (7, 0(A))
SETO T1, ;T1:=-1 BECAUSE WE COUNT 1 TOO MANY
LENGT0: AOS T1 ;GET THE LENGTH IN T1
ILDB CH,N ;AS WE SKIP ALONG THE CHARACTER STRING
JUMPN CH,LENGT0 ;UNTIL WE ARE DONE
POP P,A ;RESTORE WHAT WE SAVED
MOVEI T2,M..DEC ;VERY NAUGHTILY RESTORE OUR TYPE OUT MODE
JRST SYMOUT ;AND OUTPUT THE RESULT
;
ERRMS. LER,<Nested LENGTHs are illegal>
JRST CLNSTK
;
ERRMS. LLP,<"LENGTH" requires left parenthesis>
JRST CLNSTK
;
ERRMS. LRP,<"LENGTH" requires right parenthesis>
POP P,A ;GET LENGTH BACK
JRST CLNSTK
;
ERRMS. MLN,<"LENGTH" parameter does not work use $LENGTH only>
JRST CLNSTK
; This section implements the '<sleep(n)> command added
; by edit [1054]
;
SYMSLP: SKIPE GTLOCK ;LOCK FOR RECURSION
JRST E%%NSI ;CANNOT NEST SLEEP CALLS
SETOM GTLOCK ;FOR NEXT TIME AROUND
SETZM CH.SAV ;DO NOT WANT THE TERMINATOR
CAIE CH,"(" ;INTRODUCING AN ARGUMENT
JRST E%%IAF ;NO THEREFOR THUMBS DOWN
PUSHJ P,SYMPRM ;GET THE PARAMETER IN
JRST E%%IAF ;YELLOW CARD THAT MAN
JUMPGE N1,E%%IAF ;DITTO
CAIE CH,")" ;MUST BE TIDY
JRST E%%IAF ;HE WAS NOT!
IMULI N,^D1000 ;CHANGE SECS TO MILLISECS
MSTIME T1, ;GET NOW
ADD T1,N ;CALCULATE THEN
WENABL
MOVEM T1,SLPTIM(X) ;STORE WHEN HE IS TO BE RE-SCHEDULED AFTER
JRST ACTXCT ;ALL DONE
;
ERROR. NSI,<Nested SLEEPs are illegal>
;HERE IS WHERE WE COME TO DEAL WITH FUNCTIONS CALLED FROM MASTER
SYMB1: SKIPE ARGTYP ;ARE THESE ALLOWED?
JRST CPOPJ1 ;NO - BUT NOT AN ERROR
SKIPE CH,CURBP+7(Y) ;CHECK THE PARAMETER STACK
JRST MACER ;NO ROOM
MOVE CH,[JRST GETTB1] ;SET UP NEW LOW LEVEL I/P ROUTINE
PUSHJ P,SVLOWN ;AND SAVE THE EXISTING ONE
PUSH P,["<"] ;PUT A MARKER ON THE STACK
HRRZ T1,JOB(X) ;JOB # IS DEFAULT TABLE INDEX
MOVEM T1,DEFNDX ;SET UP THE DEFAULT INDEX
PUSHJ P,ALPHI ;READ A 6-BIT WORD
TDNN WD,[7777,,-1] ;[1112] IS IT A SINGLE CHARACTER
JRST [ LSH WD,-^D30 ;[1112] DID WE READ JUST A SINGLE CHAR.?
CAIL WD,'A' ;[1112] AND IS IT IN THE RANGE A THRU Z
CAILE WD,'Z' ;[1112]
JRST SYMERR ;[1112] NOPE, MUST BE INVALID
JRST PRMSYM ;[1112] YES, PARAMETER IS A SYMBOL
]
;IS IT A SYMBOL WE KNOW ABOUT
MOVSI T3,-SYMSIZ
CAME WD,SYMTAB(T3)
AOBJN T3,.-1
JUMPG T3,SYMER3
MOVEM CH,CH.SAV ;SAVE THE TERMINATOR
XCT MSTACT(T3) ;DO THE APPROPRIATE ACTION
JFCL ;DEFENSIVE
HLRZ T2,MSTDSP(T3) ;SET UP THE APPROPRIATE MODE
HRRZ T3,MSTDSP(T3) ;GET DISPATCH ROUTINE NAME
JRST (T3) ;AND DISPATCH
;HERE FOR GETTABS FORM MASTER
SYMGTX: SKIPE GTLOCK ;LOCK FOR RECURSIVE GETTABS
JRST SYMERM ;WHICH ARE NOT ALLOWED
SETOM GTLOCK ;SET THE LOCK
SETZM CH.SAV ;GETTABS DON'T WANT TO SAVE THE TERMINATOR
JRST SYMGT1 ;DO THE GETTAB
; THIS IS WHERE WE COME FROM SLAVE
SYMGET: PUSH P,["$"] ;MARKER
HLRZ T2,SLVSDP(T3) ;GET MODE
XCT SLVACT(T3) ;DO APPROPRIATE FING.
JFCL ;DEFEND AGAINST FUNNY GETPPN'S
HRRZ T3,SLVSDP(T3) ;GET ADDR. OF DISPATCH ROUTINE
JRST (T3) ;DISPATCH
SYMGT0: SETZM CH.SAV ;ENTRY FOR GETTABS
PJOB T1, ;GET HIS JOB NO.
MOVEM T1,DEFNDX ;SET UP THE DEFAULT INDEX
JRST SYMGT1
SYMERM:
ERRMS. NGN,<Nested GETTABs are not allowed>
PJRST CLNSTK
; Here is where we handle substitution of parameters in outer nested processes
; added by edit [1112]
;
PRMSYM: PUSH P,WD ;SAVE THE PARAMETER NAME
PUSHJ P,DECIN ;GET THE OUTER PROCESS NUMBER
POP P,WD ;GET THE PARAMETER BACK
CAIE CH,">" ;DID WE END PROPERLY
JRST SYMERR ;NOPE
MOVE T2,X ;GET COPY OF PDB ADDRESS
PUSHJ P,MUP ;MOVE TO UPPER PROCESS
JRST SYMERR ;FAILED
MOVEI T2,ARGBP-'A'(T1) ;GET THE ADDRESS OF THE PARAMETER
ADDI T2,(WD) ;AND CALCULATE ADDRESS OF PARAMETER
POP P,CH ;GET FLAG BACK
SETZM GTLOCK ;CLEAR THE INTERLOCK
SETZB CH,CH.SAV ;CLEAN UP
MOVE T1,(T2) ;POINT AT STRING
JRST CPOPJ1 ;AND RETURN
;
; Routine to work out address of outer PDB
;
MUP1: MOVEI T2,-1(T1) ;MOVE ONWRDS IN AN OUT SORT POF BACK WAY
MUP: SKIPN T1,LAST(T2) ;WHATS THIS ONES STATE?
POPJ P,0 ;NO SUCH PROCESS
SOJG N,MUP1 ;COUNT OUTWARD
SOJA T1,CPOPJ1 ;NO WE ARE THERE
POPJ P,0 ;ERROR
SYMTY0: GETLCH T1 ;GET LINE NO
ANDI T1,3777 ;NO UDX
JRST SYMOUT ;DO IT
SYMPG0: HRRZS T1 ;JUST PROG
JRST SYMOUT
SYMPJ0: HLRZS T1 ;JUST PROJ
JRST SYMOUT ;DO IT
;
; Tis page implements the PSHIFT function introduced by edit [1076]
;
PSHIFT: WENABL ;WE R GONNA MESS WIF HIS DATA BASE
SKIPE T4,ARGBP(X) ;ANY PARAMETER A?
PUSHJ P,LOSE1 ;IF YES, RECLAIM THE SPACE
TDZA T1,T1 ;[1137] 0 MEANS PSHIFT
PROTATE: MOVE T1,ARGBP(X) ;[1137] ANYTHING ELSE MEANS ROTATE
PUSH P,T1 ;[1137] SAVE IT
WENABL ;[1137] ENSURE WE CAN CHANGE THINGS
MOVEI T1,ARGBP-1(X) ;GET ADDRESS OF A-1
PSHIF0: ADDI T1,1 ;ADVANCE TO NEXT
MOVE T2,1(T1) ;GET FROM PARAM
MOVEM T2,(T1) ;STORE IN TOO PARAM (O' FOR A REVERSE BLT!)
CAIE T1,ARGBP+ARGNUM-2(X) ;HAVE WE REACHED THE LAST?
JRST PSHIF0 ;BRANCH IF YES
POP P,ARGBP+ARGNUM-1(X) ;[1137] Z:=NULL OR Z:=A
WLOCK ;SHUT THE SHOP
JRST ACTCDF ;RESET S AND ON OUR WAY
;
; This page implements the DAY parameter introduced by edit [1117]
;
MSYDAY: ;DAY FROM MASTER
SSYDAY: ;DAY FORM SLAVE
MOVE T1,[%CNYER] ;GET YEAR
GETTAB T1,
JRST SYMER2 ;OOOO
MOVEM T1,YEAR ;SAVE IT
MOVE T1,[%CNMON] ;GET MONTH
GETTAB T1,
JRST SYMERR2 ;OOO
MOVEM T1,MONTH ;SAVE IT
MOVE T1,[%CNDAY] ;GET DAY
GETTAB T1,
JRST SYMER2 ;OOO
MOVEM T1,DAY ;SAVE IT
PUSHJ P,GETDAY ;NOW GET DAY OF THE WEEK (IN T2)
MOVE T1,DAYTBL(T2) ;GET ADDRESS OF APPR. STRING IN T1
MOVEI T2,M..STR ;OUTPUT MODE
JRST SYMOUT ;GO DO IT
;
; Some constants
;
F2.6: EXP 2.6E0
F.19: EXP 0.19E0
;
GETDAY: MOVE T1,MONTH
SUBI T1,2
MOVEM T1,MONTH
JUMPG T1,MGR
SOS YEAR ;OTHERWISE DECREMENT YEAR
ADDI T1,^D12 ;AND ADD 12 TO MONTH
MOVEM T1,MONTH
MGR: MOVE T2,YEAR
IDIVI T2,^D100 ;CENTURY:=YEAR DIV 100
MOVEM T2,CENT
MOVEM T3,YEAR ;YEAR:= YEAR MOD 100
MOVE T1,MONTH
FLTR T1,T1 ;FLOAT MONTH
FMPR T1,F2.6
FSBR T1,F.19
FIX T1,T1 ;T1:=2.6*MONTH-0.19
IDIVI T3,4 ;YEAR DIV 4
ADD T1,T3
ADD T1,YEAR
ADD T1,DAY
MOVE T3,CENT
IDIVI T3,4
ADD T1,T3
SUB T1,CENT
SUB T1,CENT
IDIVI T1,7
POPJ P,0
;THIS SECTION IMPLEMENTS THE PATH FUNCTION
; ADDED BY EDIT [1053]
;
GPATHS: PJOB T1, ;SLAVE ENTRY - GET HIS JOB NUMBER
SKIPA ;AND DON'T DO WHAT MASTER DOES
GPATHM: HRRZ T1,JOB(X) ;GET JOB NUMBER THE MASTERFUL WAY
HRLZS T1 ;POSITION IT PROPER
HRRI T1,.PTFRD ;THE PATH READ FUNCTION
MOVEM T1,PTHBLK ;SET UP THE PATH BLOCK
MOVE T1,[SFDLVL+3,,PTHBLK] ;AND SET UP THE UUO ARGS
SETZM .PTSWT(T1) ;PROPERLY
PATH. T1, ;GET THE REQUIRED PATH
SKIPA ;OH DEARRIE MEE
AOS (P) ;ON SUCCESS SKIP...
POPJ P,0 ;...RETURN
;
ERRMS. PFL,<PATH. UUO failed in function>
PJRST CLNSTK ;AND CLEAN UP AND EXIT
;
;
SPATH: PUSHJ P,GPATHS ;GET THE SLAVE PATH
JRST E%%PFL ;PATH. UUO FAILED
JRST FPATH ;OK GOT IT
;
MPATH: PUSHJ P,GPATHM ;GET THE PATH THE MASTERFUL WAY
JRST E%%PFL ;PATH. UUO FAILED
; JRST FPATH ;OK, GOT IT
;
FPATH: MOVEI T1,PTHBLK ;REMEMBER FROM WHERE
JRST SYMOUT ;AND O/P IT
;This section implements the PTHPPN function
; added by edit [1055]
;
SPTHPN: PUSHJ P,GPATHS ;GET THE SLAVE PATH
JRST E%%PFL ;PATH. UUO FAILED
JRST PTHPPN ;AND GOT IT
;
MPTHPN: PUSHJ P,GPATHM ;GET THE MASTER WAY
JRST E%%PFL ;PATH. UUO FAILED
; JRST PTHPPN ;AND GOT IT
;
PTHPPN: MOVEI T1,PTHBLK ;GET THE ADDRESS OF THE PATH BLOCK
MOVE T1,.PTPPN(T1) ;AND GET THE PATH PPN
JRST SYMOUT ;AND O/P IT
;FROM HERE BOTH GETTAB ENTRIES USE COMMON CODE
;THAT IS COMMON TO SLAVE AND MASTER !!!!
SYMGT1: CAIE CH,"(" ;IF ANY ARGS
JRST SYMDF3 ;WANTS ALL DEFAULTS (I HOPE!)
PUSHJ P,SYMPRM ;GET A PARAMETER
JRST SYMERR ;SOMAT WRONG!
JUMPGE N1,SYMER4 ;(, IS ILLEGAL
PUSH P,N ;SAVE IT TILL READY
CAIN CH,")" ;IF THERE IS NO 2ND PARAMETER THE LIST
; SHOULD END WITH A ) OTHERWISE ,
JRST SYMDF2 ;1 PARAMETER ONLY USE DEFAULTS FOR REST
PUSHJ P,SYMPRM ;GET 2ND PARAMETER
JRST SYMERR ;BETTER LUCK NEXT TIME
CAMN N,[-1] ;INDEX=-1 MEANS USE JOB NO.
MOVE N,DEFNDX ;ITS HERE
JUMPGE N1,SYMER4 ;N1=0 MEANS FORMAT IS ,, OR ,) I.E. ERROR
PUSH P,N ;SAVE IT
CAIN CH,")" ; IS THERE A 3RD PARAMETER
JRST SYMDF1 ;NO--USE DEFAULT
PUSHJ P,CHARIN ;GET THE FIRST CHAR. OF THE NAME
MOVEM CH,CH.SAV ;REMEMBER IT FOR RE-READ
PUSHJ P,LOWUP ;convert lower case to upper if necc.
CAIL CH,"A" ;HAVE WE READ AN ALPHA
CAILE CH,"Z" ;CHAR.
JRST SYMGT2 ;NO, PROBABLY OLD STYLE NUMERIC
PUSHJ P,WDREAD ;READ THE NAME OF THE TYPE-OUT MODE
TLNN WD,7777 ;NAME MUST BE AT LEAST 3 CAHRS LONG
JRST [SKIPE GTLOCK ;WOT R WE (MASTER OR SLAVE)
JRST SYMER4 ;MASTER THEREFORE ERROR
PUSHJ P,ATOM1C ;[1050] FOR COMPATABILLITY
JRST SYMGT3]
HLRZS WD
MOVSI N,-VALMDS ;NO. OF VALID MODES
HLRZ N1,MODTAB(N) ;GET A MODE NAME
CAME N1,WD ;THIS ONE?
AOBJN N,.-2 ;NOPE
JUMPGE N,SYMER4 ;DIDN'T FIND IT
HRRZS N ;GET THE MODE INDEX
JRST SYMGT3
SYMGT2: PUSHJ P,SYMPRM ;GET 3RD PARAMETER
JRST SYMERR ;OH DEAR
JUMPGE N1,SYMER4 ;NO NO.THUS FORMAT IS ,, ,) I.E. ERROR
SYMGT3: MOVEI T1,V..GTB ;[1104] IS THIS MODE VALID FOR GETTABS
TDNN T1,MODTAB(N) ;[1104] CHECK IN THE TABLE
JRST SYMER4 ;[1104] IT WASN'T
PUSH P,N ;SAVE IT TILL READY
CAIE CH,")" ;SHOULD END WITH )
JRST SYMERR ;DIDN'T
JRST SYMDO ;NOW TO DO THE GETTAB
SYMDF3: PUSH P,DEFTBL ;HERE IF USING ALL DEFAULTS
SYMDF2: PUSH P,DEFNDX ;DEFAULT INDEX AND TABLE
SYMDF1: PUSH P,DEFMOD ;DEFAULT MODE ONLY
; JRST SYMDO
SYMDO: POP P,T2 ;GET THE ARGS.. FIRST MODE
POP P,T1 ;INDEX
HRLZS T1 ;IN RIGHTFUL PLACE
POP P,N ;THEN TABLE ?
HRR T1,N ;IN ITS PLACE
GETTAB T1, ;DO THE GETTAB
JRST SYMER2 ;DIDN'T WORK
;RESULT OF GETTAB IS IN T1 NOW TO O/P IT
SYMOUT: MOVEI N,V..SLV ;[1026] GET THE SLAVE FLAG
MOVE CH,(P) ;[1026] GET FLAG OF THE STACK
CAIN CH,"$" ;[1026] R WE A MASTER
MOVEI N,V..MST ;[1026] YES, GET THE MASTER FLAG INSTEAD
SKIPLE T2 ;[1010] CHECK IF VALID OUTPUT MODE
TDNN N,MODTAB(T2) ;[1026] IS THIS TYPE OUT MODE VALID
JRST SYMERR ;NO....
MOVE N,T1 ;PUT IT IN O/P PLACE
CAIN CH,"$" ;[1037] ARE WE THE MASTER?
SKIPA T4,SYMPNT ;[1037] SET UP POINTER TO THE SLAVE O/P AREA
MOVE T4,SYMPNX ;[1037] SET UP POINTER TO THE MASTER O/P AREA
CAIE CH,"$" ;[1166] MASTER?
SKIPA T3,[PUSHJ P,SYMPTR] ;[1164] MASTER PUTTER
MOVE T3,[IDPB CH,T4]
PUSH P,LOWOUT ;SAVE THE EXISTING OUTPUT PATH
MOVEM T3,LOWOUT ;AND SET UP THE ONE WE WANT
WENABL ;[1037] MAY BE A MASTER
XCT PRNTAB(T2) ;DO THE PRINT
SETZ CH,
CAIE T2,2 ;SKIP IF ASCII
IDPB CH,T4 ;PUT A ZERO BYTE AT END OF RESULT
WLOCK ;[1037] MAY BE A MASTER
POP P,LOWOUT ;RESTORE ORIG. O/P PATH
SYMDUN: MOVE CH,(P) ;ARE WE SLAVE OR ?
CAIN CH,"$" ;OR $GETTAB
JRST SLVCLS
PUSHJ P,CHARIN ;GET THE CLOSING DELIMITER
CAIN CH,76 ;[1120] ONE OF THESE
JRST SYMDO4 ;YES
CAIN CH,"]" ;OR...
JRST SYMDO4 ;YES
CAIN CH,")" ;OR...
JRST SYMDO4 ;YES
CAIE CH,175 ;OR
JRST SYMERR ;NONE OF THESE..OH DEAR
SYMDO4: POP P,CH ;CLEAN THE STACK
SETZM GTLOCK ; CLEAR THE GETTAB LOCK
SETZB CH,CH.SAV
MOVE T1,SYMPNX ;PUT THE POINTER ON THE STACK AND IT
;WILL BE PUSHED BY PARAM(PAR5)
;THIS IS WHERE WE LEAVE "GETTAB" IF IT HAS BEEN CALLED FROM THE MASTER PROCESS
JRST CPOPJ1 ;UP UP AND AWAY
SLVCLS: MOVE BP,SYMPNT ;SET UP THE POINTER TO RESULT
POP P,CH ;CLEAN THE STACK
PUSHJ P,CHARIN ;GET THE NXT CH MAY BE . OR +
MOVEM CH,CH.SAV ;OR ARITH OP.
JRST CPOPJ1
PRNTAB: JRST SYMERR ;TABLE OF O/P ENTRIES
PUSHJ P,BINPRT ;BINARY PRINTING
PUSHJ P,ASCPRT ;ASCII PRINTING
PUSHJ P,SSIXBP ;SIXBIT PRINTING
PUSHJ P,DECPRT ;DECIMAL PRINTING
PUSHJ P,PRTOCT ;OCTAL PRINTING
PUSHJ P,PRTPPN ;PPN PRINTING
PUSHJ P,TIMPRT ;TIME PRINTING
PUSHJ P,TMPRTS ;TIME PRINTING ARG. IN SECONDS
PUSHJ P,OCTPRT ;OCTAL PRINTING - SUPPRESS LEADING ZEROES
PUSHJ P,PRDATE ;DATE PRINTING
PUSHJ P,OUTSPEC ;FILE SPEC
PUSHJ P,SSXBP ;SIX BIT PRINTING (END ON NULL!)
PUSHJ P,PRTPTH ;[1053]PATH PRINTING
PUSHJ P,PRTCHR ;[1113] CHARACTER PRINTING
PUSHJ P,STRUTN ;[1117] STRING PRINTING
VALMDS==.-PRNTAB-1 ;[1026]
SYMPNT: POINT 7,SYMBUF
SYMPNX: POINT 7,SYMBFX(X) ;[1037] MASTER BUFFER POINTER
SYMERR:
ERRMS. EFC,<Error in system parameter call>
PJRST CLNSTK
SYMER2:
ERRMS. ERT,<Error return taken by GETTAB UUO>
PJRST CLNSTK
SYMER3:
ERRMS. UKF,<Unknown system parameter>
PJRST CLNSTK
SYMER4:
ERRMS. IAF,<Illegal argument format for system parameter>
PJRST CLNSTK
;A ROUTINE TO CLEAN UP A MESSY STACK
;POP'S AND THROWS AWAY EVERYTHING ON TOP OF THE STACK
;UP TO AND INCLUDING AN "$" OR "<"
;NORMALLY ONLY CALLED AFTER AN ERROR
CLNSTK: POP P,T2 ;GET SOMAT
CAIN T2,"<" ;IS IT THIS MARKER
JRST STKCLN ;YES
CAIE T2,"$" ;OR THIS
JRST CLNSTK ;NO TRY AGAIN
STKCLN: SETZM GTLOCK ;CLEAR THE LOCK
JRST CPOPJ ;WE HAVE A CLEAN STACK(I THINK)
;TABLES OF PRINT OUT MODES
V..SLV==400000 ;[1026]SET IF MODE IS AVAILABLE TO SLAVE
V..MST==200000 ;[1026]SET IF MODE IS AVAILABLE TO THE MASTER
V..GTB==100000 ;[1104]SET IF MODE IS AVAILABLE TO GETTABS
V..BTH==V..SLV!V..MST ;[1026]SET IF MODE IS AVALABLE TO BOTH
DEFINE MODES,<
.M. BIN,V..BTH!V..GTB ;;[1026]BINARY
.M. ASC,V..BTH!V..GTB ;;[1026]ASCII
.M. SIX,V..BTH!V..GTB ;;[1026]SIXBIT
.M. DEC,V..BTH!V..GTB ;;[1026]DECIMAL
.M. OCT,V..BTH!V..GTB ;;[1026]OCTAL
.M. PPN,V..BTH!V..GTB ;;[1026]PPN
.M. MSE,V..BTH!V..GTB ;;[1026]MSEC TIME
.M. SEC,V..BTH!V..GTB ;;[1026]SECONDS
.M. OC2,V..BTH!V..GTB ;;[1026]OCTAL - NO LEADING ZEROES
.M. DAT,V..BTH!V..GTB ;;[1026]DATE
.M. ,V..BTH,FIL ;;[1026]FILE SPEC - INTERNAL USE ONLY
.M. ,V..BTH,SSX ;;[1026]14 SIX BIT (END ON NULL!) INTERNAL
.M. ,V..BTH,PTH ;;[1052] 15 PATH PRINTING MODE
.M. ,V..BTH,CHR ;;[1113] 16 CHARACTER PRINTING MODE
.M. ,V..BTH,STR ;;[1117] 17 STRING PRINTING MODE
>
DEFINE .M.(A,B,C)<
IFNB <A>,< M..'A==.N>
IFB <A>,< M..'C==.N>
.n=.n+1
XWD ''A'',B
>
MODTAB: 0 ;[1026]
.n=1 ;[1026]
MODES
.ALPHABET:
ASCIZ /ABCDEFGHIJKLMNOPQRSTUVWXYZ/ ;[1141]
.NUMERIC: ;[1141]
ASCIZ /1234567890/ ;[1141]
.ASCII: ;[1141]
CNTR=0 ;;[1141]
REPEAT 22,< ;;[1234]
BYTE (7) CNTR+1,CNTR+2,CNTR+3,CNTR+4,CNTR+5 ;;[1141]
CNTR=CNTR+5 ;;[1141]
> ;END OF REPEAT 22 ;;[1234]
BYTE (7) 133,134,135,136,136 ;;[1234]
CNTR=CNTR+4 ;;[1234]
REPEAT 6,< ;;[1234]
BYTE (7) CNTR+1,CNTR+2,CNTR+3,CNTR+4,CNTR+5 ;;[1234]
CNTR=CNTR+5 ;;[1234]
> ;END OF REPEAT 6 ;;[1234]
BYTE (7) 175,176,177 ;;[1234]
; THIS ROUTINE READS IN PARAMETERS TERMINATED BY , OR )
SYMPRM: MOVN N,GTLOCK ;MASTER OR SLAVE?
XCT GETRIT(N) ;DO APPROPRIATE THING
SKIPN GTLOCK ;SLAVE MODE?
PUSHJ P,PLSMNS ;YES-CHECK UP ON +,-
;NB!!!! AT MOMENT ARITH. EXPR. ARE NOT!! ALLOWED
; IN GETTAB ARGUMENTS
SYMPR2: CAIE CH,"," ;END OF A PARAMETER OK
CAIN CH,")" ;END OF PARAMETER LIST OK
JRST CPOPJ1
CAIE CH,"%" ;OCTAL?
POPJ P,0 ;NO
JUMPN N1,CPOPJ ;CAN'T HAVE IN MIDDLE
PUSHJ P,RDOCTL
JRST SYMPR2
GETRIT: PUSHJ P,ATOM ;SLAVE PROCESS
PUSHJ P,INTIN ;MASTER
;THIS ROUTINE DEALS WITH AN ASCII WORD IN TABLE
ASCPRT: MOVEM T1,SYMBUF ;NO CONVERSION NEC.
SETZM SYMBUF+1 ;MAKE SURE A 0 BYTE FOLLOWS
MOVEM T1,SYMBFX(X) ;[1051]JUST IN CASE WE ARE THE MASTER!
SETZM SYMBFX+1(X) ;[1051] PUT IT IN THAT PLACE
POPJ P,0
;THIS ROUTINE HANDLES SIXBIT TABLE ENTRIES
SSIXBP: MOVE WD,T1
PUSHJ P,SIXBP ;DO THE SIX BIT ROUTINE
SSIXB2: SKIPE CH ;[1224] WAS LAST OF SIX A NULL?
TLNE BP,770000 ;[1223] HAVE WE DONE SIX?
JRST [SKIPN CH ;[1205]EXACTLY..
PUSHJ P,SIXBP2;[1205]..SIX..
JRST SSIXB2 ;[1223][1205]..CHARACTERS
] ;[1205]
POPJ P,0
;THIS ROUTINE DOES SIX BIT ENTRIES WHICH END ON A NULL
SSXBP: MOVE WD,T1 ;POSITION IT
PJRST SIXBP ;DO IT
;HERE TO HANDLE PPN STYLE TABLE ENTRIES
PRTPPN: MOVE WD,T1 ;GET PPN IN RITE AC
PJRST PPNOUT ;USE THE STANDARD BIT
PLSMNS: CAIE CH,"+" ;PLUS?
CAIN CH,"-" ;OR MINUS
SKIPA ;YES
POPJ P,0 ;NO
JUMPN N1,CPOPJ ;NOT IN MIDDLE
PUSH P,CH ;SAVE IT
PUSHJ P,ATOM ;DO IT AGAIN
EXCH CH,(P)
CAIN CH,"-"
MOVNS N ;NEGATE
POP P,CH
POPJ P,0
;PRINT OCTAL STYLE WITH LEADING ZEROES SIGNIF.
PRTOCT: MOVE BP,[POINT 3,T1]
MOVEI N,^D12 ;COUNT
PRTOC2: ILDB CH,BP ;GET A CHAR.
ADDI CH,"0" ;MAKE IT ASCII
PUSHJ P,OUCH ;O/P THE CHAR.
SOJG N,PRTOC2
POPJ P,0
;[1053] Interface to PTHOUT - Path printing routine.
;
PRTPTH: MOVE WD,T1 ;[1053] GET ADDRESS OF PATH IN CORRECT AC
PJRST PTHOUT ;[1053] AND DO THE STANDARD THING
;
;[1113] PRINT A SINGLE CHARACTER ROUTINE
;
PRTCHR: MOVE CH,T1 ;[1113] GET THE CHAR
PUSHJ P,OUCH ;[1113] O/P IT
SETZ CH, ;[1113] ENSURE WE END ON A ..
PJRST OUCH ;[1113] NULL
;THIS ROUTINE SAVE THE CURRENT LOW LEVEL I/P ROUTINE
;AND REPLACES IT BY THE CONTENTS OF CH
SVLOWN: EXCH CH,LOWIN
EXCH CH,(P)
PUSHJ P,(CH)
JRST .+2
AOS -1(P)
POP P,LOWIN
POPJ P,0
;[1174] As SVLOWN but for outputter - SVLOWO
SVLOWO: EXCH CH,LOWOUT ;[1174]
EXCH CH,(P) ;[1174]
PUSHJ P,(CH) ;[1174]
JRST .+2 ;[1174]
AOS -1(P) ;[1174]
POP P,LOWOUT ;[1174]
POPJ P,0 ;[1174]
;[1166] SPECIAL LOW-LEVEL PUTTER FOR '<parameter>
;[1166]
SYMPTR: IDPB CH,T4 ;[1166] SAVE THE CHARACTER
CAIN CH,"'" ;[1166] IS IT A QUOTE?
IDPB CH,T4 ;[1166] YES, DOUBLE IT
POPJ P,0 ;[1166] AND RETURN
SUBTTL STATUS - PRODUCE DISPLAY OF CURRENT MIC STATUS
;A ROUTINE TO PRINT OUT MIC STATUS
MICTAT: RESCAN
SETZB F,CH.SAV
MOVE P,[IOWD SIZ,STACK] ;SET UP THE STACK
MOVE T1,[INCHWL CH] ;GET LOW LEVEL I/P ROUTINE
MOVEM T1,LOWIN ;AND SET IT UP
PUSHJ P,WDREAD ;READ THE REENTER
.STATUS:
MOVEM CH,CH.SAV ;SAVE THE TERMINATOR
IFN FTMBCH,<
TLNE F,FLS.BC!FLS.BR ;BATCH CALL?
JRST STATS0 ;YES-LOW-LEVEL ROUTINES ARE ALREADY SET UP
>
MOVE T1,[PUSHJ P,TTYCHR] ;[1013] LOW-LEVEL OUTPUT ROUTINE
MOVEM T1,LOWOUT ;MAKE SURE OUTPUT GOES WHERE EXPECTED
PUSHJ P,BUFINI ;[1013] INITIALLISE THE OUTPUT BUFFER
STATS0: MOVEI BP,[ASCIZ/
Status of MIC at /]
IFN FTCJOB,<
PUSHJ P,STROUT
>
IFE FTCJOB,<
OUTSTR (BP)
>
MSTIME N,
PUSHJ P,TIMPRT ;PRINT THE TIME
IFN FTDDT,< ;[1024]
MOVEI BP,[ASCIZ/ ** Debbuging Version **/] ;[1024]
PUSHJ P,STROUT ;[1024]
> ;[1024]
PUSHJ P,PRVCHK
JRST STATS2 ;HES NOT GOD LIKE
TLO F,FLS.GD ;REMEMBER
IFN FTCJOB,<
MOVEI BP,[ASCIZ/
COJOBS available: /]
PUSHJ P,STROUT
MOVN N,COJOBN
PUSHJ P,DECPRT ;NO. OF COJOBS
MOVEI BP,[ASCIZ/ in use: /]
PUSHJ P,STROUT
MOVE N,CJUP
PUSHJ P,DECPRT
MOVEI BP,[ASCIZ/
Runtime for COJOBS: Default: /]
PUSHJ P,STROUT
HRRE N,DEFTIM
JUMPL N,[MOVEI BP,[ASCIZ/+inf. /]
PUSHJ P,STROUT
JRST .+2]
PUSHJ P,TMPRTS
MOVEI BP,[ASCIZ/ Maximum: /]
PUSHJ P,STROUT
HLRE N,LIMTIM ;GET MAX LIMIT
JUMPL N,[MOVEI BP,[ASCIZ/+inf./]
PUSHJ P,STROUT
JRST .+2 ] ;[1206]
PUSHJ P,TMPRTS ;PRINT IT
IFN FTMBCH,<
MOVEI BP,[ASCIZ/
BATCH jobs available = /]
PUSHJ P,STROUT
MOVN N,BCJOBN ;HOW MANY
PUSHJ P,DECPRT
MOVEI BP,[ASCIZ/ in use: /]
PUSHJ P,STROUT
MOVE N,BCHUP
PUSHJ P,DECPRT
>
>
STATS2: MOVEI BP,[ASCIZ/
/]
PUSHJ P,STROUT
WRITE <Processes: >
MOVN N,PROCNO
PUSHJ P,DECPRT
MOVEI CH,"/"
PUSHJ P,OUCH
MOVN N,LWPRNO
PUSHJ P,DECPRT
PUSHJ P,TAB
WRITE <Waiting: >
MOVE N,COMCNT
PUSHJ P,DECPRT
MOVEI CH,"/"
PUSHJ P,OUCH
MOVE N,LOWCNT
PUSHJ P,DECPRT
PUSHJ P,TAB
WRITE <Lock: >
MOVE N,LOCK
MOVEI BP,[ASCIZ /clr,/] ;[1143] NOBODY HAS INTERLOCK
SKIPL N,LOCK ;[1143] IS THE MASTER INTERLOCKED?
PUSHJ P,[PUSHJ P,DECPRT ;[1143] PRINT JOB NO. OF LOCKER
MOVEI BP,[ASCIZ /,/] ;[1143] PRETTINESS
POPJ P,0 ;[1143] AND RETURN
] ;[1143]
PUSHJ P,STROUT ;[1143] DISPLAY PRETTINESS OR CLEAR
WRITE < Master: Job >
MOVE N,MASTNO
PUSHJ P,DECPRT
IFE FTMBCH,< WRITE <, Cmds(Cjbs): > >
IFN FTMBCH,< WRITE <, Cmds(Cjbs-Brqs-Bjbs): > >
MOVE N,CMDTOT
PUSHJ P,DECPRT
IFN FTCJOB,<
OUTSYM <"(">
MOVE N,CJBTOT ;HOW MANY COJOBS HAVE WE RUN
PUSHJ P,DECPRT
IFN FTMBCH,< ;MIC BATCH CONDITIONAL
OUTSYM <"-">
MOVE N,BRQTOT ;HOW MANY BATCH REQUESTS
PUSHJ P,DECPRT
OUTSYM <"-">
MOVE N,BATTOT ;HOW MANY BATCH JOBS RUN
PUSHJ P,DECPRT
> ;END OF MIC BATCH CONDITIONAL
OUTSYM <")">
> ;END OF COJOB CONDITIONAL
MOVEI BP,[ASCIZ/
No. Mode PPN TTY#(Job) Lvl(Last) Macro
/]
PUSHJ P,STROUT
HRLZ T1,PROCNO
TDZA X,X ;START AT FIRST PROC. BUT DO NOT BUMP X
STAT1: ADDI X,PDBSIZ
HRRZI N,1(T1)
PUSHJ P,DECPRT ;PROCESS NUMBER
PUSHJ P,TAB
SKIPA
STATX: SETZ T1, ;CLEAR THE LOOP COUNTER FOR 'WHAT' ENTRIES
MOVE T2,FLAG(X)
XCT MODE(T2) ;PROCESS MODE
PUSHJ P,STROUT
JUMPE T2,STAT2 ;IF IT IS FREE DISPLAY NO FURTHER INFO
MOVE WD,OPPN(X)
PUSHJ P,PPNOUT ;WHO
WRITE < #>
PUSH P,LINTOT ;[1157] SAVE CURRENT POSN. (APPROX.)
MOVE N,LINE(X)
PUSHJ P,OCTPRT
OUTSYM <"(">
MOVE N,JOB(X) ;[1044]GET HIS JOB NO.
PUSHJ P,DECPRT ;[1044]O/P IT
OUTSYM <")">
POP P,N ;[1164][1155][1172] GET OLD PSN.
SUB N,LINTOT ;[1164][1155][1172] GET NOW
CAIGE N,7 ;[1155][1172] ARE WE PAST NEXT TAB STOP?
PUSHJ P,TAB ;[1145] ADD SOME DEBUGGING INFO ABOUT LEVELS
WRITE < > ;[1145]
HLRZ N,LAST(X) ;[1145] GET CURRENT LEVEL OF NESTING
PUSHJ P,DECPRT ;[1145] DISPLAY IT
HRRZ N,LAST(X) ;[1145] GET POINTER TO LAST LEVEL
JUMPE N,STATXX ;[1145] JUMP OUT IF NONE
OUTSYM <"("> ;[1145] PRETTY
SUBI N,1 ;[1145] ADJUST POINTER
IDIVI N,PDBSIZ ;[1145] CONVERT TO A PROCESS NO.
ADDI N,1 ;[1145] ADJUST AGAIN
PUSHJ P,DECPRT ;[1145] DISPLAY CURRENT PROCESS NO.
OUTSYM <")"> ;[1145] YTTERP
STATXX: ;[1145]
PUSHJ P,TAB
MOVE WD,FILE(X) ;[1046]
GETPPN N, ;GET HIS PPN
JFCL
TLNN F,FLS.GD ;[1205] BIG G? (OR CLOSE RELATIVE?)
CAMN N,OPPN(X) ;OR OWNER
SKIPA ;YEP
JRST STATX2 ;NEITHER
PUSH P,T1 ;[1044]SAVE THE LOOP COUNTER
MOVEI T1,DEV(X) ;[1044]GET ADDRESS OF HIS MACRO FILE SPEC
PUSHJ P,OUTSPEC ;[1044]O/P IT
POP P,T1 ;[1044]RESTORE THE LOOP COUNTER
NEWLINE
MOVEI N,[ASCIZ/[Parameters :: /] ;[1044][1146]
MOVEI N1,[ASCIZ/ ]
/] ;[1146]
PUSHJ P,ARGPRT ;& ALL HIS ARGS
PUSHJ P,LNEPRT ;AND HIS CURRENT I/P LINE BUFFER
SKIPA ;[1046]
STATX2: PUSHJ P,SIXBP ;[1046] O/P THE MACRO NAME
IFN FTCJOB,< ;IF WE USE COJOBS
SKIPE T2,COJOB(X)
PUSHJ P,STAT3 ;REPORT COJOB STATUS
> ;END OF COJOB BIT
STAT2:
IFN FTBHIV,<
MOVEI BP,[BYTE (7) 37,15,12]
PUSHJ P,STROUT
>
IFE FTBHIV,< ;DON'T INCLUDE FLASHY BEEHIVE STUFF ON RELEASE VERSION
MOVEI BP,[BYTE (7) 15,12]
PUSHJ P,STROUT
>
AOBJN T1,STAT1
IFN FTMBCH,<
TLNE F,FLS.BR
JRST COMBAT
>
JRST DOTTY
IFN FTBHIV,< ;INCLUDE HATFIELD STUFF
MOVEI BP,[ASCIZ/ active /]
MODE: MOVEI BP,[ASCIZ/ free /]
MOVEI BP,[ASCIZ/ held /]
MOVEI BP,[ASCIZ/ slave /]
>
IFE FTBHIV,< ;FOR OTHER PEOPLE
MOVEI BP,[ASCIZ/ active /]
MODE: MOVEI BP,[ASCIZ/ free /]
MOVEI BP,[ASCIZ/ held /]
MOVEI BP,[ASCIZ/ slave /]
>
IFN FTCJOB,<
MOVEI BP,[ASCIZ/Logout/]
MOVEI BP,[ASCIZ/Active/]
MOVEI BP,[ASCIZ/Login /]
MOVEI BP,[ASCIZ/Request/]
CJMESS: JFCL
STAT3: MOVEI BP,[ASCIZ/
/]
PUSHJ P,STROUT
IFE FTMBCH,<
WRITE <*COJOB >
>
IFN FTMBCH,<
SKIPE BATWRD(X)
SKIPA BP,[[ASCIZ/*Batch job /]]
MOVEI BP,[ASCIZ/*COJOB /]
PUSHJ P,STROUT
> ;END OF BATCH BIT
HLRZ CH,CJOWNR(X)
ADDI CH,"A"-1
PUSHJ P,OUCH
PUSHJ P,SPACE
XCT CJMESS(T2)
PUSHJ P,STROUT
HRRE N,CJOWNR(X) ;[1071] GET THE COJOB OWNERS LINE NUMBER
JUMPGE N,ST0 ;[1071] JUMP IF IT IS STILL VALID
WRITE < owner has logged out>
JRST ST1 ;[1071] JUMP NOW IF GONE AWAY
ST0: ;[1071]
WRITE < owner TTY>
HRRZ N,CJOWNR(X)
PUSHJ P,OCTPRT
ST1: CAIN T2,-2 ;[1071]IF IN LOGIN MODE
POPJ P,0 ;DON'T TYPE RUNTIME (MIGHT GET IT WRONG)
MOVS T2,JOB(X)
WRITE < Runtime >
HRRI T2,.GTTIM
GETTAB T2,
JFCL
SKIPE N,T2
IDIV N,JIFFY
PUSHJ P,TMPRTS
WRITE < sec.> ;[1205]
POPJ P,0
> ;END OF COJOBS BIT
;A ROUTINE TO PRINT ALL THE ARGS IN PROCESS AREA
ARGPRT: PUSH P,N1 ;[1146] SAVE TRAILING CHAR.
PUSH P,N ;[1146] SAVE OPEN CHARS.
MOVSI N,-ARGNUM
HRRI N,ARGBP(X) ;THIS IS WHERE THE POINTERS ARE
ARGPR1: MOVE BP,(N) ;GRAB A BYTE .ER
JUMPE BP,ARGPR4
SKIPN BP,(P) ;[1146] GET THE OPENING CHAR (DISPLAY 'COS SOMAT DERE!)
MOVEI BP,[ASCIZ/,/] ;[1146] 2ND CHAR, SO DISPLAY A COMMA
SETZM (P) ;[1146] NO OPENERS AGAIN!
PUSHJ P,STROUT ;[1146] DISPLAY RELEVANT STRING
HRRZ CH,N
SUBI CH,ARGBP-"A"(X) ;MAKE PARAMETER NAME
PUSHJ P,OUCH
MOVEI CH,"="
PUSHJ P,OUCH ;<PARAMETER>=
MOVE BP,(N) ;[1146] GET BYTE POINTER BACK
ARGPR2: ILDB CH,BP ;A CHAR
JUMPE CH,ARGPR3
PUSHJ P,OUCH
JRST ARGPR2
ARGPR3:
ARGPR4: AOBJN N,ARGPR1
SKIPE BP,(P) ;[1146] DIS WE DISPLAY ANYTHING?
JRST ARGPR5 ;[1146] NO
MOVE BP,-1(P) ;[1146] GET TRAILER
PUSHJ P,STROUT ;[1146] DISPLAY IT
ARGPR5: POP P,(P) ;[1146] DISPLAY TRAILER
POP P,(P) ;[1146] AND OPENER
POPJ P,0 ;[1146] AND RETURN
;HERE TO PRINT THE CONTENTS OF A GUY'S I/P LINE BUFFER
LNEPRT: SKIPN INLINE(X) ;ANYFING?
POPJ P,0 ;NO
LNEPR0: MOVEI BP,[ASCIZ/[/]
PUSHJ P,STROUT
MOVE N,[POINT 7,INLINE(X)]
LNEPR2: ILDB CH,N
JUMPE CH,LNEPR1 ;FINISH ON A NULL
PUSHJ P,ISBRK ;BREAK CHARACTER
JRST LNEPR1
PUSHJ P,OUCH
JRST LNEPR2
LNEPR1: CAIN CH,ALT ;ALTMODE
SKIPA BP,[[ASCIZ/$ ]/]]
MOVEI BP,[ASCIZ/ ]/]
PUSHJ P,STROUT
POPJ P,0
; [1013] THE FOLLOWING ROUTINES WERE ADDED TO GIVE A SIMPLE BUFFERED OUTPUT SCHEME
; TO CERTAIN MIC SLAVE COMMANDS
;
; HERE TO OUTPUT A SINGLE (BUFFERED) CHRACTER TO THE TTY
;
TTYCHR: SOSG LINTOT ;COUNT DOWN
PUSHJ P,[ PUSHJ P,TTYOUT ;[1156] O/P WHAT WE GOT SO FAR
OUTSTR [ASCIZ /
/] ;[1155] CRLFTAB
POPJ P,0 ;[1155] RETURN
] ;[1155]
SKIPE SCNDIN ;[1156] IS WE SCANDINAVIAN?
PUSHJ P,SCNDCH ;[1156] FIX THE SCANDINAVIAN CHARACTER
IDPB CH,BUFBP ;STORE THE CHRACTER
PUSHJ P,ISBRK ;ANY BREAK CAUSES AN OUTPUT
PUSHJ P,TTYOUT ;HERE
POPJ P,0 ;ALL DONE
;
;
; HERE TO OUTPUT WHAT WE GOT SO FAR
;
TTYOUT: PUSH P,CH ;SAVE THE CHRACTER
SETZ CH,0 ;AND MAKE THE STRING...
IDPB CH,BUFBP ;ASCIZ
OUTSTR BUFFER ;OUTPUT WHAT WE GOT
PUSH P,WD ;SAVE THIS REG.
PUSHJ P,BUFINI ;RESET THE BUFFER
POP P,WD ;RESTORE
POP P,CH ;GET THE CHARACTER BACK
POPJ P,0 ;AND UP,UP AND AWAY
SUBTTL WHAT COMMAND
;HERE ON WHAT COMMAND FROM MIC (NOT COJOB CONTROL)
;INCLUDED FOR ORTHOGONALITY
.WH:
.WHAT: PUSHJ P,OTHUSR ;GET IN CONTEXT
JRST LETER3 ;SO IT GOES
MOVE X,T2 ;AND IN RIGHT PLACE
JRST STATX ;DO IT
SUBTTL OTHER PRINT ROUTINES
SIXBT: PUSHJ P,SIXBP
JRST TAB
SIXBP: MOVE BP,[XWD 440600,WD]
SIXBP1: ILDB CH,BP
JUMPE CH,[POPJ P,0]
SIXBP2: ADDI CH,40
PUSH P,CH ;[1224] NON-ZERO CH USED AS A FLAG
PUSHJ P,OUCH
POP P,CH ;[1224] SO MAY HAVE A USEFUL VALUE
TLNE BP,770000
JRST SIXBP1
POPJ P,0
OCTPRT: IDIVI N,10
HRLM N1,(P)
SKIPE N
PUSHJ P,OCTPRT
HLRZ CH,(P)
ADDI CH,"0"
XCT LOWOUT
POPJ P,0
DECPR2: CAIL N,^D10
JRST RDXPRT
MOVEI CH,"0"
PUSHJ P,OUCH
JRST RDXPRT
DECPRT: MOVEI CH,"-"
SKIPGE N
PUSHJ P,OUCH
MOVMS N
RDXPRT: IDIVI N,^D10
HRLM N1,0(P)
SKIPE N
PUSHJ P,RDXPRT
HLRZ CH,0(P)
ADDI CH,"0"
OUCH: XCT LOWOUT ;USUALLY OUTCHR CH
POPJ P,0
;SUBROUTINE TO PRINT THE DATE
;CALL WITH
; PUSHJ P,PRDATE
; RETURN
PRDATE: PUSH P,P1 ;SAVE
PUSH P,P2 ;SAVE
MOVE P1,T1 ;GET THE DATE
IDIVI P1,^D31 ;GET THE DAY
MOVEI N,1(P2) ;ADD AND MOVE
PUSHJ P,TWODIG ;PRINT THE DAY
IDIVI P1,^D12 ;GET THE MONTH
MOVE WD,[POINT 7,MNTAB(P2)] ;LOAD A BYTE POINTER
MOVEI T3,5 ;CHAR. COUNT
ILDB CH,WD ;LOAD A CHAR.
PUSHJ P,OUCH ;OUTPUT IT
SOJG T3,.-2 ;LOOP OVER WORD
MOVEI N,^D64(P1) ;ADD YEAR ZERO
POP P,P2 ;UNSAVE
POP P,P1 ;UNSAVE
PJRST DECPRT ;AND PRINT
;
; [1134]
;
MNTAB: ASCII /-Jan-/
ASCII /-Feb-/
ASCII /-Mar-/
ASCII /-Apr-/ ;OR SHOULD IT BE cpu <SIC>
ASCII /-May-/
ASCII /-Jun-/
ASCII /-Jul-/
ASCII /-Aug-/
ASCII /-Sep-/
ASCII /-Oct-/
ASCII /-Nov-/
ASCII /-Dec-/
DAYTBL: [ASCIZ /Sunday/]
[ASCIZ /Monday/]
[ASCIZ /Tuesday/]
[ASCIZ /Wednesday/]
[ASCIZ /Thursday/]
[ASCIZ /Friday/]
[ASCIZ /Saturday/]
;HERE TO PRINT A TWO DIGIT NUMBER WITH A LEADING ZERO (IF NECC.)
TWODIG: CAIL N,^D10 ;DOES IT NEAD A ZERO?
PJRST DECPRT ;NO
MOVEI CH,"0" ;YES
PUSHJ P,OUCH ;LET HIM HAVE ONE
PJRST DECPRT
DOT: MOVEI CH,"." ;SAY HELLO IN TRAMAFLADORIAN
PJRST OUCH
COLON: MOVEI CH,":"
JRST OUCH
TAB: MOVEI CH,11
PJRST OUCH
SPACE: MOVEI CH," "
PJRST OUCH
.COMMA: MOVEI CH,","
PJRST OUCH
.NEWL: MOVEI BP,[ASCIZ/
/]
PJRST STROUT
PPNOUT: MOVEI CH,"["
PUSHJ P,OUCH
PUSHJ P,PRJPRG ;OUTPUT PROJ,PROG
.CLSBR: MOVEI CH,"]" ;CLOSING BRACKET
PJRST OUCH
PRJPRG: HLRZ N,WD
PUSHJ P,OCTPRT
MOVEI CH,","
PUSHJ P,OUCH
HRRZ N,WD
PUSHJ P,OCTPRT
POPJ P,0
BINPRT: MOVSI N1,400000
BINPR1: TDNE N,N1
SKIPA CH,["1"]
MOVEI CH,"0"
PUSHJ P,OUCH
LSH N1,-1
JUMPN N1,BINPR1
POPJ P,0
;END OF JS BIT
SUBTTL COJOB SERVICING AND INITIALIZATION
;HERE HAVING DECIDED A PROCESS IS ACTIVE
SCHED5: AOS ACTIVE ;MUST NOT GO TO SLEEP ON THE JOB
SKIPL T1 ;[1144] DO NOT SCHEDULE UNLESS ACTIVE
JRST SCHED4
JUMPN Y,SCHD5A ;HAS HE GOT A Y PROCESS AREA?
PUSHJ P,NEED.Y ;NO-GET HIM ONE
JRST SCHED4 ;COULDN'T - TRY TO EXPAND CORE
HRRZ Y,T1 ;SET UP NEW Y
SCHD5A:
IFE FTCJOB,< JRST GO
XLIST
> ;IF NO COJOBS
IFN FTCJOB,<
;HERE WHEN COJOB SERVICING IS REQUIRED
MOVE T1,COJOB(X)
;C(Z) 0 NOT A COJOB
; -1 COJOB PROCESS AREA REQUIRED
; COJOB AREA OFFSET,,-2 COJOB LOGIN IN PROGRESS
; COJOB AREA OFFSET,,-3 COJOB REQUIRES LISTENING
; COJOB AREA OFFSET,,-4 COJOB REQUIRES KJOB TEXT ONLY
JRST @COTAB(T1)
CCJ0 ;JUST LOG ALL UNTIL HE FINISHES
BCJ0 ;LOG ALL INPUT
ACJ0 ;FIX UP TO RUN MIC
CJ0 ;FIX UP Z & LOGIN
COTAB: GO ;NOT A COJOB
KJOB==-4 ;OFFSET FOR CCJ0 OPERATION
;HERE TO MANIPULATE COJOB NAMES
;HERE TO GET A NAME
GETNAM: SETCM T1,NAMWRD ;COMPLIMENT OF NAME GENERATOR
JFFO T1,.+2 ;FIND FIRST FREE NAME
HALT ;WE GOR TROUBLES
;REMEMBER THE RESULT IS NOW IN T2!!!
POPJ P,0 ;RETURN
;HERE TO MARK A NAME AS BEING IN USE
MRKNAM: SKIPA T4,[IORM T1,NAMWRD]
;HERE TO CLEAR A NAME
CLRNAM: MOVE T4,[ANDCAM T1,NAMWRD]
HRRZ T2,PTY.IC(Z) ;GET NAME
MOVSI T1,400000 ;FIRS NAME
MOVNS T2
LSH T1,1(T2) ;WORK OUT NAME
XCT T4 ;DO THE OPERATION
POPJ P,0
;HERE TO FIND A FREE LOW PROCESS AREA AND MARK IT IN USE (-1)
;THEN SKIP RETURN
FNDLOW: MOVEI T1,LOWPDB ;ADDR. OF FIRST LOW PROCESS
HRL T1,LWPRNO ;NO. OF LOW PROCESSES
FNDLW0: SKIPN LOWFLG(T1) ;IS FLAG IN USE?
JRST FNDONE ;NO-SUCCESS
ADDI T1,LOWSIZ-1 ;YES TRY NEXT
AOBJN T1,FNDLW0 ;AND LOOP
POPJ P,0 ;FAILED
FNDONE: SETOM LOWFLG(T1) ;MARK AS IN USE
AOS (P) ;SUCCESS RETURN
POPJ P,0
;HERE TO SET UP Z TO POINT TO AN UNUSED PROCESS AREA
NEED.Z: SKIPA T3,[HRRM T1,YZWORD(X)]
;HERE TO SET UP Y TO POINT TO AN UNUSED PROCESS AREA
NEED.Y: MOVE T3,[HRLM T1,YZWORD(X)]
PUSHJ P,FNDLOW ;FIND AN UNUSED ONE
PJRST NUNYZ ;NONE SET FLAGS TO EXPAND CORE
; HRRZM X,LOWFLG ;SET UP BACKWARDS LINKS
WENABL ;OPEN HI SEG
XCT T3 ;STORE Y/Z POINTER IN HIGH PROCESS AREA
WLOCK ;CLOSE HI SEG
AOS (P)
POPJ P,0
;HERE WHEN NO FREE LOW PROCESS AREAS
NUNYZ: SETOM HIBTIM ;FLAG NO SLEEP
WENABL ;OPEN HI SEG
AOS LOWCNT ;SET FLAG TO EXPAND LOW CORE
WLOCK ;CLOSE HI SEG
POPJ P,0
;HERE ON FINDING A NEW COJOB REQUEST
;ATTEMPT TO ASSIGN A COJOB PROCESS AREA AND PTY
CJ0: PUSHJ P,NEED.Z ;GET A LOW PROCESS AREA
JRST SCHED4 ;CAN'T WAIT TILL WE GET FIXED UP
HRRZ Z,T1 ;SET UP NEW Z
WENABL ;OPEN HI SEG
IFN FTMBCH,<
SKIPN BATWRD(X)
JRST CJ0A
TRO F,FR.BAT
MOVEI S,[ASCIZ/[No batch jobs available]/]
AOS T2,BCHUP ;TRY FOR ONE MORE BATCH JOB
ADD T2,BCJOBN
JUMPG T2,CJOOPS ;ANY FREE
JRST CJ2
CJ0A: >;END OF BATCH BIT
AOS T2,CJUP ;ONE MORE COJOB UP
ADD T2,COJOBN
JUMPLE T2,CJ2 ;OK
;HERE IF RAN OUT OF COJOB AREAS
MOVEI S,[ASCIZ/[No COJOB available]/]
CJOOPS:IFN FTMBCH,<
MOVNI T1,2 ;ERROR CODE
>
IFN FTMBCH,<
CJOOP0: TRNE F,FR.BAT
SKIPA L,BATOPR
>;BATCH BIT
HRRZ L,CJOWNR(X)
MIC DISPLAY,L ;COMPLAIN TO OWNER
JFCL
WENABL
SETZM COJOB(X) ;DO FOR COJOB LINKS
IFN FTMBCH,<
TRNN F,FR.BAT ;IS WE BATCH
JRST [
SOS CJUP
JRST FIN1A
]
MOVEM T1,BATACT ;YES-THEN SAY WE FAILED
LDB T1,BATMST ;GET CONTROLLER JOB NO.
WAKE T1, ;WAKE IT UP
SETZM BATWRD(X) ;DO FOR BATCH WORD
SOS BCHUP ;ONE LESS BATCH JOB
>
IFE FTMBCH,< ;[1007]
SOS CJUP ;[1007] WE LOOSE THIS ONE
> ;[1007]
JRST FIN1A ;AND GO TIDY UP
;HERE TO INITIALIZE A PTY FOR COJOB AREA WE HAVE SELECTED
CJ2: WLOCK ;CLOSE HI SEG
PUSHJ P,GETNAM ;GET A NAME(AND A CHANNEL)
HRRZM T2,PTY.IC(Z)
AOS PTY.IC(Z)
IFN FTTASK,<
MOVE T1,[%CNVER] ;[1074]Use TSG hack to find if charge or task
GETTAB T1, ;[1074] by looking in left half of MONVER
SETZ T1, ;[1074]???
JUMPGE T1,.+2 ;[1074]It is not a task system...
TDZA T1,T1 ;[1074]It is..., don't call it a batch job
>;[1074]Under TASK accounting, this would not let us read
;[1074]charge string from SWITCH.INI (and there is no other way to get it!)
MOVSI T1,(1B0+1B2) ;[1074]SET BATCH BIT
MOVSI T2,'PTY' ;LET MONITOR FIND US A PTY
HRRZI T3,PTY.IH(Z) ;BUFFERS ARE IN SELECTED COJOB AREA
MOVEI S,[ASCIZ/[COJOB failed: no PTY]/]
HRLZ T4,PTY.IC(Z)
LSH T4,5 ;FIX UP OPEN UUO
ADD T4,[OPEN T1]
XCT T4
IFN FTMBCH,<
JRST [SETO T1, ;ERROR CODE
JRST CJOOP0]
>
IFE FTMBCH,<
JRST CJOOPS
>
MOVE L,PTY.IC(Z) ;GET CHANNEL
IONDX. L, ;WORK OUT UNIVERSAL I/O INDEX
JRST CJOOPS
ANDI L,77 ;GET RID OF I/O INDEX FOR PTY'S
HLRZ T1,CNFPTY ;GET LINR NO. OF FIRST PTY
ADDI L,(T1) ;CALC. LINE NO. OF OUR PTY
ANDI L,3777 ;.LT. 512
PUSHJ P,MRKNAM ;MARK THE NAME AS IN USE
;SET UP VIRGIN BUFFERS FOR OUR PTY
MOVSI T1,400000 ;UNTOUCHED BUFFER
HRRI T1,PTY.IB+1(Z)
MOVEM T1,PTY.IH(Z) ; FOR INPUT
MOVSI T1,700 ;UNTOUCHED ASCII BYTE POINTER
MOVEM T1,PTY.IH+1(Z) ; FOR INPUT
MOVSI T1,20+1 ;A BUFFER OF 20 DATA WORDS
HRRI T1,PTY.IB+1(Z)
MOVEM T1,PTY.IB+1(Z)
;PUT ALL LOGGING INTO LOW SEG
MOVEI T1,LOGDEV(Z)
HRLI T1,LGSPEC(X)
BLT T1,ELWLOG(Z) ;[1207]
IFN FTPATH,<
MOVE T1,LOGPPN(Z) ;GET THE PATH ADDRESS
TLNN T1,-1 ;IS IT A PATH OR A PPN?
MOVEI T1,LOGPTH(Z) ;A PATH!
MOVEM T1,LOGPPN(Z) ;SO SET THINGS UP PROPER
>
;HERE TO ISSUE LOGIN COMMAND ON APPROPRIATE COJOB
PUSHJ P,BUFCLR ;CLEAR AND INITIALLISE LOGGING BUFFERS
PUSHJ P,PTYIN ;CLEAR UP ANYTHING THAT IS LYING AROUND
JFCL
PUSHJ P,BUFCLR ;AND JUNK IT
PUSHJ P,BUFINI ;INIT. TYPE BUFFER
MOVEI CH,CR ;MAKE SURE THAT
PUSHJ P,LOGO ;THE FIRST LINE
MOVEI CH,LF ;OF THE LOG FILE
PUSHJ P,LOGO ;IS TIMESTAMPED
;[1120] ONE LINE REMOVED (NO NEED TO SET FR.ECH THESE DAYS)
HRRI S,[ASCIZ/LOGIN /]
PUSHJ P,PTYTYP
HLRZ N,OPPN(X)
PUSHJ P,OCTPRT ;DISH OUT PROJECT
MOVEI CH,","
PUSHJ P,PTYO
HRRZ N,OPPN(X) ;PROGRAMMER
PUSHJ P,OCTPRT
MOVEI CH," " ;GET A SPACE
PUSHJ P,PTYO ;AND TYPE IT
SKIPE BP,LGNSTR(X) ;[1174] ANY LOGIN SWITCHES?
PUSHJ P,STROUT ;[1174] TYPE EM IS YES
WENABL ;[1174] OPEN UP
SKIPE T4,LGNSTR(X) ;[1174] GET POSSIBLE SPACE TO RECLAIM
PUSHJ P,LOSE1 ;[1174] RECLAIM SPACE
SETZM LGNSTR(X) ;[1174] TIDY UP
WLOCK ;[1174] AND LOCK UP
IFN FTPATH,<
MOVE N,OPPN(X) ;GET THE GUY'S PPN
MOVEI WD,OPATH(X) ;AND THE ADDRESS OF HIS PATH
SKIPN OPATH+.PTPPN+1(X) ;SKIPE ANY SFD'S?
CAME N,OPATH+.PTPPN(X) ;IF NOT IS THIS THE SAME AS THE USERS PPN
SKIPA
JRST NOPTHS ;NO , DONT NEED A PATH SWITCH
PUSHJ P,PTHOUT ;YES
MOVEI CH," " ;GET A SPACE
PUSHJ P,PTYO ;AND OUTPUT IT
MOVE N,OPATH+.PTSWT(X) ;GET THE SWITCHES
SETZ S,0 ;CLEAR THE PRINT WORD
TRNE N,.PTSCN ;IS NOSCAN SET?
HRRI S,[ASCIZ@/Noscan@] ;YES
TRNE N,.PTSCY ;OR IS SCAN SET?
HRRI S,[ASCIZ@/Scan@] ;YES
SKIPE S ;ANYTHING TO PRINT
PUSHJ P,PTYTYP
NOPTHS: > ;END OF FTPATH
IFN FTGALA&0,<
MOVEI S,[ASCIZ@/Defer@]
PUSHJ P,PTYTYP
> MOVEI S,[ASCIZ@/Spool:all/TERMINAL:LC@]
PUSHJ P,PTYTYP
WENABL ;OPEN HI SEG
HRR T1,CJOWNR(X) ;GET OWNER'S LINE NO.
IFN FTMBCH,<
TRNE F,FR.BAT ;IS THIS A BATCH JOB
HRR T1,BATOPR ;THEN THE OWNER IS THE BATCH OPR
>
HRL T1,PTY.IC(Z) ;AND CHANNEL
MOVEM T1,CJOWNR(X) ;AND REMEMBER THEM
MOVEM L,LINE(X) ;STORE THE COJOB LINE NO.
SETZM LGSPEC(X) ;CLEAN UP PDB AREA
MOVSI T1,LGSPEC(X) ;[551]
HRRI T1,LGSPEC+1(X) ;[551]
BLT T1,ENDSWT(X)
SKIPN STATIN(X) ;GET HIS STATION NO.
JRST CJ01 ;NO
HRRZI S,[ASCIZ?/Locate:?]
PUSHJ P,PTYTYP ;TYPE A LOCATE SWITCH
HRRZ N,STATIN(X) ;GET THE STATION NO.
PUSHJ P,OCTPRT ;[555]PRINT IT
CJ01:
HRLM Z,COJOB(X)
IFN FTHATF,<
MOVEI S,[ASCIZ@/BLANK@] ;[1121] FORCE BLANKS TO GET ROUND 701 PTY BUG
PUSHJ P,PTYTYP ;[1121]
>;END IFN FTHATF
IFN FTCHARGE,< ;[1074]Charge Accounting
HRRI CH,.GTCNO ;[1074]Get charge number
HRL CH,OJOB(X) ;[1074]Job # of owner (use his charge #)
GETTAB CH,
JRST CJ0TSG
JUMPE CH,CJ0TSG ;[1074]but only if there is one
PUSH P,CH
MOVEI S,[ASCIZ@/CHARGE:@]
PUSHJ P,PTYTYP ;[1074]Put out a charge switch
POP P,WD
PUSHJ P,SIXBP ;[1074]Charge "number" is SIXBIT
CJ0TSG: > ;[1074]END FTCHARGE
SKIPN WD,LOPTION(X) ;[1207] ANY OPTION SPECIFIED?
JRST CJBOPT ;[1207] NO, DO WHATEVER DEFAULTS
MOVEI S,[ASCIZ@/OPTION:@] ;[1207] PREPARE THE SWITCH
CAMN WD,[-1] ;[1207] UNLESS HE SAID NO LOGIN OPTION
MOVEI S,[ASCIZ@/NOOPTION@] ;[1207] IN WHICH CASE THE SWITCH IS THIS
PUSHJ P,PTYTYP ;[1207] SO TYPE THAT
CAME WD,[-1] ;[1207] WAS IT NOLOPTION?
PUSHJ P,SIXBP ;[1207] NO, PRINT THE OPTION NAME
CJBOPT: ;[1207]
MOVEI S,[ASCIZ@/TIME:@]
PUSHJ P,PTYTYP ;TYPE THE TIME SWITCH
SKIPN N,TIME(X) ;[1207] DID HE SUPPLY A RUNTIME
HRRZ N,DEFTIM ;NO - USE DEFAULT
WENABL ;[1207]
HRRM N,TIME(X) ;[1207] AND REMEMBER
WLOCK ;[1207]
PUSHJ P,DECPRT ;PRINT IT
MOVEI S,[ASCIZ@/NAME:"@] ;[1221] THE NAME OF THE INITIATOR
PUSHJ P,PTYTYP ;[1221] LET LOGIN KNOW
MOVE T1,USRNM1(X) ;[1221] GET FIRST HALF OF THE USER NAME
PUSHJ P,SSIXBP ;[1221] PRINT IT, INCLUDING SPACES
MOVE T1,USRNM2(X) ;[1223][1221] GET 2ND HALF
PUSHJ P,SSIXBP ;[1223][1221] AND PRINT THAT
MOVEI CH,"""" ;[1221] TERMINATOR
PUSHJ P,PTYO ;[1221] PRINT THAT
IFN FTLGNQ,< ;[1003] SUPPORT FOR U OF A LOGIN Q
MOVEI S,[ASCIZ@/Noque@] ;[1003] DONT ALLOW COJOBS TO Q
PUSHJ P,PTYTYP ;[1003]SO SET THE LOGIN SWITCH
> ;[1003]
IFN FTMBCH,< ;MIC BATCH
TRNN F,FR.BAT
JRST CJ02
HRL CH,PTY.IC(Z) ;GET CBATCH JOB NAME
WENABL ;[1120] MAY HAVE GOT LOCKED
HLLZM CH,BATACT
HRRI T1,PDB(X) ;COMBAT LIKES TO KNOW PDB'S
HRRM T1,BATACT
MOVSI T1,BTL.RN ;BATCH RUN BIT
ORM T1,BATWRD(X)
MOVSI T1,BTL.RQ ;SAY REQUEST MET
ANDCAM T1,BATWRD(X) ;(COMBAT MAY WANT TO KNOW)
LDB T1,BATMST ;GET CONTROLLER JOB NO.
WAKE T1, ;WAKE IT UP
MOVEM F,FSAV(X) ;SAVE THE FLAG WORD
> ;END OF BATCH BIT
CJ02: WENABL ;[1005] 'COS STRIB0 LOCKS IT ON LONG LOGIN LINES
SOS COJOB(X) ;PRIME TO NEXT COJOB ACTION
WLOCK ;CLOSE HI SEG
MOVEI CH,CR ;[1132] GET A CR CHAR.
PUSHJ P,PTYO ;[1132] AND TYPE IT
PUSH P,LOWOUT ;[1132] SAVE THE CURRENT LOW O/P ROUTINE
PUSHJ P,CJDSP ;[1132] INTRODUCE THE MESSAGES
MOVEI BP,[ASCIZ/started, log file is /] ;[1132][1172] THE TEXT
PUSHJ P,STROUT ;[1132] STORE IT
MOVEI T1,LOGDEV(Z) ;[1132] POINTER TO THE LOG SPEC
PUSHJ P,OUTSPEC ;[1132] STORE THAT (AS TEXT) IN THE BUFFER
MOVEI BP,[ASCIZ / ]
/] ;[1132] TERMINATOR
PUSHJ P,STROUT ;[1132] ALSO INT HE BUFFER
POP P,LOWOUT ;[1132] GET LOW O/P ROUTINE BACK AGAIN
;[1121] 2 LINES REMOVED
;HERE TO NOTE DISCRIPTIVE INFORMATION IN COJOB LOG FILE
PUSH P,LOWOUT ;SAVE LOW SEGMENT OUTPUT CALL
MOVE T1,XCTLOG
MOVEM T1,LOWOUT ;REPLACE WITH CALL TO LOG FILE
TRO F,FR.MLG ;FLAG MIC WRITING TO LOG FILE FOR TIMESTAMPER
MOVEI BP,[ASCIZ?
?]
PUSHJ P,STROUT
IFN FTMBCH,<
TRNE F,FR.BAT ;IS THIS A BATCH JOB
SKIPA BP,[[ASCIZ/[* MIC batch job * Operator Line /]]
>; END OF BATCH COND.
MOVEI BP,[ASCIZ/[* MIC COJOB * Line /]
PUSHJ P,STROUT
HRRZ N,CJOWNR(X)
PUSHJ P,OCTPRT
MOVEI BP,[ASCIZ?* /?]
PUSHJ P,STROUT
MOVEI T1,DEV(X)
PUSHJ P,OUTSPEC
MOVEI BP,[ASCIZ / *]
/] ;[1146]
PUSHJ P,STROUT ;[1146]
MOVEI N,[ASCIZ /[* Parameters :: /] ;[1146] OPENER
MOVEI N1,[ASCIZ/ *]
/] ;[1146] TRAILER
PUSHJ P,ARGPRT ;PRINT THE USER PARAMS
MOVEI BP,[ASCIZ/ *]
/]
POP P,LOWOUT
TRZ F,FR.MLG!FR.ECH ;CLEAR THE TIMESTAMP & ECHO FLAGS
WENABL ;[1210]
MOVE S,MASTNO ;[1210] THIS IS US
ADDI S,<"?">_7 ;[1210] WATCHING FOR ERROS
HLL S,LDBMIC(X) ;[1210] GET ANY BITS THE SLAVE SET UP
MOVEM S,LDBMIC(X) ;[1210] THIS IS WHAT WE THINK MIC SHOULD BE
TLZ S,LDLCLR ;[1210] CLEAR ANY VOLATILE BITS
WLOCK ;[1210]
JRST SCHED1 ;GO BACK AND SCHEDULE FROM THE START
;HERE HAVING ISSUED THE LOGIN COMMAND A COJOB MUST BE SERVICED
ACJ0: PUSHJ P,STATES ;GET LINE STATES
JFCL
TLNE S,LDL.TO ;OUTPUT AVAILABLE?
PUSHJ P,PTYIN ;GO GET IT
TLNN S,LDL.TI ;INPUT REQUIRED?
JRST SCHED4 ;NO OR IT IS STILL BABBLING
;IF INPUT IS REQUIRED AT THIS STAGE WE ASSUME COJOB IS LOGGED IN
;[1002] REPLACE 1 LINE
TRNN S,-1 ;[1002]SKIP IF HE HAS A JOB NUMBER
JRST NJA ;[1002]NULL JOB IS AS GOOD AS NO JOB
IFN FTCLASS,< ;[1074]Do we do the scheduler class stuff?
PUSH P,[1] ;[1074]Length of sub-argument block
PUSH P,CLASS(Z) ;[1074]Desired job class
HRLM S,(P) ;[1074]Fill in job # of slave
MOVEI L,-1(P) ;[1074]Addr of sub-arg block
HRLI L,.SCRJC+400000 ;[1074]Function code + Set
PUSH P,L ;[1074]Save arg block on stack
HRLI L,1 ;[1074]Length of argument block
HRRI L,(P) ;[1074]Address (on stack)
SCHED. L, ;[1074]Try to do it
JFCL ;[1074]Nice try...
SUB P,[3,,3] ;[1074]Fix up stack
>
MOVE L,LINE(X) ;SET UP LINE NO.
WENABL ;[1226] OPEN HI SEG
HRRZM S,JOB(X) ;REMEMBER NEW JOB NUMBER
SOS COJOB(X) ;JUST LOG PTY BABBLING FROM NOW ON
MOVE S,LDBMIC(X) ;[1210] RESET WHAT WE THINK S SHOULD BE
SKIPE LAST(X) ;[1226] THIS CAN HAPPEN IN A MACRO STARTED BY LOGIN SWITCH.INI!
JRST ACJ1 ;[1226] JUST LET IT USE THE LDBMIC SET BY SLAVE
SKIPG FLAG(X) ;IF WE HAVE NOT BEEN HELD (SWITCH.INI INLOGIN E.G)
MIC SET,L ;HE IS UP AND GOING
JFCL ;[1210] ITHINK!
ACJ1: WLOCK ;[1226] CLOSE HI SEG
JRST SCHED1 ;AND SCHEDULE ANOTHER REQUEST
;HERE TO SERVICE A COJOB THAT IS RUNNING MIC
BCJ0: MOVE P2,PTY.IC(Z) ;ON THIS CHANNEL
PUSHJ P,STATES ;GET LINE STATES
TLO F,FL.CCM!FL.KJO ;HE PUSHED OFF
TLNE S,LDL.TO ;ELSE...IF HE HAS OUTPUT
PUSHJ P,PTYIN ;THEN LOG IT
CAIA
JRST SCHED6 ;[1142] ELSE SERVICE THEN OTHER MIC PROCESSES
MOVE T1,FLAG(X)
JRST GO ;AND IF THAT WAS ALL PROCESS AS NORMAL
;HERE TO SERVICE A COJOB THAT IS LOGGING OUT
CCJ0: MOVE L,LINE(X) ;MAKE SURE L IS SET UP
PUSHJ P,STATES ;GET HIS LINE STAES
TLO F,FL.CCM!FL.KJO ;FLAG HE PUSHED OFF ON OWN ACCORD
CCJ1: TLNN S,LDL.TO!LDL.TI;READY FOR I/O?
JRST CCJ7 ;NO
TLNN S,LDL.TO ;GOT SUMMAT TO SAY?
JRST CCJ2 ;NO-HE MAY HAVE FINISHED
PUSHJ P,PTYIN ;READ INPUT
JRST CCJ1 ;THAT WAS THE LAST JUST CHECK AGAIN
JRST SCHED4
CCJ2: TLNN F,FL.CCM ;[1014]REQUIRES ^C FOR MON MODE
JRST CCJ3 ;YES
;NO
CCJ5: TLON F,FL.KJO ;REQUIRES KJOB COMMAND
JRST CCJ4 ;YES
HRLZ T4,PTY.IC(Z)
LSH T4,5
ADD T4,[RELEAS] ;SAY BYE BYE TO THE TTY
XCT T4
;HERE IS THE GOOD GUYS WAY OUT OF COJOB PROCESSING
PUSHJ P,LOG ;FLUSH THE LOG BUFFER (JUST IN CASE!)
JFCL ;IGNORE ERROR RETURN
PUSHJ P,OWNCHK ;IS THE OWNER THERE
JRST CJZAP0 ;NO
PUSH P,LOWOUT ;[1165] SAVE CURRENT OUTPUTTER
PUSHJ P,CJDSP ;SAY BYE BYE
MOVEI BP,[ASCIZ/complete]
/]
PUSHJ P,STROUT ;[1165] DISPLAY REST OF MESSAGE
POP P,LOWOUT ;[1165] VIA STRING OUTPUTTER
CJZAP0: MOVE L,LINE(X)
CJZAP: WENABL ;OPEN HI SEG
CJZAP1: PUSHJ P,CLRNAM ;NO NAME ANY MORE
SETZM COJOB(X) ;NO LONGER A COJOB
IFN FTMBCH,<
SKIPN BATWRD(X) ;R W BATCH?
>
SOS CJUP ;ONE LESS COJOB
IFN FTMBCH,<
SKIPN BATWRD(X) ;IS WE A BATCH JOB
JRST CJZAP2 ;NO
SOS BCHUP ;SAY ONE LESS
PUSHJ P,WAKBCH ;AND WAKE UP COMBAT
SETZM BATWRD(X) ;AND FORGET
CJZAP2: >
WLOCK ;CLOSE HI SEG
SETZM CJFLAG(Z)
SETZM LOWFLG(Z) ;FREE UP PDB
MOVSI T1,LOWFLG(Z)
HRRI T1,LOWFLG+1(Z)
BLT T1,LOWFLG+LOWSIZ-1(Z)
JRST FIN1
CCJ7: TLNE F,FL.KJO ;IS HE KJOBBED
JRST SCHED4 ;YES
JRST CCJ6 ;NO
;HERE TO PUT JOB INTO MONITOR MODE IF REQUIRED
CCJ3: TLNE S,LDL.MM ;IN MONITOR MODE ALREADY?
JRST CCJ5 ;YES-CHECK IF KJOB REQUIRED
CCJ6: TLNN F,FL.CCM ;[1012] Has he already had a ^c ?
PUSHJ P,FRCMON
TLO F,FL.CCM ;[1014] remember he has had one now!
JRST SCHED4
;SUBROUTINE TO WAKE COMBAT IF IT IS RUNNING
IFN FTMBCH,<
WAKBCH: LDB T1,BATMST ;GET COMBATS JOB NUMBER
HRLZ T4,T1 ;PREPARE FOR GETTAB
HRRI T4,.GTPRG
GETTAB T4, ;TO FIND OUT WHAT IA RUNNING AS JOB (T1)
SETZ T4, ;DEFENSIVE
CAMN T4,[SIXBIT/COMBAT/] ;IS IT COMBAT
WAKE T1, ;YES-WAKE HIM UP
POPJ P,0
POPJ P,0
>
;HERE TO TYPE KJOB
CCJ4: PUSHJ P,BUFINI ;INIT. TYPE BUFFER
IFE FTGALA,<
IFE FTHATF,<
HRRI S,[ASCIZ?KJOB ?]
>
IFN FTHATF,<
HRRI S,[ASCIZ?MKJOB ?] ;[1121]
>
PUSHJ P,TYPER
MOVE WD,LOGDEV(Z)
PUSHJ P,SIXBP ;LOG FILE
MOVEI CH,":"
PUSHJ P,OUCH
MOVE WD,LOGFIL(Z)
PUSHJ P,SIXBP
MOVEI CH,"."
PUSHJ P,OUCH
MOVE WD,LOGEXT(Z)
PUSHJ P,SIXBP
MOVE WD,LOGPPN(Z)
PUSHJ P,PTHOUT ;[1004] PRINT HIS PATH SPEC
HRRI S,[ASCIZ?=/Z:?] ;DEGREE OF Q ING DESIRED
PUSHJ P,TYPER
SKIPE CH,ZQ(X) ;[1207][1121] GET DISPATCH SETTING
JRST CCJ40 ;[1121] HE DID SET IT
HLRZ CH,DEFDSP ;[1121] GET THE DEFAULT
SKIPE BATWRD(X) ;[1121] IS HE A BATCH JOB?
HLRZ CH,BATDSP ;[1121] YES SO GET THE DEFAULT FOR BATCH
CCJ40:
PUSHJ P,OUCH
HRRI S,[ASCIZ?/W/B/VD:?]
PUSHJ P,TYPER
HRRZ CH,VDISP(X) ;[1207] DISPOSITION OF LOG FILE
SKIPE CH ;[1121] IF HE DID NOT SAY
JRST CCJ41 ;[1121] HE DID
HRRZ CH,DEFDSP ;[1121] GET THE DEFAULT VALUE
SKIPE BATWRD(X) ;[1121] IS HE BATCH?
HRRZ CH,BATDSP ;[1121] SO GET THE BATCH DEFAULT
CCJ41:
PUSHJ P,OUCH
IFN FTMBCH,< ;BATCH ONLY
HLRZ CH,VDISP(X) ;[1207] WAS A SEQUENCE NO. SPECIFIED
JUMPE CH,CCJ4A ;NO
HRRI S,[ASCIZ?/VS:?] ;YES - SO USE IT
PUSHJ P,TYPER
HLRZ N,VDISP(X)
PUSHJ P,DECPRT
CCJ4A:>
MOVEI CH,CR
PUSHJ P,PTYO
MOVEI CH,LF+200 ;FLAG NO TIMESTAMP
PUSHJ P,LOGO
> ;END OF IFE FTGALA
IFN FTGALA,<
MIC GET,L ;GET HIS LDBMIC WORD
JRST CCJGAL ;HAS NOT GOT ONE - ODD BUT POSSIBLE
TLZE S,LDL.XX ;IF HE WAS SILENCED
MIC SET,L ;UNSILENCE HIM
JFCL
CCJGAL: HRRZI S,[ASCIZ"KJOB/BATCH"]
PUSHJ P,TYPER ;THIS STYLE LOGOUT
MOVEI CH,CR ;PLUS A CR
PUSHJ P,PTYO ;TO TERMINATE
> ;END OF IFE FTGALA
PUSHJ P,LOG ;LOG A CRLF AND TIDY UP
JFCL
CAMN F,FSAV(X) ;HAS F CHANGED
JRST SCHED1 ;NO
WENABL ;OPEN HI SEG
MOVEM F,FSAV(X)
WLOCK ;CLOSE HI SEG
JRST SCHED1
NJA: PUSH P,LOWOUT ;[1165] SAVE LOW-LEVEL OUTPUTTER
PUSHJ P,CJDSP
MOVEI BP,[ASCIZ/ Login failed]
/] ;[1175][1165]
PUSHJ P,STROUT ;[1165] OUTPUT THE STRING
MOVE S,[PUSHJ P,LOGO] ;[1027] SET UP NE
MOVEM S,LOWOUT ;[1027] OUTPUT ROUTINE
ERRMS. LGF,<COJOB Login failed>,s
PUSHJ P,STROUT ;[1027] OUTPUT ERROR TEXT
POP P,LOWOUT ;[1027]RESTORE OLD O/P ROUTINE
PUSHJ P,LOG ;[1027] FLUSH THE LOG BUFFER
JFCL ;[1027] JUST ANOTHER ERROR - IGNORE IT
IFE FTMBCH,<
JRST CJZAP
> ;END OF IF NOT BATCH BIT
IFN FTMBCH,<
TRNE F,FR.BAT ;IS WE BATCH
JRST CJZAP ;NO
WENABL ;OPEN HI SEG
MOVNI T2,3 ;PUT -3 IN BATCH ACTION WORD
MOVEM T2,BATACT
JRST CJZAP1 ;AND AWAY
>;END OF BATCH BIT
;HERE TO READ A BUFFER LOAD OF PTY OUTPUT AND LOG IT
PTYIN: HRLZ T4,PTY.IC(Z)
LSH T4,5
ADD T4,[INPUT]
XCT T4
PUSHJ P,STATES ;GET THE LINE STATES
JFCL ;NOT TO INTERESTED HERE IF JOB DISAPEARED
TLNE S,LDL.TO ;STILL GOT OUTPUT
AOS (P) ;YES PREPARE FOR SKIP EXIT
PTYIN1: SOSGE PTY.IH+2(Z) ;BYTE AVAILABLE?
POPJ P,0 ;NO EXIT
ILDB CH,PTY.IH+1(Z) ;READ A CHARACTER
IFE FTGALA,<
TLNN F,FL.KJO ;NO MORE LOGGING IF HE IS "KJOB"ED
>
PUSHJ P,LOGO ;LOG IT
JRST PTYIN1 ;AND GET MORE
;A ROUTINE TO TYPE A CHARACTER DOWN A PTY
PTYO: SOSG LINTOT ;IF NO SPACE
PUSHJ P,PTYOUT ;MAKE SOME
IDPB CH,BUFBP ;AND DEPOSIT THE CHARACTER
IFE FTGALA,< TDNE F,[FL.KJO,,FR.ECH] > ;IF WE ARE KJOBBING HIM - THEN LOG TYPEIN OURSELF
IFN FTGALA,< TRNE F,FR.ECH > ;[777]THIS FLAG MEANS LOG TYPEIN
PUSHJ P,LOGO
PUSHJ P,ISBRK ;ANY BREAK
PUSHJ P,PTYOUT ;WILL CAUSE AN OUTPUT
POPJ P,0
;A ROUTINE TO WRITE A CHARACTER TO THE LOG BUFFER
LOGO: PUSHJ P,SAVET1
MOVEI T1,PR.LGN ;NO LOG BIT
TDNE T1,PROFLE(X)
POPJ P,0 ;IT IS SET
SOSGE LOGTOT(Z) ;SPACE?
JRST LOGO1 ;NO GO MAKE SOME SPACE
IDPB CH,LOGBP(Z)
CAIN CH,LF
JRST TIMSTP ;IF THAT WAS A LINE FEED TIMESTAMP LOG
POPJ P,0
LOGO1: PUSHJ P,LOG ;GO WRITE OUT THAT BLOCK
JRST LOGERR ; LOGGING ERRORS
JRST LOGO ;AND START ON THE NEXT
XCTLOG: JRST LOGXCT ;[1156] NEED THIS BIT OF INDIRECTION
LOGXCT: SKIPE SCNDIN ;[1156] IS WE SCANDINAVIAN
PUSHJ P,SCNDCH ;[1156] YES TRANSLATE
PJRST LOGO ;[1156] AND LOG IT
; A ROUTINE TO WRITE AN ASCIZ LINE TO THE LOG BUFFER
LOGDIS: WENABL ;OPEN HI SEG
MOVEM S,DISWRD(X) ;PRETEND WE ARE DOING A DISPLAY
WLOCK ;CLOSE HI SEG
POPJ P,0 ;DUN
;[1156]
;[1156] Given a character , convert it to the normal Scandinavian equivalent for
;[1156] printing. Use only in routines which output from MIC.
;[1156]
SCNDCH: CAIN CH,"[" ;[1156] IS IT OPEN BRACKET
MOVEI CH,.LT. ;[1156] YES
CAIN CH,"]" ;[1156] IS IT CLOSE BRACKET?
MOVEI CH,.GT. ;[1156] YES
POPJ P,0 ;[1156] OK
;A ROUTINE TO DISPLAY TYPICAL INFO ON COJOB OWNERS TTY
CJDSP: HRRE L,CJOWNR(X) ;[1071] GET LINE NUMBER OR -1 IF GONE AWAY
ECJDSP:
IFN FTMBCH,<
SKIPN BATWRD(X) ;IS HE BATCH
JRST .+3 ;NO
MOVE L,BATOPR ;SET UP BATCH OPERATOR LINE NO.
SKIPA BP,[[ASCIZ/
[Batch job /]] ;[1151]
>;END
MOVEI BP,[ASCIZ/
[COJOB /] ;[1151]
MOVE CH,[PUSHJ P,TELOWN] ;[1151] ALTERNATE OUTPUTTER
MOVEM CH,LOWOUT ;[1151] AND RESET IT
SETOM CJBCNT ;[1165] INIT. THE COUNTER
PUSHJ P,STROUT ;[1151] DISPLAY THE OPENING STRING
HLRZ CH,CJOWNR(X) ;[1151] GET THE OWNER CODE
ADDI CH,"A"-1 ;[1151] ASCII'ISE IT
PUSHJ P,OUCH ;[1151] PUT THAT IN THE BUFFER
MOVEI BP,[ASCIZ/ (/] ;[1172] OPENERS
PUSHJ P,STROUT ;[1172] DISPLAY EM
IFN FTMBCH,< SKIPA WD,JOBNAM(X) ;[1151] GET BATCH JOB NAME >
MOVE WD,FILE(X) ;[1151] GET COJOB NAME
PUSHJ P,SIXBP ;[1151] DISPLAY THAT
MOVEI BP,[ASCIZ/) /] ;[1172] CLOSERS
PJRST STROUT ;[1172] DISPLAY 'EM AND RETURN
;A ROUTINE TO FORCE AN OUTPUT ON THE PTY (JUST LIKE A TTY NOWADAYS)
PTYOUT: PUSH P,CH ;[1005] SAVE CHARACTER POSSIBLY
PUSH P,S ;[1005] SAVE POSSIBLE STRING
PUSH P,T1 ;[1005] SAVE THESE EARLIER (JUST IN CASE!)
PUSH P,WD ;[1005] DITTO
SETZ CH,
IDPB CH,BUFBP ;MAKE SURE ZERO BYTE
HRR L,LINE(X) ;GET LINE NO.
HRRI S,BUFFER ;AND BUFFER ADDR.
MIC TYPE,L
JFCL
PUSHJ P,STRIB0 ;STORE THE LINE (SO WE CAN SEE IT)
;[1005] DELETE TWO LINES
PUSHJ P,BUFINI
POP P,WD ;RESTORE
POP P,T1 ;RESTORE
POP P,S ;[1005] RESTORE POSSIBLE STRING
POP P,CH ;[1005] RESTORE POSSIBLE CHARACTER
POPJ P,0
;A ROUTINE TO TYPE ON A GUYS TERMINAL
TYPER: SKIPE COJOB(X) ;IS IT A COJOB?
JRST PTYTYP ;YES TYPE DOWN A PTY
TYPER2: MIC TYPE,L ;NO TYPE ON HIS TERMINAL
JFCL
POPJ P,0
;A ROUTINE TO TYPE A STRING POINTED TO BY S DOWN A PTY AND LOG IT
PTYTYP: HRRI BP,(S) ;MAKE A BYTE POINTER
PJRST STROUT ;[1117] AND INVOKE STRING ROUTINE
;A ROUTINE TO OUTPUT AN ASCIZ STRING POINTED TO BY BP
STRUTN: MOVEI BP,(N) ;[1117]ON THIS ENTRY STRING IS IN N
STROUT: HRLI BP,440700
PUSH P,CH ;[1050] SAVE THE CHAR - OCTAL 0 FIX
STROU1: ILDB CH,BP
JUMPE CH,[ POP P,CH ;[1050] RESTORE CHAR
POPJ P,0 ] ;[1050]AND UP AND AWAY
PUSHJ P,OUCH
JRST STROU1
;[1165] THIS PAGE WAS ADDED BY EDIT [1165]
;
; Here is a simple buffered output scheme for sending messages
; to COJOB owners.
;
TELOWN: SOSG CJBCNT ; ANY SPACE LEFT
PUSHJ P,TELOUT ; NO,FLUSH THE BUFFER
SKIPE SCNDIN ; SCANDINAVIAN?
PUSHJ P,SCNDCH ; YES, FIX UP CHARACTERS
IDPB CH,CJBBP ; SAVE THE CHARACTER
PUSHJ P,ISBRKC ; SHOULD WE SEND NOW
PJRST TELOUT ; YES, FLUSH THE BUFFER
POPJ P,0 ; NO, WAIT FOR NEXT
;
; Here to output a buffer load
;
TELOUT: PUSH P,CH ; SAVE THE CHARACTER
SKIPGE CJBCNT ; REALLY SOMAT TO GO?
JRST TELOU0 ; JUMP IF NOT
PUSH P,T1 ;[1200] SAVE OVER OWNCHK
SETZ CH,0 ; GET A TERMINATOR
IDPB CH,CJBBP ;[1167] SAVE IT
PUSH P,S ;[1167] SAVE THIS (THO' IT SHUD REALLY B OK)
MOVEI S,CJBUF ;[1167] GET THE BUFFER
PUSHJ P,OWNCHK ;[1174] IS THE OWNER STILL ABOUT
SKIPA ;[1174] NO
MIC DISPLAY,L ; SEND THE TEXT
JFCL ; DON'T EXPECT THIS
POP P,S ;[1167] GET WHAT WE SAVED BACK
POP P,T1 ;[1200] GET BACK WHAT WE SAVED
TELOU0: MOVEI CH,^D81 ; GET THE COUNT
MOVEM CH,CJBCNT ; RESET IT
MOVE CH,[POINT 7,CJBUF] ; GET THE POINTER
MOVEM CH,CJBBP ; SAVE IT
POP P,CH ; AND RESTORE CHARACTER
POPJ P,0 ; AND EXIT
; A ROUTINE WHICH DISPLAYS A MESSAGE ON A COJOB OWNERS TERMINAL
CJMESG: PUSHJ P,OWNCHK ;CHECK IF OUR OWNER IS STILL THERE
JRST CPOPJ ;HE AIN'T
PUSH P,LOWOUT ;[1165] SAVE THE ORIG. PUTTER
PUSH P,BP ;SAVE BP WHICH WE NEED
PUSH P,S ;SAVE THE MESSAGE
PUSHJ P,CJDSP ;WHILE HE HAS THE STANDARD BIT
MOVE BP,(P) ;WOT MESG.?
PUSHJ P,STROUT ;[1165] DISPLAY THE MESSAGE
MOVEI BP,[ASCIZ/]
/] ;END OF MESSAGE
;LET HIM HAVE IT
PUSHJ P,STROUT ;[1165] FINISH TEXT OFF
MOVE L,LINE(X) ;RESET THIS JOBS LINE
POP P,S
POP P,BP ;[1165] RESTORE THE BYTE POINTER WORD
POP P,LOWOUT ;[1165] AND RESTORE THE ORIG.
POPJ P,0 ;AND AWAY...
; THIS ROUTINE CHECKS IF THE JOB WHICH STARTED A COJOB
;IS STILL IT'S OWNER AND IF IT IS-- SKIP RETURNS
OWNCHK: TRNE F,FR.OWN ;DO WE KNOW
JRST OWNCK1 ;YES
IFN FTMBCH,<
SKIPE BATWRD(X) ;IS WE BATCH
JRST CPOPJ1
>
HRLZ T1,OJOB(X) ;GET OWNERS JOB N0.
HRRI T1,.GTPPN
GETTAB T1, ;GET THAT JOB'S PPN
SETZ T1, ;DEFENSIVE---AS T1 UNCHANGED
CAME T1,OPPN(X) ;[1071] IS HE OUR OWNER?
JRST OWNCK0 ;[1071] NOPE
HRRZ T1,OJOB(X) ;[1071] GET THE OWNERS JOB NO.
TRMNO. T1, ;[1071] FIND WHAT TERMINAL LINE HE IS ON?
SETZ T1, ;[1071] OOOOHHHHH
TRZ T1,.UXTRM ;[1071] CLEAR OUT THE I/O INDEX
PUSH P,T2 ;[1071] FREE AN AC
HRRZ T2,CJOWNR(X) ;[1071] GET THE OWNERS LINE NO.
CAIN T1,(T2) ;[1071] IS HE STILL ON THE SAME LINE?
JRST [
POP P,T2 ;[1071] RESTORE THE AC
JRST CPOPJ1 ;[1071] HE IS STILL ALIVE AND WELL
]
POP P,T2 ;[1071] GET THE AC BACK
OWNCK0: WENABL ;[1071] OPEN THE HI SEGMENT
SETO T1, ;[1071] USE -1 FOR A FLAG...
HRRM T1,CJOWNR(X) ;[1071] ..THAT HE HAS GONE AWAY
WLOCK ;[1071] AND CLOSE THE HI-SEG
JRST CPOPJ1 ;YEAH!
MOVEI S,[ASCIZ/[COJOB owner not available - continuing]
/] ;NO
PUSHJ P,LOGDIS ;LEAVE A MESSAGE IN HIS LOG FILE
TRO F,FR.OWN ;SET THE OWNER GONE AWAY BIT
OWNCK1: TLZ F,FL.CB ;MAKE SURE HE DOES NOT [BREAK]
PUSH P,S ;SAVE IT
MIC GET,L
JFCL
TLZ S,LDL.CB ;CLEAR BREAK BIT DOWN
MIC SET,L
JFCL
POP P,S
POPJ P,0
;A ROUTINE TO MAKE A LINE STATES WORD FROM A JOBSTS UUO
STATES: MOVE S,PTY.IC(Z) ;CHANNEL
JOBSTS S,
SETZ S, ;SOME ONE RELEASED THE PTY
TLZ S,617777 ;CLEAR ALL BUT JB-UML,UOA,UDI
TXZE S,JB.UML ;MONITOR LEVEL?
TLO S,LDLCHK!LDL.MM ;YEP
TXZE S,JB.UOA ;OUTPUT AVAILABLE
TLO S,LDLCHK!LDL.TO ;YEP
TXZE S,JB.UDI ;WANTS INPUT?
TLO S,LDLCHK!LDL.TI ;YEP
TRNE S,-1 ;IF HE HAS A JOB
AOS (P)
POPJ P,0 ;SKIP OUT
;A ROUTINE TO APPEND A BLOCK TO THE COJOB LOG FILE
LOG: MOVEI T1,PR.LGN ;GET NO LOGGING BIT
TDNE T1,PROFLE(X) ;IS IT SET
JRST BFCLR1 ;YES
SKIPN LOGBUF(Z) ;IF NOTHING TO LOG
JRST CPOPJ1 ;STAY HAPPY
MOVEI T1,17 ;DUMP MODE
MOVE T2,LOGDEV(Z) ;THIS DEVICE
SETZ T3, ;NO BUFFERS
OPEN T1 ;GRAB DEVICE
JRST BUFCLR ;FAILED JUST CLEAR DOWN BUFFER
PUSHJ P,SAVEP3 ;SAVE PRESERVED AC
MOVE T1,LOGFIL(Z)
MOVE T2,LOGEXT(Z)
SETZ T3,
MOVE T4,LOGPPN(Z)
IFN FTPATH,<
PUSH P,T1 ;SAVE T1
MOVE T1,T4 ;GET (POSS.) PATH ADDRESS
TLNN T1,-1 ;[1032]IS IT A PATH
PUSHJ P,CPYPTH ;YES COPY IT
MOVE T4,T1 ;RESET T4
POP P,T1 ;AND T1
>
LOOKUP T1 ;FIND LOG FILE
TDZA P3,P3 ;TIS ZERO LENGTH
HLRE P3,T4 ;P3 IS LENGTH OF FILE
MOVE T4,LOGPPN(Z) ;CALIM THE LOG FILE
IFN FTPATH,<
PUSH P,T1 ;SAVE T1
MOVE T1,T4 ;GET (POSS.) PATH ADDRESS
TLNN T1,-1 ;[1032]IS IT A PATH
PUSHJ P,CPYPTH ;YES COPY IT
MOVE T4,T1 ;RESET T4
POP P,T1 ;AND T1
>
ENTER T1
JRST BUFCLR ;FAILED JUST CLEAR DOWN BUFFER
JUMPGE P3,LOG1 ;SIZE WAS IN BLOCKS
MOVNS P3
ADDI P3,177
LSH P3,-7 ;CONVERT SIZE TO BLOCKS
LOG1: USETO 1(P3) ;WRITE NEXT BLOCK
OUTPUT LOGDMP(Z)
RELEAS ;LET THE CHANNEL GO
BFCLR1: AOS (P) ;GOOD THUS FAR
BUFCLR: MOVEI T1,200*5
MOVEM T1,LOGTOT(Z)
MOVE T1,[POINT 7,LOGBUF(Z)]
MOVEM T1,LOGBP(Z)
SETZM LOGBUF(Z) ;ZAP THAT BLOCK
MOVSI T1,LOGBUF(Z)
HRRI T1,LOGBUF+1(Z)
BLT T1,LOGBUF+177(Z)
MOVEI T1,LOGBUF-1(Z) ;SET UP DUMPER
HRLI T1,-200
MOVEM T1,LOGDMP(Z)
POPJ P,0
;HERE TO TYPE COMMANDS ON BEHALF OF A COJOB
;E.G. MIC COJOB A PROCEED
CJCNTL: TLNE WD,7777 ;1 LETTER NAME ONLY
JRST CJCNT4 ;NOOOO
MOVEM WD,CH ;PUT IT IN CH
SETZ WD,
LSH CH,-36 ;AND
ADDI CH," " ;MAKE IT ASCII
MOVEM CH,LINTOT ;SAVE NAME FOR POSS. ERROR MESG.
HRLZ T1,PROCNO ;THIS NUMBER OF PROCESSES
TDZA X,X ;START SKIP
CJCNT1: ADDI X,PDBSIZ ;ADVANCE TO NEXT
HLRZ T2,CJOWNR(X) ;OWNED?
JUMPE T2,CJCNT2 ;NO
CAIN T2,1-"A"(CH) ;DID HE SAY THIS ONE
SKIPL FLAG(X) ;YES-RUNNIG?
CJCNT2: AOBJN T1,CJCNT1 ;NO-LOOP
JUMPL T1,CJCNT3 ;YES-GO CHECK PRIVS
CJCNT4: OUTSTR [ASCIZ/%Control command "/]
PUSHJ P,SIXBP
OUTSTR [ASCIZ/" not valid for COJOB /]
OUTCHR LINTOT
JRST SLENDX ;UNHELPFULL MESSAGE FOR HACKERS
CJCNT3: GETPPN N,
JFCL
CAMN N,[1,,2]
TLOA F,FLS.GD
CAMN N,OPPN(X) ;OR OWNER PPN
SKIPA L,LINE(X) ;OK PICK UP LINE
JRST CJCNT4 ;NO-BOMB
PUSHJ P,WDREAD ;GET COMMAND IN
MOVEM CH,CH.SAV ;[1015] REMEMEBER TH TERMINATOR
CAMN WD,[SIXBIT/WH/] ;ALLOW "WH" TO MEAN "WHAT"
MOVE WD,[SIXBIT/WHAT/]
MOVE T1,[-CMDSIZ,,MICTAB] ;COMMAND TABLE
PUSHJ P,FNDNAM ;SEARCH IT
JRST CJCNT4 ;NOT PRESENT
MOVE WD,MICTAB(T1) ;GET NAME IN FULL
CAMN WD,[SIXBIT/WHAT/] ;SPECIAL TREATMENT
JRST STATX ;GO GIVE HIM SOME WHAT INFO
MOVE T1,DSPLST(T1) ;PICK UP DISPATCH BITS
TLNE T1,CJ ;RUNNING CJ OK
MIC GET,L ;GET IN MIC BITS
JRST CJCNT4 ;NO-MIC-OR WRONG COMMAND
MOVE L,LINE(X) ;SET UP L
JRST (T1)
;A ROUTINE TO TIMESTAMP THE LOG FILE
TIMSTP: MOVEI N,PR.TIM ;GET NO TIMSTAMP BIT
TDNE N,PROFLE(X) ;IS IT SET
POPJ P,0 ;YES
PUSH P,LOWOUT ;SAVE LOW OUTPUT CALL
MOVE N,XCTLOG ;JUST WRITE TO LOG FILE
MOVEM N,LOWOUT
PUSH P,BP ;SAVE BYTE POINTER
MSTIME N, ;GET DAY TIME
PUSHJ P,TIMPRT ;PRINT IT
PUSHJ P,SPACE
TRNE F,FR.MLG ;MIC MODE
JRST [
MOVE WD,[SIXBIT/MIC/]
JRST TIMST0
] ;YES
TLNE S,LDL.MM ;TIMESTAMP ACCORDING TO MODE
SKIPA WD,[SIXBIT/MONTR/]
MOVE WD,[SIXBIT/USER/]
TIMST0: PUSHJ P,SIXBT
POP P,BP ;RESTORE BYTE POINTER
POP P,LOWOUT ;BACK TO STANDARD
POPJ P,0
> ;END OF COJOB MAIN BIT
LIST
TMPRTS: IMULI N,^D1000 ;MAKE SECONDS INTO MILLI SECS.
; (I KNOW ITS WASTE OF TIME BUT......)
TIMPRT: IDIV N,[15567200]
PUSH P,N1 ;SAVE LOW RESULT
PUSHJ P,DECPR2
PUSHJ P,COLON
MOVE N,(P)
IDIVI N,165140
MOVEM N1,(P)
PUSHJ P,DECPR2
PUSHJ P,COLON
POP P,N
IDIVI N,^D1000
PUSHJ P,DECPR2
POPJ P,0
;THE REMAINING CODE IS CONCERNED WITH REPORTING OPERATIONAL ERRORS
IFE FTCJOB,<XLIST>
IFN FTCJOB,<
LOGERR: MOVE S,[XWD 440700,[ASCIZ/ Logging error - non-fatal -- Code /]]
HRRZ N,T2 ;POSITION ERROR CODE
PUSHJ P,PRPOPR ;PREPARE THE NEWS
PUSHJ P,TELOPR ;TELL THE OPERATOR
MOVEI S,BUFFER ;[1124] AND GET THE MESSAGE BACK
PUSHJ P,CJMESG ;[1124] AND TELL THE USER TOO
JRST LOGO
;HERE TO PREPARE AN ASCIZ MESSAGE IN BUFFER FROM AN ASCIZ STRING IN S
;AND AN OCTAL NO. IN N
PRPOPR: MOVEI CH,OCTPRT ;HE WANTS THIS TYPE OF ARG.
;
; GENERALISED MESSAGE PREPARATION
;
PRPMSG: PUSHJ P,SAVET1 ;SAVE T1
MOVE T1,[POINT 7,BUFFER]
PUSH P,CH ;SAVE CALL TYPE
MOVE CH,[IDPB CH,T1] ;NEW LOW-LEVEL OUTPUT ROUTINE
PUSH P,LOWOUT ;SAVE LOW-LEVEL O/P ROTINE (WHY?)
MOVEM CH,LOWOUT ;AND REPLACE IT WITH OUR OWN
HRLI S,440700 ;SET UP BYTE POINTER
ILDB CH,S ;GET ACHAR
JUMPE CH,.+3 ;IS IT NULL
IDPB CH,T1 ;NO DEPOSIT IT
JRST .-3 ;LOOP FOR MORE
PUSHJ P,@-1(P) ;PRINT IT
SETZ CH,
IDPB CH,T1 ;MAKE ASCIZ
MOVEI S,BUFFER ;GET IN CONTEXT
POP P,LOWOUT ;RESTOR ORIGINAL LOW-LEVL O/P REOTINE
POP P,(P) ;THROW AWAY OUTPUT MODE
POPJ P,0
>
LIST
;HERE TO PREPARE A MESSAGE IN BUFFER FROM AN ASCIZ STRING IN S
;AND A SIXBIT WORD IN WORD
PRPMWD: MOVEI CH,SIXBP ;THIS TYPE OUT MODE
JRST PRPMSG ;DO IT
CORERR: MOVEI S,[ASCIZ/CORERR - CORE UUO failed - Continuing/]
PUSHJ P,MSTOPR ;LET OPR KNOW
MOVNI S,^D50 ;RESET TRY COUNTER
MOVEM S,TRYCORE
JRST SCHED1 ;AND CONTINUE
;HERE TO TELL THE SYSTEM OPERATOR THAT MIC HAS HAD A
;PROBLEM
MSTOPR: PUSH P,L ;FOR COMPATABILLITY
MOVE L,MICOPR
SKIPGE MICOPR
PUSHJ P,NO.OPR
PUSH P,S ;FOR COMPATA.....
MOVEI S,[ASCIZ/
[(MIC) - /]
MIC DISPLAY,L ;LET HIM KNOW WHO WE ARE
JFCL
JRST TELOP1
IFN FTCJOB,<
;HERE TO TELL THE SYSTEM OPERATOR ABOUT SOME ERROR IN A PARTICULAR
;COJOB - I.E. MIC ERROR?
TELOPR: PUSH P,L ;SAVE USER'S LINE NUMBER
MOVE L,MICOPR ;GET MIC OPR. LINE NO.
SKIPGE L
PUSHJ P,NO.OPR ;-1 MEANS NO OPR
PUSH P,S ;SAVE MESG. OVER CALL TO CJDSP
PUSHJ P,ECJDSP ;STANDARD BIT
>
TELOP1: POP P,S ;GET THE STRING BACK
MIC DISPLAY,L ;DISPLAY MESSAGE ON OPR
JFCL ;NOWT WE CAN DO
MOVEI S,[ASCIZ/]
/]
MIC DISPLAY,L
JFCL
JRST TELDUN
NO.OPR:
IFE FTDDT,< ;[1024]
MOVSI L,'OPR' ;WORK OUT LINE NO. OF SYTEM OPR
IONDX. L, ;THIS IS A NICE UUO
JRST TELDN1 ;OOOOOOOOPS
TRZ L,.UXTRM ;REMOVE UNIVERSAL DEVICE THINGY
> ;[1024]
IFN FTDDT,< ;[1024]
SETO L, ;[1024] WANT OUR LINE
GETLCH L ;[1024] GET IT
ANDI L,3777 ;[1024] JUST THE LINE NO.
> ;[1024]
POPJ P,0 ;AND TRY THIS
TELDN1: POP P,(P) ;DONT RETURN
TELDUN: POP P,L ;RESTORE USER'S LINE NUMBER
POPJ P,0 ;AND AWAY...
LIST
IFE FTCJOB,< ;IF NOT COJOB
TYPER2:
TYPER: MIC TYPE,L
JFCL
POPJ P,0
> ;END OF IF NOT COJOB BIT
;A ROUTINE TO SAVE AC P3
SAVEP3: EXCH P3,(P)
PUSHJ P,(P3)
JRST .+2
AOS -1(P)
POP P,P3
POPJ P,0
;AND ONE TO SAVE T1
SAVET1: EXCH T1,(P)
PUSHJ P,(T1)
SKIPA
AOS -1(P)
POP P,T1
POPJ P,0
;[1162] Save t1 thro' T4 on the stack with auto restore.
SAVTMP: PUSH P,T1 ;[1162]
PUSH P,T2 ;[1162]
PUSH P,T3 ;[1162]
PUSH P,T4 ;[1162]
PUSHJ P,@-4(P) ;[1162] CALL THE ROUTINE
SKIPA ;[1162] NON SKIP
AOS -5(P) ;[1162] SKIP
POP P,T4 ;[1162]
POP P,T3 ;[1162]
POP P,T2 ;[1162]
POP P,T1 ;[1162]
;
;[1162] THEN FALL INTO POPOPJ!
;
; A ROUTINE TO THROW AWAY TOP ENTRY ON STACK, THEN DO POPJ
POPOPJ: POP P,(P) ;THROW IT AWAY
POPJ P,0
;HERE TO DO A MIC TYPE
M.TYPE:
PUSH P,L
PUSH P,[EXP 21+TYPE]
JRST M.COMN ;DO THE COMMON BIT
;HERE TO DO A MIC GET
M.GET:
PUSH P,[EXP M.GETR]
PUSH P,L
PUSH P,[EXP 21+GET]
JRST M.COMN ;DO THE COMMON BIT
M.GETR: CAIA ;AND RETURN HERE
AOS (P) ;OR HERE
MOVE S,MICBLK+2 ;GET RESULT
POPJ P,0 ;AND RETURN
;HERE TO DO A MIC SET
M.SET:
PUSH P,L
PUSH P,[EXP 21+SET]
PJRST M.COMN
;HERE TO DO A MIC CLEAR
M.CLEAR:
PUSH P,L
PUSH P,[EXP 21+CLEAR]
PJRST M.COMN
;HERE TO DO A MIC DISPLAY
M.DISPLAY:
PUSH P,L
PUSH P,[EXP 21+DISPLAY]
PJRST M.COMN
;HERE TO DO A MIC RESPONSE
M.RESPONSE:
PUSH P,L
PUSH P,[EXP 21+RESPONSE]
M.COMN: TRO L,.UXTRM
HRRZM L,MICBLK+1 ;LINE NO.& .UXTRM
POP P,MICBLK ;OPERATION CODE
MOVEM S,MICBLK+2 ;ARGUMENT
MOVE L,[3,,MICBLK]
TRMOP. L,
CAIA
AOS -1(P)
POP P,L
POPJ P,0
;HERE TO W/E THE HI SEG
.WENABL:
SKIPGE LOKBIT ;;ALREADY W/E?
POPJ P,0 ;;YES
EXCH T1,LOKBIT ;;SAVE T1
SETZ T1,
SETUWP T1,
HALT
SETO T1,
EXCH T1,LOKBIT ;;RESTORE T1
POPJ P,0
;HERE TO WRITE LOCK THE HIGH SEG
.WLOCK:
SKIPN GOD ;[1074][ISSG] Stay WE for master
AOSE LOKBIT ;;[1074]ALREADY W/L?
POPJ P,0 ;;[1074]YES
EXCH T1,LOKBIT ;;SAVE T1
MOVEI T1,1 ;;SETUWP ARG
SETUWP T1,
HALT
SETZ T1,
EXCH T1,LOKBIT ;;RESTORE T1& SET FLAG
POPJ P,0
XLIST ;PUT LITERALS BEFORE SPACE TO BE USED FOR COMMUNICATION AREA
LIT
VAR
LIST
SUBTTL PROCESS CONTROL AREA IN LOW CORE COMMON TO ALL MODES
RELOC
SIZ==100
LOWIN: BLOCK 1 ;THIS CONTAINS THE LOW LEVEL I/P CALL
LOWOUT: BLOCK 1 ;THIS CONTAINS THE LOW LEVEL OUTPUT CALL
CH.SAV: BLOCK 1 ;PLACE TO SAVE CHAR WHEN EATEN MORE THAN CAN CHEW
LINTOT: BLOCK 1
LOWCMD: BLOCK 1 ;PLACE TO STORE SIXBIT NAME OF COMMAND ON PROGRESS
LOWERR: BLOCK 1 ;PLACE TO STORE SIXBIT ERROR WHEN IT OCCURS
F.CMBT:
DEFNDX: BLOCK 1 ;PLACE TO STORE THE DEFAULT INDEX TO A GETTAB
;USUALLY A JOB NO.
P..SAV: BLOCK 1 ;USED BY COMBAT AND OTHERS
SYMBUF: BLOCK <^D132/5>+1 ;[1036]WHERE THE RESULT OF A DELIMITER IS PUT
GTLOCK: BLOCK 1 ;LOCK FOR NESTED GETTABS
; Data block used by the DAY parameter.
CENT: BLOCK 1 ;CENTURY
YEAR: BLOCK 1 ;YEAR
MONTH: BLOCK 1 ;MONTH
DAY: BLOCK 1 ;DAY
STACK: BLOCK SIZ
LDEV: BLOCK 1 ;STORAGE FOR DEV:
LFILE: BLOCK 1 ; .. .. FILNAME
LEXT: BLOCK 1 ; :: :: EXT
LPPN: BLOCK 1 ; .. .. PPN
IFN FTPATH,<
PTHBLK: BLOCK 2 ;ARG. BLOCK FOR PATH UUO
LPATH: BLOCK SFDLVL+1 ;PATH
>
IFN FTCJOB,<
LOWSWT: BLOCK TABSWT ;SPACE FOR SETTING UP SWITCHES
>
TRYCORE:BLOCK 1 ;WHERE TO COUNT THE NO. OF TIMES WE TRIED FOR CORE
LOKBIT: BLOCK 1 ;WORD FOR WLOCK STUFF
INTBLK: BLOCK 4 ;SPACE FOR CONTROL C INTERCEPT BLOCK IN SLAVE
;AND ERROR INTERCEPT BLOCK IN MASTER
;USED BY AUTO-RESTART
MICBLK: BLOCK 3 ;BLOCK USED FOR TRMOP. ARGS
GOD: BLOCK 1 ;[1074]If # 0 we are master
.LOW=. ;END OF COMMON DATA STORAGE SLAVE AND MASTER
;MASTER PROCESS AREA IN LOW CORE
BUFBP: BLOCK 1
BUFFER: BLOCK <LINSIZ/5>+1 ;[1235]
IFN FTCJOB,< ;[1151] COJOBS ONLY
CJBUF: BLOCK <^D80/5>+1 ;[1151] SPACE FOR COJOB INFORMATION MESSAGES
;[1151] TO BE BUILT
CJBBP: BLOCK 1 ;[1151] POINTER INTO THE COJOB INFO MESSAGES
CJBCNT: BLOCK 1 ;[1165] COJOB COUNTER
> ;[1151] END OF IFN FTCJOB
ACTIVE: BLOCK 1
LABWD: BLOCK 1
HIBTIM: BLOCK 1 ;TIME FOR HIBER
CURTIM: BLOCK 1 ;[1054] TIME AT THE START OF A SCHEDULE LOOP
CORSAV: BLOCK 1
ARGPNT: BLOCK 1 ;POINTER TO ARG.
ARGWRD: BLOCK 1 ;ARG.
ARGTYP: BLOCK 1 ;TYPES OF ARG. ALLOWED
; =0 MEANS ANY
; =-1 MEANS "IF" ONLY.
; =1 MEANS NONE.
IFN FTCJOB,<
NAMWRD: BLOCK 1 ;USED FOR GENERATING COJOB NAMES
>
.LOW2==.
RELOC
SUBTTL PROCESS CONTROL AREA IN SHARED CORE
PCA:
IFN FTCJOB,<
IFE FTGALA,<
DEFDSP: "0",,"D" ;DEFAULT QUEING AND DISPOSAL
IFN FTMBCH,<
BATDSP: "1",,"D" ;[1121] DEFAULT FOR BATCH
>
> ;END OF IFE FTGALA
DEFTIM: .STTLM,,IDFTIM ;SIXTY SECONDS DEFAULT RUNTIME
WHONOT: 0,,0 ;WHO MAY NOT INITIATE COJOBS
COJOBN: -1 ;NEGATIVE NUMBER OF USABLE COJOBS
CJREQ: -ICJREQ ;" " " " DESIRED COJOBS
CJUP: 0 ;NUMBER OF COJOBS IN USE
> ;END OF COJOB BIT
CMDTOT: 0 ;NUMBER OF SUCCESSFULL / COMMANDS
IFN FTCJOB,<
CJBTOT: 0 ;NO. OF COJOBS RUN
IFN FTCLASS,<
DEFCLA: IDFCLA ;[1074]Default scheduler class
BBCLA: IBBCLA ;[1074]Background batch class
>
>;END
IFN FTMBCH,<
BATBLK:
BRQTOT: 0 ;BATCH REQUESTS
BATTOT: 0 ;BATCH JOBS
BATOPR: 1
BATACT: Z ;MIC/COMBAT INTERLOCK
BCHREQ: -1 ;-VE NO. OF DESIRED BATCH JOBS
BCJOBN: 0 ;-VE NO. OF USABLE BATCH JOBS
BCHUP: 0 ;NO. OF BATCH JOBS IN USE
BATSIZ==.-BATBLK
>;END FTMBCH
MICOPR: -1 ;MIC OPERATOR'S LINE NO.
IFN FTCJOB,<
IFN FTCLASS,<
LIMCLA: IMXCLA,,IMNCLA ;[1074]Limits for scheduler class
>
LIMTIM: IMXTIM,,-1 ;[1074]TIME LIMIT
>
PROCNU==1 ;NUMBER OF PROCESS AREA YOU START WITH
PROCNO: -PROCNU ;NEGATIVE NUMBER OF PROCESS AREAS AVAILABLE
LWPRNO: -PROCNU ;NEGATIVE NO. OF LOW PROCESS AREAS AVAILABLE
MAXLVL: 77 ;MAXIMM LEVEL OF NESTING FOR PROCESSES
DEFTBL: 0 ;DEFAULT TABLE FOR GETTABS
DEFMOD: 1 ;DEFAULT MODE FOR GETTABS
LOCK: -1 ;INTERLOCK FOR GRABBING A PROCESS AREA IN SHARED CORE
;-1 FREE
;+VE IN USE
IFN FTCJOB,<
CNFPTY: BLOCK 1 ;PTY LINE INFO FROM GETTABS
COMCNT: 0 ;NUMBER OF UNSATIFIED REQUEST FOR PROCESS AREAS
LOWCNT: 0 ;NUMBER OF UNSATISFIED REQUESTS FOR LOW PROCESS AREAS
MASTNO: BLOCK 1 ;JOB NO. OF MASTER PROCESS
MICDEV: 'MIC' ;IF ERSATZ DEVICE MIC IS DEFINED IN MONITOR
;OTHERWISE REDEFINED AS 'SYS' AT STARTUP
JIFFY: EXP ^D50 ;JIFFY VALUE FOR APPROPRIATE CLOCK
;RESET AT STARTUP TIME
>;[1120] END OF IFN FTCJOB
SCNDIN: ISCNDF ;[1156] SCANDINAVIAN CHARACTERS IF # 0
PCALEN=.-PCA
.HIGH==.
SUBTTL PROCESS DATA AREA IN SHARED CORE
DEFINE .. (....,...<.....>),<
......=...
IFN ......&WH,<
A.'....: BLOCK 2
>
> ;END OF MACRO
PDB:
IFN FTCJOB,<
COJOB: 0 ;FLAG FOR COJOB PROCESSING
CJOWNR: 0
IFN FTMBCH,<
BATWRD: 0 ;WORD FOR BATCH PROCESSING
JOBNAM: 0 ;NAME OF A MIC BATCH JOB(ASS CHRISTENED BY Q!)
>
USRNM1: 0 ;[1223][1221] FIRST HALF OF USERNAME
USRNM2: 0 ;[1223][1221] 2ND HALF OF USER NAME
>
LDBMIC: 0
LINE: 0
STATIN: 0 ;STATION INFO
DEV: 0
FILE: 0 ;FILE NAME
EXT: 0 ;EXTENSION
PPN: 0 ;THIS JOB'S PPN
IFN FTPATH,<
PATH: BLOCK SFDLVL+3 ;SPACE FOR PATH
>
OPPN: 0 ;PPN OF OWNER
IFN FTPATH,<
OPATH: BLOCK SFDLVL+3 ;PATH OF THE OWNER
>
OJOB: 0 ;OWNER'S JOB NO.
JOB: 0 ;JOB NO.
IFN FTCJOB,< ;[1207]
IFE FTGALA,<
VD:
VDISP: 0 ;DISPOSAL OF LOG FILE
ZQ: 0 ;DEGREE OF Q'ING
> ;IFE FTGALA
IFN FTCLASS,<
CLASS: 0 ;DEFAULT SCHEDULAR CLASS
> ;IFN FTCLASS
TIME: 0 ;[1207] COJOB RUN-TIME
LOPTION:0 ;[1207] COJOB LOGIN OPTION
; ;[1207] IF = 0 NO OPTION SWITCH AT ALL
; ;[1207] IF =-1 THEN /NOOPTION SWITCH
; ;[1207] IF #0 &#--1 THEN /OPTION:'C(LOPTION)'
> ;[1207] IFN FTCJOB
BLAB: 0 ;SPACE FOR BACKTO LABEL DO NOT SEPERATE THIS FROM
LAB: 0 ;SPACE FOR LABEL THIS.....
FSAV: 0 ;FLAG WORD (SAVED COPY OF AC F ---USED TO BE IN LOW SEG)
PROFLE: 0 ;MIC PROFILE WORD
TYPWRD: 0 ;SPACE FOR ADDR. OF TYPE ARG.
DISWRD: 0 ;SPACE FOR ADDR. OF DISPLAY ARG.
ERRWRD: BLOCK 1 ;SPACE FOR ADDR. OF ERROR MESSAGE
ARGBP: BLOCK ARGNUM
IFN FTCJOB,<
ARG: BLOCK ARGNUM*8-4-SFDLVL-3 ;[1210][1075][1114]
LGSPEC: BLOCK 4+SFDLVL+3
ENDSWT==.-1
LGNSTR: BLOCK 1 ;[1170] POINT TO THE LOGIN SWITCHES SPECIFIED BY THE USER
>
IFE FTCJOB,<
ARG: BLOCK ARGNUM*8 ;[1075]
>
ARGSIZ=.-ARG
CHRMAX=ARGSIZ*5-2 ;[1171] MAX NO. OF CHARACTERS
SYMBFX: BLOCK <^D132/5>+1 ;[1037] RESULT SPACE FOR SYSTEM PARAMETERS
FSTVNT: CMD
LSTVNT==.-1
INLINE: BLOCK <LINSIZ/5>+2 ;[1225] SPACE FOR USERS CURRENT I/P LINE
RS: 0 ;WHERE THE BYTE POINTER TO A RESPONSE PARAMETER IS PUT
SLPTIM: 0 ;[1054]TIME AT WHICH MIC IS TO RESTART PROCESSING THIS REQUEST
YZWORD: 0 ;L.H POINTS TO Y PROCESS AREA
;R.H POINTS TO Z PROCESS AREA (IF APPLICABLE)
LAST: 0 ;SET WHEN A PREVIOUS PROCESS HAS BEEN STOPPED
;CONTAINS THE X POINTER OF THE PREVIOUS PROCESS+1
FLAG: 0 ;INTERLOCK FOR SLAVE MASTER PROCESS
; 0=FREE
; 1=IN USE SLAVE MODE
;-1=AVAILABLE FOR THE MASTER PROCESS
PDBSIZ==.-PDB
RELOC
SUBTTL COJOB NON-SHARED PROCESS AREA
IFN FTCJOB,< ;COJOBS ONLY
DEFINE ..(....,.....,C<0>),<
....: BLOCK 1
>
RELOC .LOW2
PHASE 0
;LAYOUT OF LOW PROCESS AREA WHEN USED FOR COJOB LOGGING
LOWFLG: BLOCK 1 ;IN USE FLAG 0=FREE
; #0=IN USE
PTY.IC: BLOCK 1 ;CHANNEL FOR PTY IO
PTY.IH: BLOCK 3 ;PTY INPUT BUFFER HEADER
PTY.IB: BLOCK 23 ;PTY INPUT BUFFER
LOGTOT: BLOCK 1 ;FREE BYTES IN LOGGING BUFFER
LOGBP: BLOCK 1 ;LOG BUFFER PUTTER
LOGBUF: BLOCK 200 ;LOG BUFFER
LOGDEV: BLOCK 1 ;ON WOT
LOGFIL: BLOCK 1 ;IN WOT
LOGEXT: BLOCK 1 ;MORE OF WHAT
LOGPPN: BLOCK 1 ;WHERE
IFN FTPATH,<
LOGPTH: BLOCK SFDLVL+2+1 ;MORE OF WHERE
>
ELWLOG=.-1 ;[1207]
LOGDMP: BLOCK 2 ;DUMP MODE COMMAND LIST
CJFLAG: BLOCK 1 ;NON - ZERO TO INDICATE COJOB AREA IN USE
CJSIZ==.-LOWFLG
> ;END OF COJOBS ONLY
DEPHASE
RELOC .LOW2
PHASE 0
;LAYOUT OF LOW PROCESS AREA WHEN IT IS USED FOR MIC INPUT
;PURPOSES
LPDB: BLOCK 1 ;SPACE FOR FLAG
NESTY==10 ;MAX NESTING ON PARAMETERS
LTIME: BLOCK 1 ;MORATORIUM FOR THIS PROCESS
CURBP: BLOCK NESTY
BLKNO: BLOCK 1
FILBLK: BLOCK ^D128+1
POINTR: BLOCK 1
LPDBSIZ==.-LPDB
DEPHASE
LOWSIZ==CJSIZ ;SIZE OF LOW PROCESS AREAS
IFG LPDBSIZ-CJSIZ,<
LOWSIZ==LPDBSIZ
>
RELOC .LOW2
LOWPRC:
LOWPDB: BLOCK LOWSIZ ;START WITH 1 LOW PROCESS AREA
ELWPDB==.-1 ;END OF LOW PROCESS AREA
SUBTTL LOW STORAGE FOR SLAVE PROCESS SPECIAL COMMANDS
;IF/LET COMMAND SPECIAL LOW CORE STORAGE
RELOC .LOW
LEVEL: BLOCK 1 ;REFERENCE TO OUTER LEVEL
LLX: BLOCK 1 ;LINE NUMBER
LLP: BLOCK 1 ;PARAMETER NAME...THEN ADDRESS PARAMETER .ER
BOOL: BLOCK 1 ;CONDITIONAL OPERATOR DECODE TO CAM?? N,N1
FIRST: BLOCK ARGNUM*8
SS: BLOCK 100
SECOND: BLOCK ARGNUM*8
HEAP:
HH: BLOCK 100
SUBTTL SPECIAL LOW STORAGE FOR / COMMAND
;HERE IS AN DATA AREA USED IN PROCESSING THE / COMMAND
RELOC .LOW
IFN FTMBCH,<
BUFBP: BLOCK 1 ;POINTER INTO TMPCOR O/P BUFFER
BUFFER: BLOCK 35 ;TMPCOR O/P BUFFER
>
ELKBLK: BLOCK 33 ;BLOCK FOR EXTENDED LOOKUPS
TMPCBF: BLOCK TMPCBL+1 ;BLOCK FOR TMPCOR I/P BUFFER
TMPCPT: BLOCK 1 ;POINTER INTO TMPCOR BUFFER
CHRCNT: BLOCK 1 ;[1170] COUNT OF CHARACTERS
CHRPTR: BLOCK 1 ;[1170] CHARACTER PUTTER
IFN FTCJOB,<
;
;[1207] STORAGE SPACE FOR COJOB SWITCH PROCESSING
;
DEFINE ..(NAME,SELECT,INSTR),<
IFNB <INSTR>,<
$$'NAME:
BLOCK 2 ;; 2 WORDS PER SWITCH (1 FOR SWITCH.INI)
>
>
SWTCH()
> ;;[1207] IFN FTCJOB
;[1213] Working space for the use of the SWITCH.INI processor
SWIPTR: BLOCK 1 ;[1213] POINTER INTO FILE BLOCK
SWIBSZ=200 ;[1213] SIZE OF FILE BLOCK
SWIBLK: BLOCK SWIBSZ ;[1213] SPACE TO READ IT
BLOCK 1 ;[1213]
SINLIN: BLOCK 1 ;[1213] SPACE TO SAVE THE OLD INPUTTER
SINICH: BLOCK 1 ;[1213] SAVE LOOK AHEAD CHARACTER
;DUMMY PDB IS SET UP HERE
;ALSO BATCH RETURN AREA ETC.
DUMPDB:
BLOCK PDBSIZ
DUMMYX=DUMPDB-PDB ;CORRECTED VALUE FOR SLAVE X
IFN FTMBCH,<
LWACTN: BLOCK 1 ;MIC/COMBAT COMMUNICATION
COMBRG: BLOCK 6
COMBAT: BLOCK 2
> ;END OF MIC BATCH
ELDATA==. ;END OF LOW DATA
SUBTTL MASTER PROCESS - ONCE ONLY INITIALLISATION
RELOC .HIGH
;HERE TO DO THE START UP CODE FOR MIC
;NB THIS CODE IS WIPED OUT AFTER USE!
INITIA: SETZM LOWPDB ;CLEAR CORE
MOVSI P,LOWPDB ;FROM HERE...
HRRI P,LOWPDB+1
SKIPN .JBDDT## ;DO NOT ZERO CORE IF LOADED WITH DDT
BLT P,@.JBREL## ;...TO HERE
MOVE P,[IOWD SIZ,STACK]
PUSHJ P,CLRTTI
WENABL ;OPEN HI SEG
PJOB T2, ;GET JOB NO.
CAIL T2,^D127 ;JOB NO. GREATER THAN 127
JRST [OUTSTR [ASCIZ/?MICJTH MIC job number greater than 127/]
EXIT]
MOVEM T2,MASTNO ;AND PRESERVE
WLOCK ;CLOSE HI SEG
WAKE T2, ;SET TO WAKE
SETZ T1,
HIBER T1, ;HIBERNATE
JFCL
MOVE T1,[.TCRDD,,T2] ;CLEAR TMPCOR
SETZB T2,T3
SKIPN .JBDDT## ;[1136] IF LOADED WITH DDT, DON'T!
TMPCOR T1,
JFCL
JUMPL F,INIT0 ;IS THIS A RESTART
;NO -NORMAL INITIALLISATION
;SO TELL HIM OUR VERSION NUMBER.
PUSHJ P,FRCCHK ;[1150][1170] ARE WE ON FRCLIN?
JRST INIT0 ;[1070] IF YES, NO PRETTY MESSAGES
IFN FTDDT,< OUTSTR [ASCIZ/ ** Debugging Version **/] ;[1024]>
OUTSTR [ASCIZ/
MIC version - /]
LDB N,[POINT 9,.JBVER##,11] ;MAJOR VERSION NUMBER
PUSHJ P,OCTPRT ;PRINT IT
LDB N,[POINT 6,.JBVER##,17] ;MINOR VERSION NUMBER
JUMPE N,.+3
MOVEI CH,"A"-1(N) ;(CHANGE THIS IF VMINOR>26)
PUSHJ P,OUCH
OUTCHR ["("] ;LEFT BRACKET
HRRZ N,.JBVER## ;EDIT NO.
PUSHJ P,OCTPRT ;PRINT IT
OUTCHR [")"] ;RIGHT BRACKET
LDB N,[POINT 3,.JBVER##,2] ;WHO MODIFIED DIS
SKIPE N ;NOBODY?
OUTCHR ["-"] ;NO SOMEBODY
SKIPE N
PUSHJ P,OCTPRT ;PRINT IT OUT
OUTSTR [ASCIZ/
/]
;MORE INITIALLISATION
INIT0: WENABL ;OPEN HI SEG
IFN FTCJOB,< ;IF COJOBS
MOVE T1,[XWD 3,-1]
MOVEM T1,NAMWRD ;INITIALLISE COJOB NAME GENERATOR
MOVE T1,[JRST PTYO]
MOVEM T1,LOWOUT ;FOR COJOB ACTIVITY
MOVE T1,[EXP %CNPTY]
GETTAB T1,
HALT
MOVEM T1,CNFPTY ;STORE INFO ON PTYS
> ;END OF IF COJOBS
SETZ T1, ;NOW TO CHECK UP ON MIC DEVICE
MOVSI T2,'MIC' ;DOES MIC EXIST
SETZ T3,
OPEN T1
MOVSI T2,'SYS' ;NO--WE MUST USE MIC
HLRZM T2,MICDEV ;MAKE THAT THE MIC DEVICE
MOVE T2,[%CNSTS]
MOVEI T3,^D50 ;DEFAULT IS 50 CYCLE CLOCK
GETTAB T2,
SETO T2,
TXNN T2,ST%CYC ;IS IT A 50 CYCLE CLOCK
MOVEI T3,^D60 ;NO
MOVEM T3,JIFFY ;REMEMBER
IFN FTPSI,<
IFN FTDDT,< SKIPA ;[1024] NORMALLY DONT WANT WHEN DEBUGGING!>
PUSHJ P,SETPSI ;INITIALLISE SOFTWARE INTERRUPTS
>
MOVEI T1,..DIE1 ;SET UP SO THAT A REENTER ON THE MASTER PROCESS
MOVEM T1,.JBREN## ;RESTARTS MIC
SETO T1, ;NOW DET TTY
GETLCH T1
HRLZS T1
HRRZ T2,.JBDDT## ;GET ADDR OF DDT IF ANY
JUMPN T2,INDDT ;DON'T DET IF DDT
GETLIN T3, ;GET LINE
TLNN T3,-1 ;ARE WE DETACHED?
JRST INIT1 ;YES SO DONT DETACH AGAIN
PUSHJ P,FRCCHK ;[1150][1136] IF RUNNING ON FRCLIN,
SKIPA ;[1150] DON'T TYPE MESSAGE
OUTSTR [ASCIZ/DETACHING
./]
ATTACH T1,
OUTSTR [ASCIZ/can't detach
/]
SKIPA
INDDT: OUTSTR [ASCIZ/DDT loaded - MIC will not detach!
/]
INIT1:
PUSHJ P,CLRLDB ;CLEAR ANY SPURIOUS LDBMIC WORDS
MOVE 5,[INITIA,,INITIA+1]
SETZM INITIA ;PREPARE TO WIPE OUT START UP CODE
MOVE 0,[BLT 5,E.INITIA]
MOVE 1,[SETUWP 6,]
MOVE 2,[HALT]
MOVE 3,[SETZM LOKBIT]
MOVE 4,[JRST MSTR0]
JRST 0 ;WIPE OUT!
SUBTTL INITIALLISE SOFTWARE INTERUPTS TO MAKE MIC SELF-RESTARTING
IFN FTPSI,< ;LET THIS BE CONFIGUARABLE OUT
SETPSI: MOVEI T1,..DIE ;ADDR. TO DIE AT
MOVEM T1,INTBLK ;IN PSI INTERRUPT BLOCK
SETZ T1,
TXO T1,PS.VPO!PS.VTO!PS.VDS!PS.VPM ;ENABLE FLAGS
MOVEM T1,INTBLK+.PSVFL ;IN CONTROL BLOCK
MOVEI T1,INTBLK ;GET BASE ADDR. OF INTERRUPT BLOCK
PIINI. T1, ;INITIALLISE THE PSI SYSTEM
JRST E%%PIN ;FAILED
MOVE T1,[EXP PS.FAC+[EXP .PCIUU
Z
Z]] ;TRAP ILLEGAL UUO
PISYS. T1,
JRST E%%PSI ;FAILED
MOVE T1,[EXP PS.FAC+[EXP .PCIMR
Z
Z ]] ;ILL MEM REF.
PISYS. T1,
JRST E%%PSI
MOVE T1,[EXP PS.FAC+[EXP .PCPDL
Z
Z ]] ;PDL OVERFLOW
PISYS. T1,
JRST E%%PSI
MOVE T1,[EXP PS.FAC!PS.FON+[EXP .PCSTP
Z
Z ]] ;^C
PISYS. T1,
JRST E%%PSI
POPJ P,0 ;PSI SET UP
E%%PIN: OUTSTR [ASCIZ/?MICPIN PIINI. UUO failed/]
JRST ERRPS0
E%%PSI: OUTSTR [ASCIZ/?MICPSI PISYS. UUO failed/]
ERRPS0: MOVE N,T1
OUTSTR [ASCIZ/ code-/]
PUSHJ P,OCTPRT ;PRINT THE AC
OUTSTR [ASCIZ/
/]
POPJ P,0
>
SUBTTL CLRLDB - ON A RESTART CLEAR UP ANY OLD LDBMIC WORDS
;THIS ROUTINE LOOKS AT ALL THE LINES ON THE SYSTEM
;AND IF THEY HAVE AN LDBMIC WORD SET UP - WHICH POINTS AT THIS JOB
;IT IS CLEARED DOWN AND A MESSAGE OUTPUT
CLRLDB: MOVE T1,[EXP %CNLNP]
GETTAB T1, ;GET NO. OF LINES
JRST CPOPJ ;FAILED - JUST CARRY ON
HLLZ N,T1 ;[766]SO SET UP AN AOBJN THINGY
CLRLD0: HRRZ L,N ;GET LINE NO.
MIC GET,L ;GET LDBMIC WORD
JRST CLRLD1 ;HASN'T GOT ONE
IFN FTDDT,< ;[1024]
REPEAT 0,<
NOTE:-
If the system version of MIC crashes while your debug version is running
it will wipe out YOUR lines LDBMIC words. This is unfortunate
but is rather unlikely, and is peferable to leaving spurious LDBMIC words around!
>
LDB T3,LDPMJN ;WHO DOES HE BELONG TO
CAME T3,MASTNO ;IS IT US
JRST CLRLD1 ;NO - LEAVE HIM ALONE
;CLEAR IT DOWN
>
MIC CLEAR,L
JFCL
MOVEI S,[ASCIZ/?
?MICSYS MIC system error - your MIC command has been aborted
/]
;TELL HIM THE SAD NEWS
MIC DISPLAY,L
JFCL
CLRLD1: AOBJN N,CLRLD0 ;LOOP FOR ALL LINES
POPJ P,0
XLIST
LIT
VAR
LIST
E.INITIA==.-1
END MICBGN ;PHEW
Reference in New Issue View Git Blame Copy Permalink