Trailing-Edge
-
PDP-10 Archives
-
AP-D483B-SB_1978
-
sprint.mac
Click sprint.mac to
see without markup as text/plain
There are 20 other files named sprint.mac in the archive. Click here to see a list.
SUBTTL Larry Samberg/LSS/JHT/JNG 28 MAR 77
;***Copyright 1973,1974,1975,1976,1977 Digital Equipment Corp., Maynard, MA.***
;ASSEMBLY AND LOADING INSTRUCTIONS
; .COMPILE SPRINT
; .LOAD QMANGR,SPRINT
; .SSAVE SPRINT
SEARCH QSRMAC ;GET GALAXY SYMBOLS
SEARCH MACTEN,UUOSYM ;GET MACROS AND UUO SYMBOLS
IFN FTJSYS,<
SEARCH MONSYM
> ;END IFN FTJSYS
SEARCH QPRM ;QUEUE SYSTEM SYMBOLS
SALL ;SUPPRESS MACRO EXPANSIONS
;VERSION INFORMATION
SPTVER==102 ;MAJOR VERSION NUMBER
SPTMIN==0 ;MINOR VERSION NUMBER
SPTEDT==2024 ;EDIT LEVEL
SPTWHO==0 ;WHO LAST PATCHED
%SPT==<BYTE (3)SPTWHO(9)SPTVER(6)SPTMIN(18)SPTEDT>
;STORE VERSION NUMBER IN JOBVER
LOC 137
.JBVER::EXP %SPT
TWOSEG ;TWO SEGMENT PROGRAM
RELOC 400000 ;START IN HISEG
..SEG==1 ;FLAG FOR UP-DOWN MACROS
;THIS PAGE INSTALLED AS PART OF EDIT 1050 (START OF VERSION 2A)
;SO THAT MINOR VERSIONS APPEAR CORRECTLY IN THE TITLE & LOG FILES.
;DEFINE A MACRO TO CALL THE .NAME MACRO WITH THE RIGHT ARGS
;DEFINE THE .NAME MACRO TO BE WHAT YOU WANT, THEN CALL THIS MACRO.
;IT'S USED TO GENERATE SPRINT'S VERSION CORRECTLY
DEFINE .CLNAM<
DEFINE .CLNM(LETTER,WHO)<
IRPC LETTER,<
IFE "A"-"'LETTER'"+SPTMIN-1,<
STOPI
IFIDN <LETTER><@>,<
IFE SPTWHO,< .NAME(\SPTVER,,\SPTEDT,)>
IFN SPTWHO,< .NAME(\SPTVER,,\SPTEDT,-WHO)>>
IFDIF <LETTER><@>,<
IFE SPTWHO,< .NAME(\SPTVER,LETTER,\SPTEDT,)>
IFN SPTWHO,< .NAME(\SPTVER,LETTER,\SPTEDT,-WHO)>>>>>
IFGE SPTMIN-^D26,< SPTMIN==0
PRINTX %MINOR VERSION TOO LARGE - IGNORED>
IFGE SPTWHO-7,< SPTMIN==
PRINTX %SPTWHO IS TOO LARGE - IGNORED>
.CLNM(@ABCDEFGHIJKLMNOPQRSTUVWXYZ,\SPTWHO)
>
;NOW DEFINE A .NAME MACRO TO MAKE A TITLE
DEFINE .NAME(V,M,E,W)<
TITLE SPRINT DECsystem-10 SPooling PRocessor for INpuT - Version V'M'('E')'W
>
;NOW USE IT
.CLNAM
; TABLE OF CONTENTS FOR SPRINT
;
;
; SECTION PAGE
; 1. Revision History...................................... 4
; 2. Symbol Naming Conventions............................. 5
; 3. Accumulator and Coding Conventions.................... 6
; 4. Conditional Assembly Switches......................... 7
; 5. Conditional Assembly Parameters....................... 8
; 6. Symbol Definitions.................................... 9
; 7. The Message Macro..................................... 14
; 8. Card Code Conversion Table Generation................. 17
; 9. Code Conversion Control Symbols....................... 23
; 10. TENEX JSYS OPDEFS..................................... 24
; 11. TOPS-10 - TENEX Compatibility Macros.................. 25
; 12. Device Control Cells.................................. 27
; 13. FILE-BLOCK Definitions................................ 29
; 14. Prototype QUEUE Header................................ 30
; 15. ACCT.SYS and AUXACC.SYS Table Definitions............. 31
; 16. Commonly Used Byte Pointers........................... 32
; 17. Lowsegment Storage Cells.............................. 33
; 18. Entry and Initialization.............................. 39
; 19. Operator Commands
; 19.1 Setup and Dispatch............................ 45
; 19.2 HELP - PAUSE - GO............................. 47
; 19.3 EXIT.......................................... 48
; 19.4 STOP - RESET - KILL........................... 49
; 19.5 TELL.......................................... 50
; 19.6 WHAT.......................................... 51
; 19.7 MCORE......................................... 53
; 19.8 MSGLVL........................................ 54
; 19.9 START......................................... 55
; 19.10 Subroutines................................... 57
; 20. TTY INPUT ROUTINES.................................... 58
; 21. LOOKUP/ENTER UUO Error Messages....................... 60
; 22. LUUO Handler.......................................... 61
; 23. LOG File Handler...................................... 67
; 24. Control File I/O...................................... 70
; 25. Job Setup and Idle Loop............................... 71
; 26. Main Program Loop..................................... 73
; 27. Routine to OPEN the Input Device...................... 76
; 28. Control Cards
; 28.1 Setup and Dispatch............................ 78
; 28.2 $language..................................... 83
; 28.3 $DECK......................................... 86
; 28.4 $RELOC........................................ 87
; 28.5 $INCLUDE...................................... 88
; 28.6 $DATA......................................... 89
; 28.7 $EXECUTE...................................... 90
; 28.8 $ERROR - $NOERROR - $DUMP - $EOJ.............. 92
; 28.9 $MESSAGE...................................... 93
; 28.10 $EOD.......................................... 94
; 28.11 $MODE......................................... 95
; 28.12 $TOPS10....................................... 96
; 28.13 $SEQUENCE..................................... 97
; 28.14 $JOB.......................................... 98
; 29. $JOB Card Subroutines................................. 101
; 30. $JOB Card Switch Subroutines.......................... 108
; 31. Fast-FORTRAN Stream Handler........................... 114
; 32. Routines To Finish Off a Job.......................... 121
; 33. Non-$JOB Card Switch Subroutines...................... 127
; 34. Control Card Common Subroutines....................... 129
; 35. FILE-BLOCK Manipulation Routines...................... 146
; 36. Scanners.............................................. 151
; 37. DUMMY ROUTINES TO READ ONE CHARACTER FROM CARD........ 164
; 38. Deck Stacking Routines................................ 165
; 39. Device Input Routines................................. 168
; 40. Error and Utility Routines for Device Input........... 174
; 41. User File Output Routines............................. 177
; 42. Input Device Monitor Interface........................ 178
; 43. Accounting File Handlers.............................. 180
; 44. Routines to SET and GET Search-List................... 198
; 45. Queue Manipulation Routines........................... 200
; 46. Core and Segment Handling Routines.................... 205
; 47. JOBINT Traps and Device Error Handler................. 208
; 48. Useful Routines....................................... 210
; 49. Operator Messages..................................... 214
; 50. DEVICE ERROR MESSAGES................................. 215
; 51. Miscellaneous Messages................................ 216
; 52. User Error Messages................................... 217
;MAINTENENCE EDITS - - VERSION 2A.
;;1050 (35) MAKE THIS VERSION 2A AND ADD A NEW VERSION MACRO.
;; UPDATE IN-CORE INDEX IF AUXACC.SYS CHANGES
;; ADD A MESSAGE TO INDICATE DOING SO [10-13175] (JNG).
;1051 (36) CLEAR INCREMENTAL DISK COUNTS BEFORE STORING REAL COUNTS.
;
;1052 (37) RELEASE UFD AND CTL CHANNELS WHEN THROUGH WITH THEM.
; SPR 14969
;
;1053 ZERO PROTECTION WORD(FILPRV) BEFORE CALLING FILENT IN $LANG
; PROCESSING. ELSE, LEFT OVER PROTECTIONS FROM OTHER FILE CARDS
; WILL BE IMPROPERLY REUSED.
; SPR 15269
;
;1054 EXTRANEOUS $CARDS IN HOPPER WITH OR WITHOUT LEGITIMATE JOB (S)
; IN FRONT OF THEM CAUSE UNDESIRED 'SPTHPE' MESSAGE. WHEN THE
; EXTRA $CARD IS FOUND, SPRINT GOES TO NTAJOB TO CREATE 'SPRINT.ERROR'
; AND THEN TO FLUSH TO CLEAR THE REST OF THE CARDS(IF ANY) UNTIL
; THE NEXT JOB STARTER IS FOUND. WHEN THE CDR IS EMPTY, TRAP TO
; 'INTLOC' WHICH WILL ISSUE 'SPTHPE' IF 'F.BUSY' IS ON. 'F.BUSY'
; SHOULD BE CLEARED WHEN 'FLUSH' ENTERED, SINCE AN EMPTY READER
; SATISFIES THE CONDITION 'FLUSH' REQUIRES.
; SPR 15190
;
;1055 MSGLVL 'N1N' DOES NOT TYPE THE 'SPTIJC' (ILLEGAL JOB CARD)
; MESSAGE. IT SHOULD.
; SPR 15190
;
;1056 MAKE SPRINT RECOGNIZE ACCT.SYS VERSION 4
;
;1057 CLOSE LOCAL READER IF EOF (FROM EOF BUTTON) RECOGNIZED.
; SETSTS DOESN'T CLEAR EOF CONDITION AND SPRINT LOOPS CONTINUALLY
; THINKING IT IS GETTING EOF CONDITION.
; SPR 15854
;
;1060 LACK OF ARGUMENT TO /IMAGE CAUSES NEXT SWITCH TO BE IGNORED
; SPR 15913
; AREA: W$IMAG
;
;1061 SUPPORT ALTERNATE PUNCHES FOR 026 "?" AND ":". THEY
; CURRENTLY ARE ARBITRARY.
; AREA: CDRAS2
; SPR 16095
;
;1062 NULLS ON ASCII INPUT DEVICES (MAGTAPE AND DISK) GET THROWN AWAY
; BUT THE CHARACTER COUNT IS NOT UPDATED CAUSING JUNK TO GET INTO
; FILE
; SPR 16336
; AREA: CDRAS9
;
;1063 JNG 24-Jul-75 SPR 16756
; /SUPPRESS is not defaulted correctly on a $JOB card if
; the default is /NOSUPPRESS.
; Area: $JOB10
;
;1064 JNG 24-Jul-75 SPR 16706
; Fix security problem with file protections.
;
;1065 JNG 27-Jul-75
; Correct error recovery on CDR device errors.
; Areas: CDRIN7
;
;1066 JNG 5-Aug-75
; Do not CLOSE a local CDR on an EOF card, since CDRSRX
; did not set IOEND and the CLOSE will cause data to be lost.
; Areas affected: CDRIN
;
;1067 JNG 23-Sep-75 SPR 17442
; Keep better track of whether or not we have valid accounting
; indices in core, to recover from errors like ?BAD FORMAT FOR
; ACCOUNTING FILE.
;
;1070 JNG 23-Oct-75
; Prevent spurious ?ERROR READING ACCOUNTING FILE messages.
; This was broken by edit 1067.
;
;1071 JNG 23-Oct-75 SPR 17598
; Always put a %ERR line into the control file to prevent
; unrequested dumps.
;2000 MAKE THIS VERSION 101, NOVEMBER, 1975
;;2001 REMOVE FTC AND DSF CONDITIONS
;;2002 ADD /JOBNAME SWITCH ON THE $JOB CARD
;2003 ADD A NEW ACTION CHARACTER TO GENERATE THE CORRECT MONITOR PROMPT
;2004 ADD LOTS OF TOPS20 CODE
;;2005 MAKE /OUTPUT TAKE NEW ARGUMENTS (LOG,NOLOG,ERROR).
; DON'T SET DEFAULT VALUES, QUASAR WILL DO IT.
; TAKE UNUSED SWITCHES AND CARDS OUT OF DISPATCH TABLES
; FOR THE -20.
; REMOVE /PUNCH SWITCH, INSIST ON /TPUNCH OR /CPUNCH.
;2006 CODE CLEANUP. MAKE DEFAULT INPUT DEVICE PCDR0 ON -20.
;2007 MORE CODE CLEANUP. PREPARE FOR 1B LOAD TEST.
;2010 MAKE THIS VERSION 102, JUNE 1976
;2011 FIX END-OF-FILE PROBLEM ON -20 AND REPLACE JSYSES WHICH HAVE
; BEEN SUPERCEDED IN TOPS20 RELEASE 2.
;2012 ON -20, CONNECT SPRINT TO USERS DIRECTORY. ON -10, USE
; IN HIS BEHALF FILOP. TO CREATE FILES.
;2013 CLEAR THE AFTER PARAMETER WHEN QUEUEING UP ANYTHING BUT THE
; CONTROL FILE.
;2014 ALLOW MULTIPLE $EOJ CARDS (WITHOUT GENERATING ERROR LOGS ETC.).
; FIXUP USER VERIFICATION CODE ON -20.
;2015 FIX A NUMBER OF MINOR -20 PROBLEMS.
;2016 MORE OF EDIT 2015.
;2017 WITH NETSER, THERE IS NO NEED TO RELEASE THE CDR AFTER EACH EOF.
;2020 ON -10 SET MY PATH TO THE USER'S AND DO ALL LOOKUPS AND ENTERS
; WITH RIBPPN=0.
;2021 SOME CODE CLEANUP.
;;FIRST FIELD-TEST RELEASE OF GALAXY VERSION 2, JANUARY 1977
;2022 SUPPRESS DOES NOT WORK WITH /WIDTH IF THERE ARE NON-BLANK
; CHARACTERS PAST THE /WIDTH CHARACTER.
;2023 ON -20, READ DEVICE STATUS ON $EOJ AND EOF TO AVOID HANGING IN
; I/O WAIT.
;;SECOND FIELD-TEST RELEASE OF GALAXY VERSION 2, MARCH 1977
;2024 REMOVE THE .REQUEST HELPER AND LOAD HELPER EXPLICITLY
; SINCE THE ACCT.SYS INDEX GETS BUILT ON TOP OF IT OTHERWISE.
;[END REVISION HISTORY]
; (*) DSBCL1 = DEC STANDARD BATCH CONTROL LANGUAGE - LEVEL 1
SUBTTL Symbol Naming Conventions
COMMENT \
;^;=
For all system-wide symbols, C.MAC symbol definitions
are used. Internal symbols are named as follows:
:General form:
: x.yyyy Full word storage
: L.???? Lowsegment storage locations
: H.???? Hisegment storage locations
: F.???? Flags in Accumulator F
: P.???? Byte-pointers
: Q.???? Queue Parameter Area offsets
: C.???? Control card images
:General form:
: x$yyyy Routine names of group 'x'
: W$???? Switch handling routine.
: ???? is first four characters of switch name.
: S$???? Scanner routine
:General form:
: x%yyyy 18-bit constant
: A%???? Conditional Assembly Parameters
: .FB??? File-Block Offsets
: .CC??? Device Control Cell Offsets
: .IM??? Character images
: .ASP?? Default Mode ASCII Characters
: .ASS?? Non-Default Mode ASCII CHARACTERS
: .A2??? ACCT.SYS Offsets
: .AU??? AUXACC.SYS Offsets
: CN.??? Card-Reader CONI bits
: FB.??? Fields and bits in File-Blocks
All error messages are labeled xxx%, where xxx is the 3 character
code for the message. In other words, the error message
"?SPTPWR Password is Required" is found at location
PWR%.
;--
\
SUBTTL Accumulator and Coding Conventions
COMMENT \
LEVEL A ROUTINES MAY USE P1-P4 AND T1-T5
LEVEL B ROUTINES MAY USE T1-T4
LEVEL C ROUTINES MAY USE T5
\
SUBTTL Conditional Assembly Switches
;^;++
ND FTF10,1 ;COMPILER TO CALL ON $FORTRAN AND $F4
;Bit 34 of FTF10 determines which compiler is used for
;the $F40 card, and bit 35 determines which compiler
;is used for the $FORTRAN card. A 1 bit means use
;FORTRAN-10, and a 0 bit means use F40.
IFN FTJSYS,<FTRPPN==0> ;DON'T SAVE PPNS
IFN FTJSYS,<FTFACT==0> ;DON'T MAKE FACT ENTRIES
ND FTRPPN,-1 ;CODE TO REMEMBER ACCOUNTING INFO
IFE FTRPPN,<NPPNRM==0> ;DON'T GENERATE TABLE SPACE
ND NPPNRM,^D15 ;ELSE REMEMBER THIS MANY
;If FTRPPN is non-zero, SPRINT wil remember the NPPNRM most recently
;used PPNs, thereby not needing to read ACCT.SYS on a match. The
;cost in space is 6*NPPNRM words of table space in the lowseg, and
;approximately 50 words of code in the hisegment.
ND FTFACT,-1 ;CODE TO DO ACCOUNTING
;If FTFACT is non-zero, SPRINT will generate FACT file entries
;-type 231
;--
SUBTTL Conditional Assembly Parameters
;^;++
;;I/O PARAMETERS
ND A%LCBN,10 ;NUMBER OF BUFFERS FOR LOCAL CDR
ND A%ODBN,2 ;NUMBER OF BUFFERS FOR OTHER DEVS
;;BATCH JOB DEFAULTS
ND A%UNIQ,1 ;DEFAULT UNIQUENESS
;;DEFAULTS FOR THE /ERROR SWITCH
ND A%HLER,^D100 ;DEF NUMBER OF HOLLERITH ERRORS
ND A%ICER,5 ;DEF NUMBER OF ILL BINARY CARDS
ND A%CSER,5 ;DEF NUMBER OF CHECKSUM ERRORS
;;INTERNAL PARAMETERS
ND A%PDSZ,100 ;PUSHDOWN STACK LENGTH
ND A%OMSG,100 ;DEFAULT MSGLVL
ND A%NFLR,^D10 ;NUMBER OF FILE-BLOCKS/CLUSTER
ND A%DFMD,0 ;DEFAULT INPUT MODE
; 0=ASCII
; 1=026
; 2=BCD
ND A%SPRS,0 ;DEFAULT /SUPP-/NOSUPP
; 0=/NOSUPPRESS
; 1=/SUPPRESS
IFN FTUUOS,<
XP MONPRT,"."
XP DEFDSK,'DSK'
XP DEFIND,'CDR '
>
IFN FTJSYS,<
XP MONPRT,"@"
XP DEFDSK,'PS '
XP DEFIND,'PCDR0 '
XP ER.ICC,0 ;DONT ENABLE FOR ^C ON -20
>
;--
SUBTTL Symbol Definitions
;ACCUMULATOR ASSIGNMENTS
F=0 ;FLAG REGISTER
T1=1 ;T1-T5 ARE UTITLITY ACS
T2=2
T3=3
T4=4
T5=5
P1=6 ;P1-P4 ARE PRESERVED ACS
P2=7
P3=10
P4=11
C=12 ;INPUT/OUTPUT CHARACTER
B=13 ;UTILITY BYTE POINTER
Q=14 ;INDEX TO QUEUE PARAMETER AREA
U1=15 ;RESERVED FOR UUO HANDLER
U2=16 ;RESERVED FOR UUO HANDLER
P=17 ;PUSHDOWN POINTER
;I/O DEVICE CHANNELS
; (SAVE 0 AND 17 FOR QMANGR)
;WARNING: DO NOT CHANGE CHANNEL DEFINITIONS FOR LOG AND CTL
;SINCE LUUO'S USE THESE DEFINITIONS FOR DESTINATION FIELD.
CDR==1 ;INPUT DEVICE
LOG==2 ;LOG FILE OUTPUT
FIL==3 ;USER FILE OUTPUT
CTL==4 ;CONTROL FILE OUTPUT
UFD==5 ;FOR LOOKING UP AND CREATING UFDS
ACT==6 ;FOR ACCOUNTING FILE (ACCT.SYS)
AUX==7 ;FOR AUXACC.SYS
ACT1==10 ;USED TO CHECK ACCT.SYS DATE
;LUUO DEFINITIONS
; OP-CODE DEFINITIONS
OPDEF TELL [001000,,0] ;WRITE ASCIZ STRING
OPDEF TELL6 [002000,,0] ;WRITE SIXBIT WORD
OPDEF CHR [003000,,0] ;WRITE IMMEDIATE CHARACTER
OPDEF STAMP [004000,,0] ;TIME STAMP LOG
OPDEF RAD10 [005000,,0] ;PRINT DECIMAL NUMBER
OPDEF RAD08 [006000,,0] ;PRINT OCTAL NUMBER
;DESTINATION OF UUO IS DETERMINED BY AC FIELD AS FOLLOWS:
OPR==1 ;TELL OPERATOR
;LOG==2 ;USER'S LOG FILE
;CTL==4 ;CONTROL FILE
NAC==10 ;SUPPRESS ACTION CHARACTERS ON TELL UUO
BOTH==LOG+CTL
ALL==LOG+CTL+OPR
;DESTINATION FIELD BITS RIGHT JUSTIFIED
UU.OPR==1B35 ;OPERATOR
UU.LOG==1B34 ;LOG FILE
UU.CTL==1B33 ;CONTROL FILE
UU.NAC==1B32 ;DON'T SUPPRESS 6BIT BLANKS
;FLAGS (IN ACCUMULATOR F)
F.LCDR==1B0 ;INPUT DEVICE IS - LOCAL CDR
F.RCDR==1B1 ; - REMOTE CDR
F.DSK==1B2 ; - DISK
F.MTA==1B3 ; - MAGTAPE
F.IN==1B4 ;INPUT UUO IS IN PROGRESS FOR CDR
F.EOF==1B5 ;EOF ENCOUNTERED ON INPUT
F.NXT==1B6 ;NEXT CARD ALREADY READ
F.SPS==1B7 ;SUPPRESS IS ON
F.QOPR==1B8 ;DON'T TYPE TO OPR IF MSGLVL=0XX
F.HTOP==1B9 ;I'VE GOT MY HISEG
F.BUSY==1B10 ;I'M BUSY NOW
F.RES==1B11 ;NOT START'ED
F.STOP==1B12 ;HE TYPED STOP
F.IBRK==1B13 ;BREAK SEEN ON TTY INPUT
F.SHMG==1B14 ;OPR WANTS SHORT MESSAGES
F.FFOR==1B15 ;FAST FORTRAN JOB RUNNING
F.DER==1B16 ;DEVICE ERROR FLAG
F.DECK==1B17 ;USER FILE BEING WRITTEN
F.DEXT==1B18 ;DEFERED EXIT
F.DRES==1B19 ;DEFERED RESET
F.PAUS==1B20 ;HE TYPED A PAUSE COMMAND
F.PAS2==1B21 ;THIS IS PASS2 ON THE JOB CARD
F.IMG==1B22 ;CURRENT DECK IS IMAGE
F.BIN==1B23 ;CURRENT DECK IS BINARY
F.GTIN==1B24 ;INPUT DEVICE IS OPEN
F.QLOG==1B25 ;DON'T TYPE ANYTHING TO LOG
F.QCTL==1B26 ;DON'T TYPE ANYTHING TO CTL
F.KILL==1B27 ;HE TYPED KILL
F.BTCH==1B28 ;SUBMIT JOB TO BATCH
F.MAP==1B29 ;/MAP WAS SPECIFIED
F.FATE==1B30 ;A FATAL ERROR WAS ENCOUNTERED
F.JBI==1B31 ;GOT A JOB-INT FOR THIS CARD ALREADY
F.NEOF==1B32 ;NO EOF SEEN FOR LAST JOB
F.INHI==1B33 ;INHIBIT INPUT FOR THIS CARD
F.RSCN==1B34 ;CHARACTER INPUT INHIBIT
F.DOLR==1B35 ;HE SAID /DOLLAR FOR THIS DECK
F.IDEV==F.LCDR!F.RCDR!F.DSK!F.MTA ;MASK FOR INPUT DEV
F.ICDR==F.LCDR!F.RCDR ;MASK FOR CDR
F.DCOM==F.DEXT!F.DRES!F.PAUS ;DEFERED COMMAND
;CARD READER CONI BITS
CN.PKF==1B20 ;PICK FAILURE
CN.RCK==1B21 ;READ CHECK
CN.CME==1B22 ;CARD MOTION ERROR
CN.STP==1B23 ;STOP
CN.HPE==1B25 ;HOPPER EMPTY/STACKER FULL
CN.TRB==1B27 ;TROUBLE
CN.DTM==1B28 ;DATA MISSED
;USEFUL SYMBOLS
IWPC==^D27 ;IMAGE WORDS/CARD
BWPC==^D26 ;BINARY WORDS/CARD
ACPC==^D80 ;ASCII CHARS/CARD
CPC==^D80 ;COLUMNS/CARD
;IMPORTANT ASCII CHARACTER IMAGES
.IMDOL==2102 ;DOLLAR SIGN
.IMEOF==7417 ;END-OF-FILE
.IM79==5 ;7-9 PUNCH
;USEFUL ASCII CHARACTERS
.ASSPC==40 ;SPACE
;SOME RANDOM SYMBOLS
.IOSIM==.IOIMG+IO.SIM
.QSIZE==Q.LMOD+1 ;SIZE OF INPUT QUEUE BLOCK
SLLEN==^D36*3 ;LENGTH OF A SEARCH LIST BLOCK
PTLEN==12 ;PATH EXTENSION TO S/L BLOCK
;MACRO DEFINITIONS
;MACRO TO RELOC TO HISEG
DEFINE UP<
IFE ..SEG<XLIST
LIT
VAR
RELOC
..SEG==1
LIST
SALL
>>
;MACRO TO RELOC TO LOWSEG
DEFINE DOWN<
IFE ..SEG-1<XLIST
LIT
RELOC
..SEG==0
LIST
SALL
>>
;TURN OFF A BIT IN F
DEFINE OFF(BIT)<
TXZ F,BIT
>
;TURN ON A BIT IN F
DEFINE ON(BIT)<
TXO F,BIT
>
SUBTTL The Message Macro
;CALL IS:
; MSG(CODE,TYPE,CRLF,BODY)
;
;WHERE
; CODE Is the three letter error code
; TYPE is one of:
; E Error (?)
; W Warning (%)
; M Message ([)
;
; CRLF is either (Y) to append a <CR> or (N)
; BODY is the message itself
;
;FIRST A MACRO TO GENERATE AN ASCIZ STRING WITH A CRLF TACKED ON
DEFINE ASCIC(STRING),<
XLIST
ASCIZ \STRING
\
LIST
SALL>
;DEFINE MACRO TO GENERATE ASCIZ STRING WITHOUT CRLF
DEFINE ASCIN(STRING),<
XLIST
ASCIZ \STRING\
LIST
SALL
>
;THE MSG MACRO LIVES ON THE NEXT PAGE BECAUSE OF IT'S SIZE
;NOW THE MSG MACRO
DEFINE MSG(CODE,TYPE,CRLF,BODY),<
XLIST
IFDIF <TYPE> <E>,<
IFDIF <TYPE> <W>,<
IFDIF <TYPE> <M>,<
PRINTX ?ILLEGAL .TYPE. ARGUMENT TO MSG MACRO - CODE
PASS2
END>>>
IFDIF <CRLF> <Y>,<
IFDIF <CRLF> <N>,<
PRINTX ?ILLEGAL .CRLF. ARGUMENT TO MSG MACRO - CODE
PASS2
END>>
IF1 <
IFDEF CODE'% ,<
PRINTX ?MULTIPLY DEFINED ERROR MNEMONIC - CODE
PASS2
END>>
CODE'%: BLOCK 0 ;;DEFINE THE STARTING LOCATION
IFIDN <TYPE> <E>,<
IFIDN <CRLF> <Y>,<
ASCIC(?SPT'CODE' 'BODY)
XLIST
>
IFIDN <CRLF> <N>,<
ASCIZ \?SPT'CODE' 'BODY\
>>
IFIDN <TYPE> <W>,<
IFIDN <CRLF> <Y>,<
ASCIC(%SPT'CODE' 'BODY)
XLIST
>
IFIDN <CRLF> <N>,<
ASCIZ \%SPT'CODE' 'BODY\
>>
IFIDN <TYPE> <M>,<
IFIDN <CRLF> <Y>,<
ASCIC([SPT'CODE' 'BODY)
XLIST
>
IFIDN <CRLF> <N>,<
ASCIZ \[SPT'CODE' 'BODY\
>>
LIST
SALL
>
;THE LMSG CALLS THE MESSAGE MACRO, AND THEN GENERATES A
; TWO LINE ROUTINE TO PRINT THE ERROR IN THE LOG.
DEFINE LMSG(CODE,TYPE,CRLF,BODY),<
XLIST
MSG(CODE,TYPE,CRLF,BODY)
XLIST
E$'CODE: MOVEI T1,CODE'%
PJRST LOGERR
LIST
SALL
>
;NOW DEFINE THE MACROS TO GENERATE EITHER MSG OR LMSG DEPENDING
; ON THE OPERATING SYSTEM.
DEFINE UMSG(CODE,TYPE,CRLF,BODY),<
IFN FTUUOS,<
MSG(CODE,TYPE,CRLF,BODY)
>>
DEFINE ULMSG(CODE,TYPE,CRLF,BODY),<
IFN FTUUOS,<
LMSG(CODE,TYPE,CRLF,BODY)
>>
DEFINE JMSG(CODE,TYPE,CRLF,BODY),<
IFN FTJSYS,<
MSG(CODE,TYPE,CRLF,BODY)
>>
DEFINE JLMSG(CODE,TYPE,CRLF,BODY),<
IFN FTJSYS,<
LMSG(CODE,TYPE,CRLF,BODY)
>>
SUBTTL Card Code Conversion Table Generation
;CALL IS:
; CODE(.COD,.P026,.PASC,.K)
;
;WHERE
; .COD iS the ASCII character or it's
; octal equivalent.
; .P026 is the 026 punch code
; .PASC is the ASCII punch code
; .K is non-blank if .COD is the
; octal equivalent of the character.
;ROW PUNCH DEFINITIONS
..9== 200 ;A 9 PUNCH
..12== 100 ;A 12 PUNCH
..11== 40 ;A 11 PUNCH
..0== 20 ;A 0 PUNCH
..8== 10 ;A 8 PUNCH
..1== 1 ;A 1 PUNCH
..2== 2 ;A 2 PUNCH
..3== 3 ;A 3 PUNCH
..4== 4 ;A 4 PUNCH
..5== 5 ;A 5 PUNCH
..6== 6 ;A 6 PUNCH
..7== 7 ;A 7 PUNCH
;THE MACRO FOLLOWS
DEFINE CODE(.COD,.P026,.PASC,.K),<
XLIST
IF1 <
.T026==0
.TASC==0
IRP .P026,<
.T026==.T026+..'.P026
>
IRP .PASC,<
.TASC==.TASC+..'.PASC
>
IFB <.K>,<
.OCOD==<".COD">B17
SETSPI(\.T026,.OCOD)
.OCOD==".COD"
SETSPI(\.TASC,.OCOD)
>
IFNB <.K>,<
.OCOD==<.COD>B17
SETSPI(\.T026,.OCOD)
SETSPI(\.TASC,.COD)
>
>
LIST
SALL
>
;MACRO TO GENERATE SPIXXX SYMBOL AND DEFINE IT
DEFINE SETSPI(.A,.B),<
IFNDEF SPI'.A,<SPI'.A==0>
IFN <<SPI'.A>&777777>,<
IFN <.B&777777>,<
PRINTX ?MULT. DEF. CARD CODE - .A
PASS2
END
>>
IFN <<SPI'.A>&<777777>B17>,<
IFN <.B&<777777>B17>,<
PRINTX ?MULT. DEF. CARD CODE - .A
PASS2
END
>>
SPI'.A==SPI'.A+.B
>
;NOW, GENERATE THE SPIXXX SYMBOLS FOR THE CARD CODES
;DIGITS
CODE(0,<0>,<0>)
CODE(1,<1>,<1>)
CODE(2,<2>,<2>)
CODE(3,<3>,<3>)
CODE(4,<4>,<4>)
CODE(5,<5>,<5>)
CODE(6,<6>,<6>)
CODE(7,<7>,<7>)
CODE(8,<8>,<8>)
CODE(9,<9>,<9>)
;UPPER-CASE ALPHABETICS
CODE(A,<12,1>,<12,1>)
CODE(B,<12,2>,<12,2>)
CODE(C,<12,3>,<12,3>)
CODE(D,<12,4>,<12,4>)
CODE(E,<12,5>,<12,5>)
CODE(F,<12,6>,<12,6>)
CODE(G,<12,7>,<12,7>)
CODE(H,<12,8>,<12,8>)
CODE(I,<12,9>,<12,9>)
CODE(J,<11,1>,<11,1>)
CODE(K,<11,2>,<11,2>)
CODE(L,<11,3>,<11,3>)
CODE(M,<11,4>,<11,4>)
CODE(N,<11,5>,<11,5>)
CODE(O,<11,6>,<11,6>)
CODE(P,<11,7>,<11,7>)
CODE(Q,<11,8>,<11,8>)
CODE(R,<11,9>,<11,9>)
CODE(S,<0,2>,<0,2>)
CODE(T,<0,3>,<0,3>)
CODE(U,<0,4>,<0,4>)
CODE(V,<0,5>,<0,5>)
CODE(W,<0,6>,<0,6>)
CODE(X,<0,7>,<0,7>)
CODE(Y,<0,8>,<0,8>)
CODE(Z,<0,9>,<0,9>)
;LOWER CASE ALPHABETICS
CODE(141,<12,0,1>,<12,0,1>,O)
CODE(142,<12,0,2>,<12,0,2>,O)
CODE(143,<12,0,3>,<12,0,3>,O)
CODE(144,<12,0,4>,<12,0,4>,O)
CODE(145,<12,0,5>,<12,0,5>,O)
CODE(146,<12,0,6>,<12,0,6>,O)
CODE(147,<12,0,7>,<12,0,7>,O)
CODE(150,<12,0,8>,<12,0,8>,O)
CODE(151,<12,0,9>,<12,0,9>,O)
CODE(152,<12,11,1>,<12,11,1>,O)
CODE(153,<12,11,2>,<12,11,2>,O)
CODE(154,<12,11,3>,<12,11,3>,O)
CODE(155,<12,11,4>,<12,11,4>,O)
CODE(156,<12,11,5>,<12,11,5>,O)
CODE(157,<12,11,6>,<12,11,6>,O)
CODE(160,<12,11,7>,<12,11,7>,O)
CODE(161,<12,11,8>,<12,11,8>,O)
CODE(162,<12,11,9>,<12,11,9>,O)
CODE(163,<11,0,2>,<11,0,2>,O)
CODE(164,<11,0,3>,<11,0,3>,O)
CODE(165,<11,0,4>,<11,0,4>,O)
CODE(166,<11,0,5>,<11,0,5>,O)
CODE(167,<11,0,6>,<11,0,6>,O)
CODE(170,<11,0,7>,<11,0,7>,O)
CODE(171,<11,0,8>,<11,0,8>,O)
CODE(172,<11,0,9>,<11,0,9>,O)
;CONTROL CHARACTERS
CODE(1,<12,9,1>,<12,9,1>,O)
CODE(2,<12,9,2>,<12,9,2>,O)
CODE(3,<12,9,3>,<12,9,3>,O)
CODE(4,<9,7>,<9,7>,O)
CODE(5,<0,9,8,5>,<0,9,8,5>,O)
CODE(6,<0,9,8,6>,<0,9,8,6>,O)
CODE(7,<0,9,8,7>,<0,9,8,7>,O)
CODE(10,<11,9,6>,<11,9,6>,O)
CODE(11,<12,9,5>,<12,9,5>,O)
CODE(12,<0,9,5>,<0,9,5>,O)
CODE(13,<12,9,8,3>,<12,9,8,3>,O)
CODE(14,<12,9,8,4>,<12,9,8,4>,O)
CODE(15,<12,9,8,5>,<12,9,8,5>,O)
CODE(16,<12,9,8,6>,<12,9,8,6>,O)
CODE(17,<12,9,8,7>,<12,9,8,7>,O)
CODE(20,<12,11,9,8,1>,<12,11,9,8,1>,O)
CODE(21,<11,9,1>,<11,9,1>,O)
CODE(22,<11,9,2>,<11,9,2>,O)
CODE(23,<11,9,3>,<11,9,3>,O)
CODE(24,<9,8,4>,<9,8,4>,O)
CODE(25,<9,8,5>,<9,8,5>,O)
CODE(26,<9,2>,<9,2>,O)
CODE(27,<0,9,6>,<0,9,6>,O)
CODE(30,<11,9,8>,<11,9,8>,O)
CODE(31,<11,9,8,1>,<11,9,8,1>,O)
CODE(32,<9,8,7>,<9,8,7>,O)
;MORE CONTROL CHARACTERS AND OTHER SPECIAL CHARACTERS
CODE(33,<0,9,7>,<0,9,7>,O)
CODE(34,<11,9,8,4>,<11,9,8,4>,O)
CODE(35,<11,9,8,5>,<11,9,8,5>,O)
CODE(36,<11,9,8,6>,<11,9,8,6>,O)
CODE(37,<11,9,8,7>,<11,9,8,7>,O)
CODE(<!>,<12,8,7>,<12,8,7>)
CODE(42,<0,8,5>,<8,7>,O)
CODE(<#>,<0,8,6>,<8,3>)
CODE(<$>,<11,8,3>,<11,8,3>)
CODE(<%>,<0,8,7>,<0,8,4>)
CODE(<&>,<11,8,7>,<12>)
CODE(<'>,<8,6>,<8,5>)
CODE(<(>,<0,8,4>,<12,8,5>)
CODE(<)>,<12,8,4>,<11,8,5>)
CODE(<*>,<11,8,4>,<11,8,4>)
CODE(<+>,<12>,<12,8,6>)
CODE(<,>,<0,8,3>,<0,8,3>)
CODE(<->,<11>,<11>)
CODE(<.>,<12,8,3>,<12,8,3>)
CODE(</>,<0,1>,<0,1>)
CODE(<:>,<11,8,2>,<8,2>)
CODE(<;>,<0,8,2>,<11,8,6>)
CODE(74,<12,8,6>,<12,8,4>,O)
CODE(<=>,<8,3>,<8,6>)
CODE(76,<11,8,6>,<0,8,6>,O)
CODE(<?>,<12,8,2>,<0,8,7>)
CODE(<@>,<8,4>,<8,4>)
CODE(133,<11,8,5>,<12,8,2>,O)
CODE(<\>,<8,7>,<0,8,2>)
CODE(135,<12,8,5>,<11,8,2>,O)
CODE(<^>,<8,5>,<11,8,7>)
CODE(137,<8,2>,<0,8,5>,O)
CODE(140,<8,1>,<8,1>,O)
CODE(173,<12,0>,<12,0>,O)
CODE(174,<12,11>,<12,11>,O)
CODE(175,<11,0>,<11,0>,O)
CODE(176,<11,0,1>,<11,0,1>,O)
CODE(177,<12,9,7>,<12,9,7>,O)
;NOW GENERATE THE CODE CONVERSION TABLE
DOWN
DEFINE CTGEN(K),<
IF1 <
IFNDEF SPI'K,<SPI'K==<"\",,"\">>
IFE <SPI'K & 777777>,<
SPI'K==SPI'K+"\">
IFE <SPI'K & <777777>B17>,<
SPI'K==SPI'K+<"\"B17>>
>
.XCREF
EXP SPI'K
.CREF
>
;THE TABLE GENERATION IS XLISTED BECAUSE OF SIZE, FOR THOSE OF YOU
;READING THE ASSEMBLY LISTING, THE FOLLOWING IS XLISTED:
;
;REPEAT 400,<
; CTGEN(\K)
; K==K+1>
K==0
CODTBL:
XLIST
REPEAT 400,<
CTGEN(\K)
K==K+1>
LIST
SUBTTL Code Conversion Control Symbols
CODTYP: SIXBIT /ASCII/
SIXBIT /026/
SIXBIT /BCD/
.NMCTY==.-CODTYP
H%ASC==0
H%026==1
H%BCD==2
;DEFINITIONS OF BYTE-POINTER SYMBOLS
..PASC==<POINT 7,CODTBL(C),35>
..P026==<POINT 7,CODTBL(C),17>
..PBCD==<POINT 7,CODTBL(C),17>
;NOW THE BYTE POINTERS (BASED ON AC C)
P.COD:
P.ASC: EXP ..PASC
P.026: EXP ..P026
P.BCD: EXP ..PBCD
;NOW GENERATE THE DEFAULT BYTE POINTER
IFE A%DFMD-H%ASC,<P.DFBP==P.ASC>
IFE A%DFMD-H%026,<P.DFBP==P.026>
IFE A%DFMD-H%BCD,<P.DFBP==P.BCD>
;NOW GENERATE THE NON-DEFAULT BYTE POINTER
IFE A%DFMD-H%ASC,<P.NDBP==P.026>
IFE A%DFMD-H%026,<P.NDBP==P.ASC>
IFE A%DFMD-H%BCD,<P.NDBP==P.ASC>
SUBTTL TOPS-10 - TENEX Compatibility Macros
;MACRO TO READ A CHARACTER FROM THE TELETYPE
DEFINE TTYI(CH),<
XLIST
IFE FTJSYS,<
INCHWL CH
>
IFN FTJSYS,<
IFE CH-T1,<
PBIN
>
IFN CH-T1,<
SKIPA
JRST .+4
EXCH CH,T1
PBIN
EXCH CH,T1
>>
LIST
SALL
>
;MACRO TO TYPE A CHARACTER ON THE TELETYPE
DEFINE TTYO(CH),<
XLIST
IFE FTJSYS,<
OUTCHR CH
>
IFN FTJSYS,<
IFE CH-T1,<
PBOUT
>
IFN CH-T1,<
SKIPA
JRST .+4
EXCH CH,T1
PBOUT
EXCH CH,T1
>>
LIST
SALL
>
DOWN
;STAMP MESSAGES
STDAT: SIXBIT / STDAT/
STMSG: SIXBIT / STMSG/
STERR: SIXBIT / STERR/
STCRD: SIXBIT / STCRD/
STSUM: SIXBIT / STSUM/
STOPR: SIXBIT / STOPR/
;IMPORTANT CONTROL CARD IMAGES
C.JOB:
C.END: ASCII /$JOB/
C.SEQ: ASCII /$SEQ/
.NMJCR==.-C.JOB
C.EOJ: ASCII /$EOJ/
C.EOD: ASCII /$EOD/
.NMDEN==.-C.END
C.MODE: ASCII /$MOD/
SUBTTL Device Control Cells
; !=======================================================!
; ! DEVICE NAME !
; !-------------------------------------------------------!
; ! FILENAME !
; !-------------------------------------------------------!
; ! EXTENSION !
; !-------------------------------------------------------!
; ! PPN OR PATH POINTER !
; !-------------------------------------------------------!
; ! !
; / PATH BLOCK /
; / /
; / (8 WORDS) /
; ! !
; !-------------------------------------------------------!
; ! BUFFER RING HEADER !
; !-------------------------------------------------------!
; ! BUFFER BYTE POINTER !
; !-------------------------------------------------------!
; ! BUFFER BYTE COUNT !
; !=======================================================!
;Control Cell Indices
.CCDEV==0 ;DEVICE
.CCNAM==1 ;FILE NAME
.CCEXT==2 ;EXTENSION
.CCPPN==3 ;PPN OR XWD 0,ADR OF PATH
.CCPTH==4 ;PATH BLOCK
.CCEND==13 ;END OF FILESPEC BLOCK
.CCBHD==14 ;BUFFER RING HEADER
.CCBBP==15 ;BUFFER BYTE POINTER
.CCBBC==16 ;BUFFER BYTE COUNT
DEFINE DEVBUF(..DEV),<
..DEV'BRH: BLOCK 0
..DEV'BH: BLOCK 1
..DEV'BP: BLOCK 1
..DEV'BC: BLOCK 1
>
DEFINE DEVCEL(.DEV),<
DEV'.DEV: BLOCK 0
.DEV'DEV: BLOCK 1
.DEV'NAM: BLOCK 1
.DEV'EXT: BLOCK 1
.DEV'PPN: BLOCK 1
.DEV'PTH: BLOCK 10
DEVBUF(.DEV)
>
;NOW GENERATE THE DEVICE CONTROL CELLS
DEVBEG: BLOCK 0 ;BEGINNING OF DEVICE CONTROL CELLS
DEVCEL(CDR) ;FOR THE INPUT DEVICE
CDROPN: BLOCK 3 ;INPUT DEVICE OPEN BLOCK
CDRBUF: BLOCK 1 ;ADDRESS OF INPUT DEVICE BUFFERS
CDRBFN: BLOCK 1 ;NUMBER OF INPUT DEVICE BUFFERS
CDRJFF: BLOCK 1 ;JOBFF AFTER ALLOCATING BUFFERS
CDRCNT: BLOCK 1 ;NUMBER OF CARDS READ - THIS JOB
DEKCRD: BLOCK 1 ;NUMBER OF CARDS READ - THIS DECK
DEVBUF(LOG) ;BUFFER RING HEADER FOR LOG FILE
LOGAD: BLOCK 1 ;XWD BUFN,BUFFER ADR
LOGIOW: BLOCK 2 ;LOG FILE IOWD
DEVBUF(CTL) ;CTL FILE BUFFER RING HEADER
DEVCEL(FIL) ;FOR THE USER'S CURRENT FILE
FILSTS==FILPTH ;LH=-1 IF NQC FILE, RH=#SFD IN PATH
;FIRST WORD OF PATH BLOCK
FILPRV: BLOCK 1 ;PRIVILEGE AND PROTECTION WORD
FILOFF: BLOCK 1 ;JOBFF BEFORE BUILDING BUFFERS
FILNFF: BLOCK 1 ;JOBFF AFTER BUILDING BUFFERS
DEKBLK: BLOCK 1 ;NUMBER OF BLOCKS WRITTEN - THIS DECK
DEVEND==.-1 ;END OF CONTROL CELLS
SUBTTL FILE-BLOCK Definitions
; !=======================================================!
; ! FILE-STRUCTURE NAME !
; !-------------------------------------------------------!
; ! FILENAME !
; !-------------------------------------------------------!
; ! EXTENSION !LR!LD!DL!DR!SR! LOAD ORDER !
; !-------------------------------------------------------!
; ! PROJECT-PROGRAMMER NUMBER OR PATH POINTER !
; !=======================================================!
; SYMBOL DEFINITIONS
.FBDEV==0 ;FILE STRUCTURE NAME
.FBNAM==1 ;FILENAME
.FBEXT==2 ;FILE-EXTENSION,,STATUS BITS
FB.LDR==1B18 ;LOAD FILENAME.REL ON $DATA($EX)
FB.LOD==1B19 ;LOAD FILENAME.EXT ON $DATA($EX)
FB.DEL==1B20 ;DEL THIS FILE ON .DEL LINE
FB.DLR==1B21 ;DEL THIS FILE AND REL ON .DEL LINE
FB.SRH==1B22 ;LOAD IN LIBRARY SEARCH MODE
FB.ORD==777B35 ;LOAD ORDER
.FBPPN==3 ;PPN OR PATH POINTER
FBSIZE==4 ;NUMBER OF WORDS/BLOCK
SUBTTL ACCT.SYS and AUXACC.SYS Table Definitions
;ACCT.SYS VERSION 2
.A2PPN==0 ;PROJECT-PROGRAMMER NUMBER
.A2PSW==1 ;PASSWORD
.A2PRV==2 ;PRIVILEGE WORD
.A2NAM==3 ;USER NAME (2 WORDS)
.A2TIM==5 ;TIMES MAY LOG IN
.A2DEV==6 ;DEVICE MAY LOG IN ON
.A3VMP==6 ;VIRTUAL MEMORY PARAMETERS
A3.PPL==777B8 ;PHYSICAL PAGE LIMIT
A3.VPL==777B17;VIRTUAL PAGE LIMIT
A3.IRQ==777B26;IPCF RECEIVE QUOTA
A3.IXQ==777B35;IPCF XMIT QUOTA
.A2PRF==7 ;PROFILE WORD
A2.LOC==1B26 ;MAY LOGIN LOCAL
A2.ROP==1B27 ;MAY LOGIN REMOTE OPR
A2.DST==1B28 ;MAY LOGIN DATASET
A2.RTY==1B29 ;MAY LOGIN REMOTE TTY
A2.SBT==1B30 ;MAY LOGIN AS SUBJOB OF BATCH JOB
A2.BTC==1B31 ;MAY LOGIN AS BATCH JOB
A2.TNM==1B32 ;NAME REQUIRED UNDER T/S
A2.BNM==1B33 ;NAME REQUIRED UNDER BATCH
A2.TPS==1B34 ;PASSWORD NEEDED FOR T/S
A2.BPS==1B35 ;PASSWORD NEEDED FOR BATCH
.A2CNO==14 ;CHARGE NUMBER
.A2DAT==15 ;EXPIRATION DATE
;AUXACC.SYS ENTRIES
.AUBEG==0 ;FIRST WORD, ALWAYS CONTAINS -1
.AUNUM==1 ;NUMBER OF WORDS FOLLOWING
;THIS 1+ IS 5* THE NUMBER OF STRS
.AUPPN==2 ;PROJECT-PROGRAMMER NUMBER
.AUSTR==3 ;STRUCTURE NAME
.AURSV==4 ;RESERVED QUOTA
.AUFCF==5 ;FCFS QUOTA
.AULGO==6 ;LOGOUT QUOTA
.AUSTS==7 ;STATUS BITS
AU.RON==1B0 ;READ-ONLY
AU.NOC==1B1 ;NO-CREATE
SUBTTL Commonly Used Byte Pointers
DOWN
P.ASBP: POINT 7,L.CARD
P.IMBP: POINT 12,L.CARD
P.LPRT: POINT 9,T3,8
P.PROT: POINT 9,L.UUBK+.RBPRV,8
P.UAC: POINT 4,.JBUUO,12
P.UOP: POINT 9,.JBUUO,8
P.CL1A: POINT 7,L.CARD,6
P.CL2A: POINT 7,L.CARD,13
SUBTTL Lowsegment Storage Cells
;SAVEGET BLOCK
;THESE LOCATIONS ARE STORED AT INITIALIZATION TIME AND ARE
;USED AS GETSEG BLOCK WHEN GETSEG'ING THE HISEGMENT.
L.SGDV: BLOCK 1 ;DEVICE FROM GET-RUN
L.SGNM: BLOCK 1 ;FILE NAME FROM GET-RUN
L.SGLW: BLOCK 2 ;LOW EXT FROM GET-RUN
L.SGPP: BLOCK 2 ;PPN FROM GET-RUN
;IOWD FOR ACCOUNTING FILE READS
L.ACIO: IOWD 200,L.BUF
0
LOWBEG:
;THE FOLLOWING LOCATIONS ARE NOT ZEROED OR RESET WITH EACH NEW JOB
L.CARD: BLOCK IWPC ;CURRENT CARD
L.ADAT: BLOCK 1 ;CREATION DATE-TIME OF LAST ACCT.SYS LOOKED AT
L.ASIZ: BLOCK 1 ;SIZE OF ACCT.SYS IN BLOCKS
L.XDAT: BLOCK 1 ;[1050] CREATION DATE-TIME OF AUXACC.SYS
L.BUF: BLOCK 200 ;UTILITY DISK BUFFER
L.CBLK: BLOCK 1 ;KEEPS TRACK OF WHATS IN L.BUF
L.CHOL: BLOCK 1 ;CURRENT CARD CODE BP
L.CMD: BLOCK 1 ;CURRENT OPR COMMAND
L.CNST: BLOCK 1 ;STATION # OF CENTRAL SITE
L.CRBC: BLOCK 1 ;SAVED BYTE COUNT ON INPUT
L.CRBP: BLOCK 1 ;SAVE BYTE POINTER ON INPUT
L.CRLC: BLOCK 1 ;CODE USED FOR LAST CARD READ
L.DHOL: BLOCK 1 ;DEFAULT CARD CODE BP
L.FFA: BLOCK 1 ;[OPR] PPN
L.FUN: BLOCK 1 ;RANDOM (?) NUMBER FOR FUNNY NAMES
L.HTOP: BLOCK 1 ;FLAG FOR CHKOPR TO RELEASE HISEG
L.INTB: BLOCK 4 ;JOBINT BLOCK
L.IPC: BLOCK 1 ;INTERRUPTED PC STORED HERE
L.JFSC: BLOCK 1 ;JIFSEC IS HERE (60 OR 50)
L.LOC: BLOCK 1 ;WHERE TO LOCATE JOB
L.MCOR: BLOCK 1 ;MAX ALLOWABLE CORE
L.MFPP: BLOCK 1 ;MFD PPN
L.MSGL: BLOCK 1 ;MSGLVL FLAGS FOR OPR
L.MYPP: BLOCK 1 ;PPN SPRINT IS RUNNING UNDER
L.MYST: BLOCK 1 ;NUMBER OF STATION RUNNING SPRINT
L.PDL: BLOCK A%PDSZ ;PUSHDOWN LIST
L.PPR: BLOCK 1 ;PRESERVED PROTECTION CODE
L.PRIV: BLOCK 1 ;-1 MEANS I'M [1,2] OR [100+S,2]
L.SAC: BLOCK 20 ;AC SAVE AREA DURING GETSEG
L.SCIN: BLOCK 1 ;ADR OF INPUT ROUTINE FOR SCANNERS
L.SCLN: BLOCK 1 ;ADR OF NEXT RECORD RTN FOR SCANNERS
L.SPBP: BLOCK 1 ;SUPPRESS BYTE POINTER
L.SVPT: BLOCK 1 ;STORE USER WRITE-PROTECT BIT
L.SYSN: BLOCK 15 ;SYSNAM
L.UNIS: BLOCK 1 ;DEFAULT UNIQUENESS
IFN FTJSYS,<
L.MYNM: BLOCK 10 ;MY USER STRING
L.SL1: BLOCK 12 ;MY ORIGINAL CONNECTED DIR
L.SL2: BLOCK 12 ;USER'S CONNECTED DIR
L.JFN: BLOCK 1 ;JFN OF INPUT DEVICE
L.OFF: BLOCK 1 ;-1 IF DEVICE IS OFF LINE
L.ARGS: BLOCK 2 ;ARG BLOCK FOR THE MTOPR
> ;END IFN FTJSYS
IFN FTUUOS,<
L.SL1: BLOCK SLLEN ;SAVE MY S/L ON INITIALIZATION
BLOCK PTLEN ;PATH BLOCK EXTENSION
L.SL2: BLOCK SLLEN ;CURRENT S/L (USER'S)
BLOCK PTLEN ;PATH BLOCK EXTENSION
> ;END IFN FTUUOS
IFN FTRPPN,<
L.PPTB: BLOCK NPPNRM ;PPN TABLE
L.PSTB: BLOCK NPPNRM ;PASSWORDS
L.AUTB: BLOCK NPPNRM ;XWD WORD #,BLOCK # FOR AUXACC
L.PRTB: BLOCK NPPNRM ;PROFILE WORD
L.UNTB: BLOCK NPPNRM ;FIRST HALF OF USER NAME
L.U2TB: BLOCK NPPNRM ;SECOND HALF OF USER NAME
L.RPRG: BLOCK 1 ;REPLACEMENT REGISTER FOR TABLE
L.MTCH: BLOCK 1 ;SET NON-ZERO IF CURRENT JOB HAS A MATCH
>
;THE FOLLOWING LOCATIONS ARE ZEROED AT THE BEGINNING OF EACH JOB
LOWZER:
L.ACC: BLOCK 3 ;CHKACC UUO BLOCK
L.BRK: BLOCK 1 ;LAST CHR FROM CARD WAS A BREAK
L.CCNT: BLOCK 1 ;COLUMN COUNTER (DOWN)
L.CCHK: BLOCK 1 ;CHECKSUM FROM BINARY CARD
L.CNAM: BLOCK 1 ;NAME OF CURRENT CONTROL CARD
L.DEKN: BLOCK 1 ;CURRENT DECK NUMBER
L.DPCR: BLOCK 1 ;$DUMP,,/CREF FLAG
L.FBCT: BLOCK 1 ;LOAD NUMBER FOR FILE BLOCKS
L.FBFN: BLOCK 1 ;FBFND KEEPS A COUNTER HERE
L.FILN: BLOCK 1 ;FILE BLOCKS USE COUNT
L.FILR: BLOCK FBSIZE*A%NFLR ;PREALLOCATED FILE BLOCKS
L.FLOP: BLOCK .FOPPN+1 ;FILOP BLOCK
L.FNNM: BLOCK 1 ;SECOND PART OF SPOOLED CDR NAME
L.IMGT: BLOCK 1 ;IMAGE MODE TERMINATOR
L.IWRD: BLOCK 1 ;NO. OF WORDS READ ON IMG OR BIN CARD
L.LANG: BLOCK 1 ;LANGUAGE CARD INDEX
L.LOAD: BLOCK 1 ;SET TO -1 ON $DATA OR $EXEC CARD
L.NHOL: BLOCK 1 ;NUMBER OF HOLLERITH ERRORS
L.NTRY: BLOCK 1 ;NUMBER OF TIMES I TRIED TO GET CDR
L.QFN: BLOCK 1 ;USER SPECIFIED ARG TO /QUEUE:
L.SRH: BLOCK 1 ;FLAG FOR /SEARCH SWITCH
L.SWCH: BLOCK 1 ;NAME OF CURRENT SWITCH
L.TCHK: BLOCK 1 ;TOTAL NUMBER OF CHKSUM ERRORS
L.THOL: BLOCK 1 ;TOTAL NUMBER OF HOLLER ERRORS
L.TIBC: BLOCK 1 ;TOTAL NUMBER OF ILLEGAL BIN CARDS
L.UFIN: BLOCK 3 ;UFD INTERLOCK BLOCK
L.WIDT: BLOCK 1 ;CARD WIDTH PARAMETER
IFN FTJSYS,<
L.UNAM: BLOCK 10 ;USER NAME
L.USNO: BLOCK 1 ;USER NUMBER
L.UDIN: BLOCK 15 ;GTDIR INFORMATION
L.UPSW: BLOCK 10 ;USER SPECIFIED PASSWORD
L.DPSW: BLOCK 10 ;ACTUAL PASSWORD FROM DIRECTORY
L.LONG: BLOCK 40 ;HOLD LONG FILE NAME FOR SPOOLED FILES
L.COMP: BLOCK 12 ;BLOCK FOR COMPAT UUO
> ;END IFN FTJSYS
;THESE LOCATIONS ARE FILLED BY THE DATE-TIME SCANNERS
L.HRS: BLOCK 1 ;HOURS
L.MIN: BLOCK 1 ;MINUTES
L.SEC: BLOCK 1 ;SECONDS
L.DAY: BLOCK 1 ;DAY
L.MON: BLOCK 1 ;MONTH
L.YRS: BLOCK 1 ;YEAR
LOWZND==.-1
;THE FOLLOWING LOCATIONS ARE PRESET TO CONTAIN A DEFAULT VALUE
;AT THE BEGINNING OF EACH JOB.
;EACH LOCATION HAS A CORRESPONDING HISEGMENT LOCATION WHICH CONTAINS
;THE DEFAULT VALUE, AND THE HISEG BLOCK IS BLT'ED INTO THE LOWSEG
;BLOCK BEFORE EACH NEW JOB.
DEFINE LOCS,<
PR LSW,'/LIST'
PR UCHK,A%CSER
PR UHOL,A%HLER
PR UIBC,A%ICER
>
DEFINE PR(A,B),<
UP
XALL
H.'A: EXP B ;;SET HISEG LOCATION
DOWN
XALL
L.'A: EXP 0 ;;ALLOCATED LOWSEG LOCATION
SALL
>
UP
PREHGH:
DOWN
PRELOW:
LOCS
UP
PREHND==.-1
DOWN
PRELND==.-1
L.QUE: BLOCK .QSIZE ;PRIMARY QUEUE PARAMETER AREA
;THIS IS SETUP SEPARATELY BY THE
;SETQUE ROUTINE.
;Extended UUO Block
L.UUBK:
RIBCNT: BLOCK 1 ;ARGUMENT COUNT
RP.NSE==400000 ;NON-SUPERCEDING ENTER BIT
RIBPPN: BLOCK 1 ;PROJECT-PROGRAMMER NUMBER
RIBNAM: BLOCK 1 ;FILNAME
RIBEXT: BLOCK 1 ;EXTENSION
RIBPRV: BLOCK 1 ;PROTECTION-DATE-TIME
RIBSIZ: BLOCK 1 ;LENGTH OF FILE IN WORDS
RIBVER: BLOCK 1 ;FILE'S VERSION
RIBSPL: BLOCK 1 ;SPOOLED FILENAME
RIBEST: BLOCK 1 ;ESTIMATED LENGTH
RIBALC: BLOCK 1 ;ALLOCATION
RIBPOS: BLOCK 1 ;POSITION TO ALLOCATE
RIBFT1: BLOCK 1 ;DEC NON-PROV FUT ARG
RIBNCA: BLOCK 1 ;NON-PRIV CUSTOMER ARG
RIBMTA: BLOCK 1 ;TAPE LABEL
RIBDEV: BLOCK 1 ;LOGICAL UNIT NAME
RIBSTS: BLOCK 1 ;FILE STATUS BITS
RP.NQC==2000 ;NO QUOTA CHARGE FILE
RIBELB: BLOCK 1 ;ERROR LOGICAL BLOCK
RIBEUN: BLOCK 1 ;ERROR UNIT AND LENGTH
RIBQTF: BLOCK 1 ;FCFS LOGGED-IN QUOTA
RIBQTO: BLOCK 1 ;LOGGED-OUT QUOTA
RIBQTR: BLOCK 1 ;RESERVED QUOTA
RIBUSD: BLOCK 1 ;BLOCK IN USE
RIBAUT: BLOCK 1 ;AUTHOR'S PPN
LOWEND==.-1
;Fact Entry Block
IFN FTFACT,<
L.FACT: EXP .FACT ;DAEMON FACT FUNCTION
L.FHDR: EXP <231>B8+.FSIZE ;HEADER TYPE 231 LENGTH=13
L.FPPN: BLOCK 1 ;USER'S PPN
L.FDAT: BLOCK 1 ;DATE-TIME (FILLED IN BY DAEMON)
L.FQUE: 'IN ' ;QUE-STATION-APR SERIAL NUMBER
L.FRTM: BLOCK 1 ;RUNTIME
L.FKCT: BLOCK 1 ;KCT
L.FDRD: BLOCK 1 ;DISK READS
L.FDWT: BLOCK 1 ;DISK WRITES
L.FPDV: BLOCK 1 ;PHYSICAL INPUT DEVICE
L.FSEQ: BLOCK 1 ;SEQUENCE NUMBER
L.FWRK: BLOCK 1 ;WORK DONE BY SPRINT
;BIT 0=1 BATCH INPUT REQ CREATED
; =0 BATCH INPUT REQ NOT CREATED
;BITS 18-35 = CARDS READ
.FSIZE==.-L.FHDR ;SIZE OF BLOCK
;BYTE POINTERS
P.FSTA: POINT 6,L.FQUE,17 ;STATION NUMBER
P.FJOB: POINT 9,L.FHDR,17 ;JOB NUMBER
P.FTTY: POINT 12,L.FHDR,29 ;TTY NUMBER
> ;END OF IFN FTFACT
SUBTTL Entry and Initialization
UP
SPRINT: SKIPA ;SKIP CCL ENTRY
SPTCCL: OUTSTR CCL% ;NO CCL START
IFN FTUUOS,<
MOVEM .SGNAM,L.SGNM ;SAVE MY FIRST NAME
MOVEM .SGLOW,L.SGLW ;LAST NAME
JUMPE .SGNAM,[OUTSTR NHS%
EXIT] ;DIDN'T "RUN" ME
> ;END IFN FTUUOS
SPT1: RESET ;RESET THE WORLD
MOVE T1,[PUSHJ P,UUO0]
MOVEM T1,.JB41## ;LUUO DISPATCH ADDRESS
MOVE P,[LOWBEG,,LOWBEG+1]
CLEARM LOWBEG ;ZAP FIRST STORAGE CELL
BLT P,LOWEND ;ZAP THE REST OF THEM
MOVE P,[DEVBEG,,DEVBEG+1]
CLEARM DEVBEG ;PREPARE TO ZAP DEVICE CELLS
BLT P,DEVEND ;ZAP!
MOVEI P,1 ;PREPARE TO ZAP ACS
CLEAR F,
BLT P,P ;ZAP THEM ALL
MOVE P,[IOWD A%PDSZ,L.PDL]
ON F.HTOP ;I'VE GOT MY HISEG
MOVEI T1,RESTRT ;LOW-SEG START ADDRESS
HRRM T1,.JBSA ;FOR 'START' WITHOUT MY HISEG
PUSHJ P,GTTABS ;DO ALL THE GETTABS
IFN FTUUOS,<
CLEARM L.PRIV ;ASSUME NO PRIVS
MOVE T1,L.MYPP ;GET MY PPN
CAMN T1,L.FFA ;AM I OPR?
JRST IAMPRV ;I AM PRIV'ED
MOVS T2,L.MYST ;MY STATION,,0
ADD T2,[100,,2] ;GET OPR FOR MY STATION
CAME T1,T2 ;AM I HIM?
JRST SPT1A ;NO, NO PRIVS
PJOB T1, ;YES, GET MY JOB NUMBER
MOVNS T1 ;GET NEGATIVE JOB NUMBER
JOBSTS T1, ;GET MY JOBSTS
CLEAR T1, ;ASSUME NO JACCT
TXNN T1,JB.UJC ;DO I HAVE JACCT ON?
JRST [TELL OPR,ROM%
EXIT] ;NO, DIE!!
IAMPRV: SETOM L.PRIV ;I'M PRIVELEGED!!!
> ;END IFN FTUUOS
SPT1A: MOVE T1,[4,,INTLOC] ;SETUP JOBINT BLOCK
MOVEM T1,L.INTB
MOVE T1,[ER.MSG+ER.ICC+ER.IDV+ER.QEX]
MOVEM T1,L.INTB+1 ;ENABLE BITS
CLEARM L.INTB+2 ;CLEAR THE REST
CLEARM L.INTB+3
MOVEI T1,L.INTB ;GET ADDRESS OF BLOCK
MOVEM T1,.JBINT ;AND PUT IT WHERE MONITOR CAN FIND IT
PJOB T1, ;GET JOB NUMBER
IFN FTFACT,<
DPB T1,P.FJOB ;STORE IN FACT BLOCK
MOVE T1,L.JFSC ;GET JIFSEC BIT
MOVEI T2,^D60 ;ASSUME 60 JIFS/SEC
TXNE T1,ST%CYC ;IS 50 CYCLE BIT SET?
MOVEI T2,^D50 ;YES, USE 50
MOVEM T2,L.JFSC ;AND STORE IT
>
LSH T1,12 ;*1024
MSTIME T2, ;SO RESTART DOESN'T RESET US
TLZ T2,-1 ;ZAP LH
ADD T1,T2 ;MAKE A FUNNY NUMBER
MOVEM T1,L.FUN ;AND STORE IT
IFN FTUUOS,<
MOVEI T3,4 ;WORDS -1 IN SYSNAM
MOVSI T1,.GTCNF ;CNFTBL
SPT2: MOVS T2,T1 ;TABLE #,,INDEX
GETTAB T2, ;GET NAME
CLEAR T2, ;THIS REALLY SHOULDN'T HAPPEN
MOVEM T2,L.SYSN(T1) ;STORE IT AWAY
CAILE T3,(T1) ;GOT ALL FIVE?
AOJA T1,SPT2 ;NO, LOOP AROUND
> ;END IFN FTUUOS
IFN FTJSYS,<
SETO T1, ;MY JOB
HRROI T2,T4 ;STORE 1 WORD IN T4
MOVEI T3,.JIUNO ;AND THE WORD IS MY USER NUMBER
GETJI ;GET IT!!
JFCL ;WE'LL LOSE LATER
HRROI T1,L.MYNM ;PLACE TO STORE STRING
MOVE T2,T4 ;DIRECTORY NUMBER
DIRST ;CONVERT IT TO A STRING
HALT . ;LOSE!!
MOVX T1,'SYSVER' ;GET TABLE # AND LENGTH FOR SYSTEM NAME
SYSGT ;GET IT
HLRE T3,T2 ;GET -VE LENGTH IN T3
MOVN T3,T3 ;AND MAKE IT POSITIVE
HRLZ T2,T2 ;GET TABLE#,,0
SPT2: MOVS T1,T2 ;GET INDEX,,TABLE
GETAB ;DO THE GETTAB
SETZ T1, ;STORE A NULL ON FAILURE
MOVEM T1,L.SYSN(T2) ;STORE THE WORD
CAILE T3,(T2) ;DONE?
AOJA T2,SPT2 ;NO, LOOP
> ;END IFN FTJSYS
SETZM L.MCOR ;AND SAVE IT
MOVEI T2,A%UNIQ ;GET DEFAULT UNIQUENESS
EXCH T2,L.UNIS ;STORE IT AND LOAD LIMLVL
MOVEI T1,A%UNIQ ;GET DEFAULT UNIQUENESS AGAIN
CAIE T1,.QIUSD ;UNIQUE SUB DIRECTORY??
JRST SPT3 ;NO, SKIP CHECK
SKIPN T1 ;YES,IS LIMLVL=0?
SOS L.UNIS ;YES, MAKE DEFAULT = 1
SPT3: MOVE T1,L.PPR ;GET STANDARD PROTECTION
TLNN T1,700000 ;IS OWNER PROT =0?
TLO T1,100000 ;YES, MAKE IT ONE
MOVEM T1,L.PPR ;AND RE-STORE IT
IFN FTUUOS,<
SKIPL L.PRIV ;SKIP IF I'M PRIVILEGED
JRST SPT5 ;ELSE SKIP ACCT.SYS LOOKUP
OPEN ACT,H.OSTS ;OPEN UP CHANNEL 'ACT'
JRST NOACCT ;GUESS NOT
OPEN ACT1,H.OSTS ;AND CHANNEL ACT1
JRST NOACCT ;STRANGE!!
OPEN AUX,H.OSTS ;AND CHANNEL AUX
JRST NOACCT ;ITS GETTING STRANGER
> ;END IFN FTUUOS
SPT5: MOVEI T1,L.SL1 ;BLOCK TO HOLD S/L
PUSHJ P,GETSRC ;GO GET THE SEARCH LIST
ON F.RES ;SET RESET STATE
MOVEI T1,A%OMSG ;GET DEFAULT MSGLVL
PUSHJ P,SETMSG ;AND SET IT
CHR OPR,"/" ;GIVEM A START
PUSHJ P,OPER ;GET COMMANDS
JRST SETUP ;RETURN HERE ON 'START'
;GTTABS -- Routine to do all GETTABS for initialization.
; Routine is driven by three tables generated by the TABS
; macro. The first table contains the argument to GETTAB, the
; second contains defaults to use on failure, and the third contains
; an instruction which is executed to store the results.
GTTABS: MOVSI T2,-.NMTAB ;MAKE AOBJN POINTER
GTTAB1: MOVE T1,GTAB1(T2) ;GET AN ARGUMENT
GETTAB T1, ;DO THE GETTAB
MOVE T1,GTAB2(T2) ;FAIL!! USE DEFAULT
XCT GTAB3(T2) ;STORE THE RESULT
AOBJN T2,GTTAB1 ;AND LOOP
POPJ P, ;RETURN WHEN DONE
;THE ARGUMENTS TO THE TABS MACRO ARE:
; 1) ARGUMENT TO GETTAB
; 2) DEFAULT VALUE
; 3) INSTRUCTION TO STORE RESULT
; (NOTE: MACRO EXPANSION GENERATES THE CORRECT AC FIELD
; THEREFORE IT SHOULD BE BLANK IN THE ARGUMENT)
DEFINE TABS,<
T <%LDSTP>,<57B8>,<MOVEM L.PPR>
T <%LDFFA>,<1,,2>,<MOVEM L.FFA>
T <%LDMFD>,<1,,1>,<MOVEM L.MFPP>
T <%LDSFD>,<0>,<MOVEM L.UNIS>
T <-1,,.GTLOC>,<0>,<MOVEM L.MYST>
T <0,,.GTLOC>,<0>,<MOVEM L.CNST>
T <-1,,.GTPPN>,<0>,<MOVEM L.MYPP>
T <-2,,.GTDEV>,<'DSK '>,<MOVEM L.SGDV>
T <-2,,.GTPPN>,<0>,<MOVEM L.SGPP>
IFN FTFACT,<
T <%CNSER>,<0>,<HRRM L.FQUE>
T <%CNSTS>,<0>,<MOVEM L.JFSC>
> ;END OF IFN FTFACT
> ;END OF TABS MACRO
DEFINE T(A,B,C),<
EXP <A>
>
GTAB1: TABS
.NMTAB==.-GTAB1
DEFINE T(A,B,C),<
EXP <B>
>
GTAB2: TABS
DEFINE T(A,B,C),<
EXP <C> + <T1>B12
>
GTAB3: TABS
SUBTTL Operator Commands -- Setup and Dispatch
;HERE TO PROCESS OPERATOR INTERACTIVE COMMANDS.
;CALLED WITH A PUSHJ.
;IF SPRINT IS ACTIVE, RETURN IN VIA POPJ, IF NOT
;ROUTINE LOOPS UNTIL START OR CONTINUE IS TYPED.
OPER: OFF F.IBRK ;TURN OFF BREAK FLAG
MOVEI T1,TTYIN ;GET INPUT ROUTINE
MOVEM T1,L.SCIN ;AND STORE IT FOR SCANNERS
MOVEI T1,CONTTY ;TTY CONTINUATION ROUTINE
MOVEM T1,L.SCLN ;AND STORE IT
PUSHJ P,S$SIX ;GET A COMMAND
JRST OPER5 ;THERE ISN'T ONE?
JUMPE T1,OPER1 ;NULL COMMAND, CLEAN UP AND RETURN
MOVEM T1,L.CMD ;SAVE THE COMMAND
MOVEI T2,COMTAB ;ADDRESS OF COMMAND TABLE
HRLI T2,-.NMCOM ;AND TABLE LENGTH
PUSHJ P,UNIQ6 ;GET A UNIQUE COMMAND
JRST OPER4 ;COMMAND NOT UNIQUE
PUSHJ P,@DISTAB(T1) ;DISPATCH COMMAND
OPER1: PUSHJ P,TTYBRK ;EAT THE REST OF THE LINE
TXNN F,F.RES!F.STOP ;ARE WE STOPPED OR RESET?
JRST OPER2 ;NO, CHECK FOR PAUSE
CHR OPR,"/" ;YES, TYPE A SLASH
JRST OPER ;AND LOOP FOR A COMMAND
OPER2: TXNN F,F.PAUS ;ARE WE PAUSED?
JRST OPER3 ;NO, TYPE A SMASH
TXNE F,F.BUSY ;YES, ARE WE IN A JOB?
JRST OPER3 ;YES, DON'T PAUSE NOW!
CHR OPR,"/" ;NO, PAUSE NOW
JRST OPER ;AND GO GET A COMMAND
OPER3: CHR OPR,"!" ;TYPE AN EXCLAMATION POINT
POPJ P, ;AND RETURN
OPER4: TELL OPR,ILC% ;ILLEGAL COMMAND
SKIPA ;SKIP THE OTHER ERROR
OPER5: TELL OPR,CER% ;COMMAND ERROR
JRST OPER1 ;AND CONTINUE
;COMMANDS AND COMMAND DISPATCH TABLE
DEFINE NAMES,<
X KILL,KILCOM
X STOP,STPCOM
X PAUSE,PSECOM
X WHAT,WHTCOM
X GO,GOCOM
X TELL,TELCOM
X START,STCOM
X HELP,HLPCOM
X MCORE,MCRCOM
X RESET,RSTCOM
X MSGLVL,MSGCOM
X EXIT,EXTCOM
X ST,STCOM
>
DEFINE X(A,B),<
<SIXBIT /A/>>
COMTAB: NAMES
.NMCOM==.-COMTAB
DEFINE X(A,B),<
EXP B>
DISTAB: NAMES
SUBTTL Operator Commands -- HELP - PAUSE - GO
;HLPCOM -- HELP COMMAND
; CALLS HELPER TO TYPE OUT SPRINT.HLP
HLPCOM: MOVE T1,['SPRINT'] ;THAT'S ME!!
PJRST .HELPR## ;CALL THE HELPER AND RETURN
;PSECOM -- PAUSE COMMAND
; SETS F.PAUS AND RETURNS
PSECOM: TXNN F,F.RES ;DON'T SET PAUSE IF WE ARE RESET
ON F.PAUS ;SET F.PAUSE
POPJ P, ;AND RETURN
;GOCOM -- GO COMMAND
; CONTINUE AFTER STOP OR PAUSE
GOCOM: TXNN F,F.RES ;ARE WE IN RESET STATE
JRST GOCOM1 ;NO, CONTINUE
TELL OPR,NST% ;YES, TELL HIM WE'RE NOT STARTED
POPJ P, ;AND RETURN
GOCOM1: OFF F.STOP!F.PAUS ;TURN OFF CAUSE
TXNN F,F.BUSY ;BUSY?
POPJ P, ;RETURN
STAMP STOPR ;GIVE LOG A STAMP
TELL LOG,CBO% ;CONTINUED BY OPERATOR
POPJ P, ;AND RETURN
SUBTTL Operator Commands -- EXIT
;EXTCOM -- EXIT COMMAND
; IF WE ARE BUSY, DEFER EXIT UNTIL WE ARE DONE
; ELSE, MONRET -- DO A RESTART OF SPRINT IN CONT IS GIVEN
EXTCOM: TXNE F,F.BUSY ;ARE WE BUSY
JRST EXTCM1 ;YES, DEFER THE COMMAND
PUSHJ P,TTYBRK ;CLEAR TTY INPUT
MOVEI T1,L.SL1 ;MY ORIGINAL S/L
PUSHJ P,SETSRC ;RESET IT
RESET ;RESET ALL I/O
MONRT. ;AND RETURN TO MONITOR
JRST SPT1 ;FOR A CONTINUE
EXTCM1: ON F.DEXT ;SET DEFERED EXIT
PJRST GOIFST ;AND GO IF STOPPED, ELSE RETURN
SUBTTL Operator Commands -- STOP - RESET - KILL
;STPCOM -- STOP COMMAND
; SETS F.STOP AND RETURNS
STPCOM: TXNE F,F.RES ;IS RESET SET?
POPJ P, ;YES, JUST RETURN
ON F.STOP ;SET STOP FLAG
TXNN F,F.BUSY ;BUSY?
POPJ P, ;NO, RETURN
STAMP STOPR ;STAMP THE LOG
TELL LOG,SBO% ;STOPPED BY OPERATOR
POPJ P, ;AND RETURN
;RSTCOM -- RESET COMMAND
; IF SPRINT IS BUSY, DEFER UNTIL IDLE, OTHERWISE DO A RESTART
RSTCOM: TXNE F,F.BUSY ;ARE WE BUSY?
JRST RSTCM1 ;YES, TELL HIM
TELL OPR,RSTMSG ;TELL HIM WE'RE RESETING
PUSHJ P,TTYBRK ;CLEAR THE LINE
MOVEI T1,L.SL1 ;PRIME SEARCH LIST
PUSHJ P,SETSRC ;SET IT
JRST SPT1 ;AND RESET!!
RSTCM1: ON F.DRES ;SET DEFERED RESET
PJRST GOIFST ;AND GO IF STOPPED, ELSE RETURN
;KILCOM -- KILL COMMAND
; IF JOB IS IN PROGRESS, SET F.KILL AND RETURN
; OTHERWISE GIVE OPR AN ERROR MESSAGE
KILCOM: TXNE F,F.BUSY ;ARE WE BUSY?
JRST KILCM1 ;YES, GO DO IT
MOVEI T1,NJA% ;NO, LOAD NJA MESSAGE
PJRST TYPONM ;TYPE SPTNJA "ON DEV" AND RETURN
KILCM1: ON F.KILL ;ELSE SET KILL
PJRST GOIFST ;GO IT STOPPED, ELSE JUST RETURN
SUBTTL Operator Commands -- TELL
;TELCOM -- TELL COMMAND
; STAMPS LOG WITH STOPR STAMP AND TYPES THE OPERATORS MESSAGE
; INTO THE LOG FILE. REPLACES THE OPERATORS BREAK CHARACTER
; BY A CRILIF TO KEEP THE LOG NEAT.
TELCOM: TXNE F,F.BUSY ;ARE WE BUSY?
JRST TELCM1 ;YES, CONTINUE
MOVEI T1,NJA% ;NO, LOAD ADDRESS OF MESSAGE
PJRST TYPONM ;AND TYPE A MESSAGE AND RETURN
TELCM1: TXNN F,F.FFOR ;FAST-FORTRAN JOB?
JRST TELCM2 ;NO, ALL IS OKAY
TELL OPR,ICF% ;FF JOBS HAVE NO LOG FILE
POPJ P, ;AND RETURN
TELCM2: STAMP STOPR ;STAMP THE LOG
TELCM3: PUSHJ P,.SCIN ;GET A CHARACTER
JRST TELCM4 ;EOL FINALLY!!
CHR LOG,(C) ;TYPE THE CHARACTER INTO THE LOG
JRST TELCM3 ;AND LOOP
TELCM4: TELL LOG,CRLF ;FINISH THE LINE
POPJ P, ;AND RETURN
SUBTTL Operator Commands -- WHAT
;WHTCOM -- WHAT COMMAND
; TYPES STATUS OF SPRINT TO OPR IN THE FORM:
;
; SPRINT JOB RUNNING ON CDR0
; SEQ:3 USER:LARRYSAMBERG PPN:77,77 JOB:TEST
; CARD #334 -- CARD #10 IN DECK #2
;
;GIVES SIMILAR INFORMATION FOR FAST-FORTRAN JOBS
WHTCOM: SETOM L.NTRY ;CAUSE CDR BUSY MESSAGE
TXNE F,F.BUSY ;AM I DOING ANYTHING?
JRST WHTCM1 ;YES, TELL HIM
MOVEI T1,IDLMSG ;LOAD ADDRESS OF IDLE MESSAGE
PUSHJ P,TYPONM ;AND TYPE IT + ON DEV:
JRST WHTCM3 ;CHECK FOR OPERATOR INTERVENTION
WHTCM1: MOVEI T1,CDJMSG ;SPRINT JOB
TXNE F,F.FFOR ;FAST FORTRAN JOB?
MOVEI T1,FFJMSG ;YUP
TELL OPR,(T1) ;TELL OPR
TXNE F,F.FFOR ;FAST FORTRAN JOB?
JRST WHTCM2 ;YES, SKIP QUEUE INFO
TELL6 OPR,['SEQ:']
RAD10 OPR,Q.SEQ(Q) ;SEQUENCE NUMBER
TELL OPR,[ASCIZ / USER:/]
IFN FTUUOS,<
TELL6 OPR,Q.USER(Q) ;USERS FIRST NAME
TELL6 OPR,Q.USER+1(Q) ;USERS SECOND NAME
TELL OPR,[ASCIZ / PPN:/] ;GET SET FOR PPN
HLRZ T3,Q.PPN(Q) ;GET PROJECT NUMBER
RAD08 OPR,T3 ;AND TYPE IT
CHR OPR,"," ;COMMA
HRRZ T3,Q.PPN(Q) ;AND PROGRAMMER NUMBER
RAD08 OPR,T3 ;AND TYPE IT
> ;END IFN FTUUOS
IFN FTJSYS,<
TELL OPR,L.UNAM ;GIVE THE NAME
> ;END IFN FTJSYS
TELL OPR,[ASCIZ / JOB:/]
TELL6 OPR,Q.JOB(Q)
TELL OPR,CRLF ;JOB NAME <>
WHTCM2: TELL OPR,WHTMSG ;CARD INFORMATION
TXNE F,F.DECK ;ARE WE IN A DECK?
TELL OPR,HOL3% ;YES, GIVE DECK INFO
TELL OPR,CRLF ;AND A CRLF
WHTCM3: TXNN F,F.BUSY ;ARE WE BUSY?
JRST WHTCM4 ;NO, DON'T CHECK FOR DEVICE PROBLEMS
TXNN F,F.DER!F.JBI ;ANY DEVICE PROBLEMS?
JRST WHTCM4 ;NO
TELL OPR,DNR% ;YES, TELL HIM
JRST WHTCM6 ;TYPE OIR AND RETURN
WHTCM4: TXNE F,F.STOP ;STOP ON?
JRST WHTCM6 ;YES, TELL HIM
TXNE F,F.PAUS ;IS PAUSE ON?
TXNN F,F.BUSY ;YES, IS BUSY ON TOO?
POPJ P, ;PAUSE IS ZERO, RETURN
WHTCM6: TELL OPR,OIR% ;TELL HIM TO INTERVENE
POPJ P, ;AND RETURN
SUBTTL Operator Commands -- MCORE
;MCRCOM -- MCORE COMMAND
;ROUTINE TO SET JOBS' CORE LIMIT. SET TO DEFAULT AT INITIALIZATION
; AND CHANGED VIA MCORE XX COMMAND. XX IS ASSUMED TO
; BE A DECIMAL NUMBER OF K UNLESS IMMEDIATELY FOLLOWED BY
; THE LETTER 'P' IN WHICH CASE IT IS DECIMAL PAGES. AN
; ARGUMENT OF 0 OR A NULL ARGUMENT RESETS IT TO DEFAULT.
MCRCOM: PUSHJ P,S$DEC ;GET DECIMAL ARGUMENT
JRST MCRCM1 ;EOL OR JUNK
JUMPE T1,MCRCM2 ;ZERO IMPLIES DEFAULT
LSH T1,^D10 ;CONVERT K TO WORDS
CAIE C,"K" ;CHECK FOR SUFFIX
CAIN C," " ;EITHER K OR SPACE IMPLIES K
JRST MCRCM3 ;GOT ONE OF THEM, GO STORE ANSWER
CAIE C,"P" ;ONLY OTHER CHOICE IS "P"
PJRST JUNK ;LOSE!!
LSH T1,-1 ;DIVIDE BY 2
JRST MCRCM3 ;AND STORE ANSWER
MCRCM1: PJUMPE T1,JUNK ;EOL RETURNS A -1
MCRCM2: MOVEI T1,0 ;LOAD THE DEFAULT
MCRCM3: MOVEM T1,L.MCOR ;STORE THE ANSWER
POPJ P, ;AND RETURN
SUBTTL Operator Commands -- MSGLVL
;MSGCOM - MSGLVL COMMAND
;ROUTINE TO SET LEVEL AND VERBOSITY OF OPERATOR MESSAGES.
; COMMAND IS 'MSGLVL ABC' WHERE:
;
; A=0 TYPE SHORT MESSAGES TO OPR
; =1 TYPE FULL-LENGTH MESSAGES TO OPR
;
; B=0 SUPPRESS ERROR CARD OUTPUT
; =1 TYPE THE FIRST FATAL ERROR CARD OF EACH JOB
;
; C=0 TYPE NO CARDS TO OPERATOR
; =1 TYPE EACH $JOB CARD TO OPERATOR
; =2 TYPE EACH $-CARD TO OPERATOR
; =3 TYPE EACH CARD TO OPERATOR
MSGCOM: PUSHJ P,S$OCT ;GET AN OCTAL NUMBER
SKIPA ;ITS EITHER EOL OR JUNK
JRST SETMSG ;ITS OK, GO DO IT
PJUMPE T1,JUNK ;T1=0 MEANS JUNK!
MOVEI T1,A%OMSG ;T1=-1 MEANS EOL, USE DEFAULT
SETMSG: CAIGE T1,100 ;GREATER THAN OR EQUAL 100
TXOA F,F.SHMG ;NO, SHORT MESSAGES
OFF F.SHMG ;YES, LONG MESSAGES
LDB T2,[POINT 3,T1,32]
CLEAR T3, ;GET 'B' (OF ABC) INTO T2, CLEAR T3
SKIPE T2 ;B=0?
TLO T3,1B18 ;NO, SET FLAG
HLLM T3,L.MSGL ;AND STORE
ANDI T1,7 ;AND DOWN TO LAST DIGIT
HRRM T1,L.MSGL ;AND STORE THAT TOO
POPJ P, ;AND RETURN
SUBTTL Operator Commands -- START
STCOM: TXNE F,F.RES ;ARE WE ALREADY START'ED
JRST STCOMA ;NO, KEEP GOING
TELL OPR,STD% ;YES, ALREADY STARTED
POPJ P, ;AND RETURN
STCOMA: MOVEI T1,DEVCDR ;ADDRESS OF DEVICE CONTROL CELLS
PUSHJ P,CLRCEL ;CLEAR THEM!!
PUSHJ P,S$FILE ;GET A FILESPEC
JRST STCOME ;GO TELL HIM ABOUT ERROR
MOVE P1,CDRDEV ;GET DEVICE NAME
JUMPN P1,STCOMB ;IS DEVICE=0
MOVX P1,DEFIND ;YES, USE DEFAULT INPUT DEVICE
SKIPE CDRNAM ;IS FILENAME NULL?
MOVSI P1,'DSK' ;NO, USE DISK AS DEFAULT
STCOMB: DEVNAM P1, ;FIND REAL NAME
JRST STCOMF ;NO SUCH DEVICE?
MOVEM P1,CDRDEV ;SAVE DEVICE NAME
MOVEM P1,CDROPN+1 ;AND STORE IN OPEN BLOCK
IFN FTFACT,<
MOVEM P1,L.FPDV ;STORE DEVICE IN FACT BLOCK
>
DEVTYP P1,UU.PHY ;GET TYPE BITS
JRST STCOMF ;STRANGE?
IFN FTUUOS,<
TXNE P1,TY.SPL ;DEVICE SPOOLED?
TELL OPR,SPL%
> ;END IFN FTUUOS
TXNE P1,TY.IN ;CAN IT DO INPUT?
JRST STCOM1 ;YUP!!
TELL OPR,CDI%
POPJ P, ;AND RETURN
STCOM1: LDB P2,[POINT 6,P1,35]
CAIN P2,.TYCDR ;GET DEVICE CODE INTO P2 AND TEST
ON F.ICDR ;IT'S A CDR!!!
CAIN P2,.TYDSK ;DISK?
ON F.DSK ;YES!!
CAIN P2,.TYMTA ;MAGTAPE?
ON F.MTA ;YES!!
TXNN P1,TY.SPL ;WAS IT SPOOLED?
JRST STCOM2 ;NO
OFF F.ICDR ;YES, TURN OFF CDR
ON F.DSK ;AND TURN ON DSK
;START COMMAND CONTINUED
STCOM2: TXNN F,F.IDEV ;IS THERE AN INPUT DEVICE?
ON F.DSK ;NO, MAKE IT LIKE A DSK
MOVEI T1,.IOASL ;JUST IN CASE ITS A DISK
TXNN F,F.ICDR ;IS IT A CDR?
JRST STCOM5 ;NO, HANDLE MAGTAPES AND DSKS
IFN FTUUOS,<
MOVE P1,CDRDEV ;YES, GET DEVICE NAME
WHERE P1, ;WHERE IS IT
CLEAR P1, ;WHERE FAILS MEANS CENTRAL
SKIPE P1 ;STATION 0?
JRST STCOM3 ;NO,DO THE COMPARE
OFF F.RCDR ;YES, ITS LOCAL!!
MOVEI T1,.IOSIM ;GET SUPER-IMAGE MODE
JRST STCOM5 ;STORE IO-MODE AND RETURN
STCOM3: CAME P1,L.CNST ;SEE IF IT MATCHES CENTRAL STATION
TXZA F,F.LCDR ;NO, ITS REMOTE
TXZ F,F.RCDR ;YES, ITS LOCAL
MOVEI T1,.IOSIM ;GET SUPERIMAGE
TXNN F,F.LCDR ;IS IT LOCAL?
MOVEI T1,.IOIMG ;NO, LOAD IMAGE
JRST STCOM5 ;STORE MODE AND RETURN
> ;END IFN FTUUOS
IFN FTJSYS,<
TXNE P1,TY.SPL ;IS IT SPOOLED?
TELL OPR,SPL% ;YES, TELL HIM
OFF F.LCDR ;MAKEIT LOOK LIKE A REMOTE CDR
MOVEI T1,.IOIMG ;LOAD THE MODE
JRST STCOM5 ;AND CONTINUE
> ;END IFN FTJSYS
STCOM5: TXO T1,UU.PHS ;TURN ON PHYSICAL ONLY BIT
MOVEM T1,CDROPN ;STORE MODE IN OPEN BLOCK
MOVEI T1,CDROPN ;GET ADDRESS OF OPEN BLOCK
DEVSIZ T1, ;GET BUFFER SIZE
JRST STCOMF ;SHOULDN'T HAPPEN
MOVEI T2,A%LCBN ;NUMBER OF LOCAL CDR BUFFERS
TXNN F,F.LCDR ;IS IT A LOCAL CDR?
MOVEI T2,A%ODBN ;NO, LOAD ALTERNATE NUMBER OF BUFFERS
SKIPN T2 ;IS BUF NUM = 0?
HLRZ T2,T1 ;YES, USE MONITOR DEFAULT FOR THIS DEVICE
MOVEM T2,CDRBFN ;SAVE NUMBER OF BUFFERS
TLZ T1,-1 ;ZAP LH OF T1
IMUL T1,T2 ;AMOUNT=BUFFERSIZE*BUFFERNUMBER
TXNN F,F.RCDR ;IS IT REMOTE?
JRST STCOM6 ;NO.
PUSH P,T1 ;ELSE SAVE T1
MOVE T1,.JBFF ;LOAD JOBFF
IORI T1,777 ;OR UP TO A PAGE
ADDI T1,1 ;AND BREAK A BOUNDARY
SUB T1,.JBFF ;GET THE DIFFERENCE
PUSHJ P,EXPND ;AND WASTE THE SPACE
POP P,T1 ;RESTORE BUFFER SIZE
STCOM6: PUSHJ P,EXPND ;GET THE CORE
MOVEM T1,CDRBUF ;SAVE ADDRESS OF BUFFERS
MOVE T1,.JBFF ;GET CURRENT JOBFF
MOVEM T1,CDRJFF ;AND SAVE IT FOR LATER
OFF F.RES!F.DCOM!F.STOP
IFN FTUUOS,<
SKIPGE L.PRIV ;ARE WE PRIVILEGED?
PJRST BILDAC ;YES, BUILD ACCT.SYS INDEX AND RETURN
> ;END IFN FTUUOS
POPJ P, ;NO, JUST RETURN
STCOMF: MOVEI T1,NSD% ;NO SUCH DEVICE
STCOME: TELL OPR,(T1) ;TELL HI WHAT IT WAS
POPJ P, ;AND RETURN
SUBTTL Operator Commands -- Subroutines
;^;+TYPONM -- Routine to type to the operator the message pointed
; to by T1, followed by "on dev" if an input device has
; been specified.
;-;#2
TYPONM: TELL OPR,(T1) ;TYPE THE MESSAGE TO THE OPERATOR
SKIPE CDRDEV ;IS THERE A DEVICE??
TELL OPR,ONMSG ;YES, TYPE "ON DEV:"
TELL OPR,CRLF ;TYPE A CRLF
POPJ P, ;AND RETURN
;+JUNK -- Routine to type "Command Error" message to the
; operator, and return.
;-;#2
JUNK: TELL OPR,CER% ;TYPE THE MESSAGE
POPJ P, ;AND RETURN
;+DODEF -- Routine to process deferred commands.
;-;#2
DODEF: TXZE F,F.DEXT ;DEFERRED EXIT?
JRST EXTCOM ;YES, DO THE EXIT
TXZE F,F.DRES ;DEFERRED RESET?
JRST RSTCOM ;YES, DO THE RESET
TELL OPR,PSEMSG ;MUST BE PAUSE
SKIPE CDRDEV ;ANY DEVICE?
TELL OPR,ONMSG ;YES, TYPE IT
TELL OPR,CCRLF ;AND A ]<CRLF>
PUSHJ P,PSECOM ;DO THE PAUSE
PJRST OPER ;AND GO WAIT!!
;+GOIFST -- Routine called by commands which do an automatic
; GO if SPRINT is STOPed. If F.STOP
; is on, finish command off via GOCOM, else just return.
;-
GOIFST: TXNE F,F.STOP ;IS STOP ON?
PJRST GOCOM ;YES, GIVE A GO!
POPJ P, ;NO, JUST RETURN
SUBTTL TTY INPUT ROUTINES
;TTYIN -- ROUTINE TO RETURN ONE CHARACTER FROM THE TELETYPE IN AC C.
; IGNORES NULLS, CONVERTS TABS AND CR TO A SPACE, CONVERTS
; LOWER CASE TO UPPER CASE.
;
;CALL:
; PUSHJ P,TTYIN
; RETURN HERE IF THIS CHARACTER IS END-OF-LINE
; RETURN HERE OTHERWISE
TTYIN: TTYI C ;GET A CHARACTER
JUMPE C,.-1 ;IGNORE A NULL
CAIE C,.CHTAB ;CONVERT TABS
CAIN C,.CHCRT ; AND CARRIAGE RETURNS
MOVEI C,.ASSPC ;TO SPACE
CAIL C,141 ;SEE IF IT IS LOWER CASE
CAILE C,172 ; LC RANGE IS 141-172
SKIPA ;NOT LOWER CASE
SUBI C,.ASSPC ;IT IS, MAKE IT UC
CAILE C,.CHESC ;GREATER THAN ESCAPE?
PJRST .POPJ1 ;YES, RETURN WITH A SKIP
PUSHJ P,ISBRK ;IS IT A BREAK?
POPJ P, ;YUP!
PJRST .POPJ1 ;NO, SKIP BACK
;CONTTY -- TTY CONTINUATION ROUTINE
; CONTTY PRINTS "#" ON TTY, FLUSHES TILL END OF LINE, AND
; AND SKIPS BACK.
CONTTY: MOVEI T1,"#" ;LOAD A #
TTYO T1 ;AND TYPE IT
PUSHJ P,TTYBRK ;FLUSH A COMMENT IF NEXESSARY
OFF F.IBRK ;SET NO BREAK
PJRST .POPJ1 ;AND SKIP BACK
;ISBRK -- ROUTINE TO DETERMINE IF THE CHARACTER IN AC C IS A
; BREAK CHARACTER.
;
;CALL:
; PUSHJ P,ISBRK
; RETURN HERE IF IT IS A BREAK
; RETURN HERE OTHERWISE
ISBRK: MOVSI T5,-.NMBRK ;SETUP AOBJN POINTER
ISBRK1: CAMN C,BRKTBL(T5) ;COMPARE TO TABLE
JRST ISBRK2 ;IT MATCHES!!
AOBJN T5,ISBRK1 ;LOOP AROUND
PJRST .POPJ1 ;NOT A BREAK, SKIP BACK
ISBRK2: ON F.IBRK ;IT IS A BREAK!!
CAIE C,.CHCNC ;WAS IT CONTROL C?
CAIN C,.CHCNZ ;OR CONTROL Z?
SKIPA ;YES!!
POPJ P, ;NO, RETURN
MOVSI T5,ER.ICC ;GET CONTR-C INTERCEPT BIT
MOVEM T5,L.INTB+3 ;AND STORE IT
MOVEI T5,.POPJ ;PLACE TO GO ON RETURN
MOVEM T5,L.INTB+2 ;AND STORE
JRST INTLOC ;WE'VE JUST SIMULATED ^C INTERCEPT!!
;BRKTBL -- TABLE OF BREAK CHARACTERS
BRKTBL: EXP .CHLFD ;LINE-FEED
EXP .CHESC ;ESCAPE
EXP .CHFFD ;FORM-FEED
EXP .CHVTB ;VERTICAL TAB
EXP .CHBEL ;BELL
EXP .CHCNZ ;CONTROL Z
EXP .CHCNC ;CONTROL C
.NMBRK==.-BRKTBL
;TTYBRK -- ROUTINE TO FLUSH THE TTY UNTIL EOL
;
;CALL:
; PUSHJ P,TTYBRK
; ALWAYS RETURN HERE
TTYBRK: TXNE F,F.IBRK ;GOT A BREAK ALREADY?
POPJ P, ;YES, RETURN
TTYBR1: TTYI C ;GET A CHARACTER
PUSHJ P,ISBRK ;BREAK?
POPJ P, ;YES, RETURN
JRST TTYBR1 ;LOOP AROUND
SUBTTL LOOKUP/ENTER UUO Error Messages
UUOMSG: [ASCIZ /File Not Found/]
[ASCIZ /No UFD/]
[ASCIZ /Protection Failure/]
[ASCIZ /File Being Modified/]
[ASCIZ /Already Existing Filename/]
0
[ASCIZ /RIB or UFD Error/]
0
0
[ASCIZ /Device Not Available/]
[ASCIZ /No Such Device/]
0
[ASCIZ /No Room or Quota Exceeded/]
[ASCIZ /Write Locked/]
[ASCIZ /Not Enough Table Space/]
0
[ASCIZ /Block Not Free/]
0
[ASCIZ /Cannot Supersede Directory/]
[ASCIZ /SFD Not Found/]
[ASCIZ /Search List Empty/]
[ASCIZ /SFD Level Too Deep/]
[ASCIZ /No Create on All Strs/]
0
.NMUUM==.-<UUOMSG+1>
[ASCIZ /Unknown UUO Error/]
SUBTTL LUUO Handler
COMMENT /
;^;++
LUUO Handler
Output to all files except the user's decks is done via LUUOs.
The format of the LUUOs is:
LUUO DEST,ADR
where LUUO is one of the following.
LUUO OP-CODE ACTION
TELL 1 Print the ASCIZ string starting
at ADR.
TELL6 2 Print the 6 Sixbit characters in ADR.
CHR 3 Print the number ADR as an ASCII
character.
STAMP 4 Place a timestamp in the LOG with the
message contained in ADR.
RAD10 5 Print contents of ADR in decimal.
RAD08 6 Print contents of ADR in octal.
;--;=
The DEST field specifies the destination of the
message. The destination may be:
OPR Send to the operator
LOG Send to the LOG file
CTL Send to the CTL file
BOTH Send to the CTL & LOG file
ALL All three
One additional specification in the DEST field may
be NAC which inhibits the translation of Action Characters
on the TELL UUO.
;--
/
DOWN
;UUO0 -- LUUO HANDLER IS CALLED VIA PUSHJ IN .JB41, AND
; RETURNS WITH POPJ. UUO ROUTINES MAY USE ACS U1 AND
; U2 FREELY. UUO HANDLER IS RECURSIVE, BUT ANY UUO ROUTINE
; WHICH EXECUTES LUUOS MUST SAVE U1 AND U2 FIRST. THESE
; ARE SAVED BY CALLER INSTEAD OF CALLEE SINCE STAMP IS THE
; ONLY UUO WHICH USES IT.
UUO0: PUSH P,T1 ;WE NEED TWO MORE ACS
PUSH P,T2
UUO1: LDB U1,P.UOP ;GET OP-CODE
LDB U2,P.UAC ;GET AC FIELD (DESTINATION)
CAILE U1,.NMUUO ;ONE THAT WE KNOW ABOUT?
JRST UUOERR ;ILLEGAL UUO
HRRZ T1,.JBUUO ;GET E FIELD
CAIN T1,T1 ;IS THE EFFEC ADR T1?
MOVEI T1,-1(P) ;YES, POINT TO PSEUDO-T1
CAIN T1,T2 ;OR, IS IT T2?
MOVEI T1,0(P) ;YES, POINT TO PSEUDO-T2
TXNE F,F.QLOG ;QUIET LOG FILE?
TXZ U2,UU.LOG ;YES!!
TXNE F,F.QCTL ;QUIET CTL FILE?
TXZ U2,UU.CTL ;YES!!
PUSHJ P,@UUODIS-1(U1) ;DISPATCH UUO
POP P,T2 ;RETURN TO HERE AND RESTORE T2
PJRST T1POPJ ;RESTORE T1 AND RETURN TO USER
UUOERR: PUSHJ P,GETHGH ;GET THE HISEG
TELL OPR,ILU% ;FATAL ERROR
JRST ABEND ;AND GO BYE-BYE
;UUO DISPATCH TABLE
UUODIS: EXP MSGOUT ;TELL UUO
EXP SIXOUT ;TELL6 UUO
EXP CHROUT ;CHR UUO
EXP TIMSTP ;STAMP UUO
EXP DECOUT ;RAD10 UUO
EXP OCTOUT ;RAD08 UUO
.NMUUO==.-UUODIS
MSGOUT: HRLI T1,440700 ;POINTER TO ASCIZ STRING
MSGOU1: ILDB U1,T1 ;GET A CHARACTER
TXNE U2,UU.NAC ;INHIBIT ACTION CHARACTERS?
JRST MSGOU2 ;YES
CAIN U1,"^" ;ACTION CHARACTER?
PUSHJ P,ACTCHR ;YES GO PROCESS
;RETURNS HERE WITH NEXT PRINT CHAR
MSGOU2: JUMPE U1,.POPJ ;NULL MEANS END-OF-STRING
PUSHJ P,CHROU1 ;PRINT THE CHARACTER
JRST MSGOU1 ;AND LOOP FOR NEXT CHARACTER
SIXOUT: HRLI T1,440600 ;MAKE 6BIT BYTE POINTER
SIXOU1: ILDB U1,T1 ;GET A CHARACTER
ADDI U1,.ASSPC ;MAKE IT ASCII
CAIE U1,.ASSPC ;IS IT A SPACE?
PUSHJ P,CHROU1 ;NO, PRINT IT
TLNE T1,770000 ;FINISHED?
JRST SIXOU1 ;NO, LOOP AROUND FOR ANOTHER
POPJ P, ;FINISHED
OCTOUT: SKIPA U1,.POPJ ;LOAD AN 8
DECOUT: MOVEI U1,12 ;LOAD A 10
MOVE T1,(T1) ;GET NUMBER INTO T1
NUMOUT: IDIVI T1,(U1) ;DIVIDE BY RADIX
HRLM T2,(P) ;SAVE REMAINDER
SKIPE T1 ;ARE WE DONE?
PUSHJ P,NUMOUT ;NO, RECURSE
HLRZ U1,(P) ;GET LAST CHARACTER
ADDI U1,"0" ;MAKE IT ASCII
PUSHJ P,CHROU1 ;PRINT IT
POPJ P, ;UNWIND
CHROUT: MOVE U1,T1 ;GET THE CHARACTER
CHROU1: TXNE U2,UU.LOG ;GO TO LOG?
PUSHJ P,LOGOUT ;YES, PRINT IT
TXNE U2,UU.CTL ;GO TO CTL FILE
PUSHJ P,CTLOUT ;YUP, PRINT IT THERE
TXNN U2,UU.OPR ;TO OPERATOR?
POPJ P, ;NO, RETURN
TXNE F,F.SHMG ;DOES OPR WANT SHORT MESSAGES
TXNN F,F.QOPR ;YES, ARE WE PAST THE SHORT PART?
TTYO U1 ;NO, PRINT THE CHARACTER
POPJ P, ;RETURN
;^;+ACTCHR -- Routine to handle Action Characters.
; Action Characters are any characters which follow an "^"
; in an ASCIZ string printed by a TELL UUO. They
; cause certain extra information to be printed out, or flip a bit
; to determine message length for the operator.
;-;#1
;CALL:
; PUSHJ P,ACTCHR
; RETURN HERE WITH NEXT PRINTABLE CHARACTER IN U1
;
;:Action Characters are:
;: ^0 Print "CDRCNT" in decimal
;: ^1 Print "DEKCRD" in decimal
;: ^2 Print "DEKBLK" in decimal
;: ^3 Print "L.DEKN" in decimal
;: ^4 Complement F.QOPR bit
;: ^5 Print "CDRDEV" in 6bit
;: ^6 Print "FILDEV" in 6bit
;: ^7 Print "L.SWCH" in 6bit
;: ^9 Print "L.CNAM" in 6bit
;: ^A Print "L.NHOL" in decimal
;: ^B Print "FILNAM" in 6bit
;: ^C Print "FILEXT" in 6bit
;: ^D Print "FILDEV" in 6bit
;: ^E Print First SFD in path in 6bit
;: ^F Print T3 in octal
;: ^G Print "L.CMD" in 6bit
;: ^H Print "L.QFN" in 6bit
;: ^I Print the monitor prompt character
;: ^J Print jobname in 6bit
;: ^K Print L.FNNM in 6bit
;#5
ACTCHR: ILDB U1,T1 ;GET ACTION CHARACTER
CAIL U1,"A" ;IS IT A LETTER?
SUBI U1,"A"-"9"-1 ;YES, MAKE LETTERS FOLLOW NUMBERS
SUBI U1,"0" ;MAKE A BINARY NUMBER
SKIPL U1 ;LESS THAN 0 IS ILLEGAL
CAILE U1,.NMACT ;GREATER THAN ACTNUM IS ILLEGAL
JRST UUOERR ;TELL HIM
PUSH P,U2 ;SAVE U2
LSH U2,^D23 ;PUT DESTINATION IN AC FIELD
MOVE U1,ACTTBL(U1) ;GET THE SPECIAL ACTION
TLNE U1,700000 ;IT IS A UUO?
SKIPA U2,U1 ;NO, GOT OPERATION INTO U2
IOR U2,U1 ;YES, OR IN DESTINATION
XCT U2 ;DO THE ACTION
POP P,U2 ;RESTORE U2
ILDB U1,T1 ;GET THE NEXT CHARACTER
CAIN U1,"^" ;ANOTHER ACTION CHARACTER
JRST ACTCHR ;YES, LOOP AROUND
POPJ P, ;NO - RETURN
ACTTBL: RAD10 CDRCNT ;^0
RAD10 DEKCRD ;^1
RAD10 DEKBLK ;^2
RAD10 L.DEKN ;^3
TXC F,F.QOPR ;^4
TELL6 CDRDEV ;^5
TELL6 FILDEV ;^6
TELL6 L.SWCH ;^7
CHR (C) ;^8
TELL6 L.CNAM ;^9
RAD10 L.NHOL ;^A
TELL6 FILNAM ;^B
TELL6 FILEXT ;^C
TELL6 FILDEV ;^D
TELL6 Q.IDDI+1(Q) ;^E
RAD08 T3 ;^F
TELL6 L.CMD ;^G
TELL6 L.QFN ;^H
CHR MONPRT ;^I
TELL6 Q.JOB(Q) ;^J
TELL6 L.FNNM ;^K
.NMACT==.-ACTTBL
;:TIMSTP -- Routine to place a TIMESTAMP in the LOG file.
;:
;:TIMESTAMP is of the form:
;: HH:MM:SS<SPACE>STxxx<TAB>
;:
;&Where HH:MM:SS is the current time, and STxxx is the
;& stamp specified as the effective address of
;& the STAMP UUO.
;&
;:STAMPS are:
;: STDAT -- DATE,SYSTEM NAME,SPRINT VERSION,DEVICE
;: STMSG -- ANY SPRINT NON-ERROR MESSAGE
;: STERR -- ANY SPRINT ERROR MESSAGE
;: STCRD -- ANY SPRINT CONTROL CARD
;: STOPR -- ANY ACTION BY OR MESSAGE FROM THE OPERATOR
;: STSUM -- SUMMARY AT THE END
TIMSTP: PUSH P,T1 ;SAVE STAMP ADDRESS
MSTIME T1, ;GET TIME OF DAY
IDIV T1,[15567200] ;DIV BY #MS/HR =1000*60*60 (DEC)
CAIGE T1,^D10 ;GREATER THAN 10?
CHR LOG,"0" ;NO, PAD IT
RAD10 LOG,T1 ;PRINT THE HOURS
MOVE T1,T2 ;GET THE REMAINDER INTO T1
CHR LOG,":" ;PUT IN A COLON
IDIVI T1,165140 ;DIV BY #MS/MIN =1000*60 (DEC)
CAIGE T1,^D10 ;GREATER THAN 10?
CHR LOG,"0" ;NO, PAD IT
RAD10 LOG,T1 ;AND PRINT THE NUMBER
CHR LOG,":" ;AND A COLON
MOVE T1,T2 ;GET REMAINDER INTO T1
IDIVI T1,^D1000 ;DIV BY #MS/SEC
CAIGE T1,^D10 ;CHECK FOR PADDING
CHR LOG,"0" ;PAD IT
RAD10 LOG,T1 ;PRINT SECS
POP P,T1 ;GET THE STAMP BACK
CHR LOG,.ASSPC ;PRINT A SPACE
TELL6 LOG,(T1) ;PRINT IT
CHR LOG,.CHTAB ;TAB
POPJ P, ;AND RETURN
SUBTTL LOG File Handler
COMMENT /
;^;=
Since numerous timing problems exist as to where and when
to create the LOG file, the LOG is handled differently
from the CTL File.
At the top of the main program loop, LOGINI is called
to initalized various parameters for the LOG, and put in the
introductory message. At this time, the LOG is neither
OPENed nor ENTER'ed, and this is flagged by location
LOGBH containing 0. All messages typed-in the
LOG are deposited in the buffer. When the buffer is full
and the LOG is not ENTER'ed, another buffer
is tacked on the end. Once the LOG is ENTER'ed, the
output routine uses all the buffers that have been allocated, and outputs
them normally when they are full. At the end, the remaining characters
in the buffer are written out.
The LOG is handled this way since it is desirable
to put messasges in the LOG (e.g. $JOB card, switch
errors etc.) before it is ENTER'ed (which must be done after
the PPN and Password have been verified).
;--
/
LOGOUT: SOSG LOGBC ;DECREMENT BYTE COUNT AND SKIP IF ROOM
PUSHJ P,LOGUUO ;NO ROOM
IDPB U1,LOGBP ;DEPOSIT THE BYTE
POPJ P, ;AND RETURN
LOGUUO: PUSH P,U1 ;SAVE U1
SKIPL LOGBH ;IS THE LOG OPEN AND ENTERED?
JRST LOGUU1 ;NO, APPEND ON ANOTHER BUFFER
OUT LOG,LOGIOW ;OUTPUT THE BUFFER
SKIPA ;NO ERROR
JRST IOERR ;ERROR!!
HRRZ U1,LOGAD ;GET START ADR OF BUFFER
HRLI U1,440700 ;AND MAKE A BYTE POINTER
MOVEM U1,LOGBP ;AND STORE IT
HLRZ U1,LOGAD ;GET NUMBER OF BUFFERS
IMULI U1,1200 ;CONVERT TO # OF CHARS
MOVEM U1,LOGBC ;STORE BYTE COUNT
PJRST U1POPJ ;RESTORE U1 AND RETURN
;HERE IF WE RUN OUT OF SPACE BEFORE THE LOG IS OPEN, ADD IN A NEW BUFFER
LOGUU1: MOVSI U1,1 ;GET XWD 1,,0
ADDM U1,LOGAD ;MAKE 1 MORE BUFFER
PUSH P,T1 ;SAVE T1
MOVEI T1,200 ;GET NUMBER OF WORDS PER BUFFER
PUSHJ P,EXPND ;AND GET THE CORE
POP P,T1 ;RESTORE T1
MOVEI U1,1200 ;GET # CHARS / BUFFER
MOVEM U1,LOGBC ;GIVE ME SOME MORE ROOM
HLLZ U1,LOGAD ;GET XWD BUFN,,0
IMUL U1,[-200] ;CONVERT TO -VE WORDS
HRR U1,LOGAD ;GET START ADR
SUBI U1,1 ;MINUS 1
MOVEM U1,LOGIOW ;STORE IOWD
CLEARM LOGIOW+1 ;AND SET END-OF-COMMAND-LIST
U1POPJ: POP P,U1 ;RESTORE U1
POPJ P, ;AND RETURN
;CLSLOG IS CALLED TO WRITE OUT WHAT'S IN THE BUFFER AND CLOSE
;THE LOG FILE OFF. IT'S IN THE HISEG SINCE IT'S ONLY CALLED BY THE
;HISEG QUEUE ROUTINES.
UP
CLSLOG: TELL LOG,CRLF ;PUT IN A FINAL CRLF
HLRZ T1,LOGAD ;GET NUMBER OF BUFFERS
IMULI T1,1200 ;GET TOTAL NUMBER OF CHARS
SUB T1,LOGBC ;SUBTRACT WHATS LEFT
CLEAR T3, ;MAKE A NULL FOR FINISHING THE LAST WORD
IDIVI T1,5 ;AND CONVERT TO WORDS
JUMPE T2,CLSLG1 ;JUMP IF DIVISION IS EXACT
AOS T1 ;ELSE COUNT THE PARTIAL WORD
JRST .(T2) ;AND FILL IN THE LAST WORD WITH NULLS
IDPB T3,LOGBP ;REM=1 DEPOSIT 4 NULLS
IDPB T3,LOGBP ;REM=2 DEPOSIT 3 NULLS
IDPB T3,LOGBP ;REM=3 DEPOSIT 2 NULLS
IDPB T3,LOGBP ;REM=4 DEPOSIT 1 NULL
CLSLG1: JUMPE T1,CLSLG2 ;JUMP TO THE "RELEAS" IF ZERO.
MOVNS T1 ;GET NEGATIVE WORDS
HRLM T1,LOGIOW ;AND STORE IN IOWD WORD
OUT LOG,LOGIOW ;DO THE OUTPUT
SKIPA ;SKIP IF IT WINS
JRST IOERR ;PUNT IF IT LOSES
IFN FTJSYS,<
MOVE T1,[3,,T2] ;3 ARGS STARTING IN T2
MOVE T2,[LOG,,5] ;CHANNEL,,FUNCTION
MOVE T3,[POINT 7,L.QUE+Q.LSTR]
MOVE T4,[111110,,1] ;JFNS FLAGS
COMPT. T1, ;CONVERT NAME TO STRING
JRST CLSLG2 ;NO, STRING (I HOPE)
MOVX T1,1B15 ;MAGIC TEMP FLAG FOR STRING
IORM T1,Q.LMOD(Q) ;SET IT FOR QMANGR
> ;END IFN FTJSYS
CLSLG2: RELEAS LOG, ;RELEAS THE LOG
CLEARM LOGBH ;TURN OFF "OPENED AND ENTERED" FLAG
CLEARM LOGBC ;FORCE BUFFER CREATION
POPJ P, ;AND RETURN
DOWN ;AND DOWN WE GO
SUBTTL Control File I/O
CTLOUT: SOSG CTLBC ;ANY ROOM?
PUSHJ P,CTLUUO ;NO, DUMP SOME
IDPB U1,CTLBP ;DEPOSIT BYTE
POPJ P, ;AND RETURN
CTLUUO: OUT CTL, ;THIS ONE IS EASY
POPJ P, ;WIN!
IOERR: TELL OPR,IOE% ;IOERROR
JRST ABEND ;UNRECOVERABLE
SUBTTL Job Setup and Idle Loop
SETUP: OFF F.FATE!F.KILL!F.EOF ;CLEAR SOME BITS
TXNE F,F.GTIN ;DO I HAVE THE CDR?
JRST SETUP1 ;YES, CONTINUE
PUSHJ P,GETIND ;NO, GET INPUT DEVICE
JRST IDLE ;CAN'T GET IT, TRY AGAIN LATER
SETUP1: MOVE T1,P.DFBP ;GET THE DEFAULT MODE
MOVEM T1,L.DHOL ;SAVE AS DEFAULT
MOVEM T1,L.CHOL ;SAVE FOR READ ROUTINE
TXZE F,F.NXT ;GOT NEXT CARD ALREADY?
JRST SETUP2 ;YES, SKIP THE INPUT
SETUPR: PUSHJ P,CDRASC ;GET A CARD
JRST IDLE ;JOBINT!! (OR AN EXTRA EOF CARD)
SETUP2: MOVE T1,L.SPBP ;GET SUPPRESS BYTE POINTER
CAMN T1,P.CL1A ;ALL BLANKS?
JRST SETUPR ;YES, SKIP THIS CARD
ON F.BUSY ;I'M BUSY
PUSHJ P,SETLOW ;SETUP LOWSEG STORAGE
PUSHJ P,MAIN ;GO DO A JOB
OFF F.BUSY!F.KILL!F.FATE ;NOT BUSY
MOVE T1,CDRJFF ;RECLAIM ALL BUT CDR BUFFERS
PUSHJ P,SHRINK ;AND SHRINK BACK
TXZN F,F.EOF ;WAS EOF SEEN?
JRST SETUP3 ;NO, SKIP DSK CHECK
TXNE F,F.DSK!F.MTA ;IS INPUT DEVICE A DSK OR MTA?
SETRES: ON F.DRES ;YES, DUMMY UP A RESET
SETUP3: TXNN F,F.DCOM ;ANY DEFERRED COMMANDS?
JRST SETUP ;NO, JUST LOOP AROUND
PUSHJ P,GETHGH ;YES, GET THE HISEG
PUSHJ P,DODEF ;AND DO THE COMMANDS
JRST SETUP ;GO LOOP AGAIN
IDLE: TXNN F,F.ICDR ;IS INPUT FROM CARD-READER?
JRST SETRES ;NO, DO A RESET
TXZE F,F.EOF ;WAS IT AN EXTRA EOF?
JRST SETUP ;YES, TRY AGAIN
PUSHJ P,RELHGH ;RELEAS THE HISEG
RELEAS CDR, ;GET RID OF INPUT DEVICE
OFF F.GTIN ;AND CLEAR GTIN FLAG
MOVE T1,CDRJFF ;LOAD "LOGICAL" TOP OF CORE
PUSHJ P,SHRINK ;AND SHRINK TO IT
PUSHJ P,HIBR10 ;GO SLEEP
PUSHJ P,CHKOPR ;SEE IF OPR SAID SOMETHING
JRST SETUP ;AND TRY FOR ANOTHER JOB
;RESTRT -- PROGRAM RESTART ROUTINE
; THE ADDRESS OF THIS ROUTINE IS PLACED IN .JBSA
; AT INITIALIZATION TIME TO ALLOW THE USER TO TYPE
; '^C ^C START' TO SPRINT WHETHER OR NOT THE HISEG IS
; IN CORE.
RESTRT: PUSHJ P,GETHGH ;GET THE HISEG
JRST SPT1 ;RESTART!!
;SETLOW -- ROUTINE TO SETUP LOWSEGMENT STORAGE FOR EACH JOB
SETLOW: PUSHJ P,GETHGH ;GET MY HISEG
MOVE T1,[LOWZER,,LOWZER+1]
CLEARM LOWZER ;FIRST ALL THE PRE-ZEROED LOCS
BLT T1,LOWZND ;ZAP!
MOVE T1,[PREHGH,,PRELOW]
BLT T1,PRELND ;AND THEN ALL THE PRE-SET LOCS
POPJ P,
SUBTTL Main Program Loop
COMMENT \
;^;=
Main Program Loop
The main program loop is entered with the first card in the line
buffer L.CARD. This card was read by the SETUP routine while
polling the card-reader for input. Flow of control is as follows:
;--;++
------------------------ ------------------------
/SEE IF CARD IS VALID / / FLUSH AND CREATE /
/ JOB STARTER /----NO---->/ SPTERR.LOG /
------------------------ ------------------------
!
V
------------------------
-->/ GET A CARD /<-----------------------
^ ------------------------ ^
! ! !
! V !
! ------------------------- ------------------------
! / START WITH A $ ? /----NO---->/PUT CARD IN CTL FILE /<--
! ------------------------- ------------------------ ^
! ! !
! V !
! ------------------------ !
! /GET SECOND COLUMN / !
! ------------------------ !
! ! !
! V !
! ------------------------ !
! /IS IT A LETTER (A-Z) ? /-------NO-------------------------------
! ------------------------
! !
! V
! ------------------------
! / DISPATCH CONTROL CARD /
! ------------------------
! !
! V
! ------------------------ -----------------------
! /EOF SEEN OR KILL TYPED?/----YES---->/FINISH OFF JOB & RET /
! ------------------------ -----------------------
! !
! V
! ------------------------ -----------------------
^--/FATAL ERROR DETECTED? /----YES---->/GO ABORT JOB & RET /
------------------------ -----------------------
;--
\
;MAIN -- MAIN PROGRAM LOOP
MAIN: PUSHJ P,GETHGH ;GET THE HISEGMENT
PUSHJ P,LOGINI ;INITIALIZE THE LOG FILE
PUSHJ P,STRTJB ;SEE IF WHAT WE JUST READ WAS A REASONABLE
; WAY OF STARTING A JOB
JRST NTAJOB ;I GUESS NOT
TXZE F,F.FATE!F.FFOR ;DID WE LOSE, OR IS IT A FFS JOB?
POPJ P, ;YES JUST RETURN
MAIN0: PUSHJ P,RELHGH ;GET RID OF HISEG
MAIN1: PUSHJ P,CDRASC ;GET A CARD
PJRST ENDJOB ;END OF FILE = END OF JOB
MAIN1A: PUSHJ P,FSUPR ;SUPRESS TRAILING BLANKS
LDB T1,P.CL1A ;GET COLUMN 1
CAIE T1,"$" ;CONTROL CARD?
JRST MAIN6 ;NO, MUST BE AN ERROR
LDB T1,P.CL2A ;GET SECOND COLUMN
CAIL T1,"A" ;SEE IF SECOND LETTER IS ALPHABETIC
CAILE T1,"Z" ;BETWEEN A AND Z
JRST MAIN5 ;NO, EITHER A COMMENT OR AN ERROR
PUSHJ P,CONTRL ;PROCESS CONTROL CARD
PJRST MAIN4 ;HE LOSES
TXNE F,F.EOF ;EOF ENCOUNTERED SOMEWHERE?
PJRST ENDJOB ;YUP, FINISH IT OFF
TXNE F,F.KILL ;WAS KILL TYPED?
PJRST KILJOB ;YES, DO IT!!
TXNE F,F.FATE ;DID HE GET A FATAL ERROR?
PJRST ABORT ;YES, KILL HIM
TXZE F,F.NXT ;GOT NEXT CARD ALREADY?
JRST MAIN1A ;YES, SKIP THE READ
JRST MAIN1 ;AND GO READ ANOTHER
MAIN4: TXZE F,F.NEOF ;DID HE FORGET EOF
POPJ P, ;YES, RETURN
PJRST ABORT ;NO, HE JUST LOST
MAIN5: CAIE T1,"!" ;EXCLAIM?
IFN FTUUOS,<
CAIN T1,";" ;OR SEMI?
SKIPA ;YES, IT'S A COMMENT
> ;END IFN FTUUOS
JRST MAIN6 ;NO, IT'S AN ERROR
STAMP STCRD ;STAMP THE LOG
TELL LOG!NAC,L.CARD ;PUT IT IN THE LOG
MOVX T1,<"!">B6 ;LOAD AN EXCLAIM
MOVX T2,177B6 ;LOAD A MASK
ANDCAM T2,L.CARD ;TURN OFF CHAR 1
IORM T1,L.CARD ;AND MAKE IT AN EXCLAIM
TELL CTL!NAC,L.CARD ;AND WRITE THE COMMENT INTO CTL FILE
JRST MAIN1 ;AND LOOP AROUND
MAIN6: PUSHJ P,ILLCRD ;GIVE THE MESSAGE
PJRST ABORT ;AND ABORT HIM
;HERE TO CHECK THE FIRST CARD OF A DECK TO SEE IF ITS WHAT I WANT
;RETURNS NON-SKIP IF CARD ISN'T A STARTER, AND SKIP IF IT WAS,
;WITH F.FATE ON IF AN ERROR OCCURED.
STRTJB: MOVEI T1,1 ;LOAD A ONE
MOVEM T1,CDRCNT ;AND SAVE AS CARD COUNT
MOVE T1,L.CARD ;LOAD FIRST FIVE CHARACTERS
TRZ T1,377 ;ZAP THE LAST CHARACTER
CLEAR T2, ;PLACE FOR DISPATCH ADDRESS
CAMN T1,C.JOB ;JOB CARD?
MOVEI T2,$JOB ;YES, LOAD ADR OF JOB CARD ROUTINE
CAMN T1,C.SEQ ;SEQUENCE CARD?
MOVEI T2,$SEQ ;YES, HANDLE $SEQ CARD
CAMN T1,C.EOJ ;IS IT AN $EOJ CARD?
MOVEI T2,.POPJ ;YES, CAUSE A PLAIN RETURN
PJUMPE T2,.POPJ ;RETURN IF NO MATCH
PUSHJ P,(T2) ;DISPATCH
ON F.FATE ;AN ERROR WAS FOUND
MOVE T1,P.DFBP ;GET DEFAULT BYTE POINTER
MOVEM T1,L.CHOL ;AND STORE IT
PJRST .POPJ1 ;SKIP BACK
;HERE WHEN THE FIRST CARD OF A DECK IS NOT WHAT I WANT. I.E., NOT
;A $SEQ OR $JOB.
;CREATE A LOG FILE CALLED SPTERR.LOG AND QUEUE IT TO THE OPR.
NTAJOB: PUSHJ P,SETQUE ;SETUP QUEUE AREA
LDB T1,[POINT 4,CDRDEV,23]
LDB T2,[POINT 4,CDRDEV,29] ;GET 1ST AND 2ND DIG OF PHYS CDR
SKIPN T2 ;SECOND DIGIT 0?
EXCH T1,T2 ;YES, MAKE IT 0N
LSH T1,6 ;MOVEIT OVER 6 BITS
TRO T1,2020(T2) ;MAKE IT SIXBIT NN
IOR T1,['SPTE '] ;AND THE REST OF THE NAME
MOVEM T1,Q.LNAM(Q) ;MAKE IT THE LOG-FILE NAME
PUSHJ P,NOJOB ;MAKE THE LOG FILE
STAMP STERR ;STAMP AN ERROR
TELL LOG,IJC% ;ILL JOB CARD
TELL LOG,[ASCIZ / Card= /]
TELL LOG!NAC,L.CARD ;PUT THE FIRST CARD IN
;[1055] NTAJOB+21 1/2 JHT 3/5/75
SKIPL L.MSGL ;DOES OPR WANT TO SEE THIS?
JRST NTAJB1 ; NO, PROCEED
TELL OPR,IJC% ;YES, GIVE 'ILLEGAL JOB CARD'
TXNE F,F.SHMG ;TEST LONG AND SHORT OF IT
JRST NTAJB1 ; NOT INTERESTED IN DETAIL
TELL OPR,[ASCIZ / Card= /]
TELL OPR,L.CARD ;GIVE HIM THE FIRST CARD
NTAJB1: PUSHJ P,FLUSH ;FLUSH 'EM
PJRST QUELOG ;AND QUE THE LOG
SUBTTL Routine to OPEN the Input Device
;GETIND -- ROUTINE TO OPEN THE INPUT DEVICE
; ENTER WITH THE DEVICE CONTROL CELLS LOADED WITH THE
; NECESSARY INFORMATION, DEVNAM,DEVMOD...
;
;CALL:
; PUSHJ P,GETIND
; RETURN HERE IF DEVICE CAN'T BE OPENED
; RETURN HERE WITH DEVICE OPEN ON CHANNEL CDR
;
;IF INPUT FILE IS NOT READABLE (FNF OR PROT FAIL) GETIND CAUSES SPRINT
;TO GO BACK INTO RESET STATE.
GETIND: MOVEI T3,CDRBH ;INPUT BUFFER RING HEADER
MOVEM T3,CDROPN+2 ;SAVE IN OPEN BLOCK
OPEN CDR,CDROPN ;OPEN THE DEVICE
JRST GTIND9 ;CAN'T DO IT
ON F.GTIN ;I'VE GOT IT
IFN FTJSYS,<
MOVE T1,[1,,T2] ;1 ARG IN T2
MOVE T2,[CDR,,10] ;CHANNEL,,FUNCTION
COMPT. T1, ;GET THE JFN OF THE DEVICE
JFCL
MOVEM T1,L.JFN ;AND SAVE IT
> ;END IFN FTJSYS
SETOM L.NTRY ;CLEAR NTRY FLAG
MOVE T1,CDRBUF ;LOAD ADDRESS OF BUFFERS
MOVE T2,CDRBFN ;LOAD NUMBER OF BUFFERS
EXCH T1,.JBFF ;FAKE OUT THE MONITOR
INBUF CDR,(T2) ;GET THE BUFFERS ALLOCATED
MOVEM T1,.JBFF ;SAVE JOBFF AGAIN
TXNE F,F.LCDR!F.MTA ;IS IT LOCAL CDR OR MTA?
PJRST .POPJ1 ;YES, RETURN SUCCESSFULLY
TXNE F,F.DSK ;IS IT A DSK?
JRST GTIN1A ;YES, GO DO THE LOOKUP
MOVSI T1,1400 ;MUST BE REMOTE CDR, LOAD BYTE SIZE
MOVEM T1,CDRBP ;SIZE IN BYTE-POINTER
PJRST .POPJ1 ;AND RETURN
GTIN1A: MOVE T1,CDRNAM ;GET INPUT FILENAME
MOVE T2,CDREXT ;GET INPUT FILE EXTENSION
CLEAR T3,
MOVE T4,CDRPPN ;GET PPN OR PATH BLOCK
LOOKUP CDR,T1 ;LOOKUP THE FILE
JRST GTIND8 ;FNF??
SKIPN T2,CDRPPN ;GET INPUT FILE'S PPN
MOVE T2,L.MYPP ;USE MINE INSTEAD
TLNE T2,-1 ;IS IT XWD 0,ADR
JRST GTIN1B ;NO, ITS A PPN
MOVE T2,2(T2) ;GET PPN FROM PATH BLOCK
;**;[1064] CHANGE @ GTIN1B JNG 24-Jul-75
GTIN1B: LDB T1,P.LPRT ;GET FILES PROTECTION
HRLI T1,.ACRED ;GET ACCESS CODE
MOVE T3,L.MYPP ;[1064] GET MY PPN
MOVE T4,CDRDEV ;GET DEVICE NAME
DEVPPN T4, ;GET A PPN FOR IT
MOVE T4,L.MYPP ;DEFAULT TO MY OWN
CAME T4,L.MYPP ;IS IT MINE?
MOVE T2,T4 ;NO, USE IT
MOVEI T4,T1 ;LOAD ADR OF CHKACC BLOCK
CHKACC T4, ;DO THE CHKACC
CLEAR T4, ;IF CHKACC LOSES, HE WINS
JUMPE T4,.POPJ1 ;WIN!! I CAN READ IT
MOVEI T1,ERPRT% ;PROTECTION FAILURE
JRST GTIN8A ;CLEAN UP AND WAIT
GTIND8: HRRZ T1,T2 ;GET ERROR CODE
GTIN8A: PUSHJ P,ENTERO ;TYPE ENTER/LOOKUP ERROR
JRST SPT1 ;AND RESET THE WHOLE WORLD
GTIND9: AOSG L.NTRY ;DON'T KEEP TYPING TO HIM
TELL OPR,[ASCIZ /[Device ^5 is Not Available]
/]
POPJ P, ;AND RETURN
SUBTTL Control Cards -- Setup and Dispatch
;CONTRL -- ROUTINE TO INTERPRET AND DISPATCH CONTROL CARDS
;
;CALL:
; PUSHJ P,CONTRL
; RETURN HERE ON FATAL ERROR
; RETURN HERE OTHERWISE
CONTRL: PUSHJ P,$EOD ;CLOSE OUT FILE IN PROGRESS
JFCL ;WON'T GET HERE
MOVEI T1,DEVFIL ;LOAD ADR OF DEVICE CELLS
PUSHJ P,CLRCEL ;AND CLEAR THEM
MOVEI T1,CDRCHR ;ROUTINE TO LOAD A BYTE
MOVEM T1,L.SCIN ;STORE IT
MOVEI T1,CDRNXT ;ROUTINE TO GET A RECORD
MOVEM T1,L.SCLN ;AND STORE IT
MOVE B,P.CL1A
CLEARM L.CNAM ;CLEAR FOR NEXT TIME
PUSHJ P,S$SIX ;PICK-UP KEYWORD
JRST ILLCRD ;ILLEGAL CONTROL CARD
ON F.RSCN ;RESCAN THE BREAK LATER ON
MOVEM T1,L.CNAM ;IN CASE OF ERROR NOW!
MOVEI T2,CARDS ;TABLE OF LEGAL KEYWORDS
HRLI T2,-.NMCCR ;XWD -TABLE LENGTH,TABLE ADR
PUSHJ P,UNIQ6 ;GET A MATCH
JRST ILLCRD ;NO MATCH
MOVE P1,CARDS(T1) ;GET CARD NAME
MOVEM P1,L.CNAM ;AND SAVE IT
MOVE P1,CADRS(T1) ;GET DISPATCH ADDRESS
TLNE P1,(CD.BTC) ;THIS CARD NEED THE BATCH BIT?
ON F.BTCH ;YES, TURN IT ON!
TLNE P1,(CD.CLO) ;CLEAR THE LOAD ORDER?
PUSHJ P,FBCLOD ;YUP!!
TLZ P1,-1 ;ZAP ALL THE BITS
CAIE P1,NOEOF ;IS CARD FOR NEXT JOB,
CAIN P1,PASCRD ;OR IS IT A PASSWORD CARD?
PJRST (P1) ;YES, DON'T PRINT IT INTO LOG, DISPATCH
STAMP STCRD ;STAMP THE LOG
TELL LOG!NAC,L.CARD ;AND PRINT THE CARD
HRRZ T1,L.MSGL ;GET MSGLVL
CAIN T1,2 ;WANT TO SEE ALL CONTROL CARDS?
TELL OPR!NAC,L.CARD ;YES, SHOW HIM
PJRST (P1) ;DISPATCH TO CORRECT ROUTINE
ILLCRD: STAMP STCRD ;CARD STAMP
TELL LOG!NAC,L.CARD ;AND THE CARD
MOVEI T1,ICC% ;ADDRESS OF MESSAGE
PJRST LOGERR ;PRINT IT AND RETURN
;DEFINE TABLE OF CONTROL CARD NAMES
; X CARD,DISPATCH ADR,DISPATCH BITS
;
;WHERE DISPATCH BITS ARE:
CD.BTC==1B0 ;THIS CARDS TURNS THE BATCH BIT ON
CD.CLO==1B1 ;CLEAR LOAD ORDER ON THIS CARD
CD.LAN==CD.BTC!CD.CLO ;DISPATCH BITS FOR ALL $LANG CARDS
DEFINE CNAMES,<
X FORTRAN,$FORTRAN,CD.LAN,
X COBOL,$COBOL,CD.LAN,
X10 DECK,$DECK,,
X CREATE,$CREAT,,
X10 F40,$F40,CD.LAN,
X MACRO,$MACRO,CD.LAN,
X MODE,$MODE,,
X DATA,$DATA,CD.BTC,
X EOD,$EOD,,
X ALGOL,$ALGOL,CD.LAN,
X BLISS,$BLISS,CD.LAN,
X EXECUTE,$EXEC,CD.BTC,
X10 RELOCATABLE,$RELOC,CD.CLO,
X10 DUMP,$DUMP,CD.BTC,
X SNOBOL,$SNOBOL,CD.LAN,
X ERROR,$ERROR,CD.BTC,
X NOERROR,$NOERR,CD.BTC,
X INCLUDE,$INCL,CD.CLO,
X JOB,NOEOF,,
X SEQUENCE,NOEOF,,
X PASSWORD,PASCRD,,
X EOJ,$EOJ,,
X MESSAGE,$MESS,,
X10 TOPS10,$TOPS,CD.BTC,
IFN FTJSYS,<
X TOPS20,$TOPS,CD.BTC,
>
>
DEFINE X(A,B,C),<
XLIST
<SIXBIT /A/>
LIST
SALL>
DEFINE X10(A,B,C),<
IFN FTUUOS,<
X(A,B,C)
>
>
CARDS: CNAMES
.NMCCR==.-CARDS
DEFINE X(..A,..B,..C),<
XLIST
EXP ..B+..C
LIST
SALL>
DEFINE X10(..A,..B,..C),<
IFN FTUUOS,<
X(..A,..B,..C)
>
>
CADRS: CNAMES
;SWITCH TABLES
;VALID SWITCHES FOR ALL CARDS EXCEPT $JOB CARD
; Y SWITCH NAME,DISPATCH ADR,VALID CARD FLAGS
;
;WHERE VALID CARD FLAGS ARE:
SW.LAN==1B18 ;LANGUAGE CARDS
SW.DEC==1B20 ;$DECK CARD
SW.MOD==1B21 ;$MODE CARD
SW.DAT==1B22 ;$DATA CARD
SW.EXE==1B24 ;$EXECUTE CARD
SW.INC==1B25 ;$INCLUDE CARD
SW.JOB==1B26 ;$JOB CARD
SW.TOP==1B27 ;$TOPS10 CARD
SW.ALL==SW.LAN!SW.DEC!SW.MOD!SW.DAT!SW.TOP
DEFINE SNAMES,<
Y ASCII,SW.ALL
Y10 026,SW.ALL
Y10 BCD,SW.ALL
Y10 BINARY,SW.DEC!SW.DAT
Y IMAGE,SW.DEC!SW.DAT
Y SUPPRESS,SW.ALL
Y NOSUPPRESS,SW.ALL
Y WIDTH,SW.ALL
Y SEARCH,SW.INC
Y PRINT,SW.DEC
Y10 CPUNCH,SW.DEC
Y10 TPUNCH,SW.DEC
Y10 PLOT,SW.DEC
Y NOLIST,SW.LAN
Y CREF,SW.LAN
Y MAP,SW.DAT!SW.EXE
Y LIST,SW.LAN
Y NOMAP,SW.DAT!SW.EXE
Y DOLLAR,SW.ALL
Y NODOLLAR,SW.ALL
Y10 PROTECT,SW.DEC
>
DEFINE Y10(A,B),<
IFN FTUUOS,<
Y(A,B)
>>
DEFINE Y(A,B),<
XALL
<SIXBIT /A/>
SALL>
SWTCH: SNAMES
.NMSW==.-SWTCH
DEFINE Y(A,B),<
XLIST
XWD B,W$'A
LIST
SALL>
SADRS: SNAMES
SUBTTL Control Cards -- $language
;The LANGS macro is used to define all the $language
; cards which will be accepted by SPRINT. The format
; for each language in the macro is:
;
; L <entry-point>,<default-extension>,<COMPIL switch>,<code>
;
;where <code> is one of:
;
; I Interpreter -- No REL file
; R Compiler -- Generates a REL file
DEFINE LANGS,<
L $SNOBOL,SNO,SNO,I
L $BLISS,BLI,BLI,R
L $ALGOL,ALG,ALG,R
L $COBOL,CBL,COB,R
L $MACRO,MAC,MAC,R
IFN FTUUOS,<
IFN FTF10&1,<
L $FORTRAN,FOR,F10,R
>
IFE FTF10&1,<
L $FORTRAN,F4 ,F40,R
>
IFN FTF10&2,<
L $F40,FOR,F10,R
>
IFE FTF10&2,<
L $F40,F4 ,F40,R
>
>
IFN FTJSYS,<
L $FORTRAN,FOR,FOR,R
>
> ;END DEFINE LANGS
;GENERATE ENTRY POINTS
DEFINE L(A,B,C,D),<
IFIDN <D> <R> ,<
A: HRRZI T1,K
JRST $LANG
K=K+1>
IFIDN <D> <I> ,<
A: HRROI T1,K
JRST $LANG
K=K+1>
>
K=0
LANCRD: LANGS
;NOW GENERATE TABLE OF EXTENSION,,COMPILE SWITCH
DEFINE L(A,B,C,D),<
<SIXBIT /B/>(<SIXBIT /C/>)
>
EXTTBL: LANGS
$LANG: MOVEM T1,L.LANG ;SAVE THE INDEX
HLLZ T2,EXTTBL(T1) ;GET THE DEFAULT EXTENSION
MOVEM T2,FILEXT ;AND SAVE IT
PUSHJ P,GETFS ;GET A FILESPEC
POPJ P, ;FILESPEC ERROR
MOVEI T1,'LN' ;GET 2 CHAR PREFIX
PUSHJ P,MAKFUN ;AND DO FUNNY NAME STUFF
SKIPL FILSTS ;FUNNY NAMED?
JRST $LANG2 ;NO, HE SPECIFIED ONE
MOVX T1,FB.LDR!FB.DLR;LOAD THE REL AND DELETE BOTH
SKIPGE L.LANG ;IS IT AN INTERPRETER?
MOVX T1,FB.DEL ;YES, JUST DELETE THE SOURCE
SETZM FILPRV ;CLEAR PROTECTION
PUSHJ P,FILENT ;ENTER THE FILE
POPJ P, ;LOSE...
JRST $LANG3 ;MEET AT THE PASS
$LANG2: MOVX T1,FB.LDR ;LOAD THE REL FILE
SKIPGE L.LANG ;UNLESS ITS AN INTERPRETER
CLEAR T1, ;IN WHICH CASE DON'T DO ANYTHING
PUSHJ P,FBENT ;ENTER IT IN THE FILE-BLOCKS
$LANG3: TELL CTL,CLINE ;PUT IN FIRST PART OF COMPILE LINE
HRRZ T1,L.LANG ;GET LANGUAGE INDEX
HRLZ T1,EXTTBL(T1) ;GET COMPIL SWITCH
TELL6 CTL,T1 ;AND SEND IT
CHR CTL,.ASSPC ;AND A SPACE
MOVEI T1,DEVFIL ;ADDRESS OF FILE-DEVICE CELLS
PUSHJ P,TFLCTL ;AND TYPE A FILESPEC
ON F.RSCN ;RESCAN LAST CHARACTER
PUSHJ P,.SCFLS ;AND FLUSH LEADING SPACES
JRST $LANG8 ;EOL, GO SEND LISTING SWITCH
CAIE C,"(" ;BEGINNING OF PROCESSOR SWITCH?
JRST $LANG7 ;NO, GO CHECK FOR SPRINT SWITCHES
CHR CTL,"(" ;YES, SEND THE OPEN PAREN
MOVEI T1,")" ;LOAD THE BREAK CHARACTER
PUSHJ P,CTLCRD ;GO TRANSFER FROM CARD TO CTL
JFCL ;IGNORE EOL (RECOVER FROM USER ERROR)
CHR CTL,")" ;TYPE THE BREAK
$LANG7: MOVEI T1,SW.LAN ;VALID SWITCHES FOR LANGUAGE CARD
PUSHJ P,SETSWC ;DO THE SWITCHES
$LANG8: TELL6 CTL,L.LSW ;PRINT THE LISTING SWITCH
TELL CTL,CRLF ;TYPE A CRILIF
SETOM L.LANG ;SET THE LANGUAGE FLAG FOR $EOD ROUTINE
SKIPL FILSTS ;IS IT FUNNY NAMED?
PJRST .POPJ1 ;NO, JUST RETURN
PJRST STDECK ;YES, GO STACK THE DECK
SUBTTL Control Cards -- $DECK - $CREATE
$CREAT: PUSHJ P,GETFS ;GET A FILESPEC
POPJ P, ;ERROR IN FILESPEC??
MOVEI T1,'CR' ;TWO CHARACTER PREFIX
JRST $DECK1 ;AND FALL IN-LINE
$DECK: PUSHJ P,GETFS ;GET A FILESPEC
POPJ P, ;ERROR IN FILESPEC??
MOVEI T1,'DK' ;TWO CHAR PREFIX
$DECK1: CLEARM FILPRV ;STANDARD PROT
PUSHJ P,MAKFUN ;AND MAKE A FUNNY NAME IF NECESSARY
MOVEI T1,SW.DEC ;LEGAL SWITCHES
PUSHJ P,SETSWC ;DO THE SWITCHES
HRRZS FILSTS ;JUST IN CASE
CLEAR T1, ;NOTHING TO REMEMBER
PUSHJ P,FILENT ;ENTER THE FILE
POPJ P, ;LOSE BIGLY
CLEARM L.LANG ;SET THE NO-LANG FLAG FOR $EOD ROUTINE
PJRST STDECK ;AND GO STACK THE DECK
SUBTTL Control Cards -- $RELOC
$RELOC: MOVSI T1,'REL' ;GET DEFAULT EXTENSION
MOVEM T1,FILEXT ;AND SAVE IT
PUSHJ P,GETFS ;GET A FILESPEC
POPJ P, ;FILESPEC ERROR
MOVEI T1,'RL' ;LOAD 2 CHARACTER PREFIX
PUSHJ P,MAKFUN ;AND MAKE A FUNNY NAME IF NECESSARY
$REL1: MOVEI T1,FB.LOD ;LOAD ON NEXT $DATA OR $EXEC
SKIPGE FILSTS ;USER-NAMED FILE?
TXO T1,FB.DEL ;NAME, DELETE AT THE END
ON F.BIN ;SET BINARY FLAG
PUSHJ P,FILENT ;ENTER THE FILE AND CREATE FILE-BLOCK
POPJ P, ;SOME KIND OF ERROR
PJRST STDECK ;AND DO STACK THE DECK
SUBTTL Control Cards -- $INCLUDE
$INCL: MOVSI T1,'REL' ;LOAD DEFAULT EXTENSION
MOVEM T1,FILEXT ;AND SAVE IT
PUSHJ P,GETFS ;GET A FILESPEC
POPJ P, ;FILESPEC ERROR
MOVE P1,FILNAM ;GET THE FILENAME
MOVEI T1,FSR% ;LOAD FSR ERROR MESSAGE
PJUMPE P1,LOGERR ;?FILESPEC REQUIRED
$INCL1: CLEARM L.SRH ;CLEAR THE SEARCH FLAG
MOVEI T1,SW.INC ;LOAD VALID SWITCH BITS
PUSHJ P,SETSWC ;AND SEARCH FOR THE SWITCH
MOVEI T1,FB.LOD ;LOAD THE "LOAD" BIT
SKIPE L.SRH ;WAS /SEARCH SPECIFIED?
MOVEI T1,FB.LOD!FB.SRH;YES, USE "LOAD" AND "SEARCH" BITS
PUSHJ P,FBENT ;GO REMEMBER THE FILE
PJRST .POPJ1 ;AND RETURN SUCCESS
SUBTTL Control Cards -- $DATA
$DATA: PUSHJ P,GETFS ;GET A FILESPEC
POPJ P, ;FILESPEC ERROR
SKIPE FILNAM ;IS IT UNNAMED?
JRST $DATA1 ;NO, SKIP THIS STUFF
PUSHJ P,FUNNY ;GET A FUNNY NAME
HRLZM T1,FILNAM ;SAVE 3 CHARACTER NAME
MOVSI T1,'CDR' ;DEFAULT EXTENSION IS CDR
MOVEM T1,FILEXT ;SAVE IT
HRROS FILSTS ;MARK IT AS NQC
$DATA1: MOVEI T1,SW.DAT ;LEGAL SWITCHES
PUSHJ P,SETSWC ;DO THE SWITCHES
$DATA2: CLEAR T1, ;CLEAR FB BITS
SKIPGE FILSTS ;IS IT NQC?
MOVEI T1,FB.DEL ;YES SET DELETE BIT
IFN FTJSYS,<
SKIPGE FILSTS ;IS IT FUNNY NAMED?
JRST $DATA5 ;YES, HANDLE SPECIAL CASE
> ;END IFN FTJSYS
PUSHJ P,FILENT ;ENTER THE FILE
POPJ P, ;BAD THING?
SKIPL FILSTS ;IS IT A NO-CHARGE FILE?
JRST $DATA3 ;NO, GO STACK
TELL CTL,SETCDR ;SET CDR LINE
$DATA3: SKIPN L.FBCT ;ANYTHING TO LOAD?
JRST $DATA4 ;NO, NOTHING TO LOAD
PUSHJ P,EXECUT ;PUT IN THE EXECUTE LINE
JFCL ;NO ERROR RETURN
PJRST STDECK ;AND DO THE STACKING
$DATA4: STAMP STERR ;STAMP THE LOG
TELL LOG,NFT% ;TELL HIM NOTHING TO LOAD
PJRST STDECK ;AND STACK THE DECK
IFN FTJSYS,<
$DATA5: SKIPE L.FNNM ;GENERATE A NAME ALREADY?
JRST $DAT5A ;YES, CONTINUE ON
PUSHJ P,FUNNY ;NO, GET 4 FUNNY CHARS
LSH T1,^D12 ;AND LEFT JUSTIFY THEM
MOVEM T1,Q.DEAD(Q) ;SAVE IN DEADLINE WORD (HACK)
MOVEM T1,L.FNNM ;SAVE FOR LATER
TELL CTL,SETCDR ;AND PUT SET COMMAND IN CTL
$DAT5A: MOVE T2,[ASCII /PS:<S/]
MOVEM T2,L.LONG
MOVE T2,[ASCII /POOL>/]
MOVEM T2,L.LONG+1
MOVE T2,[ASCII /CDR-/]
MOVEM T2,L.LONG+2
MOVE T1,[POINT 7,L.LONG+2,27] ;SETUP TO BUILD THE REST OF THE STRING
HRRZ T3,L.USNO ;GET THE USER NUMBER
PUSHJ P,$DATA6 ;CONVERT TO STRING
JRST $DATA7 ;AND CONTINUE ON
$DATA6: IDIVI T3,10 ;DIVIDE BY 8
PUSH P,T4 ;PUSH THE REMAINDER
SKIPE T3 ;DONE YET?
PUSHJ P,$DATA6 ;NO, RECURSE
POP P,T3 ;GET BACK A DIGIT
ADDI T3,"0" ;CONVERT TO ASCII
IDPB T3,T1 ;DEPOSIT IT INTO STRING
POPJ P, ;AND RETURN
$DATA7: MOVEI T3,"." ;LOAD A DOT
IDPB T3,T1 ;AND DEPOSIT IT
MOVE T2,[POINT 6,Q.JOB(Q)] ;POINT TO THE JOB NAME
PUSHJ P,$DATA8 ;DEPOSIT IN STRING
MOVE T2,[POINT 6,L.FNNM] ;POINT TO SUFFIX
PUSHJ P,$DATA8 ;AND DEPOSIT IT ALSO
JRST $DATA9 ;CONTINUE ON
$DATA8: ILDB T3,T2 ;GET A CHARACTER
JUMPE T3,.POPJ ;NULL, DONE
ADDI T3,40 ;CONVERT 6BIT TO ASCII
IDPB T3,T1 ;DEPOSIT IT
TLNE T2,770000 ;AM I DONE?
JRST $DATA8 ;NO, LOOP SOME
POPJ P, ;DONE, RETURN
$DATA9: MOVEI T3,0 ;LOAD A NULL
IDPB T3,T1 ;TERMINATE THE STRING
MOVE T2,[FIL,,1] ;ARG,,FUNCTION (CHANNEL,,FNC)
MOVEM T2,L.COMP ;STORE IN THE BLOCK
MOVX T2,GJ%FOU!GJ%SHT ;LOAD GTJFN FLAGS
MOVEM T2,L.COMP+1 ;STORE SECOND ARG
MOVE T2,[POINT 7,L.LONG] ;LOAD STRING POINTER
MOVEM T2,L.COMP+2 ;STORE AS 3RD ARG
MOVX T1,7B5 ;USE 7BIT BYTE
TXNE F,F.IMG!F.BIN ;UNLESS BINARY FILE
MOVX T1,44B5 ;THEN USE 36 BIT BYTES
TXO T1,OF%WR ;SET WRITE FLAG
MOVEM T1,L.COMP+3 ;SAVE IT
MOVEI T1,.IOASL ;LOAD ASCII LINE MODE
TXNE F,F.IMG!F.BIN ;IS IT BINARY MODE?
MOVEI T1,.IOBIN ;YES USE THAT INSTEAD
MOVEM T1,L.COMP+4 ;SAVE OPEN MODE
SETZM L.COMP+5 ;CLEAR 6TH ARG
MOVEI T2,FILBH ;GET ADR OF BUFFER RING HHDR
MOVEM T2,L.COMP+6 ;AND STORE 7TH ARG
SETZM L.COMP+7 ;0 THE LAST ARG
MOVE T1,[10,,L.COMP] ;ARG FOR COMPT.
COMPT. T1, ;AND ENTER THE FILE
HALT
MOVE T1,.JBFF ;GET JOBFF BEFORE BUFFERS
MOVEM T1,FILOFF ;SAVE IT AWAY
OUTBUF FIL,2 ;ALLOCATE BUFFERS
MOVE T1,.JBFF ;GET JOBFF
MOVEM T1,FILNFF ;SAVE JOBFF AFTER BUFFERS
JRST $DATA3 ;AND CONTINUE IN LINE
> ;END IFN FTJSYS
SUBTTL Control Cards -- $EXECUTE
$EXEC: SKIPN L.FBCT ;ANYTHING TO LOAD?
JRST $EXEC1 ;NO, TELL HIM AND RETURN
MOVEI T1,SW.EXE ;LEGAL SWITCHES
PUSHJ P,SETSWC ;GET ANY SWITCHES
PJRST EXECUT ;AND GO PUT IN EXECUTE LINE
$EXEC1: STAMP STERR ;ERROR STAMP
TELL LOG,NFT% ;NO FILES TO LOAD
PJRST .POPJ1 ;AND RETURN
;HERE THE $DATA AND $EXECUTE CARDS MERGE TO GENERATE THE
;EXECUTE COMMAND IN THE CONTROL FILE.
EXECUT: SETOM L.LOAD ;FLAG THAT WE ARE DOING A LOAD
TELL CTL,ELINE ;PUT IN THE BEGINNING OF THE LINE
TXZE F,F.MAP ;WAS /MAP SPECIFIED
TELL CTL,[ASCIN(/MAP:LPT:MAP)]
CHR CTL,.ASSPC ;AND A SPACE
CLEAR T1, ;CLEAR ARG TO FBFND
EXECT1: PUSHJ P,FBFND ;LOOP TO GET INDICES OF LOADABLE FILES
JUMPE T1,EXECT2 ;DONE, GO PRINT THEM
HRRZ T2,.FBEXT(T1) ;GET STATUS BITS
TRNN T2,FB.LOD!FB.LDR;LOADABLE?
JRST EXECT1 ;NO, LOOP FOR THE REST
ANDI T2,FB.ORD ;AND DOWN TO LOAD ORDER
MOVEM T1,L.UUBK(T2) ;SAVE FILE BLOCK ADDRESS
JRST EXECT1 ;AND LOOP AROUND
EXECT2: MOVEI P1,1 ;GET STARTING INDEX
EXECT3: MOVE P2,L.UUBK(P1) ;GET A FILE TO LOAD
CAIE P1,1 ;FIRST FILE?
CHR CTL,"," ;NO, PRINT A COMMA
MOVEI T1,.FBDEV(P2) ;LOAD ADDRESS OF FILESPEC
MOVE P4,.FBEXT(P2) ;GET STATUS BITS
MOVSI P3,'REL' ;LOAD POSSIBLE EXTENSION
TRNE P4,FB.LDR ;LOAD THIS GUY'S REL?
MOVEM P3,.FBEXT(P2) ;YES, SAVE REL EXTENSION
PUSHJ P,TFLCTL ;TYPE THE FILESPEC INTO THE CTL FILE
MOVEM P4,.FBEXT(P2) ;RESTORE STATUS BITS AND EXTENSION
TRNE P4,FB.SRH ;LOAD IN LIBRARY SEARCH MODE?
TELL CTL,[ASCIZ "/SEARCH"]
CAMGE P1,L.FBCT ;GOT THEM ALL?
AOJA P1,EXECT3 ;NO, LOOP FOR THE REST
TELL CTL,CRLF ;YES, PUT IN A CRILIF
PJRST .POPJ1 ;AND RETURN
SUBTTL Control Cards -- $ERROR - $NOERROR - $DUMP - $EOJ
$ERROR: TELL CTL,[ASCIZ /^IIF(ERROR) /]
JRST $NOER1 ;PUT IN REST OF LINE
$NOERR: TELL CTL,[ASCIZ /^IIF(NOERROR) /]
$NOER1: CLEAR T1, ;BREAK ON EOL
PUSHJ P,CTLCRD ;COPY REST OF CARD
JFCL ;IGNORE THIS
$NOER2: TELL CTL,CRLF ;CRILIF
PJRST .POPJ1 ;AND RETURN
$DUMP: HRROS L.DPCR ;AND FLAG DUMP LINE NEEDED
PJRST .POPJ1 ;AND SKIP BACK
$EOJ: ON F.NEOF ;MAKE ALL THE RIGHT THINGS HAPPEN
IFN FTJSYS,<
PUSHJ P,TSTOFF ;CHECK OFF-LINE
> ;END IFN FTJSYS
PJRST ENDJOB ;AND FINISH HIM OFF
SUBTTL Control Cards -- $MESSAGE
$MESS: CLEAR P1, ;CLEAR WAIT-NOWAIT FLAG
OFF F.RSCN ;AND TURN OFF THE RESCAN BIT
CAIE C,"/" ;IS THERE A COMMAND SWITCH?
JRST $MESS1 ;NO, NOWAIT IS DEFAULT
PUSHJ P,S$SIX ;YES, GET THE SWITCH
PJRST E$ICS ;ILLEGAL COMMAND SWITCH
MOVE T2,[-2,,['NOWAIT'
'WAIT ']]
PUSHJ P,UNIQ6 ;GET UNIQUE MATCH
PJRST E$ICS ;GUESS NOT!!
MOVE P1,T1 ;SAVE INDEX AS THE FLAG
$MESS1: TELL CTL,[ASCIN(^IMESSAGE )]
CLEAR T1, ;BREAK ON EOL
PUSHJ P,CTLCRD ;COPY THE REST OF THE CARD
JFCL
SKIPN P1 ;IS IT NOWAIT?
CHR CTL,.CHESC ;YES, PUT IN AN ESCAPE!!
TELL CTL,CRLF ;PUT IN A CRILIF
PJRST .POPJ1 ;AND SKIP BACK
SUBTTL Control Cards -- $EOD
$EOD: OFF F.IMG!F.BIN!F.DOLR
MOVE T1,L.DHOL ;LOAD THE DEFAULT BP
MOVEM T1,L.CHOL ;AND SAVE FOR THE NEXT CARD
PUSHJ P,W$LIST ;GO RESET THE LIST SWITCH
TXZN F,F.DECK ;IS THERE A DECK OPEN?
PJRST .POPJ1 ;NO, SKIP BACK
TXNE F,F.FATE ;IS THERE A FATAL ERROR?
JRST $EOD3 ;YES, DON'T CREATE THE DECK
SKIPL L.LANG ;IS IT A $DECK CARD?
JRST $EOD1 ;YES, HE CAN CREATE A NULL FILE
SKIPN DEKCRD ;ANY CARDS WRITTEN?
JRST $EOD3 ;NO, GO TELL HIM
$EOD1: STAMP STMSG ;MESSAGE STAMP
RELEAS FIL, ;OTHERWISE CLOSE IT
MOVE T1,FILNFF ;GET JOBFF AFTER BUFFERS
CAME T1,.JBFF ;ANYTHING BUILT ABOVE IT?
JRST $EOD2 ;YES, DON'T RECLAIM SPACE
MOVE T1,FILOFF ;NO, GET JOBFF BEFORE BUFFERS
MOVEM T1,.JBFF ;SAVE IT
;DON'T SHRINK CORE HERE, SINCE WE WILL
;EITHER START A NEW DECK OR END THE JOB.
$EOD2: TELL LOG,[ASCIZ /File /]
IFN FTJSYS,<
SKIPN L.LONG ;IS THIS A SPOOLED CDR FILE?
JRST $EOD2A ;NO, CONTINUE ON
TELL LOG,L.LONG ;YES, TYPE THE NAME
SETZM L.LONG ;CLEAR WORD FOR NEXT TIME
JRST $EOD2B ;AND CONTINUE ON
$EOD2A:> ;END IFN FTJSYS
MOVEI T1,DEVFIL ;BASE ADR OF FILE CONTROL CELLS
PUSHJ P,TFLLOG ;TYPE FILESEPC INTO THE LOG
IFN FTUUOS,<
TELL LOG,[ASCIZ / Created - ^1 Cards Read - ^2 Blocks Written
/]
> ;END IFN FTUUOS
IFN FTJSYS,<
$EOD2B: TELL LOG,[ASCIZ / Created - ^1 Cards Read
/]
> ;END IFN FTJSYS
SKIPE L.QFN ;NEED TO QUEUE THE FILE?
PUSHJ P,QUEFIL ;YES, DO IT
PJRST .POPJ1 ;AND SKIP BACK
$EOD3: STAMP STMSG ;MESSAGE STAMP
TELL LOG,[ASCIZ /No File Created
/]
CLOSE FIL,CL.RST ;DO A CLOSE RESET
PJRST .POPJ1 ;AND SKIP BACK
SUBTTL Control Cards -- $MODE
$MODE: MOVEI T1,SW.MOD ;GET LEGAL SWITCHES
PUSHJ P,SETSWC ;DO SWITCHES
PJRST .POPJ1 ;AND SKIP BACK
;DOMODE -- HERE TO DO A $MODE CARD IN THE MIDDLE OF
; STACKING A DECK.
DOMODE: STAMP STCRD ;STAMP THE LOG
TELL LOG,L.CARD ;AND TELL HIM THE CARD
MOVE B,[POINT 7,L.CARD+1]
PUSHJ P,$MODE ;DO THE MODE STUFF
JFCL ;IT SHOULDN'T
POPJ P, ;AND CONTINUE STACKING
SUBTTL Control Cards -- $TOPS10 - $TOPS20
$TOPS: MOVEI T1,SW.TOP ;VALID SWITCH BITS
PUSHJ P,SETSWC ;DO THE SWITCHES
$TOPS1: PUSHJ P,CDRASC ;GET A CARD
JRST $TOPS6 ;EOF!
TXNE F,F.FATE ;ERROR?
POPJ P, ;YES, RETURN
LDB T1,P.CL1A ;GET THE FIRST COLUMN
CAIE T1,"$" ;DOLLAR SIGN?
JRST $TOPS3 ;NO, JUST WRITE IT OUT
$TOPS2: LDB T1,P.CL2A ;GET COLUMN 2
CAIL T1,"A" ;CHECK FOR AN ALPHABETIC
CAILE T1,"Z"
JRST $TOPS3 ;ITS NOT, JUST WRITE THE CARD
JRST $TOPS4 ;IT IS, CHECK A FEW OTHER THINGS
$TOPS3: PUSHJ P,SUPRES ;SUPPRESS THE CARD
TELL CTL!NAC,L.CARD ;WRITE THE CARD INTO CTL FILE
JRST $TOPS1 ;AND LOOP AROUND
$TOPS4: TXNN F,F.DOLR ;ARE WE STACKING /DOL?
JRST $TOPS6 ;NO, $<ALPHA> STOPS US THEN
MOVE T1,L.CARD ;GET FIRST FIVE CHARS
TRZ T1,377 ;AND DOWN TO 4
HRLZI T2,-.NMDEN ;AND SETUP AN AOBJN POINTER
$TOPS5: CAMN T1,C.END(T2) ;CHECK LIST OF TERMINATORS
JRST $TOPS6 ;FOUND ONE!!
AOBJN T2,$TOPS5 ;LOOP!
JRST $TOPS3 ;NOT A TERMINATOR
$TOPS6: TXNN F,F.EOF ;EOF HIT?
TXOA F,F.NXT ;NO, TURN ON NEXT, AND SKIP
OFF F.NXT ;YES, TURN OFF NEXT
PJRST .POPJ1 ;AND SKIP BACK
SUBTTL Control Cards -- $SEQUENCE
UP
$SEQ: MOVEI T1,CDRCHR ;ADDRESS OF CHARACTER ROUTINE
MOVEM T1,L.SCIN ;FOR THE SCANNERS
MOVEI T1,CDRNXT ;ADDRESS OF RECORD ROUTINE
MOVEM T1,L.SCLN ;FOR THE SCANNERS
MOVE B,P.CL1A
PUSHJ P,S$SIX ;SKIP OVER "SEQUENCE"
JFCL ;IGNORE THAT
PUSHJ P,SETQUE ;SETUP QUEUE AREA
STAMP STCRD ;STAMP THE LOG
TELL LOG!NAC,L.CARD ;AND WRITE OUT THE SEQUENCE CARD
PUSHJ P,S$DEC ;GET DECIMAL SEQUENCE NUMBER
SKIPA ;BAD ARGUMENT
JRST $SEQ1 ;GOOD ARGUMENT
MOVEI T1,UCO% ;TYPE THE UCO ERROR
PUSHJ P,LOGER1 ;SEND IT TO THE LOG AND SKIP
$SEQ1: MOVEM T1,Q.SEQ(Q) ;AND STORE THE SEQUENCE WORD
PUSHJ P,CDRASC ;GET NEXT CARD
POPJ P, ;EOF NOW?
MOVE T1,L.CARD ;GET THE FIRST WORD
TRZ T1,377 ;ZAP THE LAST 8 BITS
CAME T1,C.JOB ;IS IT A JOB CARD?
PJRST FLUSH ;NO!!, FLUSH EVERYTHING
PJRST $JOB1 ;YES, GO HANDLE JOB CARD
SUBTTL Control Cards -- $JOB
$JOB: MOVEI T1,CDRCHR ;ADDRESS OF CHARACTER ROUTINE
MOVEM T1,L.SCIN ;FOR SCANNERS
MOVEI T1,CDRNXT ;ADDRESS OF RECORD ROUTINE
MOVEM T1,L.SCLN ;FOR SCANNERS
PUSHJ P,SETQUE ;SETUP QUEUE AREA
$JOB1: OFF F.PAS2 ;CLEAR PASS2 FLAG
PUSHJ P,FSUPR ;SUPPRESS THE TRAILING BLANKS
HRRZ T1,L.MSGL ;GET OPR MSG LEVEL
CAIE T1,2 ;DOES HE WANT TO SEE ALL $ CARDS?
CAIN T1,1 ;DOES HE WANT TO SEE ALL $JOB CARDS?
TELL OPR!NAC,L.CARD ;YES, SHOW HIM!!
CLEARM L.LOC ;LOCATE HIM HERE
IFN FTFACT,<
MOVE T1,L.MYST ;LOAD MY STATION NUMBER
DPB T1,P.FSTA ;STORE THE STATION
CLEAR T1, ;FOR MY JOB
RUNTIM T1, ;GET MY RUNTIME
IDIVI T1,^D10 ;CONVERT MS TO CS
MOVNM T1,L.FRTM ;AND STORE -VE
HRROI T1,.GTKCT ;GET KCT'S
GETTAB T1, ;GET IT
CLEAR T1, ;SO WHAT
MOVNM T1,L.FKCT ;AND STORE IT
HRROI T1,.GTRCT ;GETTAB TO DISK READS
GETTAB T1, ;GET IT
CLEAR T1, ;OH WELL
TLZ T1,777700 ;[1051] CLEAR INCREMENTAL READS
MOVNM T1,L.FDRD ;STORE IT
HRROI T1,.GTWCT ;DISK WRITES
GETTAB T1, ;GET IT
CLEAR T1,
TLZ T1,777700 ;[1051] CLEAR INCREMENTAL WRITES
MOVNM T1,L.FDWT ;AND STORE THEM
>;END OF IFN FTFACT
$JOB2: STAMP STCRD ;STAMP THE LOG
TELL LOG!NAC,L.CARD ;AND TYPE THE JOB CARD
MOVE B,[POINT 7,L.CARD+1]
IFN FTUUOS,<
PUSHJ P,S$SIX ;NO, GET JOB NAME
JFCL
JUMPN T1,$JOB3 ;THERE WAS A NAME!!
> ;END IFN FTUUOS
PUSHJ P,FUNNY ;NO NAME, MAKE A FUNNY ONE
TLO T1,'JB ' ;JB????
$JOB3: MOVEM T1,Q.JOB(Q) ;JOB NAME
MOVEM T1,Q.CNAM(Q) ;CONTROL FILE NAME
MOVEM T1,Q.LNAM(Q) ;LOG FILE NAME
IFN FTUUOS,<
;START LOOKING FOR PROJECT-PROGRAMMER NUMBER
CAIE C,.ASSPC ;WAS BREAK CHAR A SPACE?
JRST $JOB5 ;NO, CHECK FOR PPN OPENER
PUSHJ P,.SCFLS ;YES, FLUSH LEADING SPACES
JRST NOPPN ;EOL, NO PPN SPECIFIED
$JOB5: CAIE C,"[" ;OPEN SQUARE BRACKET?
CAIN C,"<" ;NO, OPEN ANGLE BRACKET?
JRST $JOB6 ;A MATCH!!
CAIN C,"(" ;CHECK OPEN PAREN
JRST $JOB6 ;WIN!
TXNE F,F.ICDR ;IS THIS A CDR?
TXOE F,F.PAS2 ;YES, IS THIS PASS2?
JRST NOPPN ;NOT CDR OR PASS2
CAIN C,"/" ;IS IT THE BEGINNING OF A SWITCH?
JRST NOPPN ;YES, NO PPN ON CARD
ON F.INHI ;TURN ON "INHIBIT INPUT"
MOVE T1,P.NDBP ;GET NON-DEFAULT MODE BP
CAMN T1,L.CRLC ;DID WE USE IT ON PASS1?
MOVE T1,P.DFBP ;YES, SET DEFAULT
MOVEM T1,L.CHOL ;AND SAVE THE OTHER
PUSHJ P,CDRASC ;AND RE-READ THE CARD
HALT . ;***CAN'T HAPPEN***
JRST $JOB2 ;AND TRY AGAIN
$JOB6: PUSHJ P,S$OCT ;GET PROJECT NUMBER
PJRST IPPNF ;???
HRLZM T1,Q.PPN(Q) ;SAVE PROJECT NUMBER
CAIE C,"," ;BREAK ON COMMA?
JRST IPPNF ;NO, BAD FORMAT
PUSHJ P,S$OCT ;GET PROGRAMMER NUMBER
SKIPA ;NO NUMBER THERE, CHECK WILDCARD
JRST $JOB7 ;GOT A NUMBER!!
CAIE C,"#" ;IS IT A WILDCARD?
JRST IPPNF ;NO, BAD FORMAT
PUSHJ P,@L.SCIN ;SKIP TO NEXT CHARACTER
JFCL ;IGNORE EOL
MSTIME T1, ;GET RANDOM NUMBER (RANDOM?)
TXO T1,1B18 ;MAKE IT GT 400000
TXZ T1,1B19!1B20 ;FOLLOW CONVENTION
$JOB7: HRRM T1,Q.PPN(Q) ;SAVE PROGRAMMER NUMBER
CAIE C,.ASSPC ;WAS BREAK CHARACTER A SPACE?
JRST $JOB8 ;NO, LOOK FOR CLOSER
PUSHJ P,.SCFLS ;YES, FLUSH SPACES
JRST IPPNF ;BAD FORMAT FOR PPN
$JOB8: CAIE C,"]" ;CLOSE SQUARE BRACKET?
CAIN C,">" ;OR CLOSE ANGLE BRACKET
JRST $JOB9 ;YES, WIN!!
CAIE C,")" ;FINALLY, CLOSE PAREN
JRST IPPNF ;NO!!!!
;NOW DO SOME CHECKING, AND GET THE SWITCHES AND ACCOUNTING INFO
$JOB9: SKIPE L.PRIV ;AM I GOD?
JRST $JOB10 ;YES!!
MOVE T1,L.MYPP ;NO, GET MY PPN
CAME T1,Q.PPN(Q) ;IS THE JOB MINE?
JRST NOTYRS ;NO, TELL HIM
HRROI T1,.GTNM1 ;FIRST HALF OF USER NAME
GETTAB T1, ;GET IT
CLEAR T1, ;GUESS IT AINT THERE
MOVEM T1,Q.USER(Q) ;SAVE IT
HRROI T1,.GTNM2 ;AND THE SECOND HALF
GETTAB T1, ;GET IT
CLEAR T1, ;OH WELL,
MOVEM T1,Q.USER+1(Q) ;AND SAVE IT
> ;END IFN FTUUOS
IFN FTJSYS,<
MOVEI T1,L.UNAM ;LOAD ADDRESS OF BLOCK
PUSHJ P,S$STRG ;GET A STRING
SETZM Q.USER(Q)
SETZM Q.USER+1(Q)
MOVE T1,[POINT 7,L.UNAM]
MOVE T2,[POINT 6,Q.USER(Q)] ;POINT TO QUEUE AREA
MOVEI T3,^D12 ;LOAD A COUNT
$JOB9: ILDB T4,T1 ;GET A CHARACTER
JUMPE T4,$JOB10 ;DONE IF NULL
SUBI T4,40 ;CONVERT TO 6BIT
IDPB T4,T2 ;DEPOSIT IT
SOJG T3,$JOB9 ;AND LOOP
> ;END IFN FTJSYS
$JOB10:
IFE A%SPRS,<
TXZ F,F.SPS ;[1063] RESET /SUPPRESS ON $JOB CARD
>
IFN A%SPRS,<
TXO F,F.SPS ;[1063] RESET /SUPPRESS ON $JOB CARD
>
MOVE T1,[-.NMJSW,,JSWTCH]
MOVE T2,[SW.JOB,,JADRS] ;VAL SW BITS,,DIS ADR
PUSHJ P,DOSWCH ;DO THE SWITCHES
PUSHJ P,STLPQ ;GET LPTSXX (ONLY USE THE SXX)
HRRM T1,Q.DEV(Q) ;AND STORE IT
PUSHJ P,DOACCT ;CHECK ACCOUNTING
PJRST BADACT ;LOSE BIG!!
IFN FTUUOS,<
MOVSI T1,Q.IDDI(Q) ;ADDRESS OF USER'S PATH
HRRI T1,Q.CDIR(Q) ;FOR CTL FILE
BLT T1,Q.CDIR+5(Q) ;BLITTTTT
MOVSI T1,Q.IDDI(Q) ;AND AGAIN ADDRESS OF PATH
HRRI T1,Q.LDIR(Q) ;FOR LOG FILE
BLT T1,Q.LDIR+5(Q) ;BLLLIITTTTTT
> ;END IFN FTUUOS
PUSHJ P,MAKCTL ;MAKE EVERYTHING
TXNE F,F.FATE ;IS FATE ON?
PJRST BADACT ;YES, GO ABORT JOB
PJRST .POPJ1 ;WIN!!
SUBTTL $JOB Card Subroutines
;^;+SETQUE -- Routine to Setup the QUEUE parameter area.
; SETQUE BLTs the prototype QUEUE header into the parameter
; area, clears the rest, and sets the default uniqueness. Also
; initially loads AC Q with the base address of the queue AREA.
;-;#2
SETQUE: MOVEI Q,L.QUE ;LOAD BASE ADDRESS OF PARAMETER AREA
MOVE T1,[L.QUE,,L.QUE+1]
SETZM L.QUE ;CLEAR THE FIRST WORD OF TE QUEUE AREA
BLT T1,Q.LMOD(Q) ;AND ZERO THE REST OF THE BLOCK
MOVX T1,<<%QOSPT>B29+.QORCR+2B23>
MOVEM T1,Q.OPR(Q) ;SETUP THE OPR WORD
MOVX T1,<BYTE (9) .QIHED,Q.FMOD+1 (18) 2>
MOVEM T1,Q.LEN(Q) ;AND SAVE Q.LEN WORD
MOVSI T1,'INP' ;GET QUEUE NAME
MOVEM T1,Q.DEV(Q) ;AND SAVE IT
MOVE T1,L.UNIS ;GET DEFAULT UNIQUESS
SKIPGE L.PRIV ;AM I PRIVILEGED?
JRST SETQU1 ;YES, ALLOW /UNI:2
CAIN T1,.QIUSD ;NO, IS IT RUN IN UNIQUE SFD?
SOS T1 ;YES, CHANGE IT TO UNIQUE:1
SETQU1: DPB T1,P.UNI ;DEPOSIT IT
MOVE T1,L.MCOR ;GET CORE LIMIT
HRLM T1,Q.ILIM(Q) ;STORE IN QUEUE REQUEST
MOVSI T1,'LOG' ;LOG FILE EXTENSION
MOVEM T1,Q.LEXT(Q) ;STORE IT
MOVSI T1,'CTL' ;CONTROL FILE EXTENSION
MOVEM T1,Q.CEXT(Q) ;STORE IT
MOVX T1,<QF.LOG!QF.NFH+111001> ;GET FMOD BITS
MOVEM T1,Q.LMOD(Q) ;FOR LOG FILE
TXZ T1,QF.LOG ;TURN OFF LOG-BIT
MOVEM T1,Q.CMOD(Q) ;AND STORE FOR CTL FILE
POPJ P, ;AND RETURN
;SPECIAL CASE ROUTINES
IFN FTUUOS,<
NOPPN: SKIPE L.PRIV ;AM I GOD?
JRST NOPPN1 ;YES, LOSE BIG
MOVE T1,L.MYPP ;USE MY PPN
MOVEM T1,Q.PPN(Q) ;AND SAVE IT
JRST $JOB9 ;AND CONTINUE PARSING JOB CARD
NOPPN1: MOVEI T1,IPP% ;ADDRESS OF MESSAGE
JRST NOLOG ;AND DO SOMETHING ABOUT IT
IPPNF: MOVEI T1,IFP% ;ADDRESS OF BAD FORMAT MESSAGE
JRST NOLOG ;AND LOSE GRACEFULLY
NOTYRS: TELL OPR,NYP% ;TELL THE OPERATOR FIRST
MOVEI T1,NYP% ;NOT YOUR PPN
> ;END IFN FTUUOS
;FALL INTO NOLOG ROUTINE
NOLOG: PUSHJ P,LOGERR ;LOG THE ERROR
BADACT: PUSHJ P,NOJOB ;ENTER THE LOG
PJRST ABORT ;AND ABORT THE JOB
;+LOGINI -- Routine to initialize the LOG file. LOGINI
; initializes all the I/O flags and pointers, and puts the
; STDAT introductory message in.
;-;#2
LOGINI: CLEARM LOGBH ;FLAG THAT OPEN AND ENTER HAVEN'T BEEN DONE
CLEARM LOGBC ;FORSE BUFFER CREATION
MOVE T1,.JBFF ;GET ADDRESS FOR FIRST BUFFER
MOVEM T1,LOGAD ;AND STORE IT
HRLI T1,440700 ;MAKE A BYTE POINTER
MOVEM T1,LOGBP ;AND STORE IT
;PUT IN INITIAL STUFF
TELL LOG,CRLF ;START WITH A CRILIF
STAMP STDAT ;INTRODUCTION
DATE T1, ;GET THE DATE
IDIVI T1,^D31 ;GET DAY-1 IN T2
ADDI T2,1 ;MAKE IT DAY-0
RAD10 LOG,T2 ;AND PRINT IT
IDIVI T1,^D12 ;GET MONTH-1 IN T2
TELL6 LOG,MONTAB(T2) ;AND PRINT MONTH NAME
ADDI T1,^D64 ;AND OFFSET FOR YEAR
RAD10 LOG,T1 ;AND PRINT IT
CHR LOG,.ASSPC ;AND A SPACE
TELL LOG!NAC,L.SYSN ;PRINT SYSNAM
TELL LOG,SPTNAM ;PRINT MY NAME
POPJ P, ;AND RETURN
;NOJOB -- ROUTINE TO INITALIZE THE PARAMETER AREA SO WE CAN QUEUE
; A LOG FILE WHICH HAS LOST ITS JOB.
NOJOB: MOVE T1,Q.LNAM(Q) ;GET LOG FILE NAME
MOVEM T1,Q.JOB(Q) ;SAVE AS JOB NAME
MOVSI T1,DEFDSK ;GET DSK
MOVEM T1,Q.LSTR(Q) ;SAVE FOR LOG
MOVEI T1,.QFDDE ;LOAD /DISP:DEL
DPB T1,[POINTR(Q.LMOD(Q),QF.DSP)]
IFN FTUUOS,<
MOVE T1,L.MYPP ;USE MY PPN
MOVEM T1,Q.PPN(Q) ;PUT IT THERE
MOVSI T1,L.SL1+SLLEN+.PTPPN
HRRI T1,Q.LDIR(Q) ;POINTER TO BLT PATH
BLT T1,Q.LDIR+5(Q) ;LOG GOES IN MY PATH
> ;END IFN FTUUOS
IFN FTJSYS,<
MOVEI T1,L.MYNM ;POINT TO MY NAME
MOVEM T1,Q.PPN(Q) ;STORE FOR THE LOG REQUEST
> ;END IFN FTJSYS
MOVEI T1,L.SL1 ;GET MY ORIG S/L
PUSHJ P,SETSRC ;AND SET IT
SKIPE Q.USER(Q) ;IS THERE A NAME?
PJRST MAKLOG ;YES, USE IT
MOVE T1,['SPRINT'] ;ELSE USE 'SPRINT ERROR'
MOVE T2,[' ERROR']
MOVEM T1,Q.USER(Q) ;SAVE FIRST HALF
MOVEM T2,Q.USER+1(Q) ;AND SECOND HALF
PJRST MAKLOG ;ENTER THE LOG AND RETURN
;ROUTINES TO CREATE CTL AND LOG FILES
MAKCTL: PUSHJ P,CLRUUO ;CLEAR THE UUO BLOCK
MOVE T1,Q.CNAM(Q) ;GET CTL FILE NAME
MOVEM T1,RIBNAM ;SAVE IN UUO BLOCK
MOVE T1,Q.CEXT(Q) ;EXTENSION
MOVEM T1,RIBEXT ;SAVE
SETZM RIBPPN ;DEFAULT PPN
MOVE T1,L.PPR ;GET PRESERVED PROTECTION
MOVEM T1,RIBPRV ;AND STORE IT
MOVEI T1,.RBSTS ;NUMBER OF UUO ARGS
MOVEM T1,RIBCNT ;STORE IT
MOVEI T1,RP.NQC ;GET NQC BIT
MOVEM T1,RIBSTS ;AND SAVE IT
MOVEI T1,.IOASL ;OPEN LOG IN ASCII-LINE MODE
MOVSI T2,DEFDSK ;USE DSK FOR NOW
MOVSI T3,CTLBH ;BUFFER-RING HEADER
OPEN CTL,T1 ;OPEN IT UP
JRST CNTOPN ;CAN'T DO IT
ENTER CTL,L.UUBK ;ENTER IT
JRST CNTENT ;CAN'T DO IT
MOVE T1,RIBDEV ;GET REAL DEVICE
MOVEM T1,Q.CSTR(Q) ;AND SAVE IT
;AND FALL INTO LOG FILE MAKER
MAKLOG: PUSHJ P,CLRUUO ;CLEAR UUO BLOCK
MOVE T1,Q.LNAM(Q) ;GET LOG FILE NAME
MOVEM T1,RIBNAM ;STORE IT
MOVE T1,Q.LEXT(Q) ;EXTENSION
MOVEM T1,RIBEXT ;AND STORE IT ALSO
SETZM RIBPPN ;SET DEFAULT PPN
MOVEI T1,.RBSTS ;NUMBER OF UUO ARGUMENTS
MOVEM T1,RIBCNT ;SO FILSER KNOWS
MOVEI T1,.IODMP ;DUMP MODE
MOVSI T2,DEFDSK ;GET THE CORRECT DEVICE
CLEAR T3, ;NO BUFFERS
OPEN LOG,T1 ;OPEN THE LOG
JRST CNTOPN ;I CAN'T
LOOKUP LOG,L.UUBK ;LOOKUP THE LOG
JFCL ;OH WELL, GUESS WE CREATE IT
MAKLG1: MOVEI T2,RP.NQC ;NQC BIT
MOVEM T2,RIBSTS ;AND SET IT
ENTER LOG,L.UUBK ;ENTER THE LOG
JRST CNTENT ;I CAN'T DO THAT
MOVE T1,RIBSIZ ;GET FILE-SIZE
ADDI T1,^D127 ;COUNT THE PARTIAL BLOCK
IDIVI T1,^D128 ;AND CONVERT TO BLOCKS
USETO LOG,1(T1) ;SET THE BLOCK NUMBER
SETOM LOGBH ;AND FLAG THAT IT'S ENTERED
MOVE T1,RIBDEV ;GET THE DEVICE
MOVEM T1,Q.LSTR(Q) ;AND SAVE IT
POPJ P, ;AND RETURN
;LOG AND CTL FILE ERROR ROUTINES
CNTOPN: TELL OPR,COD%
JRST ABEND
CNTENT: HRRZ T3,RIBEXT ;GET ERROR CODE
STAMP STERR ;STAMP THE ERROR
TELL OPR!LOG,CCC%
TELL OPR!LOG,@UUOMSG(T3) ;UUO ERROR MESSAGE
TELL OPR!LOG,CRLF ;CRLF
MOVE T1,RIBPPN ;GET RIBPPN
CAMN T1,L.MYPP ;MY PPN?
JRST ABEND ;YES, LOSE
ON F.FATE ;TURN ON FATE
POPJ P, ;AND RETURN
;JOB CARD SWITCHES
DEFINE JNAMES,<
Y AFTER,SW.JOB
Y10 CARDS,SW.JOB
Y10 CORE,SW.JOB
Y10 CHARGE,SW.JOB
Y10 DEADLINE,SW.JOB
Y DEPEND,SW.JOB
Y ERROR,SW.JOB
Y10 FEET,SW.JOB
Y10 HOLLERITH,SW.JOB
Y JOBNAME,SW.JOB
Y10 LOCATE,SW.JOB
Y LOGDISP,SW.JOB
Y10 NAME,SW.JOB
Y OUTPUT,SW.JOB
Y PAGES,SW.JOB
Y PRIORITY,SW.JOB
Y RESTART,SW.JOB
Y NORESTART,SW.JOB
Y SEQUENCE,SW.JOB
Y TIME,SW.JOB
Y10 TPLOT,SW.JOB
Y UNIQUE,SW.JOB
>
DEFINE Y10(A,B),<
IFN FTUUOS,<
Y A,B
>>
DEFINE Y(A,B),<
XLIST
<SIXBIT /A/>
LIST
SALL>
JSWTCH: JNAMES
.NMJSW==.-JSWTCH
DEFINE Y(A,B),<
XLIST
XWD B,W$'A
LIST
SALL>
JADRS: JNAMES
SUBTTL $JOB Card Switch Subroutines
;/CARDS
W$CARD: PJSP T1,SWTDEC ;HANDLE DECIMAL SWITCH VALUE
XWD 0,777777 ;MIN, MAX
POINTR(Q.ILM2(Q),QM.CDP);POINTER TO RESULTS
;/CORE
W$CORE: PUSHJ P,S$DEC ;GET DECIMAL ARGUMENT
PJRST E$USV ;GARBAGE!!
JUMPE T1,.POPJ ;USE DEFAULT IF ZERO
CAIE C,"P" ;DID HE SPECIFY PAGES?
ASH T1,1 ;NO, MULTIPLY BY 2
ASH T1,11 ;AND BY 2**9
W$COR1: HRLM T1,Q.ILIM(Q) ;STORE IT
POPJ P, ;AND RETURN
;/DEPEND
W$DEPE: PJSP T1,SWTDEC ;DECIMAL VALUE
XWD 0,177777 ;MIN,MAX
POINTR(Q.IDEP(Q),QI.DEP);WHERE TO PUT RESULTS
;/FEET
W$FEET: PJSP T1,SWTDEC ;DECIMAL ARGUMENT
XWD 0,777777 ;MIN,MAX
POINTR(Q.ILM3(Q),QM.PTP);POINTER TO RESULTS
;/LOCATE
W$LOCA: PJSP T1,SWTOCT ;HANDLE OCTAL SWITCH VALUE
XWD 1,77 ;MIN,MAX
POINT 18,L.LOC,35 ;PUT IT IN L.LOC
;/PAGES
W$PAGE: PJSP T1,SWTDEC ;DECIMAL ARGUMENT
XWD 0,777777 ;MIN,MAX
POINTR(Q.ILM2(Q),QM.LPT);POINTER TO USE FOR SWITCH VALUE
;/CHARGE
W$CHAR: PUSHJ P,S$SIX ;GET SIXBIT ARGUMENT
PJRST E$MSV ;MISSING SWITCH VALUE
MOVEM T1,Q.CNO(Q) ;STORE IN Q.CNO
POPJ P, ;AND RETURN
;/JOBNAME
W$JOBN: PUSHJ P,S$SIX ;GET SIXBIT VALUE
PJRST E$MSV ;NOT THERE?
MOVEM T1,Q.JOB(Q) ;STORE IT
MOVEM T1,Q.CNAM(Q) ;SAVE AS CTL FILE NAME
MOVEM T1,Q.LNAM(Q) ;AND AS LOG FILE NAME
POPJ P, ;AND RETURN
;/TIME
W$TIME: PUSHJ P,S$TIM ;GET A TIME-SPEC
JRST E$USV ;SOMETHING ILLEGAL
MOVEI T1,^D3600 ;START CONVERTING TO SECS
IMULM T1,L.HRS ;SEC/HRS
MOVEI T1,^D60 ;SEC/MIN
IMUL T1,L.MIN
ADD T1,L.HRS ;AND ADD THEM UP
ADD T1,L.SEC ;ADD IN SECONDS
HRRM T1,Q.ILIM(Q) ;STORE AWAY
POPJ P,
;/ERROR:CHK:IBC:HOL
W$ERRO: PUSHJ P,S$TIM ;GET WHAT LOOKS LIKE A TIME SPEC
JRST E$USV ;GIVE ERROR MESSAGE
MOVE T1,L.HRS ;GET HRS
MOVEM T1,L.UCHK ;AND MAKE IT CHKSUM ERRORS
MOVE T1,L.MIN ;GET MINUTES
MOVEM T1,L.UIBC ;AND MAKE IT ILL BIN CARDS
MOVE T1,L.SEC ;AND GET SECONDS
MOVEM T1,L.UHOL ;AND MAKE THEM HOLLERITH ERRORS
POPJ P, ;AND RETURN
;/HOLLERITH
W$HOLL: PUSHJ P,S$SIX ;GET A SIXBIT ARGUMENT
PJRST E$MSV ;MISSING ARGUMENT
MOVE T2,[-.NMCTY,,CODTYP]
PUSHJ P,UNIQ6 ;GET A UNIQ MATCH
PJRST E$USV ;VALUE OUT OF RANGE
MOVE T1,P.COD(T1) ;GET THE RIGHT BYTE-POINTER
MOVEM T1,L.DHOL ;SAVE AS DEFAULT
MOVEM T1,L.CHOL ;AND FOR NEXT CARD
POPJ P, ;AND RETURN
;/NAME
W$NAME: MOVE T2,[POINT 6,Q.USER(Q)]
PUSHJ P,.SCFLS ;FLUSH LEADING SPACES, AND LOAD CHAR
POPJ P, ;JUST RETURN - EOL
CAIE C,42 ;IS IT A DOUBLE QUOTE?
CAIN C,"'" ;OR A SINGLE QUOTE?
JRST W$NAM4 ;YES, GO GET QUOTED STRING
JRST W$NAM2 ;JUMP INTO LOOP
W$NAM1: PUSHJ P,.SCIN ;GET A CHAR
POPJ P, ;EOL, RETURN
W$NAM2: CAIN C,"/" ;BEGINNING OF NEXT SWITCH
POPJ P, ;YES, RETURN
PUSHJ P,W$NAM9 ;DEPOSIT IT
JRST W$NAM1 ;AND LOOP
;HERE ON A QUOTED STRING
W$NAM4: MOVEM C,L.ACC+1 ;SAVE QUOTE CHARACTER
W$NAM5: PUSHJ P,.SCIN ;GET A CHARACTER
POPJ P, ;EOL, RETURN
CAMN C,L.ACC+1 ;IS IT A QUOTE?
JRST W$NAM6 ;YES, GO COUNT IT
PUSHJ P,W$NAM9 ;ELSE, DEPOSIT CHARACTER
JRST W$NAM5 ;AND LOOP AROUND
W$NAM6: PUSHJ P,.SCIN ;GET NEXT CHARACTER
POPJ P, ;EOL FINISHES US OFF
CAME C,L.ACC+1 ;IS IT A QUOTE?
POPJ P, ;NO, WE DONE!!
PUSHJ P,W$NAM9 ;YES!,PRINT A QUOTE
JRST W$NAM5 ;AND LOOP AROUND
W$NAM9: CAMN T2,[600,,Q.USER+1(Q)] ;DONE?
POPJ P, ;YES, NO-OP
SUBI C,.ASSPC ;CONVERT TO 6BIT
IDPB C,T2 ;DEPOSIT
POPJ P, ;AND RETURN
;/PRIO
W$PRIO: PJSP T1,SWTDEC ;GET DECIMAL VALUE
XWD 0,76 ;MIN,MAX
POINTR(Q.PRI(Q),QP.PRI) ;WHERE TO PUT IT
;/RESTART
W$REST: MOVSI T1,(QI.NRS) ;GET THE NORESTART BIT
ANDCAM T1,Q.IDEP(Q) ;TURN IT OFF
POPJ P, ;AND RETURN
;/NORESTART
W$NORE: MOVSI T1,(QI.NRS) ;GET NOT-RESTART BIT
IORM T1,Q.IDEP(Q) ;SET IT
POPJ P, ;AND RETURN
;/SEQUENCE
W$SEQU: PJSP T1,SWTDEC ;GET DECIMAL ARGUMENT
XWD 0,777777 ;MIN,MAX
POINT 18,Q.SEQ(Q),35 ;WHERE TO PUT IT
;/TPLOT
W$TPLO: PJSP T1,SWTDEC ;GET DECIMAL ARGUMENT
XWD 0,777777 ;MIN,MAX
POINTR(Q.ILM3(Q),QM.PLT);POINTER FOR RESULTS
;/UNIQUE
W$UNIQ: PJSP T1,SWTDEC ;GET DECIMAL ARGUMENT
XWD 0,2 ;MIN,MAX
P.UNI: POINTR(Q.IDEP(Q),QI.UNI);POINTER TO RESULTS
;/OUTPUT
W$OUTP: PUSHJ P,S$SIX ;GET SIXBIT ARG
PJRST E$MSV ;GIVE ERROR
MOVE T2,[-3,,['NOLOG '
'LOG '
'ERROR ']]
PUSHJ P,UNIQ6 ;GET UNIQUE MATCH
PJRST E$USV ;BAD SWITCH VALUE
MOVE T1,[EXP %EQONL,%EQOLG,%EQOLE](T1)
DPB T1,[POINTR(Q.IDEP(Q),QI.OUT)]
POPJ P, ;AND RETURN
;/LOGDISP
W$LOGD: PUSHJ P,S$SIX ;GET SIXBIT ARGUMENT
PJRST E$MSV ;MISSING SWITCH VALUE
MOVE T2,[-2,,['PRESER'
'DELETE']]
PUSHJ P,UNIQ6 ;GET UNIQUE MATCH
PJRST E$USV ;UNRECOGNIZED SWITCH VALUE
MOVE T1,[EXP .QFDPR,.QFDDE](T1)
DPB T1,[POINTR(Q.LMOD(Q),QF.DSP)] ;DEPOSIT THE CODE
POPJ P, ;AND RETURN
;/AFTER
W$AFTE: PUSHJ P,.SCDT ;GET DATE-TIME SPEC
PJRST E$BDT ;BAD FORMAT
MOVEM T1,Q.AFTR(Q) ;STORE IN QUEUE REQUEST
POPJ P, ;AND RETURN
;/DEADLINE
W$DEAD: PUSHJ P,.SCDT ;GET A DATE-TIME SPEC
PJRST E$BDT ;BAD FORMAT
MOVEM T1,Q.DEAD(Q) ;SAVE IT
POPJ P, ;AND RETURN
DOWN
;NOEOF -- THIS ROUTINE IS CALLED BY CONTRL WHEN A $JOB, $SEQUENCE,
; CARD IS FOUND IN A DECK. NOEOF ASSUMES
; AN EOF CARD WAS FORGOTTEN, PLACES A MESSAGE IN THE
; LOG, SETS F.NXT AND F.NEOF. TAKES ERROR RETURN
; (NON-SKIP) WHICH WILL GET US UP TO MAIN PROGRAM LOOP.
NOEOF: STAMP STERR ;STAMP THE LOG
TELL LOG,NEF% ;PLACE A MESSAGE THERE
ON F.NXT!F.NEOF ;SET SOME BITS
PJRST ENDJOB ;AND FINISH HIM OFF
;HERE, IF AN EXTRANEOUS PASSWORD CARD IS FOUND. TELL USER JUST THAT!
PASCRD: MOVEI T1,EPF% ;EXTRANEOUS PASSWORD
PJRST LOGER1 ;LOG IT AND SKIP BACK
SUBTTL Routines To Finish Off a Job
;^;+ENDJOB -- Routine to finish off a job normally.
; Puts CREF, DUMP, DELETE lines into CTL file,
; and goes off to queue up the job.
;-;#2
ENDJOB: PUSHJ P,$EOD ;END DECK IN PROGRESS IF ANY
JFCL ;NO ERROR RETURN FOR $EOD
STAMP STSUM ;A SUMMARY LINE
TELL LOG,[ASCIZ /End of Job Encountered
/]
PUSHJ P,SUMARY ;GIVE SUMMARY
;**;[1071] Insert @ ENDJOB+6L JNG 23-Oct-75
TELL CTL,ERRLIN ;[1071] ALWAYS PUT %ERR INTO CTL FILE
MOVE T1,L.DPCR ;GET DUMP AND CREF FLAGS
SKIPGE T1 ;IS DUMP SIDE (LH) SET?
TELL CTL,DUMLIN ;YUP!
TRNE T1,-1 ;CREF?
TELL CTL,CRFLIN ;YES
CLEARB P1,P2 ;CLEAR A FLAG AND A COUNTER
CLEARB T1,P3 ;CLEAR ARGUMENT TO FBFND
ENDJB1: MOVE T1,P3 ;LOAD THE LAST VALUE RETURNED
PUSHJ P,FBFND ;GET A FILE
JUMPE T1,ENDJB4 ;GO TYPE CRLF WHEN DONE
MOVE P3,T1 ;SAVE THE ADDRESS
MOVE P4,.FBEXT(T1) ;GET THE EXTENSION WORD
TRNN P4,FB.DEL!FB.DLR;IS IT DELETABLE?
JRST ENDJB1 ;NO, GET NEXT FILE
JUMPN P2,ENDJB2 ;HAVE WE PRINTED DELETE COMMAND YET?
SETO P2, ;NO, FLAG THAT WE ARE
TELL CTL,DELLIN ;PUT IN DELETE LINE
SKIPA ;SKIP COMMA FIRST TIME THRU
ENDJB2: CHR CTL,"," ;PUT IN A COMMA
MOVE T1,P3 ;LOAD THE ADDRESS
PUSHJ P,TFLCTL ;TYPE FILESPEC INTO CTL
MOVSI T1,'REL' ;GET REL EXTENSION
HLLM T1,.FBEXT(P3) ;STORE IT
TRZE P4,FB.DLR ;DEL THIS GUY'S REL?
AOJA P1,ENDJB2 ;YES, INCR NUMBER PRINTED, AND DO REL
ENDJB3: CAIGE P1,5 ;TYPED 6 YET?
AOJA P1,ENDJB1 ;NO, LOOP SOME MORE
CLEARB P1,P2 ;SETUP TO PRINT THE NEXT LINE
TELL CTL,CRLF ;PUT IN A CRILIF
JRST ENDJB1 ;AND KEEP LOOPING
ENDJB4: SKIPE P2 ;ANYTHING ON THE LINE?
TELL CTL,CRLF ;YES, FINISH IT OFF
PUSHJ P,QUEJOB ;QUEUE UP THE JOB
PJRST DOFACT ;AND DO THE FACT FILE STUFF
;+KILJOB -- Routine to Kill off a job due to KILL command.
; Just puts a message in the LOG and calls ABORT.
;-;#2
KILJOB: STAMP STOPR ;OPR ACTION CAUSED IT
TELL LOG,ABO% ;ABORTED BY OPERATOR
JRST ABORT1 ;AND CLEAN UP AFTER "ME"
;+ABORT -- Routine to abort a job. Puts necessary messages
; in the LOG, deletes temp files, and flushes to EOJ.
;-;#2
ABORT: ON F.FATE ;TURN ON THE FATE BIT
STAMP STSUM ;GIVE A SUMMARY
TELL LOG,[ASCIZ /Job Aborted due to Fatal Error
/]
SKIPL L.MSGL ;DO OPR WANT TO SEE FATAL CARD?
JRST ABORT1 ;NO, DON'T SHOW HIM
MOVE T1,L.CARD ;YES, GET FIRST FIVE CHARS
TRZ T1,377 ;ZAP LAST 8 BITS
MOVEI T2,T1 ;GET ADDRESS OF MESSAGE (MAYBE)
CAME T1,[ASCII /$PAS/] ;DOES IT LOOK LIKE A PASSWORD CARD?
MOVEI T2,L.CARD ;NO, TYPE ENTIRE CARD OUT
TELL OPR!NAC,(T2) ;DO IT!!!
ABORT1: OFF F.BTCH!F.DECK ;NO BATCH JOB HERE NOR A DECK
PUSHJ P,SUMARY ;GIVE SUMMARY
CLOSE CTL,CL.RST ;RESET THE CTL FILE
CLOSE FIL,CL.RST ;RESET THE USER'S FILE
PUSHJ P,QUELOG ;QUEUE THE LOG FILE TO LPT
PUSHJ P,DOFACT ;AND CHARGE HIM
MOVEI T1,16 ;DUMP MODE
MOVEM T1,L.ACC ;USE AS OPEN BLOCK
CLEARM L.ACC+1 ; " "
CLEARB T1,L.ACC+2 ; " " & CLEAR ARG TO FBFND
ABORT2: PUSHJ P,FBFND ;GET A FILE
PJUMPE T1,FLUSH ;NO MORE, DONE
MOVE P1,.FBEXT(T1) ;GET EXTENSION AND STATUS WORD
TRNN P1,FB.DEL!FB.DLR;IS IT DELETABLE?
JRST ABORT2 ;NO, DON'T WORRY ABOUT IT
MOVE P1,.FBNAM(T1) ;GET FILENAME
MOVE P2,.FBDEV(T1) ;GET DEVICE
CAMN P2,L.ACC+1 ;SAME AS LAST TIME?
JRST ABORT3 ;YES, SKIP OPEN
MOVEM P2,L.ACC+1 ;STORE STR NAME
OPEN FIL,L.ACC ;OPEN THE CHANNEL
JRST ABORT2 ;I REALLY DON'T CARE
ABORT3: HLLZ P2,.FBEXT(T1) ;LOAD EXTENSION
CLEAR P3,
IFN FTUUOS,<
MOVEI P4,Q.IDDI-2(Q) ;GET USER'S PATH
> ;END IFN FTUUOS
LOOKUP FIL,P1 ;LOOK IT UP
JRST ABORT2 ;CAN'T WORRY ABOUT IT
CLEARB P1,P2 ;ZAP NAME
RENAME FIL,P1 ; FOR DELETE UUO
JFCL ;IT'S NOT IMPORTANT
JRST ABORT2 ;JUST KEEP LOOPING
;ROUTINE TO DO ACCOUNTING AT THE END OF A JOB
UP
IFE FTFACT,<
DOFACT: POPJ P,>
IFN FTFACT,<
DOFACT: SETO T1, ;FOR OUR TTY NUMBER
GETLCH T1 ;GET IT'S LICH
DPB T1,P.FTTY ;AND STORE IN ENTRY
MOVE T1,Q.PPN(Q) ;GET USER'S PPN
MOVEM T1,L.FPPN ;STORE IT
CLEAR T1, ;CLEAR FOR RUNTIME
RUNTIM T1, ;GET RUNTIME
IDIVI T1,^D10 ;CONVERT MS TO CS
ADDM T1,L.FRTM ;ADD IN
HRROI T1,.GTKCT ;GET TAB TO KCTS
GETTAB T1, ;GET TAB IT
CLEAR T1, ;LOSE
ADD T1,L.FKCT ;ADD IT IN
IMULI T1,^D100 ;MULITPLY BY 100
IDIV T1,L.JFSC ;AND DIVIDE BY JIFSEC
MOVEM T1,L.FKCT ;AND STORE KCORE-CENTISECS
HRROI T1,.GTRCT ;DISK READS
GETTAB T1, ;GET THEM
CLEAR T1, ;LOSE
TLZ T1,777700 ;[1051] CLEAR INCREMENTAL READS
ADDM T1,L.FDRD ;ADD THEM IN
HRROI T1,.GTWCT ;DISK WRITES
GETTAB T1, ;AND THEM ALSO
CLEAR T1, ;LOSE
TLZ T1,777700 ;[1051] CLEAR INCREMENTAL WRITES
ADDM T1,L.FDWT ;ADD THEM IN
MOVE T1,Q.SEQ(Q) ;GET USER'S SEQUENCE NUMBER
MOVEM T1,L.FSEQ ;SAVE IT
MOVE T1,CDRCNT ;GET CDRCNT
TXNE F,F.BTCH ;ARE WE SUBMITTING BATCH JOB?
TXO T1,1B0 ;YES, SET THE BIT
MOVEM T1,L.FWRK ;AND SAVE # CARDS READ
MOVE T1,[.FSIZE+1,,L.FACT] ;POINTER FOR THE DAEMON
DAEMON T1, ;LIKE MAGIC!!!!
SKIPA ;NOT GOOD ENOUGH THOUGH
POPJ P, ;WIN AND RETURN
TELL OPR,DUF% ;GIVE AN ERROR
RAD08 OPR,T1 ;AND THE ERROR CODE
TELL OPR,CRLF ;AND A CRLF
POPJ P, ;AND RETURN
MSG(DUF,W,N,DAEMON UUO Failed - Code )
> ;END OF IFN FTFACT
DOWN
;+SUMARY -- Routine to give summary statistics at the end of
; a job. Stamps with STSUM. The routine is driven
; by two tables, SUMTB1 and SUMTB2. SUMTB1 contains
; a list of addresses of locations to be printed
; in decimal, and SUMTB2 contains a list of addresses
; of messages.
;-;#2
SUMARY: CLEAR T1, ;CLEAR A COUNTER
SUMAR1: SKIPN @SUMTB1(T1) ;IS IT A ZERO?
JRST SUMAR2 ;YES, DON'T TYPE IT
STAMP STSUM ;SUMMARY STAMP
RAD10 LOG,@SUMTB1(T1) ;TYPE THE NUMBER
CHR LOG,.ASSPC ;AND A SPACE
TELL LOG,@SUMTB2(T1) ;AND THE MESSAGE
SUMAR2: CAIGE T1,.NMSMM-1 ;GOT ALL THE SUMMARY MESSAGES?
AOJA T1,SUMAR1 ;NO, LOOP AROUND FOR THE NEXT ONE
POPJ P, ;YES, RETURN!
SUMTB1: EXP CDRCNT ;NUMBER OF CARDS READ
EXP L.THOL ;NUMBER OF HOLLERITH ERRORS
EXP L.TIBC ;NUMBER OF ILLEGAL BINARY CARDS
EXP