Trailing-Edge
-
PDP-10 Archives
-
AP-4172F-BM
-
3a-sources/sprint.mac
There are 37 other files named sprint.mac in the archive. Click here to see a list.
SUBTTL Larry Samberg/LSS/JHT/JNG 24 AUG 77
;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,ACTSYM
> ;END IFN FTJSYS
SEARCH QPRM ;QUEUE SYSTEM SYMBOLS
SALL ;SUPPRESS MACRO EXPANSIONS
;VERSION INFORMATION
SPTVER==103 ;MAJOR VERSION NUMBER
SPTMIN==0 ;MINOR VERSION NUMBER
SPTEDT==2102 ;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
;COPYRIGHT (C) 1973, 1974, 1975, 1976, 1977, 1978 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
;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.
;2100 MAKE THIS VERSION 103. ADD /ACCOUNT SWITCH ON -20.
;2101 PUT IN USAGE FILE ACCOUNTING ON THE -20.
;2102 FIX PROBLEM WHICH CAUSES 81 CHARACTERS PER CARD.
;[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
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 20 ;GTDIR INFORMATION
L.UPSW: BLOCK 10 ;USER SPECIFIED PASSWORD
L.ACNT: BLOCK 10 ;BLOCK FOR ACCOUNT STRING
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
L.RTM: BLOCK 1 ;STORE RUNTIME
L.DTM: BLOCK 1 ;STORE DAYTIME
L.TBLK: BLOCK 1 ;TOTAL DISK BLOCKS WRITTEN
> ;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,<
IFN FTUUOS,<
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 IFN FTUUOS
IFN FTJSYS,<
GTAD ;GET CURRENT DATE AND TIME
MOVEM T1,L.DTM ;AND STORE IT
MOVX T1,.FHSLF ;LOAD FORK HANDLE
RUNTM ;GET RUNTIME
MOVNM T1,L.RTM ;AND STORE IT
> ;END IFN FTJSYS
> ;END 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
IFN FTJSYS,<
Y ACCOUNT,SW.JOB
> ;END IFN TJSYS
>
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
IFN FTJSYS,<
W$ACCOUNT:
MOVEI T1,L.ACNT ;GET ADDRESS OF THE BLOCK
PUSHJ P,S$STRG ;AND GET THE ACCOUNT STRING
MOVEI T1,L.ACNT ;GET ADDRESS OF THE BLOCK
MOVEM T1,Q.CNO(Q) ;AND STORE IT
POPJ P, ;AND RETURN
>;END IFN FTJSYS
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,<
IFN FTUUOS,<
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 IFN FTUUOS
IFN FTJSYS,<
DOFACT: MOVX T1,.FHSLF ;GET FORK HANDLE
RUNTM ;GET RUNTIME
ADDM T1,L.RTM ;GET RUNTIME FOR THE JOB
MOVE T1,L.TBLK ;GET NUMBER OF BLOCKS WRITTEN
ADDI T1,3 ;ROUND IT UP
IDIVI T1,4 ;CONVERT TO PAGES
MOVEM T1,L.TBLK ;STORE IT
MOVEI T1,.USENT ;WRITE AN ENTRY
MOVEI T2,ACTLST ;GET ADDRESS OF BLOCK
USAGE ;ACCOUNT FOR THE WORLD
ERCAL [TELL OPR,[ASCIZ /?SPTUJF USAGE JSYS FAILED
/]
POPJ P,] ;RETURN FROM ERCAL
POPJ P, ;AND RETURN
ACTLST: USENT. (.UTINP,1,1)
USJNO. (-1)
USTAD. (-1)
USTRM. (-1)
USLNO. (-1)
USPNM. (<SIXBIT /SPRINT/>,US%IMM)
USPVR. (%SPT,US%IMM)
USAMV. (-1)
USNOD. (-1)
USACT. (<-1,,L.ACNT>)
USSRT. (L.RTM)
USSDR. (0,US%IMM)
USSDW. (L.TBLK)
USJNM. (Q.JOB(Q))
USQNM. (<SIXBIT /INP/>,US%IMM)
USSDV. (CDRNAM)
USSSN. (Q.SEQ(Q))
USSUN. (CDRCNT)
USCRT. (L.DTM)
USDSP. (<SIXBIT /BATCH/>,US%IMM)
USTXT. (<-1,,[ASCIZ / /]>)
USPRI. (0,US%IMM)
0 ;END OF LIST
> ;END OF IFN FTJSYS
> ;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 L.TCHK ;NUMBER OF CHECKSUM ERRORS
.NMSMM==.-SUMTB1
SUMTB2: [ASCIC(Cards Read)]
[ASCIC(Hollerith Errors)]
[ASCIC(Illegal Binary Cards)]
[ASCIC(Binary Checksum Errors)]
;+FLUSH -- Routine to flush the input stream until the next
; EOF, or $EOJ, $JOB, $SEQ.
;-
;CALL:
; PUSHJ P,FLUSH
; RETURN HERE ALWAYS
FLUSH: TXNE F,F.EOF ;IS EOF ON?
POPJ P, ;YES, JUST RETURN
;[1054] FLUSH 1 1/2 JHT 3/5/75
OFF F.NXT!F.BUSY ;TURN THESE OFF
PUSHJ P,CDRASC ;GET A CARD
POPJ P, ;EOF, RETURN
MOVE T1,L.CARD ;GET FIRST 5 CHARACTERS OF CARD
TRZ T1,377 ;ZAP LAST 8 BITS
CAMN T1,C.EOJ ;EOJ CARD?
POPJ P, ;YES, RETURN
ON F.NXT ;IF WE MATCH, WE'VE GOT NEXT CARD
MOVSI T2,-.NMJCR ;NUMBER OF POSSIBLE START CARDS
FLUSH1: CAMN T1,C.JOB(T2) ;MATCH?
POPJ P, ;YUP, RETURN
AOBJN T2,FLUSH1 ;LOOP
JRST FLUSH ;AND, LOOP
SUBTTL Non-$JOB Card Switch Subroutines
;/ASCII
W$ASCI: OFF F.IMG!F.BIN
MOVE T1,P.ASC ;LOAD ASCII MODE POINTER
MOVEM T1,L.CHOL ;AND SAVE FOR READ ROUTINE
POPJ P, ;TURN EVERYTHING OFF, AND RETURN
;/026
W$BCD:
W$026: OFF F.IMG!F.BIN ;TURN THESE OFF
MOVE T1,P.026 ;LOAD 026 POINTER
MOVEM T1,L.CHOL ;AND SAVE FOR READ ROUTINE
POPJ P, ;AND RETURN
;/BINARY
W$BINA: OFF F.IMG ;TURN THESE OFF
ON F.BIN ;TURN THIS ON
POPJ P, ;AND RETURN
;/IMAGE
W$IMAG: OFF F.BIN ;" "
ON F.IMG ;" "
;[1060] W$IMAG + 1 1/2
CAIE C,":" ;ANY ARGUMENT?
JRST W$IMA1 ; NO, TAKE DEFAULT
PUSHJ P,S$DEC
JFCL
SKIPG T1 ;WAS THERE AN ARG?
W$IMA1: MOVEI T1,2 ;NO, MAKE IT 2
MOVEM T1,L.IMGT ;AND STORE IT
POPJ P, ;AND RETURN
;/SUPPRESS - /NOSUPPRESS
W$NOSU: TXZA F,F.SPS ;CLEAR SUPPRESS FLAG
W$SUPP: ON F.SPS ;SET SUPPRESS FLAG
POPJ P, ;AND RETURN
;/LIST - /NOLIST
W$LIST: SKIPA T1,[SIXBIT "/LIST"]
W$NOLI: CLEAR T1, ;CLEAR THE LISTING SWITCH
MOVEM T1,L.LSW ;STORE IT
POPJ P, ;AND RETURN
;/SEARCH
W$SEAR: SETOM L.SRH ;SET THE SEARCH FLAG
POPJ P, ;AND RETURN
;/PROTECT
W$PROT: PJSP T1,SWTOCT ;GET OCTAL SWITCH VALUE
XWD 000,777 ;MIN,MAX
POINT 9,FILPRV,8 ;WHERE TO PUT IT
;/CREF
W$CREF: MOVE T1,[SIXBIT "/CREF"]
MOVEM T1,L.LSW ;STORE /CREF SWITCH
HLLOS L.DPCR ;FLAG IT FOR LATER
POPJ P, ;AND RETURN
;/WIDTH
W$WIDT: PJSP T1,SWTDEC ;GET DECIMAL ARGUMENT
XWD 1,^D80 ;MIN,MAX
POINT 18,L.WIDT,35 ;POINTER TO RESULTS
;/MAP - /NOMAP
W$NOMA: TXZA F,F.MAP ;TURN OFF MAP BIT
W$MAP: ON F.MAP ;TURN ON A BIT
POPJ P, ;AND RETURN
;/DOLLAR - /NODOLLAR
W$NODO: TXZA F,F.DOLR ;TURN OFF DOLLAR BIT
W$DOLL: TXO F,F.DOLR ;TRUN ON DOLLAR BIT
POPJ P, ;RETURN
;/PRINT
W$PRIN: MOVSI T1,'LPT'
JRST QSWRET
;/TPUNCH
W$TPUN: MOVSI T1,'PTP'
JRST QSWRET
;/CPUNCH
W$CPUN: MOVSI T1,'CDP'
JRST QSWRET
;/PLOT
W$PLOT: MOVSI T1,'PLT'
QSWRET: MOVEM T1,L.QFN ;STORE DEVICE
POPJ P, ;AND RETURN
SUBTTL Control Card Common Subroutines
COMMENT /
;^;++
Control Card Common Subroutines
The following routines are used by many of the Control Card
processors.
Routines are:
GETFS Get a filespec
LOGERR Type an error message into the LOG file
SETSWC Set-up to call DOSWCH
SFDSET Routine to setup PPN for ENTER-LOOKUP
DOSWCH Process Switches
FNDSWC Routine to scan for a slash
SWTOCT Routine to process octal value switches
SWTDEC Routine to process decimal value switches
FILENT ENTER a user file
CHKENT CHKACC an ENTER
ENTERT Process ENTER errors
MAKFUN Routine to setup default filespecs
FUNNY Funny Name Generator
STDECK Routine to call the correct stacking routine
CTLCRD Routine to copy from current card to CTL file.
;--;^
/
;+GETFS -- Routine to read a filespec from Control Card.
;GETFS assumes that the filespec should be stored in the file
; device control cells. Sets the default device to DSK, and
; fills in default PPN from Q.PPN if necessary.
;-;#2
; !-------------------------------------------------------!
; ! GETFS (B) !
; ! +1 IF FILESPEC ERROR !
; ! +2 OTHERWISE !
; !-------------------------------------------------------!
GETFS: MOVEI T1,DEVFIL ;DEVICE CONTROL CELLS
MOVSI T2,DEFDSK ;DSK IS DEFAULT DEVICE
MOVEM T2,.CCDEV(T1) ;SAVE IT
PUSHJ P,S$FILE ;GET THE FILESPEC
PJRST LOGERR ;FILESPEC ERROR
GETFS1: MOVE T1,FILDEV ;GET THE SPECIFIED DEVICE
DEVCHR T1, ;GET CHARACTERISTICS
TXNN T1,DV.DSK ;IS IT A DISK?
JRST GETFS6 ;NO, TELL HIM HE LOSES
SKIPN FILPPN ;SKIP IF DIRECTORY WAS SPECIFIED
JRST .POPJ1 ;ELSE, JUST RETURN
MOVE T2,FILPTH+2 ;GET PPN FROM PATH BLOCK
MOVE T1,Q.PPN(Q) ;GET DEFAULT PPN
TLNN T2,-1 ;WAS PROJECT NUMBER SPECIFIED
HLLM T1,FILPTH+2 ;NO, DEFAULT IT
TRNN T2,-1 ;WAS PROGRAMMER NUMBER SPECIFIED
HRRM T1,FILPTH+2 ;NO, DEFAULT IT TOO
PJRST .POPJ1 ;AND RETURN
GETFS6: MOVEI T1,DND% ;DEVICE NOT A DISK
JRST LOGERR ;AND LOG THE ERROR
;+LOGERR -- Routine to type an error message into the LOG.
; Call with T1 containing the address of the message.
; LOGERR stamps the LOG and prints the message. If
; the first character of the message is a "?", set
; F.FATE bit.
;-;#2
; !-------------------------------------------------------!
; ! LOGERR - LOGER1 (B) !
; ! +1 IF LOGERR !
; ! +2 IF LOGER1 !
; !=======================================================!
; ! AC ! CALLED ! RETURNED !
; !-------------------------------------------------------!
; ! T1 ! ADDRESS OF MESSAGE ! --- !
; !-------------------------------------------------------!
LOGER1: AOS (P) ;SET FOR SKIP RETURN
LOGERR: STAMP STERR ;ERROR STAMP
TELL LOG,(T1) ;PRINT THE MESSAGE
LDB T1,[POINT 7,0(T1),6]
CAIN T1,"?" ;IS THE FIRST CHARACTER A QUESTION MARK?
ON F.FATE ;YES, SET FATAL ERROR BIT
POPJ P, ;AND RETURN
;+SETSWC -- Routine to setup for and call DOSWCH to search
; the non-$JOB card switch table. Sets up the ACs
; and calls DOSWCH.
;-;#2
; !-------------------------------------------------------!
; ! SETSWC (B) !
; ! +1 ALWAYS !
; ! +2 NEVER !
; !=======================================================!
; ! AC ! CALLED ! RETURNED !
; !-------------------------------------------------------!
; ! T1 ! VALID SWITCH BITS ! --- !
; !-------------------------------------------------------!
SETSWC: MOVS T2,T1 ;GET XWD VALID SW BITS,0
HRRI T2,SADRS ;GET XWD VAL SW BITS,DISTAB ADR
MOVE T1,[-.NMSW,,SWTCH]
PJRST DOSWCH ;AND CALL DOSWCH
;+DOSWCH -- Routine to process switches. Call with T1 con-
; taining -table length,,table address and T2 containing
; valid switch bits,,dispatch table address.
;-;#2
; !-------------------------------------------------------!
; ! DOSWCH (B) !
; ! +1 ALWAYS !
; ! +2 NEVER !
; !=======================================================!
; ! AC ! CALLED ! RETURNED !
; !-------------------------------------------------------!
; ! T1 !-LENGTH,,TABLE ADDRESS! --- !
; !-------------------------------------------------------!
; ! T2 !SW. BITS,,DISP TBL ADR! --- !
; !-------------------------------------------------------!
DOSWCH: MOVEM T1,DOSW.A ;SAVE -TABLEN,,TABADR
MOVEM T2,DOSW.B ;SAVE BITS,,DISPADR
DOSWC1: PUSHJ P,FNDSWC ;GO FIND A SWITCH
POPJ P, ;EOL, RETURN
PUSHJ P,S$SIX ;GET SWITCH NAME
JRST DOSWC2 ;ILLEGAL CHARACTER
MOVEM T1,L.SWCH ;SAVE WHAT WE'VE GOT
MOVE T2,DOSW.A ;LOAD -TABLEN,,TABADR
PUSHJ P,UNIQ6 ;GET A UNIQUE MATCH
JRST DOSWC3 ;SOME CASE!
HRRZ T2,DOSW.A ;GET SWITCH TABLE ADDRESS
ADD T2,T1 ;ADD IN THE OFFSET
MOVE T2,(T2) ;GET FULL SWITCH NAME
MOVEM T2,L.SWCH ;AND SAVE IT
HRRZ T2,DOSW.B ;GET ADR OF DISPATCH TABLE
ADD T2,T1 ;ADD IN THE OFFSET
HLRZ T3,DOSW.B ;GET VALID SWITCH BITS
HRRZ T1,(T2) ;LOAD ADR OF SWITCH HANDLER
HLRZ T2,(T2) ;LOAD VALID BITS FOR THIS SWITCH
TRNN T2,(T3) ;TEST THE BITS FOR LEGALITY
JRST DOSWC4 ;HE LOSES
PUSHJ P,(T1) ;WIN, DISPATCH!!!
JRST DOSWC1 ;AND LOOP FOR NEXT SWITCH
DOSWC2: SKIPA T1,[EXP UCO%] ;LOAD ADR OF UCO MESSAGE
DOSWC3: MOVEI T1,URS% ;LOAD ADR OF URS MESSAGE
PUSHJ P,LOGERR ;LOG THE MESSAGE
JRST DOSWC1 ;AND LOOP AROUND
DOSWC4: PUSHJ P,E$ISW ;ILLEGAL SWITCH
JRST DOSWC1 ;AND LOOP AROUND
DOSW.A: BLOCK 1 ;-TABLE LENGTH,,TABLE ADDRESS
DOSW.B: BLOCK 1 ;VALID SWITCH BITS,,DISPATCH TABLE ADR
;+FNDSWC -- Routine to scan for a "/" to begin the next
; switch.
;-;#2
; !-------------------------------------------------------!
; ! FNDSWC (B) !
; ! +1 ON END-OF-LINE !
; ! +2 WITH BEGINNING OF NEXT SWITCH FOUND !
; !-------------------------------------------------------!
FNDSWC: CAIN C,"/" ;GOT ONE ALREADY?
PJRST .POPJ1 ;YES, SKIP BACK
FNDSW1: PUSHJ P,.SCIN ;GET A CHARACTER
POPJ P, ;EOL, RETURN
CAIN C,"/" ;A SLASH?
PJRST .POPJ1 ;YES, SKIP BACK
JRST FNDSW1 ;NO, LOOP
;+SWTOCT - SWTDEC -- Routines to process octal and decimal
; valued switches. Call with T1 containing address
; of 2-word block as described below.
;-;#1
;: !=======================================================!
;: ! MINIMUM VALUE ! MAXIMUM VALUE !
;: !-------------------------------------------------------!
;: ! BYTE POINTER FOR RESULT !
;: !=======================================================!
; !-------------------------------------------------------!
; ! SWTDEC - SWTOCT (B) !
; ! +1 ALWAYS !
; ! +2 NEVER !
; !=======================================================!
; ! AC ! CALLED ! RETURNED !
; !-------------------------------------------------------!
; ! T1 !ADR OF TWO WORD BLOCK ! --- !
; !-------------------------------------------------------!
SWTOCT: CAIN C,"/" ;BREAK ON A SLASH?
PJRST E$MSV ;YES, MISSING VALUE!!
MOVEM T1,SWT.A ;SAVE CALLING ARGUMENT
PUSHJ P,S$OCT ;GET OCTAL ARGUMENT
PJRST E$USV ;GARBAGE
JRST SWTNUM ;OK, GO HANDLE THINGS
SWTDEC: CAIN C,"/" ;A SLASH SEEN?
PJRST E$MSV ;YES, GIVE ERROR
MOVEM T1,SWT.A ;SAVE CALLING ARGUMENT
PUSHJ P,S$DEC ;GET DECIMAL ARGUMENT
PJRST E$USV ;GARBAGE!
SWTNUM: MOVE T2,SWT.A ;LOAD POINTER TO ARG BLOCK
HLRZ T3,(T2) ;GET MINIMUM VALUE
HRRZ T4,(T2) ;GET MAXIMUM VALUE
CAML T1,T3 ;CHECK RANGE
CAMLE T1,T4
PJRST E$SOR ;OUT OF RANGE
DPB T1,1(T2) ;DEPOSIT THE ARGUMENT
POPJ P, ;AND RETURN
SWT.A: BLOCK 1 ;TEMPORARY STORAGE
;^;+FILENT -- Routine to setup User's Files.
; Called to ENTER a user's files in the
; correct place. Call with accumulator T1 con-
; taining the File Block Bits. ENTERS tHE FILE,
; causes the file to be remembered in the FILE BLOCKS.
;-;#2
;CALL:
; PUSHJ P,FILENT
; RETURN HERE ON ERROR
; RETURN HERE OTHERWISE
FILENT: MOVEM T1,FILE.A ;SAVE FILE BLOCK BITS
MOVSI T1,FIL ;LOAD THE CHANNEL
IOR T1,[FO.PRV+.FOCRE] ;FILOP STUFF
SKIPL FILSTS ;IS THIS A UNIQUE NAME?
HRRI T1,.FOWRT ;NO, USE WRITE, NOT CREATE
MOVEM T1,L.FLOP+.FOFNC ;SAVE IT
MOVEI T1,.IOASL ;LOAD ASCII MODE
TXNE F,F.IMG!F.BIN ;IS IT IMAGE OR BINARY?
MOVEI T1,.IOBIN ;YES, LOAD BINARY
MOVEM T1,L.FLOP+.FOIOS ;SAVE IT
MOVE T1,FILDEV ;GET THE DEVICE
MOVEM T1,L.FLOP+.FODEV ;STORE IT
MOVSI T1,FILBH ;LOAD OBUF,,0
MOVEM T1,L.FLOP+.FOBRH ;STORE IT
PUSHJ P,CLRUUO ;CLEAR THE UUOBLK
MOVE T2,FILNAM ;GET FILENAME
MOVEM T2,RIBNAM ;PUT IN UUO BLOCK
MOVE T2,FILEXT ;AND THE EXTENSION
MOVEM T2,RIBEXT ;AND STORE IT
MOVE T2,FILPRV ;GET PROTECTION
MOVEM T2,RIBPRV ;AND STORE IT
MOVE T2,FILPPN ;GET FILE'S PPN
MOVEM T2,RIBPPN ;AND SAVE IT
MOVEI T2,.RBSTS ;GET LENGTH OF UUO BLOCK
MOVEM T2,RIBCNT ;AND STORE IT
MOVEI T1,RP.NQC ;GET NQC BIT
SKIPGE FILSTS ;IS IT AN NQC FILE?
MOVEM T1,RIBSTS ;YES, SET IT
MOVSI T1,-1 ;USE DEFAULT # OF BUFFERS
MOVEM T1,L.FLOP+.FONBF ;STORE IT
MOVEI T1,L.UUBK ;LOAD ADDRESS OF LOOKUP BLOCK
MOVEM T1,L.FLOP+.FOLEB ;STORE IT
SETZM L.FLOP+.FOPAT ;CLEAR PATH WORD
MOVE T1,.JBFF ;GET JOBFF BEFORE BUFFER
MOVEM T1,FILOFF ;SAVE
;FILENT IS CONTINUED ON THE NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
IFN FTUUOS,<
MOVE T1,Q.PPN(Q) ;GET USER'S PPN
MOVEM T1,L.FLOP+.FOPPN ;SAVE FOR CHKACC
MOVE T1,[.FOPPN+1,,L.FLOP] ;FILOP POINTER
FILOP. T1, ;DO IT
JRST FILEN2 ;PROBLEM?
MOVE T1,.JBFF ;GET JOBFF
MOVEM T1,FILNFF ;SAVE AS NEW JOBFF
MOVE T1,FILE.A ;GET FILE BLOCK BITS
PUSHJ P,FBENT ;ENTER IN FILE BLOCKS
PJRST .POPJ1 ;AND RETURN
> ;END IFN FTUUOS
IFN FTJSYS,<
OPEN FIL,L.FLOP+.FOIOS ;OPEN THE I/O CHANNEL
JRST [MOVEI T1,ERNSD% ;NO SUCH DEVICE
JRST FILEN2] ;AND LOSE
SKIPL FILSTS ;IS IT NON-SUPER FILE?
JRST FILENC ;NO, JUST ENTER IT
MOVEI T1,ERAEF% ;LOAD POSSIBLE ERROR CODE
LOOKUP FIL,L.UUBK ;NO, LOOK IT UP
JRST FILENB ;FAILED, HOPE ITS FNF
HRRZM T1,RIBEXT ;LOOKUP WON, SO LOSE
FILENB: HRRZ T1,RIBEXT ;GET THE ERROR CODE
JUMPN T1,FILEN2 ;LOSE IF NO FNF
FILENC: ENTER FIL,L.UUBK ;ENTER THE FILE
JRST FILEN2 ;LOSE!
MOVE T1,[1,,T2] ;SETUP ARG FOR COMPT.
MOVE T2,[FIL,,10] ;CHANNEL,,FUNCTION
COMPT. T1, ;GET FILE'S JFN
JRST FILEN2 ;LOSE BIG
MOVEM T1,L.COMP+.CKAUD ;SAVE THE JFN OF THE FILE
MOVX T1,.CKACN ;GET ACCESS DESIRED
MOVEM T1,L.COMP+.CKAAC ;SAVE IT
HRROI T1,L.UNAM ;STRING POINTER TO USER
MOVEM T1,L.COMP+.CKALD ;SAVE IT
HRROI T1,L.SL2 ;POINTER TO CONNECTED DIR
MOVEM T1,L.COMP+.CKACD ;SAVE IT
SETZM L.COMP+.CKAEC ;NO CAPABILITIES
MOVX T1,<CK%JFN+.CKAUD+1> ;ARG FOR CHKACC
MOVEI T2,L.COMP ;ADDRESS OF BLOCK
CHKAC ;DO IT!
SETZ T1, ;FAIL
PJUMPE T1,FILEND ;JUMP IF NO ACCESS
OUTBUF FIL,2 ;ELSE, MAKE BUFFERS
MOVE T1,.JBFF ;GET JOBFF
MOVEM T1,FILNFF ;SAVE NEW JOBFF
MOVE T1,FILE.A ;GET FILE BLOCK BITS
PUSHJ P,FBENT ;ENTER FILE IN FB
PJRST .POPJ1 ;AND RETURN
;FILENT IS CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
FILEND: CLOSE FIL,CL.RST ;DO A CLOSE RESET
MOVEI T1,ERPRT% ;LOAD A PROTECTION FAIL
JRST FILEN2 ;AND GO LOSE
> ;END IFN FTJSYS
FILEN2: CAIE T1,ERAEF% ;ALREADY EXISTING FILE?
JRST ENTERT ;NO, LOSE
LDB T1,[POINT 6,FILNAM,11] ;GET CODE
CLEARM FILNAM ;CLEAR THE WORD
PUSHJ P,MAKFUN ;MAKE A NEW NAME
MOVE T1,FILE.A ;LOAD FILE BLOCK BITS
JRST FILENT ;AND TRY AGAIN
FILE.A: BLOCK 1 ;SAVE FB FLAGS
;+ENTERR - ENTERT - ENTERO -- Routine to put together an ENTER
; error and send it to the correct place. Entry points are:
;-
;:ENTERR - send message to both OPR and LOG
;:ENTERT - send message to the LOG
;:ENTERO - send message to the OPR
;#2
; !-------------------------------------------------------!
; ! ENTERR - ENTERT - ENTERO (B) !
; ! +1 ALWAYS !
; ! +2 NEVER !
; !=======================================================!
; ! AC ! CALLED ! RETURNED !
; !-------------------------------------------------------!
; ! T1 ! UUO ERROR CODE ! --- !
; !-------------------------------------------------------!
ENTERT: TXOA F,F.QOPR ;QUIET THE OPER
ENTERO: ON F.QLOG ;QUIET THE LOG
ENTERR: TXOE F,F.SHMG ;TURN OF SHMG AND MULTIPLX ITS STATE WITH FATE
ON F.FATE ;TURN ON FATAL ERROR BIT
PUSHJ P,GETHGH ;UUO ERROR MESSAGES ARE IN HISEG
STAMP STERR ;ERROR STAMP
SKIPL T1 ;LT 0?
CAILE T1,.NMUUM ;OR GREATER THAN MAX?
MOVEI T1,.NMUUM+1 ;YES, USE UUU ERROR
MOVE T3,T1 ;PUT CODE IN T3 FOR ^F ACTION CHAR
TELL LOG!OPR,LKE% ;PRINT ENTER ERROR MESSAGE
TELL LOG!OPR,@UUOMSG(T1) ;PRINT UUO MESSAGE
TELL LOG!OPR,CRLF ;A CRLF
OFF F.QOPR!F.QLOG ;REVIVE ALL
TXON F,F.FATE ;TURN ON FATAL ERROR BIT
OFF F.SHMG ;IF IT WAS OFF TURN OFF SHORT MESSAGES
POPJ P, ;AND RETURN
;+MAKFUN -- Routine to setup up a default filespec.
; Call with T1 containing the 2 character prefix
; right justified.
; Generates funnyname.ext if necessary and sets the
; NQC flag.
;-;#2
; !-------------------------------------------------------!
; ! MAKFUN (B) !
; ! +1 ALWAYS !
; ! +2 NEVER !
; !=======================================================!
; ! AC ! CALLED ! RETURNED !
; !-------------------------------------------------------!
; ! T1 ! 2 CHAR PREFIX ! --- !
; !-------------------------------------------------------!
MAKFUN: SKIPE FILNAM ;IS THERE A FILE NAME?
POPJ P, ;YES, JUST RETURN
PUSH P,T1 ;SAVE THE PREFIX
PUSHJ P,FUNNY ;GET LAST FOUR CHARACTERS
POP P,T3 ;GET THE PREFIX BACK
ROT T3,-^D12 ;LEFT JUSTIFY IT
IOR T1,T3 ;INCLUSIVE OR IT IN
MOVEM T1,FILNAM ;SAVE THE FILNAM
HRROS FILSTS ;SET THE NQC FLAG
POPJ P, ;AND RETURN
;+FUNNY -- Routine to make up a 4 character Funny Name.
; Returns the four characters in 6bit right justified in T1.
; The names consist of the letters A-Z and the digits 0-9.
;
;The algorithm used is to first AOS location L.FUN and use this
; as a pseudo-random number. Dividing this by 36^4 and using
; the remainder as a 4-digit number base 36. (See FILUUO in the
; TOPS10 Monitor.)
;-;#2
; !-------------------------------------------------------!
; ! FUNNY (B) !
; ! +1 ALWAYS !
; ! +2 NEVER !
; !=======================================================!
; ! AC ! CALLED ! RETURNED !
; !-------------------------------------------------------!
; ! T1 ! --- ! 4 CHARS RT JUSTIFIED !
; !-------------------------------------------------------!
FUNNY: AOS T1,L.FUN ;GET NEXT FUNNY NUMBER
IDIV T1,[^D1679616] ;DIVIDE BY 36^4
MOVM T1,T2 ;AND LOAD THE REMAINDER
PUSHJ P,FUNLUP ;MAKE A NAME
JFCL ;IGNORE THE SKIP
TLZ T1,777700 ;MAKE SURE ITS ONLY 4 CHARS
POPJ P, ;AND RETURN
FUNLUP: IDIVI T1,^D36 ;DIVIDE BY 36
HRLM T2,(P) ;STORE DIGIT ON STACK
SKIPE T1 ;FINISHED?
PUSHJ P,FUNLUP ;NO, RECURSE
MOVEI T1,'000' ;PRE-LOAD T1
HLRZ T2,(P) ;LOAD A DIGIT
ADDI T2,20 ;MAKE IT 6BIT
CAILE T2,31 ;NUMERIC?
ADDI T2,7 ;NO, ALPHABETIC, ADD OFFSET
LSH T1,6 ;SHIFT OVER ACCUMULATED NAME
IOR T1,T2 ;OR IN NEXT CHARACTER
PJRST .POPJ1 ;AND UNWIND
;+STDECK -- Routine to call the correct stacking routine.
; STDECK determines which of the stacking routines
; to call, ASCII, IMAGE or BINARY, by checking the mode
; flags in F. Before returning, it correctly sets F.NXT
; flag if necessary.
;-;#2
; !-------------------------------------------------------!
; ! STDECK (B) !
; ! +1 NEVER !
; ! +2 ALWAYS !
; !-------------------------------------------------------!
STDECK: ON F.DECK ;TURN ON THE STACKING FLAG
TXNN F,F.IMG ;IS IT AN IMAGE DECK?
JRST STDEK1 ;NO, CHECK OTHERS
PUSHJ P,STIMG ;YES, CALL IMAGE STACKER
JRST STDEK4 ;AND RETURN
STDEK1: TXNN F,F.BIN ;IS IT A BINARY DECK?
JRST STDEK2 ;NO, CHECK OTHERS
PUSHJ P,STBIN ;YES, CALL BINARY STACKER
JRST STDEK3 ;AND RETURN
STDEK2: PUSHJ P,STASC ;GO STACK AN ASCII DECK
STDEK3: TXNN F,F.EOF ;IS EOF SET?
TXOA F,F.NXT ;NO, SO SET F.NXT
STDEK4: OFF F.NXT ;EOF IS SET, SO CLEAR F.NXT
PJRST .POPJ1 ;AND SKIP BACK
;+CTLCRD -- Routine to copy the remainder of the current card
; (up to a specified break character) into the control
; file. Call with T1 containing the desired break
; character (zero if break on eol is desired). Returns
; with break character in accumulator C. Break character
; is NOT written in control file.
;-
; !-------------------------------------------------------!
; ! CTLCRD (B) !
; ! +1 IF EOF ENCOUNTERED !
; ! +2 IF BREAK ENCOUNTERED !
; !=======================================================!
; ! AC ! CALLED ! RETURNED !
; !-------------------------------------------------------!
; ! T1 ! BREAK CHARACTER OR 0 ! UNCHANGED !
; !-------------------------------------------------------!
CTLCRD: PUSHJ P,.SCIN ;GET A CHARACTER
POPJ P, ;EOL, RETURN
CAIN C,(T1) ;CHECK FOR BREAK
PJRST .POPJ1 ;GOT IT!! RETURN
CHR CTL,(C) ;TYPE IT INTO CTL
JRST CTLCRD ;AND LOOP
SUBTTL FILE-BLOCK Manipulation Routines
COMMENT /
;^;=
! The FILE BLOCKS
The FILE BLOCKS are a set of four word blocks which are used to
store information about files which should be remembered by SPRINT
for one reason or another. The entries in each word are as follows:
Word 0 File Structure Name
Word 1 File Name
Word 2 Filename Extension ,, Status Bits
Word 3 File's real PPN
The FILE BLOCKS are allocated in clusters with A%NFLR blks per cluster.
The first cluster is preallocated starting at location L.FILR. The
last FILE BLOCK in a cluster is used as a link to the next
cluster if more space is needed. The link contains 0,,-1 in the
0th word, and the address of the next cluster in the 1st word.
The 'load order' field is set for each file which is to be loaded
on the next $DATA or $EXECUTE card. This is done so that the
files are loaded in the order specified by the user, which is
important especially for files loaded in library search mode.
Routines are:
FBENT Enter a file into the FILE BLOCKS
FBFND Find files in the FILE BLOCKS
FBLNK Link in a new cluster of FILE BLOCKS
FBCLOD Clear the load order for a new set of files
;--;^
/
;+FBENT -- Routine to place a file in the FILE BLOCKS.
;FBENT uses the information in the file device cells (i.e.
;FILDEV, FILNAM,..) to fill in the FILE BLOCK. Call with the
;FILE BLOCK flags in T1. FBENT will set the load order for
;the file if necessary.
;-;#3
;CALL:
; PUSHJ P,FBENT
; ALWAYS RETURN HERE
FBENT: PJUMPE T1,.POPJ ;IF BITS ARE ZERO, DON'T STORE ANYTHING
MOVEI T2,L.FILR ;GET ADDRESS OF FIRST FILE BLOCK
CLEAR T3, ;CLEAR A COUNTER
FBENT1: SKIPN .FBNAM(T2) ;IS IT FREE?
JRST FBENT3 ;YES, GO FILL IT IN
ADDI T2,FBSIZE ;INCREMENT INDEX
CAIGE T3,A%NFLR-2 ;SEE IF WE HAVE HIT THE LAST ONE
AOJA T3,FBENT1 ;NO, LOOP SOME MORE
FBENT2: MOVE T3,.FBDEV(T2) ;IS THERE ANOTHER CLUSTER?
CAIE T3,-1 ;YES IF IT IS 0,,-1
PUSHJ P,FBLNK ;NO, GO CREATE ONE
CLEAR T3, ;CLEAR THE COUNTER
MOVE T2,.FBNAM(T2) ;LOAD NEW BASE ADDRESS
JRST FBENT1 ;AND KEEP LOOPING
FBENT3: CLEAR T4, ;CLEAR FOR LOAD ORDER IF NECESSARY
TXNE T1,FB.LOD!FB.LDR;WILL THIS BE LOADED?
AOS T4,L.FBCT ;YES, GET NEXT NUMBER
ADD T1,T4 ;ADD INTO STATUS BITS
HLL T1,FILEXT ;GET THE EXTENSION IN THERE
MOVEM T1,.FBEXT(T2) ;AND STORE IT
SKIPN T1,FILDEV ;GET STR NAME
MOVSI T1,DEFDSK ;DSK IF 0
MOVEM T1,.FBDEV(T2) ;AND SAVE IT
MOVE T1,FILNAM ;GET FILENAME
MOVEM T1,.FBNAM(T2) ;SAVE THAT
MOVE T1,FILPPN ;AND FINALLY PPN
JUMPE T1,FBENT4 ;DON'T CHECK FOR PATH IF ZERO
TLNE T1,-1 ;IS LEFT HALF 0?
JRST FBENT4 ;NO, ITS A PPN
MOVEI T1,10 ;YES, LETS ALLOCATE A PATH BLOCK
PUSHJ P,EXPND ;AND EXPAND CORE, RET: T1=ADR OF BLOCK
MOVSI T3,FILPTH ;FROM
HRRI T3,(T1) ;TO,
BLT T3,7(T1) ;BLT!!!
FBENT4: MOVEM T1,.FBPPN(T2) ;STORE IT
AOS L.FILN ;INCREMENT NUMBER OF USED FILEBLOCKS
POPJ P, ;AND RETURN
;+FBFND -- Routine to Scan the FILE BLOCKS.
; IF FBFND is called with 0 in T1, it will return in T1
; the address of the first in-use FILE BLOCK. If this
; Address is used as the argument to FBFND, the address
; of the next in-use FILE BLOCK will be returned. When
; all FILE BLOCKs have been scanned, 0 is returned in T1.
;-;#3
; !-------------------------------------------------------!
; ! FBFND (B) !
; ! +1 ALWAYS !
; ! +2 NEVER !
; !=======================================================!
; ! AC ! CALLED ! RETURNED !
; !-------------------------------------------------------!
; ! T1 ! 0 !ADR OF NEXT FILE BLOCK!
; ! ! OR ADR OF A FILE BLK ! OR 0 !
; !-------------------------------------------------------!
FBFND: JUMPN T1,FBFND1 ;JUMP IF ARG IS NOT 0
MOVE T2,L.FILN ;GET TOTAL NUMBER IN-USE
MOVEM T2,L.FBFN ;SAVE IT
MOVEI T1,L.FILR-FBSIZE;GET STARTING ADDRESS LESS INCREMENT
FBFND1: SOSGE L.FBFN ;LAST ONE FOUND?
JRST FBFND5 ;YES, RETURN 0
FBFND2: ADDI T1,FBSIZE ;POINT TO NEXT FILE BLOCK
FBFND3: SKIPN .FBNAM(T1) ;IN-USE?
JRST FBFND2 ;NO, GET NEXT ONE
MOVE T2,.FBDEV(T1) ;GET DEVICE
CAIE T2,-1 ;0,,-1 MEANS ITS A LINK
POPJ P, ;ITS NOT, RETURN ADDRESS
MOVE T1,.FBNAM(T1) ;GET ADDRESS OF NEXT CLUSTER
JRST FBFND3 ;AND LOOP WITHOUT INCREMENTING 1ST TIME
FBFND5: CLEAR T1, ;END OF SCAN
POPJ P, ;RETURN
;+FBLNK -- Routine to link up a new FILE BLOCK cluster.
; Call with T2 containing the address of the last FILE
; BLOCK in the last cluster.
;-;#3
;CALL:
; PUSHJ P,FBLNK
; ALWAYS RETURN HERE
FBLNK: PUSH P,T1 ;SAVE T1
MOVEI T1,<FBSIZE*A%NFLR> ;LOAD SIZE OF DESIRED BLOCK
PUSHJ P,EXPND ;GET BLOCK OF DESIRED SIZE (ZEROED)
MOVEM T1,.FBNAM(T2) ;SAVE LINK ADDRESS
MOVEI T1,-1 ;LOAD 0,,-1
MOVEM T1,.FBDEV(T2) ;FLAG END OF CHUNK
PJRST T1POPJ ;RESTORE T1 AND RETURN
;+FBCLOD -- Routine to reset the load order.
; FBCLOD is called on the first $language, $RELOC
; or $INCLUDE card after a $DATA or $EXECUTE card.
; It resets the load order, clears the load bits in
; the currently used FILE BLOCKS, and deletes entries
; which are no longer needed.
;-
; !-------------------------------------------------------!
; ! FBCLOD (B) !
; ! +1 ALWAYS !
; ! +2 NEVER !
; !-------------------------------------------------------!
FBCLOD: SKIPN L.LOAD ;IS LOAD SET?
POPJ P, ;NO, JUST RETURN
CLEARB T1,L.LOAD ;CLEAR THE LOAD FLAG, AND T1
CLEARM L.FBCT ;CLEAR THE LOAD ORDER WORD
FBCLD1: PUSHJ P,FBFND ;GET AN ENTRY
PJUMPE T1,.POPJ ;RETURN WHEN DONE
HRRZ T2,.FBEXT(T1) ;GET STATUS FLAGS
TRNN T2,FB.LOD!FB.LDR;WAS IT LOADED?
JRST FBCLD1 ;NO, LOOP AROUND FOR THE NEXT ONE
TRZ T2,FB.LOD!FB.LDR!FB.SRH!FB.ORD
HRRM T2,.FBEXT(T1) ;CLEAR ALL THE LOAD BITS AND RESTORE STATUS
JUMPN T2,FBCLD1 ;IF THERE ARE STILL BITS SET, LOOP FOR
; ANOTHER
CLEARM .FBDEV(T1) ;OTHERWISE, RECLAIM THE ENTRY
CLEARM .FBEXT(T1)
CLEARM .FBNAM(T1)
CLEARM .FBPPN(T1)
SOS L.FILN ;DECREMENT USE COUNT
JRST FBCLD1 ;AND LOOP AROUND FOR NEXT ONE
SUBTTL Scanners
COMMENT /
;^;=
Scanners
All the scanners are called with location L.SCIN containing the
address of a get-a-character routine from the desired source of
input, and location L.SCLN containing the address of a get next
record routine.
It should be assumed that all scanners use T1 through T5, even
though some don't use all of them.
The scanners are:
S$DEC Return a decimal number
S$OCT Return an octal number
S$SIX Return a sixbit word
S$STRG Return an ASCIZ string
S$TIM Return a time specification
.SCDT Return a date-time specification
S$FILE Return a file-specification
Scanner utility routines are:
UNIQ6 Return index of unique table match
.SCFLS Flush leading spaces
.SCIN Get the next valid character
;--
/
;^;+S$OCT - S$DEC -- Octal and decimal number scanners.
; Returns scanned number in T1. Skip returns if at
; least one digit was found. Non-skip return is taken if the
; first character was not a digit. On a non-skip return, if
; T1 contains -1, then an end of line was seen while scanning
; for the first character.
;--
S$OCT: SKIPA T2,S$NUM1 ;LOAD AN 8
S$DEC: MOVEI T2,12 ;LOAD A 10
S$NUM: CLEAR T1, ;CLEAR THE ACCUMULATOR
PUSHJ P,.SCFLS ;FLUSH LEADING SPACES AND GET A CHAR
JRST S$NUM4 ;EOL, RETURN -1
CAIL C,"0" ;CHECK RANGE
CAILE C,"0"-1(T2)
S$NUM1: POPJ P,8 ;NOT IN RANGE
JRST S$NUM3 ;OK, SKIP INTO LOOP
S$NUM2: PUSHJ P,.SCIN ;GET A CHARACTER
PJRST .POPJ1 ;EOL, RETURN.
CAIL C,"0" ;CHECK THE RANGE
CAILE C,"0"-1(T2)
PJRST .POPJ1 ;ITS NOT A NUMBER
S$NUM3: IMULI T1,(T2) ;SHIFT RADIX POINT OVER ONE
ADDI T1,-"0"(C) ;ADD IN THE NEXT DIGIT
JRST S$NUM2 ;AND LOOP AROUND FOR THE NEXT DIGIT
S$NUM4: SETO T1, ;LOAD A -1
POPJ P, ;AND TAKE ERROR RETURN
;+S$SIX -- Routine to scan off a sixbit word.
; Returns with T1 containing the first six alphanumeric
; characters from the input source, and T3 containing the number
; of characters returned. Returns next character in C.
;-;#2
;CALL:
; PUSHJ P,S$SIX
; RETURN HERE IF 1ST CHAR WAS NOT A-Z 0-9 OR SPACE
; RETURN HERE OTHERWISE
S$SIX: CLEARB T1,T3 ;T1 GETS RESULTS T3 GETS COUNT
MOVE T4,[POINT 6,T1] ;A BYTE POINTER FOR RESULTS
PUSHJ P,.SCFLS ;FLUSH LEADING SPACES
PJRST .POPJ1 ;EOL!
JRST S$SIX3 ;FALL INTO LOOP WITH 1ST CHAR
S$SIX1: PUSHJ P,.SCIN ;GET A CHARACTER
JRST S$SIX5 ;NO MORE
S$SIX3: CAIL C,"A" ;CHECK FOR ALPHA
CAILE C,"Z"
SKIPA ;ITS NOT, TRY 0-9
JRST S$SIX4 ;GOT AN ALPHA
CAIL C,"0" ;TRY FOR NUMBERIC
CAILE C,"9"
JRST S$SIX5 ;NOT, RETURN
S$SIX4: SUBI C,.ASSPC ;MAKE IT 6BIT
PUSHJ P,S$SIX6 ;DEPOSIT IT
JRST S$SIX1 ;AND LOOP
S$SIX5: PJUMPE T3,.POPJ ;NON-SKIP IF LOST ON 1ST CHAR
PJRST .POPJ1 ;ELSE SKIP BACK
S$SIX6: TLNN T4,770000 ;GOT SIX ALREADY?
POPJ P, ;YUP DON'T DEPOSIT MORE
IDPB C,T4 ;ELSE, STORE CHAR
AOJA T3,.POPJ ;INCR COUNT AND RETURN
;+S$STRG -- Routine to scan an ASCIZ string.
; Call with T1 containing the address of an 8 word
; block to store the string. String terminates on a blank, or
; after the 39th character.
;-;#2
;CALL:
; PUSHJ P,S$STRG
; ALWAYS RETURN HERE
S$STRG: HRLI T1,440700 ;MAKE A BYTE POINTER
CLEAR T2, ;AND CLEAR A COUTNER
S$STR1: PUSHJ P,.SCIN ;GET A CHARACTER
JRST S$STR2 ;EOL OR SOMETHING LIKE THAT
CAIN C," " ;IS THIS OUR BREAK?
JRST S$STR2 ;YES, DEPOSIT THE NULL AND RETURN
IDPB C,T1 ;ELSE DEPOSIT THE CHAR
CAIGE T2,^D38 ;GOT ENUF?
AOJA T2,S$STR1 ;NO, GET SOMEMORE
S$STR2: MOVEI C,0 ;LOAD NULL
IDPB C,T1 ;DEPOSIT IT
POPJ P, ;AND RETURN
UP
;+S$TIM -- Routine to return a Time Specification
;S$TIM scans a string of the form hh:mm:ss and returns
; L.HRS, L.MIN, L.SEC updated. No range checking
; is done so 120 may be used instead of 2:0.
;-;#2
;CALL:
; PUSHJ P,S$TIM
; RETURN HERE IF TOO MANY ARGS SPECIFIED (# IN T1)
; RETURN HERE OTHERWISE
S$TIM: CLEARM L.HRS ;CLEARM ANSWERS
CLEARM L.MIN ;BEFORE WE ASK THE QUESTIONS
CLEARM L.SEC
MOVEI T5,L.SEC ;ADDRESS FOR LAST ARGUMENT
MOVNI T4,3 ;-VE NUMBER OF LEGAL ARGS
PUSHJ P,S$TML ;GO SCAN SOME
JUMPLE T4,.POPJ1 ;WIN BIG
ADDI T4,3 ;CONVERT TO NUMBER OF ARGS
POPJ P, ;ANY NOTIFY THAT HE LOSES
S$TML: PUSHJ P,S$DEC ;GET A DECIMAL NUMBER
JFCL
HRLM T1,(P) ;SAVE IT ON THE STACK
AOJG T4,S$TL1 ;AOS COUNT AND AVOID RUNAWAY RECURSION
CAIN C,":" ;BREAK ON COLON?
PUSHJ P,S$TML ;YES, RECURSE
S$TL1: JUMPG T4,.POPJ ;AUTOMATICALLY UNWIND IF TOO MANY ARGS
HLRZ T1,(P) ;GET AN ARGUMENT
MOVEM T1,(T5) ;SAVE IT
SOS T5 ;POINTER FOR NEXT ARG
POPJ P, ;AND UNWIND
DOWN
UP
;+.SCDT -- Date-Time Scanner.
; .SCDT is called by the /DEADLINE and /AFTER
; switches to parse a date-time specification.
;-;#2
;
;Legal date-time specifications are of the form:
;
; [+[HH:[MM]]]
; [[DD-MMM]-YY]
; [[[DD-MMM]-YY] [HH:[MM]]]
;
;FOR ALL MONTH SPECIFICATIONS (MMM) AN NUMBER OR THE MONTH NAME WILL
; BE ACCEPTED.
;FOR ALL YEAR SPECFICATIONS (YY) THE CENTURY NEED NOT BE SPECIFIED,
; I.E. 1973 OR 73 MAY BE SPECIFIED.
;
;NOTE - IN THIS ROUTINE, L.MIN HOLDS HOURS AND L.SEC HOLDS MINUTES.
; - THIS ROUTINE IS ONLY GOOD UNTIL 1999
RADIX 10 ;*****NOTE WELL*****
.SCDT: MOVE T1,[L.HRS,,L.HRS+1]
CLEARM L.HRS ;SETUP TO CLEAR RESULTS
BLT T1,L.YRS ;AND DO IT!
PUSHJ P,.SCIN ;GET A CHARACTER
POPJ P, ;EOL!!
CAIN C,"+" ;PLUS?
JRST .SCDTR ;YES, GET RELATIVE TIME
CAIL C,"0" ;CHECK TO BE SURE ITS A DIGIT
CAILE C,"9" ;0-9
POPJ P, ;NO, LOSE
.SCDT0: ON F.RSCN ;SET TO REREAD CHARACTER
PUSHJ P,S$DEC ;GET A DECIMAL NUMBER
POPJ P, ;LOSE BIG!!
CAIN C,"-" ;BACK ON A HYPHEN?
JRST .SCDAT ;YES, GET A DATE!!
.SCTMA: CAIN C,":" ;COLON?
JRST .SCTA1 ;YES, GET MORE TIME
MOVEM T1,L.SEC ;SAVE WHAT WE HAVE AS MINUTES
JRST MAKDT ;AND GO PUT IT ALL TOGETHER
.SCTA1: MOVEM T1,L.MIN ;SAVE T1
PUSHJ P,S$DEC ;GET MINUTES
POPJ P, ;???
MOVEM T1,L.SEC ;SAVE THEM
JRST MAKDT ;AND MAKE A DATE
.SCDTR: PUSHJ P,S$TIM ;GET A TIME SPEC
POPJ P, ;HE LOSES
SKIPE L.HRS ;ONLY WANT 2 ARGS
POPJ P, ;HE'S TOO ACCURATE
MSTIME T1, ;GET NOW!!
IDIV T1,[^D1000*^D3600]
ADDM T1,L.MIN ;ADD IN HRS
IDIVI T2,^D60000 ;GET MINUTES
ADDM T2,L.SEC ;ADD IT IN
JRST MAKDT ;AND GO MAKE A DATE-TIME
.SCDAT: MOVEM T1,L.DAY ;SAVE 1ST ARG AS DAY
PUSHJ P,.SCIN ;GET NEXT CHAR
POPJ P, ;LOSE!
ON F.RSCN ;RESCAN THE CHARACTER
TRNN C,^O100 ;ALPHABETIC?
JRST .SCDA3 ;ITS NOT, MUST BE NUMBER
PUSHJ P,S$SIX ;IT IS, GET MONTH NAME
POPJ P, ;??
HRRI T1,'- ' ;START MAKING IT LOOK LIKE TABLE
LSH T1,-6 ; WHICH IS '-MON- '
TLO T1,'- '
MOVSI T2,-12 ;SETUP AOBJN POINTER
.SCDA1: CAMN T1,MONTAB(T2) ;DO A COMPARE
JRST .SCDA2 ;A MATCH!!
AOBJN T2,.SCDA1 ;AND LOOP
POPJ P, ;NO MONTH THAT I'VE HEARD OF
.SCDA2: HRRM T2,L.MON ;AND STORE IT
JRST .SCDA4 ;JOIN-UP AT THE PASS
.SCDA3: PUSHJ P,S$DEC ;GET THE MONTH NUMBER
POPJ P, ;BAD FORMAT??
CAIL T1,1 ;MAKE SURE ITS 1-12
CAILE T1,12
POPJ P, ;NOPE
SOS T1 ;MAKE IT MONTH -1
MOVEM T1,L.MON ;AND STORE IT
.SCDA4: CAIE C,"-" ;SEE IF YR COMING
JRST .SCDA6 ;NO,
PUSHJ P,S$DEC ;YES, GET IT
POPJ P, ;BAD NUMBER??
CAIG T1,99 ;DID HE SPECIFY A CENTURY?
JRST .SCDA5 ;NO,
SUBI T1,1900 ;YES, MAKE IT YEARS SINCE 1900
.SCDA5: SUBI T1,64 ;MAKE IT YEARS SINCE 1964
MOVEM T1,L.YRS ;AND STORE THEM
JRST .SCDA7 ;AND FINISH UP
.SCDA6: DATE T1, ;GET THE DATE
IDIVI T1,12*31 ;GET THE YEAR-1964
MOVEM T1,L.YRS ;AND STORE IT
.SCDA7: CAIN C,"/" ;SWITCH COMING?
JRST MAKDT ;YES, SETTLE FOR WHAT WE HAVE
PUSHJ P,.SCFLS ;FLUSH LEADING SPACES
JRST MAKDT ;EOL!
CAIN C,"/" ;NOW A SWITCH?
JRST MAKDT ;YES!
CAIL C,"0" ;NO, SEE IF IT LOOKS LIKE A TIME
CAILE C,"9" ;WHICH IMPLIES A DIGIT
POPJ P, ;NO???
JRST .SCDT0 ;YES, GET A TIME
MAKDT: SKIPE L.YRS ;DATE SPECIFIED?
JRST MAKDT4 ;YES, SKIP ALL THIS
DATE T1, ;NO GET THE DATE
IDIVI T1,12*31 ;GET YEAR-1964 IN T1
IDIVI T2,31 ;GET MON-1 IN T2 AND DAY-1 IN T3
ADDI T3,1 ;MAKE A DAY
MOVEM T2,L.MON ;SAVE THE MONTH
MOVEM T3,L.DAY ;SAVE THE DAY
MAKDT1: MOVEM T1,L.YRS ;SAVE THE YEAR
MSTIME T1, ;ELSE, GET THE TIME
IDIV T1,[3600*1000] ;GET HOURS IN T1
IDIVI T2,60000 ;AND MINUTES IN T2
CAMLE T1,L.MIN ;ARE WE PAST WHAT HE SPEC'ED
JRST MAKDT3 ;MOST DEFINITELY, GO ADD A DAY
CAME T1,L.MIN ;IS IT LT OR EQ
JRST MAKDT4 ;ITS LT, DON'T ADD A DAY
CAMG T2,L.SEC ;ARE THE MINUTES PAST
JRST MAKDT4 ;NO, ALL IS WELL
MAKDT3: MOVEI T3,24 ;GOING TO INCREMENT BY 24 HOURS
ADDM T3,L.MIN ;AND DO IT
MAKDT4: MOVE T1,L.MIN ;GET HOURS
IMULI T1,60 ;AND MAKE MINUTES
ADD T1,L.SEC ;ADD MINUTES
CLEAR T2, ;FOR LOW HALF
ASHC T1,-17 ;MULT BY 2**18
DIVI T1,60*24 ;DIVIDE BY MIN/DAY
MOVEM T1,L.SEC ;AND STORE
MAKDT5: MOVE T1,L.YRS ;GET YEARS - 1964
MOVE T3,L.MON ;AND THE MONTH - 1
ADDI T1,3 ;GET <YEAR-1964>+3 (FOR LY IN 1964)
SOS T4,L.DAY ;AND GET THE DAY - 1
ADD T4,DATTBL(T3) ;ADD DAYS TO THE BEGINNING OF MONTH
IDIVI T1,4 ;GET LEAP YEARS SINCE 1964
ADDI T4,<1964-1859>*365+<1964-1859>/4+<31-18>+31(T1)
;<1964-1859>*365 = DAYS SINCE 1/1/1859
;<1964-1859>/4 = LEAP YEARS SINCE 1/1/59
;<31-18> = 11/30/1859 - 11/18/1859
;31 = DAYS IN DECEMBER 1859
;T1 CONTAINS LEAP YEARS SINCE 1964
AOS T4 ;ASSUME THIS IS A LEAP YEAR
CAIL T3,2 ;IF ITS JAN OR FEB
CAIE T2,3 ;OR ITS NOT A LEAP YEAR
SOS T4 ;NO EXTRA DAY
MOVE T1,L.YRS ;GET THE YEAR - 1964
IMULI T1,365 ;DAYS SINCE 1/1/64
ADD T4,T1 ;ADD THEM IN
MOVS T1,T4 ;GET DAYS IN LH
ADD T1,L.SEC ;ADD THE TIME
PJRST .POPJ1 ;AND RETURN WITH DATE-TIME
DATTBL: EXP 0,31,59,90,120,151,181
EXP 212,243,273,304,334
RADIX 8 ;*****BACK TO RADIX 8*****
DOWN
;+S$FILE -- Routine to scan off a filespec.
; Call with T1 containing the address of the appropriate
; device control cells.
;
;If some part of the filespec is not given, the corresponding
; location is returned unchanged, so defaults can be
; filled in before calling.
;-;#3
;CALL:
; PUSHJ P,S$FILE
; RETURN HERE ON ERROR WITH T1 CONTAINING ADR OF ERROR MESSAGE
; RETURN HERE ON SUCCESS
; FILESPEC FLAGS KEPT IN T5
SC.DIR==1B0 ;DIRECTORY WAS FOUND
SC.DEV==1B1 ;DEVICE WAS FOUND
SC.NAM==1B2 ;NAME WAS FOUND
SC.EXT==1B3 ;EXTENSION WAS FOUND
S$FILE: HRRZ T5,T1 ;FOR FLAGS,,ADDRESS
CLEARM .CCPTH(T5) ;CLEAR THE FILE STATUS WORD
S$FIL1: PUSHJ P,S$SIX ;GET FIRST ATOM
JRST S$FIL2 ;NOT ALPHANUMERIC
JUMPE T1,.POPJ1 ;EOL - SUCCESS RETURN
S$FIL2: CAIN C,":" ;DEVICE SPECIFIED?
JRST S$DEV ;YUP, GO DO IT
JUMPE T1,S$FIL3 ;NULL CANT BE FILENAME
TXOE T5,SC.NAM ;SET NAME FLAG AND SKIP IF 1ST ONE
JRST .SCFE1 ;TWO NAMES ARE ILLEGAL
MOVEM T1,.CCNAM(T5) ;STORE FILENAME
S$FIL3: CAIN C,"." ;EXTENSION COMING?
JRST S$EXT ;YES, DO IT!
IFN FTUUOS,<
CAIE C,"[" ;DIRECTORY SPEC COMING?
CAIN C,74 ;ACCEPT EITHER DELIMETER
JRST S$DIR ;YES, GO GET IT
> ;END IFN FTUUOS
CAIN C," " ;A BLANK?
JRST S$FIL1 ;YES, TRY SOME MORE
PJRST .POPJ1 ;NO, TAKE SUCCESS RETURN
S$DEV: JUMPE T1,.SCFE3 ;NULL DEVICE?
TXOE T5,SC.DEV ;SET DEV FLAG AND SKIP IF NOT DUPLICATE
JRST .SCFE4 ;DUPLICATE DEVICE
MOVEM T1,.CCDEV(T5) ;STORE DEVICE NAME
JRST S$FIL1 ;AND LOOP FOR MORE STUFF
S$EXT: TXOE T5,SC.EXT ;SET EXT FLAG AND SKIP IF 1ST ONE
JRST .SCFE2 ;NOT THE FIRST TIME!
PUSHJ P,S$SIX ;GET EXTENSION
JFCL ;NOT A VALID CHAR, STORE NULL
MOVEM T1,.CCEXT(T5) ;STORE THE EXTENSION
JRST S$FIL3 ;AND LOOP FOR MORE
IFN FTUUOS,<
S$DIR: TXOE T5,SC.DIR ;DO WE HAVE A DIRECTORY ALREADY?
JRST .SCFE8 ;YES, LOSE
MOVEI T1,.CCPTH(T5) ;LOAD ADDRESS OF PATH BLOCK
MOVEM T1,.CCPPN(T5) ;STORE IN PPN WORD
PUSHJ P,S$OCT ;GET AN OCTAL NUMBER
JFCL
JUMPN T1,S$DIR1 ;WE'VE GOT PROJ, GET PROG
CAIN C,"," ;SEE IF NULL PROJ NUMBER
JRST S$DIR1 ;IT IS, GET PROG NUMBER
CAIE C,"-" ;SEE IF DEFAULT DIRECTORY
JRST .SCFE5 ;IT ISN'T, ITS GARBAGE
PUSHJ P,.SCIN ;GET NEXT CHARACTER
JRST S$FIL1 ;EOL, LOOP FOR MORE FILSPEC STUFF
CAIN C,"," ;IS IT A COMMA
MOVEI C,"-" ;YES, MAKE IT GARBAGE CHARACTER
JRST S$DIR2 ;AND MAKE SURE DIRECTORY IS CLOSED OFF
S$DIR1: HRLM T1,.CCPTH+2(T5) ;SAVE PROJECT NUMBWR
PUSHJ P,S$OCT ;GET PROG
JFCL
HRRM T1,.CCPTH+2(T5) ;SAVE PROGRAMMER NUMBER
S$DIR2: CAIE C,"]" ;THE END
CAIN C,76 ;ONE WAY OR ANOTHER
JRST S$FIL1 ;YES, GO BACK TO THE BEGINNING
CAIE C,"," ;MORE TO COME?
JRST .SCFE5 ;NO, MORE GARBAGE
MOVEI P2,.CCPTH+3(T5) ;POINT TO FIRST SFD
S$DIR3: PUSHJ P,S$SIX ;GET SFD NAME
JRST .SCFE5 ;LOSE BIG
MOVEM T1,(P2) ;STORE IN PATH BLOCK
AOS .CCPTH(T5) ;INCREMENT 1ST WORD OF PATH BLOCK
CAIE C,"]" ;DONE YET?
CAIN C,76 ;OR THIS WAY
JRST S$FIL1 ;AND BACK TO THE BEGINNING FOR MORE FILESPEC
CAIE C,"," ;TERMINATED BY ","
JRST .SCFE5 ;NO, LOSE
MOVE T3,P2 ;GET CURRENT ADR
SUBI T3,.CCPTH(T5) ;SUBRACT BEGGINGING ADR
CAIGE T3,10 ;GREATER THAN MAX?
AOJA P2,S$DIR3 ;NO, WIN
JRST .SCFE7 ;YES, NESTING TO DEEP
> ;END IFN FTUUOS
;ERROR ROUTINES FOR FILE-SPEC SCANNER
.SCFE1: MOVEI T1,DFN%
POPJ P, ;LOAD ERROR MESSAGE ADR AND RETURN
.SCFE2: MOVEI T1,DEX% ;ERROR MSG ADDRESS
POPJ P, ;RETURN
.SCFE3: MOVEI T1,NDV% ;ERROR MSG ADDRESS
POPJ P, ;AND RETURN
.SCFE4: MOVEI T1,DDV% ;ERROR MSG ADDRESS
POPJ P, ;AND RETURN
.SCFE5: MOVEI T1,IDS% ;ERROR MSG ADDRESS
POPJ P,
.SCFE7: MOVEI T1,SND% ;ERROR MESSAGE ADDRESS
POPJ P, ;AND GOTO FAIL RETURN
.SCFE8: MOVEI T1,DDI% ;ERROR MESSAGE ADDRESS
POPJ P, ;AND RETURN
;UNIQ6 -- ROUTINE TO RETURN INDEX OF UNIQUE 6BIT MATCH
;
;CALL WITH T1 CONTAINING 6BIT WORD
; T2 CONTAINING XWD -TABLE LENGTH,TABLE ADR
; T3 CONTAINING NUMBER OF CHARACTERS INPUT
;
;CALL:
; PUSHJ P,UNIQ6
; RETURN HERE IF NO MATCH, OR NON-UNIQUE MATCH
; RETURN HERE OTHERWISE WITH T1 CONTAINING INDEX
;
;ON NON-SKIP RETURN T1 STILL HAS 6BIT WORD.
UNIQ6: MOVE T3,MSKTBL-1(T3) ;GET MASK FOR CHARACTERS
MOVEM T3,UNIQ.A ;SAVE THE MASK
HRRZM T2,UNIQ.B ;SAVE START ADR OF TABLE
CLEAR T3, ;CLEAR UNIQUENESS BITS
UNIQ.1: MOVE T4,(T2) ;GET TABLE ENTRY
CAMN T1,T4 ;EXACT MATCH?
JRST UNIQ.3 ;YES, WIN!
TDZ T4,UNIQ.A ;MASK OUT CHARS NOT TYPED
CAME T1,T4 ;MATCH NOW?
JRST UNIQ.2 ;NO, LOOP AROUND FOR ENTIRE TABLE
TROE T3,1 ;SET FIRST OCCURENCE
TROA T3,2 ;IT WAS SET, SET SECOND OCCUR
HRLI T3,(T2) ;SAVE INDEX OF FIRST OCCUR
UNIQ.2: AOBJN T2,UNIQ.1 ;AND LOOP AROUND
TRNE T3,2 ;TWO OR MORE MATCHES?
POPJ P, ;YES, LOSE
TRNN T3,1 ;DID WE GET ONE?
POPJ P, ;NO, LOSE AGAIN
MOVS T2,T3 ;GET INDEX INTO T2
UNIQ.3: HRRZ T1,T2 ;GET MATCH ADDRESS
SUB T1,UNIQ.B ;GET ABSOLUTE OFFSET
PJRST .POPJ1 ;AND SKIP BACK
MSKTBL: 7777777777 ;1 CHARACTER
77777777 ;2 CHARACTERS
777777 ;3
7777 ;4
77 ;5
0 ;6
UNIQ.A: BLOCK 1 ;FIRST TEMP
UNIQ.B: BLOCK 1 ;SECOND TEMP
;USEFUL SCANNING ROUTINES
;.SCFLS -- ROUTINE TO FLUSH LEADING SPACES
;
;CALL:
; PUSHJ P,.SCFLS
; RETURN HERE IF END-OF-LINE WAS ENCOUNTERED
; RETURN HERE OTHERWISE WITH FIRST SIGNIFICANT CHAR IN C
.SCFLS: PUSHJ P,.SCIN ;GET A CHARACTER
POPJ P, ;END-OF-LINE
CAIN C,.ASSPC ;A SPACE?
JRST .SCFLS ;YES, LOOP
PJRST .POPJ1 ;NO, RETURN
;.SCIN -- ROUTINE TO CALL THE GET A CHARACTER ROUTINE FOR THE
; SCANNERS. CHECKS FOR CONTINUATION CHARACTERS, COMMENTS ETC.
;
;CALL:
; PUSHJ P,.SCIN
; RETURN HERE ON END-OF-LINE
; RETURN HERE OTHERWISE WITH CHARACTER IN C
.SCIN: TXZE F,F.RSCN ;RESCANNING THIS CHAR?
PJRST .POPJ1 ;YES, JUST RETURN
PUSHJ P,@L.SCIN ;CALL CALLER'S ROUTINE
POPJ P, ;EOL
CAIE C,"!" ;START COMMENT FIELD?
CAIN C,";" ;EITHER TYPE!!
POPJ P, ;YES, SAME AS EOL
CAIE C,"-" ;OR CONTINUATION MARK?
PJRST .POPJ1 ;NO, SKIP BACK WITH CHARACTER
PUSH P,B ;SAVE BYTE POINTER
.SCIN1: PUSHJ P,@L.SCIN ;GET ANOTHER CHARACTER
JRST .SCIN2 ;EOL MEANS IT WAS A CONTINUATION
CAIE C,"!" ;SO DOES A COMMENT
CAIN C,";" ; EITHER TYPE OF COMMENT
JRST .SCIN2 ;SO GO GET IT
CAIN C," " ;IS IT A BLANK?
JRST .SCIN1 ;YES, LOOP FOR NON-BLANK
POP P,B ;ITS NOT A CONTINUATION
MOVEI C,"-" ;SO RESTORE THE HYPHEN
PJRST .POPJ1 ;AND RESTORE BP AND SKIP BACK
.SCIN2: POP P,B ;BRING STACK INTO PHASE
PUSHJ P,@L.SCLN ;GET NEXT RECORD
POPJ P, ;THATS THE END
JRST .SCIN ;NOPE, TRY AGAIN
SUBTTL DUMMY ROUTINES TO READ ONE CHARACTER FROM CARD
;CDRCHR -- ROUTINE TO LOAD ONE BYTE FROM CARD (L.CARD).
; CONVERTS TABS AND CR TO SPACES, AND LOWER TO UPPER
; CASE. ASSUMES AC B CONTAINS A CORRECT BYTE POINTER
;
;CALL:
; PUSHJ P,CDRCHR
; RETURN HERE IF THIS IS EOL
; RETURN HERE OTHERWISE
CDRCHR: SKIPE L.BRK ;WAS LAST CHARACTER A BREAK?
POPJ P, ;YES, JUST RETURN
ILDB C,B ;GET A CHARACTER
CAIE C,.CHTAB ;TAB?
CAIN C,.CHCRT ;NO, CARRIAGE RETURN?
MOVEI C,.ASSPC ;YES, MAKE A SPACE
CAIN C,.CHLFD ;LINEFEED?
JRST CDRCH1 ;YES, SET BREAK FLAG A NON-SKIP BACK
CAIL C,141 ;CHECK FOR LOWER CASE
CAILE C,172 ; I.E. 141-172
PJRST .POPJ1 ;NO, RETURN
SUBI C,40 ;MAKE IT UPPER CASE
PJRST .POPJ1 ;AND RETURN
CDRCH1: SETOM L.BRK ;SET BREAK FLAG
MOVEI C,.ASSPC ;MAKE BREAK CHAR LOOK LIKE A SPACE
POPJ P, ;AND NON-SKIP BACK
;CDRNXT -- ROUTINE TO GET A RECORD FOR SCANNERS
; READS IN A CARD AND PRINTS IT INTO THE
; LOG, SINCE IT IS A CONTINUATION OF A CONTROL CARD.
;
;CALL:
; PUSHJ P,CDRNXT
; RETURN HERE ON EOF
; RETURN HERE OTHERWISE
CDRNXT: PUSH P,T1 ;SAVE T1
MOVE T1,[T2,,L.SAC+2];BLT POINTER
BLT T1,L.SAC+T5 ;SAVE T2-T2
PUSHJ P,CDRASC ;GET A CARD
POPJ P, ;END-OF-FILE
STAMP STCRD ;STAMP THE LOG
TELL LOG!NAC,L.CARD ;TYPE THE CARD
MOVE B,[POINT 7,L.CARD]
MOVE T1,[L.SAC+T2,,T2]
BLT T1,T5 ;RESTORE T2-T5
POP P,T1 ;RESTORE T1
PJRST .POPJ1 ;LOAD A NEW BP, AND RETURN
SUBTTL Deck Stacking Routines
;^;+STASC -- Routine to transfer User's ASCII or 026 Deck to disk.
; Deck ends on CDR-EOF or a control card (except $MODE).
;-;#3
;CALL:
; PUSHJ P,STASC
; RETURN HERE ALWAYS
;
;F.EOF WILL BE SET IF INPUT EOF TERMINATED TRANSFER.
;IF LOCATION DEKCRD IS RETURNED ZERO, NO FILE WAS CREATED.
STASC: CLEARM DEKCRD ;CLEAR CARD COUNTER
CLEARM DEKBLK ;CLEAR BLOCK COUNTER
AOS L.DEKN ;START NEW DECK
STASC1: PUSHJ P,CDRASC ;GET ASCII CARD IMAGE
POPJ P, ;EOF ENCOUNTERED
TXNE F,F.FATE!F.KILL ;ANY STOP CONDITION?
POPJ P, ;YES, STOP!!
LDB T1,P.CL1A ;GET ASCII COLUMN 1
CAIE T1,"$" ;DOLLAR SIGN?
JRST STASC3 ;NO, TREAT AS DATA
LDB T1,P.CL2A ;GET ASCII COLUMN 2
CAIL T1,"A" ;CHECK FOR ALPHABETIC
CAILE T1,"Z" ;BETWEEN A AND Z
JRST STASC2 ;NOT A CONTROL CARD, CHECK OTHERS
JRST STASC7 ;CONTROL CARD -- CHECK $MODE
STASC2: TXNE F,F.DOLR ;IS /DOLLARS ON?
JRST STASC3 ;YES, DON'T TRIM ANYTHING OFF!
MOVSI T2,774000 ;MASK FOR FIRST ASCII CHARACTER
CAIN T1,"$" ;IS SECOND CHARACTER A "$"?
ANDCAM T2,L.CARD ;TURN OFF FIRST "$"
STASCF: ;ENTRY POINT FOR FFJOB
STASC3: PUSHJ P,SUPRES ;DO SUPPRESS AND WIDTH
PUSHJ P,WRTASC ;WRITE THE CARD
AOS DEKCRD ;COUNT THE CARD
JRST STASC1 ;AND GO AROUND FOR ANOTHER
STASC7: MOVE T1,L.CARD ;GET FIRST 5 CHARACTERS
TRZ T1,377 ;AND IT DOWN TO 4 CHARACTERS
CAME T1,C.MODE ;$MODE CARD?
JRST STASC8 ;NOPE, CHECK FOR END OF DECK
PUSHJ P,DOMODE ;GO CHANGE MODE
JRST STASC1 ;AND CONTINUE STACKING
STASC8: TXNN F,F.DOLR ;IS /DOLLARS ON?
POPJ P, ;NO, END THE DECK
HRLZI T2,-.NMDEN ;NUMBER OF DECK ENDERS
STASC9: CAMN T1,C.END(T2) ;COMPARE
POPJ P, ;MATCH!! RETURN
AOBJN T2,STASC9 ;AND LOOP AROUND
JRST STASC3 ;NO MATCH, ITS PART OF THE DECK!
;+STIMG -- Routine to transfer User's IMAGE mode deck to disk.
; Deck ends on CDR-EOF or Image Terminator.
;-;#3
;CALL:
; PUSHJ P,STIMG
; RETURN HERE ALWAYS
;
;F.EOF WILL BE SET IF INPUT EOF TERMINATED TRANSFER.
;LOCATION DEKCRD IS RETURNED ZERO IF NO FILE WAS CREATED.
STIMG: TXNN F,F.ICDR ;IS CDR INPUT?
PJRST E$AMO ;NO, TELL HIM
CLEARM DEKCRD ;CLEAR CARD COUNTER
CLEARM DEKBLK ;CLEAR BLOCK COUNTER
AOS L.DEKN ;NEW DECK
MOVE T1,L.IMGT ;GET IMAGE MODE TERM COLUMN
IDIVI T1,3 ;GET WORD IN T1, BYTE # IN T2
ADD T1,P.ICOL(T2) ;MAKE BYTE POINTER TO CORRECT COLUMN
STIMG1: PUSHJ P,CDRIMG ;GET IMAGE MODE CARD
POPJ P, ;END OF FILE
TXNE F,F.FATE!F.KILL ;A STOP CONDITION?
POPJ P, ;YES, STOP!!
LDB T2,P.CL1I ;GET IMAGE COLUMN 1
CAIE T2,7777 ;FULLY LACED?
JRST STIMG3 ;NO, NOT END OF DECK
LDB T2,T1 ;YES, GET SPECIFIED TERM COLUMN
CAIN T2,7777 ;FULLY LACED?
JRST STIMG5 ;YES, CHECK ALL OTHER COLS FOR ZEROES
STIMG3: PUSHJ P,WRTIMG ;WRITE THE CARD
AOS DEKCRD ;COUNT THE CARD
JRST STIMG1 ;LOOP AROUND FOR ANOTHER CARD
STIMG5: PUSH P,L.CARD ;SAVE FIRST WORD
PUSH P,(T1) ;AND WORD WITH TERMINATOR
CLEAR T3, ;CLEAR A COUNTER
DPB T3,P.CL1I ;ZERO OUT FIRST COLUMN
DPB T3,T1 ;AND TERMINATOR COLUMN
STIMG6: SKIPE L.CARD(T3) ;WORD ZERO?
JRST STIMG7 ;NOT, NOT A TERMINATOR
CAIGE T3,IWPC-1 ;LOOP FOR 27 WORDS
AOJA T3,STIMG6 ;AND AROUND WE GO
POP P,(T1) ;RESTORE TERMINATOR COLUMN
POP P,L.CARD ;AND FIRST COLUMN
POPJ P, ;AND END THE DECK
STIMG7: POP P,(T1) ;RESTORE TERMINATOR COLUMN
POP P,L.CARD ;RESTORE FIRST COLUMN
JRST STIMG3 ;ITS A DATA CARD!!
IFN FTUUOS,<
;+STBIN -- Routine to transfer user's BINARY mode deck. Deck
; ends on CDR-EOF or a control card. Special check is made
; to insure that a null file is not created. The CDR input
; routine CDRBIN is called. CDRBIN does all the
; checksumming and 7-9 checking and will decide whether it is a
; control card (which will trap as an illegal binary card).
;-
;CALL:
; PUSHJ P,STBIN
; RETURN HERE ALWAYS
;
;F.EOF WILL BE SET IF INPUT EOF TERMINATED TRANSFER.
;LOCATION DEKCRD IS RETURNED ZERO IF NO FILE WAS CREATED.
STBIN: TXNN F,F.ICDR ;IS CDR INPUT DEVICE?
PJRST E$AMO ;NO, TELL HIM
CLEARM DEKCRD ;CLEAR CARD COUNT
CLEARM DEKBLK ;CLEAR BLOCK COUNT
AOS L.DEKN ;START NEW DECK
STBIN1: PUSHJ P,CDRBIN ;GET A CARD
POPJ P, ;EOF OR CONTROL CARD
TXNE F,F.FATE!F.KILL ;ANY STOP CONDITION?
POPJ P, ;YES, STOP NOW
PUSHJ P,WRTIMG ;WRITE OUT THE CARD
AOS DEKCRD ;COUNT IT
JRST STBIN1 ;AND LOOP AROUND FOR ANOTHER
> ;END IFN FTUUOS
IFN FTJSYS,<
STBIN: PJRST E$BNS ;BINARY NOT SUPPORTED
> ;END IFN FTJSYS
;BYTE POINTERS FOR STIMG AND STBIN
P.ICOL: POINT 12,L.CARD,35 ;THIRD BYTE OF WORD
P.CL1I: POINT 12,L.CARD,11 ;FIRST BYTE OF WORD
POINT 12,L.CARD,23 ;SECOND BYTE OF WORD
POINT 12,L.CARD,35 ;THIRD BYTE OF WORD
SUBTTL Device Input Routines
;^;+CDRASC -- Routine to read one logical ASCII record (card) from
; the input device. If device is DSK or MTA read in ASCII
; mode. If device is a local CDR read in Super-image
; mode and convert to ASCII. If device is remote CDR
; read in image mode, convert to superimage, and then to ASCII.
;-;#3
;CALL:
; PUSHJ P,CDRASC
; RETURN HERE ON INPUT EOF
; RETURN HERE OTHERWISE
;
;ON NORMAL RETURN (SKIP), INTERNAL BUFFER 'L.CARD' WILL HAVE ASCIZ RECORD.
;JOBINT INTERRUPT WILL CAUSE NON-SKIP RETURN TO BE TAKEN IF F.BUSY
;IS OFF.
CDRASC: MOVE B,P.ASBP ;SETUP BYTE POINTER TO 'L.CARD'
OFF F.RSCN ;CLEAR RESCAN BIT
CLEARM L.BRK ;CLEAR BREAK FLAG
MOVE T3,P.CL1A ;POINT TO 1ST COLUMN
MOVEM T3,L.SPBP ;FOR SUPPRESS
SKIPN T1,L.WIDT ;GET WIDTH PARAMETER
MOVEI T1,^D80 ;USE 80 IF NULL
MOVEM T1,L.CCNT ;AND SET DOWN COUNTER FOR THIS CARD
TXNN F,F.LCDR ;LOCAL CDR?
JRST CDRAS5 ;NO, GO HANDLE OTHER THINGS
TXZE F,F.INHI ;INHIBIT THIS INPUT?
JRST .+3 ;YES
PUSHJ P,CDRIN ;GET A CARD
POPJ P, ;EOF
MOVE T4,L.CRBP ;GET SAVED BYTE-POINTER
MOVEM T4,CDRBP ;AND SAVE IT
CLEARB T4,L.NHOL ;CLEAR A COUNTER, AND # OF HOL ERRORS
MOVSI T4,-ACPC ;SETUP LOOP COUNTER (AOBJN)
HRR T4,CDRBP ;GET ADDRESS OF DATA WORD-1
ADDI T4,1 ;POINT TO FIRST DATA WORD
MOVE T3,L.CHOL ;AND LOAD THE BYTE POINTER
MOVEM T3,L.CRLC ;SAVE FOR CHECK
CDRAS1: MOVEI C,.ASSPC ;TRY FOR MOST OBVIOUS FIRST
SKIPN T5,(T4) ;WAS IT A SPACE?
JRST CDRAS2 ;YES, WIN!
JUMPL T5,[MOVEI C,"\"
AOS L.NHOL
JRST CDRAS2];HOLLERITH ERROR!!
HLRZ C,T5 ;GET SUPER HALF
LDB C,T3 ;AND GET THE CHARACTER
;[1061] CDRAS1+5 1/2
CAME T3,P.026 ;IS MODE 026?
JRST CDRAS2 ;NO
CAIN C,173 ;ALTERNATE "?"?
MOVEI C,77 ;YES, MAKE IT REAL "?"
CAIN C,175 ;ALTERNATE ":"?
MOVEI C,72 ;YES, MAKE IT REAL ":"
CDRAS2: IDPB C,B ;DEPOSIT CHARACTER IN BUFFER
SOSL L.CCNT ;PAST /WIDTH?
CAIN C,.ASSPC ;NO, WAS IT A SPACE?
AOBJN T4,CDRAS1 ;YES, JUST LOOP
MOVEM B,L.SPBP ;NO, SAVE BP FOR SUPPRESS
AOBJN T4,CDRAS1 ;AND LOOP FOR A FULL CARD
CDRAS3: MOVE T1,B ;LOAD T1 WITH BP
PUSHJ P,DEPEOL ;AND DEPOSIT <CR-LF-NULL>
SKIPE L.NHOL ;ANY HOLLERITH ERRORS?
PUSHJ P,TELHOL ;YUP, GO TELL HIM
JRST CDRA10 ;CHECK IF OPR WANTS TO SEE, AND RETURN
CDRAS5: TXNN F,F.RCDR ;REMOTE CDR?
JRST CDRAS8 ;NO GO HANDLE ASCII DEVICES
;HERE HANDLE REMOTE CARD READERS
TXZE F,F.INHI ;INHIBIT INPUT?
JRST .+3 ;YES
PUSHJ P,CDRIN ;GET A CARD
POPJ P, ;EOF -- RETURN
MOVE T5,L.CRBC ;GET SAVED BYTE COUNT
CAILE T5,^D80 ;MORE THAN 80 CHARACTERS?
MOVEI T5,^D80 ;YES, MAKE IT 80
MOVEM T5,CDRBC ;AND SAVE IT
MOVE T5,L.CRBP ;GET SAVED BYTE POINTER
MOVEM T5,CDRBP ;AND SAVE IT
CLEARM L.NHOL ;CLEAR # OF HOLLERITH ERRORS
MOVE T5,L.CHOL ;AND LOAD THE BYTE POINTER
MOVEM T5,L.CRLC ;AND SAVE IT
CDRAS6: SOSGE CDRBC ;COUNT DOWN (YES, SOSGE IS CORRECT)
JRST CDRAS3 ;DONE, PUT CRLF-NULL ON AND RETURN
ILDB T3,CDRBP ;GET 12-BIT IMAGE
IFN FTJSYS,<
ANDI T3,7777 ;AND OUT THE GARBAGE
> ;END IFN FTJSYS
MOVEI C,40 ;CHECK FOR SPACE
JUMPE T3,CDRAS7 ;WIN!!
CLEARB C,T4 ;CLEAR THESE TO BUILD SUPER-IMG
;HERE BUILD SUPER-IMAGE FROM IMAGE
LSHC T3,-11 ;SPLIT IMAGE BET T3 AND T4
LSH T3,4 ;LEAVE SOME ROOM
TRO C,(T3) ;THIS IS PART OF IT
LSH T4,-1 ;BIT NUMBER CORRESPONDS WITH
; COLUMN NUMBER
TLZE T4,(1B8) ;GET BIT 8
TRO C,1B32 ;AND SET IT IF IT WAS SET
TLZE T4,(1B9) ;DO THE SAME FOR BIT 9
TRO C,1B28 ; " " " "
MOVE T3,T4 ;COPY OVER FOR JFFO
JFFO T3,.+1 ;SEE IF ANY COLUMN LIT!!
ADDI C,(T4) ;FINISH UP LAST 3 BITS (COL 1-7)
LSH T3,1(T4) ;CHECK FOR HOLLERITH ERROR
SKIPE T3 ;BETTER BE ZERO!!
JRST [MOVEI C,"\"
AOS L.NHOL
JRST CDRAS7] ;HOLLERITH ERROR
LDB C,T5 ;AND GET ASCII CODE
CDRAS7: IDPB C,B ;DEPOSIT IT
SOSL L.CCNT ;PAST /WIDTH?
CAIN C,.ASSPC ;NO, WAS IT A SPACE?
JRST CDRAS6 ;YES, JUST LOOP
MOVEM B,L.SPBP ;NO, SAVE BYTE-POINTER FOR SUPPRESS
JRST CDRAS6 ;AND LOOP FOR ANOTHER CHAR
;HERE TO HANDLE ASCII INPUT DEVICES
CDRAS8: SOSLE CDRBC ;ANYTHING LEFT IN BUFFER?
JRST CDRAS9 ;YUP, GO PROCESS
PUSHJ P,CDRIN ;NO, GET ANOTHER BUFFER FUL
POPJ P, ;EOF
SOS CDRCNT ;BUFFERS DON'T EQUAL CARDS HERE
CDRAS9: ILDB C,CDRBP ;GET A CHARACTER
;[1062] CDRAS9 + 1
JUMPE C,CDRAS8 ;IGNORE NULLS
IDPB C,B ;DEPOSIT IT INTO 'L.CARD'
CAIN C,.CHCRT ;CARRIAGE RETURN?
JRST CDRAS8 ;YES, JUST LOOP AROUND
CAIN C,.CHLFD ;LINE-FEED?
JRST CDRAS0 ;YES, FINISH UP
SOSL L.CCNT ;PAST /WIDTH?
CAIN C,.ASSPC ;NO, WAS IT A SPACE?
JRST CDRAS8 ;YES, LOOP
MOVEM B,L.SPBP ;NO, SAVE BYTE POINTER FOR SUPPRESS
JRST CDRAS8 ;YES, GET ANOTHER CHARACTER
;HERE ON END-OF-LINE
CDRAS0: CLEAR C, ;MAKE A NULL
IDPB C,B ;MAKE ASCII STRING ASCIZ STRING
AOS CDRCNT ;ONE MORE CARD
CDRA10: HRRZ C,L.MSGL ;GET MSGLVL
CAIN C,3 ;DOES OPR WANT TO SEE EVERY CARD?
TELL OPR!NAC,L.CARD ;YES, TELL HIM
PJRST .POPJ1 ;AND RETURN
;+CDRIMG -- Routine to read one card in Image mode.
; Handles local and remote CDRs separately.
;-;#3
;CALL:
; PUSHJ P,CDRIMG
; RETURN HERE ON EOF OR IMAGE TERMINATOR
; RETURN HERE OTHERWISE
;
; ON NORMAL RETURN 'L.CARD' CONTAINS CARD IMAGE IN
; 12-BIT PACKED BYTES.
CDRIMG: PUSHJ P,CDRIN ;GET A CARD
POPJ P, ;END-OF-FILE
IFN FTUUOS,<
TXNN F,F.LCDR ;LOCAL CDR?
JRST CDRIM2 ;NO, GO HANDLE REMOTE CDR
HRRZ T4,CDRBH+1 ;GET ADDRES OF 1ST DATA WORD-1
MOVE B,P.IMBP ;LOAD BYTE POINTER TO CARD
HRLZI T5,-CPC ;AOBJN POINTER FOR 80 COLUMNS
CDRIM1: AOJ T4, ;POINT TO NEXT DATA WORD
HRRZ C,(T4) ;GET 12-BIT SIDE OF WORD
IDPB C,B ;DEPOSIT IT INTO 'CARD'
AOBJN T5,CDRIM1 ;LOOP AROUND FOR ALL COLUMNS
JRST CDRIM4 ;GO TAKE COMMON RETURN
;HERE FOR REMOTE CDRS
CDRIM2: HRLZ T5,CDRBH+1 ;GET ADR OF FIRST DATA WORD -1
HRRI T5,L.CARD-1 ;GET DESTINATION ADR -1
AOBJN T5,.+1 ;SOURCE,,DESTIMATION FOR BLT
MOVEI T4,L.CARD+IWPC-1;LAST PLACE TO BLT TO
BLT T5,(T4) ;ALL IN ONE FELL SWOOP
> ;END IFN FTUUOS
IFN FTJSYS,<
MOVE B,P.IMBP ;LOAD BYTE-POINTER TO CARD
HRLZI T5,-CPC ;MAKE A 80 COLUMN AOBJN POINTER
CDRIM1: ILDB C,CDRBP ;GET A COLUMN
IDPB C,B ;DEPOSIT
AOBJN T5,CDRIM1 ;AND LOOP
JRST CDRIM4 ;DONE, RETURN
> ;END IFN FTJSYS
;COMMON RETURN
CDRIM4: MOVEI T5,IWPC ;SETUP NUMBER OF WORDS
MOVEM T5,L.IWRD ;STORE IT
PJRST .POPJ1 ;AND SKIP BACK
IFN FTUUOS,<
;+CDRBIN -- Routine to read a Binary mode card.
; Reads each card and checks for a 7-9 punch, stores the
; word count and checksum from card. Computes checksum
; and checks against punched checksum. If no 7-9 punch
; is found, checks for a control card, and if found takes
; non-skip return else an error is put out.
;-
;CALL:
; PUSHJ P,CDRBIN
; RETURN HERE ON EOF OR CONTROL CARD
; RETURN HERE WITH BINARY IN 'L.CARD'
;
;ON NORMAL RETURN BINARY IS PACKED IN 12-BIT PACKED BYTES IN
;LINE BUFFER 'L.CARD', AND L.IWRD IS SET TO WORD COUNT.
CDRBIN: PUSHJ P,CDRIN ;GET A CARD
POPJ P, ;END-OF-FILE
MOVE B,P.IMBP ;LOAD IMAGE MODE BYTE POINTER TO 'CARD'
HRRZ T5,CDRBP ;GET ADDRESS OF DATA WORD -1
AOS T5 ;POINT TO DATA
HRRZ C,(T5) ;GET FIRST DATA WORD (IF LOCAL CDR)
TXNN F,F.LCDR ;IS IT LOCAL?
ILDB C,CDRBP ;NO, GET FIRST BYTE IN IMAGE
TRC C,.IM79 ;REVERSE ROWS 7 AND 9
TRCE C,.IM79 ;WERE THEY BOTH ON?
JRST NO79 ;NOPE!!
LSH C,-6 ;RIGHT JUSTIFY WORD COUNT
MOVEM C,L.IWRD ;AND STORE IT
HRRZ C,1(T5) ;GET NEXT COLUMN (IF LOCAL)
TXNN F,F.LCDR ;IS IT LOCAL?
ILDB C,CDRBP ;NO LOAD NEXT COLUMN
MOVEM C,L.CCHK ;THIS IS THE CHECKSUM
TXNN F,F.LCDR ;LOCAL CDR?
JRST CDRBI5 ;NO, HANDLE REMOTES DEVICE DEPENDENTLY
;BINARY INPUT FOR LOCAL CDRS
MOVE T4,L.IWRD ;GET WORD COUNT
IMULI T4,-3 ;MAKE INTO NEGATIVE COLUMNS
HRLZS T4 ;PUT IN LH
ADDI T4,2(T5) ;ADD IN ADR OF 1ST DATA WORD
CDRBI1: HRRZ C,(T4) ;GET A 12-BIT IMAGE
IDPB C,B ;DEPOSIT IN LINE BUFFER
AOBJN T4,CDRBI1 ;AND LOOP FOR ALL COLUMNS
JRST CDRBI7 ;CHECK CHECKSUM AND RETURN
;HERE FOR REMOTE CDRS
CDRBI5: MOVE T4,L.IWRD ;GET NUMBER OF WORDS
IMULI T4,-3 ;MAKE NEG COL COUNT
HRLZS T4 ;AND MAKE AOBJN POINTER
CDRBI6: ILDB C,CDRBP ;GET A BYTE
IDPB C,B ;DEPOSIT IT
AOBJN T4,CDRBI6 ;AND LOOP AROUND
;HERE TO CHECK CHECKSUM AND RETURN
CDRBI7: MOVN T4,L.IWRD ;GET NEG WORD COUNT
HRLZ T4,T4 ;PUT IN LEFT HALF
ADDI T4,L.CARD ;MAKE AOBJN POINTER
CLEAR T3, ;ACCUMUALTE CHECKSUM HERE
CDRBI8: ADD T3,(T4) ;ADD A WORD
AOBJN T4,CDRBI8 ;GET ALL WORDS
LSHC T3,-30 ;THIS ALGORITHM IS USED BY UUOCON
LSH T4,-14 ; ROUTINE CKS12 TO COMPUTE A
ADD T3,T4 ; 12 BIT FOLDED CHECKSUM
LSHC T3,-14
LSH T4,-30
ADD T3,T4
TRZE T3,770000
AOS T3
CAMN T3,L.CCHK ;DOES IT MATCH CHECKSUM ON CARD
PJRST .POPJ1 ;YUP, SKIP BACK
STAMP STERR ;STAMP THE ERROR
TELL LOG,BCK% ;GIVE HIM A WARNING
TELL LOG,HOL3% ;AND CARD INFO
TELL LOG,CRLF
AOS T3,L.TCHK ;INCREMENT ERROR COUNT AND LOAD
CAMG T3,L.UCHK ;COMPARE AGAINST MAX
PJRST .POPJ1 ;STILL LEGAL
MOVEI T1,TMC% ;ADR OF MESSAGE
PJRST LOGERR ;LOG AND RETURN
> ;END IFN FTUUOS
SUBTTL Error and Utility Routines for Device Input
;^;+TELHOL -- Routine to tell user about Hollerith errors in the
; current card. Called at the end of card-translation if
; L.NHOL is non-zero. Tells the user how many errors and
; shows him the card. Also detects 'Too Many Hollerith
; Errors' condition.
;-;#3
;CALL:
; PUSHJ P,TELHOL
; RETURN HERE ALWAYS
TELHOL: TXNE F,F.FATE ;WAS THERE A FATAL ERROR?
POPJ P, ;YES, SKIP THIS STUFF
STAMP STERR ;STAMP THE LOG
TELL LOG,HOL% ;HOLLERITH ERROR
AOS DEKCRD ;GIVE THE CORRECT COUNT
TXNE F,F.DECK ;ARE WE IN A DECK?
TELL LOG,HOL3% ;YES GIVE CARD IN DECK MESSAGE
TELL LOG,CRLF ;AND A CRILIF
SOS DEKCRD ;BRING COUNT INTO PHASE AGAIN
STAMP STERR ;STAMP
TELHL1: TELL LOG,[ASCIZ / Card= /]
TELL LOG!NAC,L.CARD ;AND TYPE THE OFFENDING CARD
MOVE T1,L.NHOL ;GET NUMBER OF ERRORS
ADDB T1,L.THOL ;ADD TO TOTAL
CAMG T1,L.UHOL ;GREATER THAN ALLOWABLE?
POPJ P, ;NO, ALL IS WELL
MOVEI T1,TMH% ;TOO MANY HOLLERITH ERRORS
PJRST LOGERR ;AND LOG THE ERROR
;+SUPRES -- Routine to implement /WIDTH and /SUPPRESS switches.
; SUPRES first processes WIDTH if set, by placing
; the sequence <CR-LF-NULL> after the nth character, where
; n is the argument to /WIDTH. Then SUPPRESS is
; done by placing the same sequence following the last non-blank
; character of the card, using the byte-pointer saved in L.SPBP.
; Call FSUPR to force suppression only.
;-;#3
;CALL:
; PUSHJ P,SUPRES
; ALWAYS RETURN HERE
SUPRES: SKIPN T1,L.WIDT ;LOAD THE WIDTH AND SKIP IF NOT ZERO
JRST SUPRS2 ;ZERO, GO DO SUPPRESS
IDIVI T1,5 ;CONVERT CHARACTERS TO WORDS
ADDI T1,L.CARD ;ADD IN BASE ADDRESS
ADD T1,WIDTBL(T2) ;MAKE IT A BYTE POINTER
SUPRS1: PUSHJ P,DEPEOL ;DEPOSIT THE EOL
SUPRS2: TXNN F,F.SPS ;IS SUPPRESS ON?
POPJ P, ;NO, RETURN
FSUPR: MOVE T1,L.SPBP ;YES, LOAD THE BYTE-POINTER
PJRST DEPEOL ;AND GO DEPOSIT AN EOL
WIDTBL: POINT 7,0
POINT 7,0,6
POINT 7,0,13
POINT 7,0,20
POINT 7,0,27
;+DEPEOL -- Routine to deposit <CR-LF-NULL> according
; to the byte-pointer in T1. Call with T1 containing a
; byte-pointer to the byte before the CR (ie so IDPB
; can be done).
;-;#2
;CALL:
; PUSHJ P,DEPEOL
; ALWAYS RETURN HERE
DEPEOL: MOVEI C,.CHCRT ;LOAD A CARRIAGE RETURN
IDPB C,T1 ;DEPOSIT IT
MOVEI C,.CHLFD ;A LINE-FEED
IDPB C,T1 ;DEPOSIT IT
MOVEI C,0 ;A NULL
IDPB C,T1 ;DEPOSIT IT
POPJ P, ;AND RETURN
IFN FTUUOS,<
;+NO79 -- Routine called when a BINARY card has no 7-9 punch in
; column 1. If column 1 is a "$" in ASCII, converts the
; card to ASCII and POPJ's back with control card.
; Otherwise, gives a warning and ignores the card by reading
; reading the next, unless the TMB condition holds,
; in which case we notify the user, and punt.
;-;#2
NO79: CAIE C,.IMDOL ;IS COLUMN 1 AN DOLLAR SIGN?
JRST NO798 ;NO, ILL BIN CARD
TXNE F,F.LCDR ;IS IT A LOCAL CDR?
JRST NO791 ;YES, GO RETRANSLATE
MOVEI T1,1400 ;OTHERWISE FIX UP CDRBP A LITTLE
HRLM T1,CDRBP ;RESET LEFT HALF,
SOS CDRBP ;AND SOS RIGHT HALF
NO791: ON F.INHI ;INHIBIT ANOTHER INPUT
PUSHJ P,CDRASC ;CONVERT TO ASCII
HALT ;EOF CAN'T POSSIBLY HAPPEN
POPJ P, ;AND RETURN
;HERE IF COLUMN 1 IS NOT A DOLLAR SIGN
NO798: STAMP STERR ;STAMP THE LOG
TELL LOG,IBC% ;ILLEGAL BINARY CARD
TELL LOG,HOL3% ;WHERE IS IT
TELL LOG,CRLF ;AND CRLF
AOS T3,L.TIBC ;INCREMENT COUNT
CAMG T3,L.UIBC ;GREATER THAN ALLOWABLE?
JRST CDRBIN ;NO, JUST IGNORE CARD
MOVEI T1,TMB% ;TOO MANY ILL BIN CARDS
PJRST LOGERR ;LOG IT!!
> ;END IFN FTUUOS
SUBTTL User File Output Routines
;WRTASC -- ROUTINE TO PLACE ASCII LINE IN 'L.CARD' INTO DSK
; OUTPUT BUFFER TO USER'S FILE.
;
;CALL:
; PUSHJ P,WRTASC
; ALWAYS RETURN HERE
WRTASC: MOVE B,P.ASBP ;POINT TO 'L.CARD'
WRTAS1: ILDB C,B ;GET A CHARACTER
JUMPE C,WRTAS1 ;IGNORE NULLS
SOSG FILBC ;ANYMORE ROOM IN DSK BUFFER?
PUSHJ P,FILUUO ;NO, DUMP IT AND ADVANCE
IDPB C,FILBP ;DEPOSIT CHARACTER
CAIE C,.CHLFD ;EOL?
JRST WRTAS1 ;NO, GET ANOTHER CHARACTER
POPJ P, ;DONE, RETURN
;WRTIMG -- ROUTINE TO PLACE IMAGE OR BINARY CARD DATA INTO USER'S
; DISK FILE. WRITES THE NUMBER OF WORDS SPECIFIED IN
; LOCATION L.IWRD.
;
;CALL:
; PUSHJ P,WRTIMG
; ALWAYS RETURN HERE
WRTIMG: MOVN T4,L.IWRD ;GET NEGATIVE WORD COUNT
HRLZS T4 ;PUT IT IN LEFT HALF
ADDI T4,L.CARD ;ADDRESS OF DATA
WRTIM1: SOSG FILBC ;ANY ROOM IN DSK BUFFER
PUSHJ P,FILUUO ;NO, DUMP IT
MOVE C,(T4) ;GET A DATA WORD
IDPB C,FILBP ;DEPOSIT IT IN BUFFER
AOBJN T4,WRTIM1 ;LOOP FOR ALL OF THEM
POPJ P, ;AND RETURN
;HERE TO DO THE OUTPUT UUO
FILUUO: AOS DEKBLK ;INCREMENT THE BLOCK COUNTER
IFN FTJSYS,<
AOS L.TBLK ;TOTAL BLOCKS WRITTEN
> ;END IFN FTJSYS
OUT FIL, ;DO THE UUO
POPJ P, ;WIN!!
MOVEI T1,EWF% ;ERROR WRITING FILE
PJRST LOGERR ;LOG IT
SUBTTL Input Device Monitor Interface
;CDRIN -- ROUTINE TO DO INPUT UUO FROM INPUT DEVICE.
; CDRIN INCREMENTS CDRCNT
;
;CALL:
; PUSHJ P,CDRIN
; RETURN HERE ON END OF FILE
; RETURN HERE OTHERWISE
CDRIN: PUSHJ P,CHKOPR ;SEE IF THE OPR WANTS SOMETHING
IFN FTJSYS,<
SKIPE L.OFF ;WAS IT OFF-LINE?
PUSHJ P,TSTOFF ;YES, CHECK NOW
SKIPE L.OFF ;IS IT OFF-LINE?
POPJ P, ;YES, RETURN
> ;END IFN FTJSYS
ON F.IN ;FLAG INPUT UUO IN PROGRESS
IN CDR, ;GET A CARD
JRST CDRINA ;WIN!!
OFF F.IN ;TURN OFF UUO IN PROGRESS BIT
STATZ CDR,IO.EOF ;I/O ERROR, CHECK FOR EOF
JRST INEOF ;ITS AN EOF!!
JRST CDRIN2 ;NOT EOF, DO SOME ANALYSIS
CDRINA: STATO CDR,IO.SYN ;IS SYNCH ON?
JRST CDRIN0 ;NO, CONTINUE NORMALLY
PUSH P,T1 ;SAVE T1
JRST CDRIN7 ;AND CHECK FOR BAD DATA
CDRIN0: OFF F.IN ;TURN OFF THE UUO FLAG
TXNN F,F.ICDR ;IS IT A CDR?
JRST CDRIN1 ;NO, DSK OR MTA
MOVE C,CDRBC ;GET THE BYTE COUNT
MOVEM C,L.CRBC ;SAVE IT
MOVE C,CDRBP ;WE'VE GOT TO HANDLE EOF
MOVEM C,L.CRBP ;AND SAVE BYTE POINTER ALSO
ILDB C,C ;GET FIRST CHARACTER
ANDI C,7777 ;GET RID OF ANY GARBAGE
CAIN C,.IMEOF ;EOF?
JRST INEOF ;YES, SET FLAG AND RETURN
CDRIN1: AOS CDRCNT ;INCREMENT CARD COUNT
OFF F.DER!F.JBI ;CLEAR THE DEVICE ERROR FLAG
PJRST .POPJ1 ;AND SKIP BACK
;HERE ON INPUT EOF
INEOF: ON F.EOF ;SET EOF FLAG
PUSH P,T1 ;SAVE T1
GETSTS CDR,T1 ;GET CHANNEL STATUS
TXZE T1,IO.EOF ;TURN OFF THE EOF BIT, SKIP IF TWAS OFF
CLOSE CDR, ;CLEAR IODEND
SETSTS CDR,(T1) ;AND RE-SET THE STATUS
IFN FTJSYS,<
PUSHJ P,TSTOFF ;CHECK THE OFF-LINE
> ;END IFN FTJSYS
PJRST T1POPJ ;AND RETURN
CDRIN2: STATZ CDR,IO.DER ;DEVICE ERROR IS ALL I UNDERSTAND
TXNN F,F.ICDR ;IT IS, IS IT A CDR?
JRST INERR ;NO, I CAN'T DO ANYTHING
CDRIN3: PUSH P,T1 ;SAVE T1
IFN FTJSYS,<
TELL OPR,RCK% ;READ CHECK
JRST CDRIN6 ;AND CONTINUE ON
> ;END IFN FTJSYS
MOVEI T1,CDR ;GET CDR CHANNEL NUMBER
DEVSTS T1, ;GET DEVICE STATUS
JRST CDRIN5 ;MAKE UP A MESSAGE
TXNE T1,CN.RCK ;READ CHECK?
TELL OPR,RCK% ;YES, TELL HIM
TXNE T1,CN.CME ;CARD MOTION?
TELL OPR,CME% ;YUP!!
TXNE T1,CN.DTM ;OR DATA MISSED?
TELL OPR,DTM% ;YOU BET!
SKIPA ;AND RESET LAST CARD
CDRIN5: TELL OPR,DVE% ;A CARD-READER ERROR
CDRIN6: TELL OPR,RLC% ;RESET LAST CARD
ON F.DER ;SET THIS FOR THE JOBINT ROUTINE
MOVE T1,CDROPN ;GET THE IO MODE
SETSTS CDR,IO.SYN(T1) ;AND SET THE STATUS AND SYNCHONIZE
CDRIN7: MOVE T1,CDRBH ;GET THE ADR OF CURRENT BUFFER
MOVE T1,-1(T1) ;GET THE BUFFER STATUS
TXNE T1,IO.DER ;IS THIS THE BAD BUFFER?
JRST CDRIN8 ;YES, FIX THINGS UP AND IGNORE IT
;**;[1065] CHANGE @ CDRIN7+4 JNG 27-Jul-75
MOVE T1,@CDRBH ;[1065] GET LINK WORD OF CURRENT BUFFER
SKIPGE (T1) ;[1065] IS NEXT BUFFER NOT IN USE?
JRST [POP P,T1
JRST CDRIN0] ;NO, THIS BUFFER "MUST" BE GOOD!
CDRIN8: MOVE T1,CDROPN ;GET IO MODE
SETSTS CDR,(T1) ;SET THE STATUS
POP P,T1 ;RESTORE T1
JRST CDRIN ;AND RE-DO THE UUO
;HERE FOR AN UNRECOVERABLE INPUT ERROR
INERR: GETSTS CDR,T1 ;GET THE DEVICE STATUS
TELL OPR,UIE% ;UNRECOVERABLE INPUT ERROR
RAD08 OPR,T1 ;STATUS
JRST ABEND ;AND DIE
IFN FTJSYS,<
TSTOFF: SETZM L.OFF ;ASSUME ITS ON-LINE
PUSH P,T1 ;SAVE T1
PUSH P,T2 ;SAVE T2
PUSH P,T3 ;SAVE T3
MOVE T1,L.JFN ;GET THE JFN
MOVX T2,.MORST ;READ STATUS
MOVEI T3,2 ;LEN OF ARG BLOCK
MOVEM T3,L.ARGS ;STORE IT
MOVEI T3,L.ARGS ;GET ADR OF ARG BLOCK
MTOPR ;DO THE READ STATUS
ERJMP TSTOF1 ;LOSE?
MOVE T3,L.ARGS+1 ;GET THE STATUS
TXNE T3,MO%OL ;IS IT OFF-LINE?
SETOM L.OFF ;YES, SET THE FLAG
TSTOF1: POP P,T3 ;RESTORE T3
POP P,T2 ;RESTORE T2
POP P,T1 ;RESTORE T1
POPJ P, ;AND RETURN
> ;END IFN FTJSYS
SUBTTL Accounting File Handlers
UP
IFN FTUUOS,<
;***THIS CONDITIONAL CONTINUES FOR APPROXIMATELY 18 PAGES**
; IT TERMINATES AFTER INPAUX ROUTINE
COMMENT /
;^;=
Accounting File Handlers
The Accounting File Handlers are a set of routines which manipulate
the ACCT.SYS and AUXACC.SYS files.
The routines are:
BILDAC Build In-core Index
SRHACC Search ACCT.SYS
SRHAUX Search AUXACC.SYS
MAKSL Generate Search List
MAKPTH Make UFD and SFD's
SETUFL Routine to Set UFD Interlock
DOACCT Setup all accounting for a specific job
The accounting file index consists of two parallel tables. The first
table contains the first PPN in each block of ACCT.SYS. The
second table contains XWD word #,block # for the corresponding
entry in AUXACC.SYS.
;--;^
The following hiseg variable locations are used to store information
about the tables, and effect the necessary interlocks.
/
.HWFRMT ;SWITCH TO OLD FORMAT LISTING
H.IDX: BLOCK 1 ;0=NO INDEX EXISTS, -1=INDEX EXISTS
H.LOCK: -1 ;GE ZERO=INDEX BEING BUILT
;-1 MEANS LOCK IS AVAILABLE
H.ASIZ: BLOCK 1 ;LENGTH OF TABLE. =SIZE OF ACCT.SYS
;IN BLOCKS
H.ADAT: BLOCK 1 ;CREATION DATE-TIME OF ACCT
H.XDAT: BLOCK 1 ;[1050] CREATION DATE-TIME OF AUXACC
H.ESIZ: BLOCK 1 ;ENTRY SIZE
;DUMP MODE OPEN BLOCK FOR 'SYS
H.OSTS: EXP .IODMP ;DUMP MODE
H.OSYS: SIXBIT /SYS/ ;SYS
H.OBRH: EXP 0 ;NO BUFFER HEADER
.AFMT2==2 ;OUR ACCT.SYS FORMAT
.AFMT3==3 ;NEW VM ACCT.SYS FORMAT
.AFMT4==4 ;[1056] SCHED AND ENQ/DEQ ACCT.SYS
.UFMT==0 ;OUR AUXACC.SYS FORMAT
.UBKS==5 ;WORDS/STR IN AUXACC
.MFRMT ;BACK TO NEW FORMAT LISTING
;BILDAC -- Routine to build in-core ACCT.SYS index
; and AUXACC.SYS Index.
BILDAC: PUSHJ P,LKACC ;GO CHECK FOR ACCT.SYS CHANGE
JRST BILDC2 ;IT CHANGED, GO BUILD THE INDEX
PJRST SLEEPR ;WAIT FOR IT TO BE BUILT, AND RETURN
BILDC2: USETI ACT,1 ;START FROM THE BEGINNING
PUSH P,.JBINT ;SAVE JOBINT LOCATIONS
CLEARB T1,.JBINT ;DISABLE INTERUPTS
SETUWP T1, ;WRITE-ENABLE THE HISEG
JFCL ;???
MOVEM T1,L.SVPT ;SAVE THE OLD SETTING
AOSN H.LOCK ;GET THE INTERLOCK
JRST BILDC3 ;GOT IT!!
PUSHJ P,SLEEPR ;GO WAIT FOR IT
JRST BILDRT ;AND GO RETURN
;[1067] HERE WITH THE INTERLOCK AND WRITE PROTECT OFF. DO THE REBUILD.
;**;[1067] Insert @ BILDC3 JNG 23-Sep-75
BILDC3: SETZM H.IDX ;[1067] CERTAINLY NO INDEX IN CORE NOW
SKIPE H.ADAT ;[1050] IF NOT THE FIRST TIME...
TELL OPR,RAI% ;[1050] SAY WE'RE REBUILDING
MOVE T1,L.ADAT ;GET THE CREATION DATE
MOVEM T1,H.ADAT ;AND SAVE IT IN HISEG
MOVE T1,L.XDAT ;[1050] GET AUXACC'S CREATION DATE
MOVEM T1,H.XDAT ;[1050] AND REMEMBER IT IN HIGH-SEG
MOVE T1,L.ASIZ ;GET BACK THE SIZE
MOVEM T1,H.ASIZ ;STORE IN HISEG
ASH T1,2 ;DOUBLE SIZE FOR AUXACC INDEX
MOVEI T2,H.TABL ;GET ADDRESS OF THE TABLE
ADD T1,T2 ;ADD THE LENGTH
HRLZS T1 ;SWAP IT
CORE T1, ;AND GET THE CORE
JRST NOCORE ;LOSE BIGLY
BILDC4: PUSHJ P,RDACCT ;READ FIRST BLOCK
JRST ACTERR ;ERROR NOW?
MOVE C,L.BUF ;GET FIRST WORD
HRRZM C,H.ESIZ ;SAVE ENTRY SIZE
HLRZS C ;SWAP HALVES
CAIL C,.AFMT2 ;IS VERSION 2,3, OR 4?
CAILE C,.AFMT4
JRST BADFOR ;NO, LOSE
MOVEI T1,200 ;SIZE OF ENTRY
IDIV T1,H.ESIZ ;DIVIDE BY ENTRY SIZE
MOVEI T1,H.TABL ;GET ADDRESS OF TABLE
MOVEI T3,1 ;AND INITIAL OFFSET
BILDC5: SKIPN C,L.BUF(T3) ;GET FIRST PPN OF BLOCK
HRLOI C,377777 ;IF ZERO,MAKE IT BIG NUMBER
CAMG C,-1(T1) ;MAKE SURE ITS BIGGER THAN LAST ONE
JRST BADFOR ;BAD FORMAT FOR ACCT SYS
MOVEM C,(T1) ;SAVE IN THE TABLE
SUB T3,T2 ;SUBTRACT OFFSET FOR NEXT BLOCK
SKIPGE T3
ADD T3,H.ESIZ ;KEEP IT NON-NEGATIVE
PUSHJ P,RDACCT ;READ NEXT BLOCK
SKIPA ;EOF
AOJA T1,BILDC5 ;AND LOOP FOR THIS BLOCK
BILDC6: GETSTS ACT,T1 ;GET CHANNEL STATUS
TXZ T1,IO.EOF ;CLEAR EOF FLAG
SETSTS ACT,(T1) ;AND RESET STATUS
;NOW BUILD AUXACC INDEX
BILAUX: MOVEI T1,1 ;SET TO READ FIRST BLOCK
MOVEM T1,L.ACC+1 ;STORE BLOCK NUMBER
PUSHJ P,INPAUX ;GO READ THE BLOCK
CLEARM L.ACC+2 ;CLEAR WORD TO READ
SETO T2, ;POINT T2 TO -1ST ENTRY IN ACT TABLE
MOVEI T1,H.TABL ;BEGINNING OF TABLE
ADD T1,H.ASIZ ;PLUS SIZE=ADR OF AUX TABLE
BILAU0: PUSHJ P,AUXSCN ;GET FIRST AUX ENTRY
JRST ACTERR ;THAT'S IMPOSSIBLE
BILAU1: PUSHJ P,BILAUS ;SAVE AUXACC ENTRY IN TABLE
AOS T2 ;POINT TO NEXT ACT ENTRY
CAML T2,H.ASIZ ;GOT LAST ACCT.SYS ENTRY?
JRST BILAU6 ;YES, RESET EOF AND RETURN
BILAU2: CAML U1,H.TABL(T2) ;IS AUX .LT. ACT ?
AOJA T1,BILAU1 ;NO, GET NEXT ACT ENTRY
BILAU3: PUSHJ P,BILAUS ;SAVE CURRENT ENTRY
PUSHJ P,AUXSCN ;GET NEXT AUXACC ENTRY
HRLOI U1,377777 ;MAKE A MOBY PPN
JRST BILAU2 ;LOOP BACK AGAIN
BILAU6: GETSTS AUX,T1 ;GET CHANNEL STATUS
TXZ T1,IO.EOF ;TURN OFF EOF BIT
SETSTS AUX,(T1) ;SET IT BACK
BILDRT: SETOM H.IDX ;INDEX EXISTS
SETOM H.LOCK ;UNLOCK
MOVE T1,L.SVPT ;GET STATE OF UWP
SETUWP T1, ;AND SET UWP
JFCL ;DON'T CRY NOW
POP P,.JBINT ;RE-ENABLE INTERUPTS
MOVE T1,[HB.SWP+1] ;SETUP TO HIBER AND SWAP OUT IMMEDITELY
PJRST HIBR ;AND HIBER FOR A MILLISEC
;SUBROUTINE TO STORE WORD#,,BLOCK# FOR CURRENT
; AUXACC ENTRY AT (T1)
BILAUS: MOVE T5,L.ACC+1 ;GET BLOCK NUMBER
MOVE T4,L.ACC+2 ;GET WORD NUMBER
SUBI T4,3 ;BACK UP TO [-1] WORD
JUMPGE T4,BILAS1 ;JUMP IF IN CURRENT BLOCK
ADDI T4,200 ;OFFSET TO LAST BLOCK
SOS T5 ;NUMBER OF LAST BLOCK
BILAS1: HRL T5,T4 ;GET W#,,B#
MOVEM T5,(T1) ;PUT IN TABLE
POPJ P, ;AND RETURN
;LKACC -- ROUTINE TO DETERMINE WHETHER ACCT.SYS HAS CHANGED
;
;CALL:
; PUSHJ P,LKACC
; RETURN HERE IF TABLE MUST BE REBUILT
; RETURN HERE IF NOT
;**;[1067] Insert @ LKACC JNG 23-Sep-75
LKACC: SKIPN H.IDX ;[1067] INDEX IN CORE?
;**;[1070] Change @ LKACC JNG 23-Oct-75
PJRST LKACC2 ;[1067] NO, GO REBUILD
MOVE T1,[SIXBIT /ACCT/] ;FILENAME
MOVSI T2,'SYS' ;EXTENSION
CLEARB T3,T4
CLOSE ACT1, ;CLOSE IF PREVIOUSLY OPENED
LOOKUP ACT1,T1 ;LOOKUP ACCT.SYS
JRST NOACCT ;???
MOVE T5,T3 ;GET CREATION INFO
;[1050] LKACC+7,JNG,12/4/74
TLZ T5,777740 ;[1050] GET TIME AND LOW-DATE
CAME T5,H.ADAT ;[1050] CHECK AGAINST PREVIOUS
JRST LKACC2 ;[1050] GO REBUILD
;**;[1067] Delete @ LKACC+12 JNG 23-Sep-75
MOVE T1,[SIXBIT/AUXACC/] ;[1050] NAME
MOVSI T2,'SYS' ;[1050] EXTENSION
CLEARB T3,T4 ;[1050] 2 MORE WORDS
CLOSE ACT1, ;[1050] CLEAR THE CHANNEL
LOOKUP ACT1,T1 ;[1050] FIND AUXACC.SYS
JRST NOACCT ;[1050] NOT THERE???
MOVE T5,T3 ;[1050] GET TIME WORD
TLZ T5,777740 ;[1050] CLEAR EXTRANEOUS BITS
CAME T5,H.XDAT ;[1050] SAME AS BEFORE??
JRST LKACC2 ;[1050] NO....GO REBUILD
;**;[1067] Change @ LKACC+26 JNG 23-Sep-75
AOS (P) ;[1067] YES, NO NEED TO REBUILD
SKIPE L.ADAT ;[1067] BUT UNLESS WE'VE DONE
SKIPN L.XDAT ;[1067] BOTH LOOKUPS ONCE...
JRST LKACC2 ;[1067] WE NEED TO GO DO THEM
POPJ P, ;[1067] ALL OK, JUST RETURN
;HERE IF WE MUST LOOKUP ACCOUNTING FILES TO GET NEW VERSIONS
;**;[1067] Delete @ LKACC2-1 JNG 23-Sep-75
LKACC2: MOVE T1,[SIXBIT/ACCT/] ;[1050] A GOOD NAME
MOVSI T2,'SYS' ;[1050] STANDARD EXTENSION
CLEARB T3,T4 ;SETUP TO LOOK AGAIN
CLOSE ACT,
LOOKUP ACT,T1 ;LOOK IT UP FOR REAL
JRST NOACCT ;??
HLRE T1,T4 ;GET SIZE INTO T1
JUMPGE T1,LKACC1 ;JUMP IF IN +BLOCKS
SUBI T1,^D127 ;ACCOUNT FOR PARTIAL BLOCK
IDIV T1,[-^D128] ;CONVERT TO BLOCKS
LKACC1: MOVEM T1,L.ASIZ ;AND SAVE IT
;[1050] LKACC1+1,JNG,12/4/74
TLZ T3,777740 ;[1050] GET DATE-TIME OF ACCT
MOVEM T3,L.ADAT ;[1050] AND SAVE IT.
MOVE T1,[SIXBIT /AUXACC/] ;RE FIND AUXACC
MOVSI T2,'SYS'
CLEARB T3,T4
CLOSE AUX, ;CLOSE OUT PREVIOUS VERSION
LOOKUP AUX,T1 ;LOOKUP NEW VERSION
JRST NOACCT ;NOT THERE?
;[1050] LKACC1+11,JNG,12/4/74
TLZ T3,777740 ;[1050] GET LATEST CREATION TIME
MOVEM T3,L.XDAT ;[1050] AND STORE IT AWAY.
IFN FTRPPN,<
MOVSI T1,L.PPTB ;LETS BLT THE CACHE TO 0
HRRI T1,L.PPTB+1
CLEARM L.PPTB ;THATS THE FIRST WORD
BLT T1,L.PPTB+NPPNRM-1 ;AND THE REST
>
POPJ P, ;[1050] GO REBUILD
;+SRHACC -- Routine to search ACCT.SYS for a PPN.
;Call SRHACC with the PPN in Q.PPN. If
;entry is found, return with entire entry in the UUO block,
;L.UUBK, starting at RIBCNT.
;-;#3
;CALL:
; PUSHJ P,SRHACC
; RETURN HERE IF ENTRY NOT FOUND
; RETURN HERE OTHERWISE
SRHACC: PUSHJ P,BILDAC ;GO BUILD AN INDEX IF NECESSARY
SRHAC0: MOVE T1,Q.PPN(Q) ;GET THE PPN
TRNE T1,1B18 ;IS IT A WILDCARD PPN?
HRRI T1,-2 ;YES, USE STANDARD FLAG (P,,-2)
IFN FTRPPN,<
MOVSI T2,-NPPNRM ;SETUP AOBJN POINTER
CAMN T1,L.PPTB(T2) ;START COMPARING DOWN THE TABLE
JRST SRHAC9 ;A MATCH!!
AOBJN T2,.-2 ;KEEP LOOPING
>
MOVN T2,H.ASIZ ;GET SIZE OF ACCT.SYS
HRLZS T2 ;PUT IN LH FOR AOBJN POINTER
HRRI T2,H.TABL ;AND LOAD START ADDRESS OF TABLE
SRHAC1: CAMGE T1,(T2) ;LOOK FOR A BIGGER ENTRY
JRST SRHAC2 ;FOUND ONE THAT'S BIGGER OR EQUAL
AOBJN T2,SRHAC1 ;LOOP FOR ENTIRE TABLE
SRHAC2: SUBI T2,H.TABL+1 ;SUBTRACT THE START ADDDRESS OF TABLE
;AND BACK UP A BLOCK
USETI ACT,1(T2) ;AND SET THE BLOCK NUMBER FOR A READ
HRRZM T2,L.ACC ;SAVE INDEX INTO TABLE
;NOW FIND THE FIRST ENTRY IN THAT BLOCK
SRHAC4: HRRZ T3,T2 ;COPY OVER THE ENTRY NUMBER (BLK-1)
MOVE T5,H.ESIZ ;WE'RE GONNA USE THIS
ASH T3,7 ;GET NUMBER OF WORDS BEFORE THIS BLOCK
IDIV T3,T5 ;DIVIDE BY ENTRY SIZE
SUBI T4,1 ;SUBTRACT 1 FOR FORMAT WORD
MOVNS T4 ;AND NEGATE
SKIPGE T4 ;SKIP IF GE 0
ADD T4,T5 ;ELSE MAKE IT POSITIVE
PUSHJ P,RDACCT ;READ THE BLOCK
JRST ACTERR ;I/O ERROR
SRHAC5: MOVE T2,L.BUF(T4) ;GET THE PPN FROM TABLE
CAMN T2,T1 ;IS IT THE RIGHT ONE?
JRST SRHAC6 ;YUP, FOUND IT
ADD T4,T5 ;POINT TO THE NEXT ONE
CAIG T4,177 ;STILL IN THIS BLOCK?
JRST SRHAC5 ;YES, KEEP LOOPING
POPJ P, ;IT'S NOT THERE!!!
SRHAC6: MOVEI T2,200 ;LOAD SIZE OF A BLOCK
SUB T2,T4 ;SUBTRACT INDEX INTO THIS BLOCK
CAMGE T2,T5 ;IS ENTIRE ENTRY IN THIS BLOCK?
JRST SRHAC7 ;NO, SPLIT ACROSS TWO BLOCKS
MOVSI T1,L.BUF(T4) ;START ADDRESS FOR BLT
HRRI T1,L.UUBK ;DESTINATION ADDRESS FOR BLT
BLT T1,L.UUBK-1(T5) ;BLT THE ENTRY INTO UUO BLOCK
JRST SRHAC8 ;REMEMBER ACCT.SYS IF FTRPPN IS ON, AND
;SKIP BACK
SRHAC7: MOVSI T1,L.BUF(T4) ;STARTING ADDRESS
HRRI T1,L.UUBK ;DESTINATION ADDRESS
BLT T1,L.UUBK-1(T2) ;BLT THAT MANY WORDS FROM THIS BLOCK
MOVSI T1,L.BUF ;START AT TOP OF NEXT BLOCK
HRRI T1,L.UUBK(T2) ;START WHERE THE LAST BLT LEFT OFF
PUSHJ P,RDACCT ;READ THE NEXT BLOCK
JRST ACTERR ;I/O ERROR?
BLT T1,L.UUBK-1(T5) ;BLT THE REST
JRST SRHAC8 ;SAVE ACCT STUFF IF FTRPPN IS ON
IFN FTRPPN,<
SRHAC8: MOVEI T4,L.UUBK ;LOAD ADDRESS OF STORED ENTRY
MOVE T1,L.RPRG ;LOAD THE REPLACEMENT REGISTER
MOVE T2,.A2PPN(T4) ;GET THE PPN
MOVEM T2,L.PPTB(T1) ;SAVE IT
MOVE T2,.A2PSW(T4) ;GET THE PASSWORD
MOVEM T2,L.PSTB(T1) ;SAVE IT
MOVE T2,.A2PRF(T4) ;GET PROFILE WORD
MOVEM T2,L.PRTB(T1) ;SAVE IT
MOVE T2,.A2NAM(T4) ;FIRST HALF OF USER NAME
MOVEM T2,L.UNTB(T1) ;SAVE IT
MOVE T2,.A2NAM+1(T4) ;SECOND HALF OF USER NAME
MOVEM T2,L.U2TB(T1) ;SAVE IT
PJRST .POPJ1 ;AND SKIP BACK
SRHAC9: MOVEI T4,L.UUBK ;LOAD ADDRESS OF STORAGE BLOCK
MOVEM T1,.A2PPN(T4) ;SAVE THE PPN
MOVE T1,L.PSTB(T2) ;GET PASSWORD
MOVEM T1,.A2PSW(T4) ;AND SAVE IT
MOVE T1,L.PRTB(T2) ;GET PROFILE WORD
MOVEM T1,.A2PRF(T4) ;STORE IT
MOVE T1,L.UNTB(T2) ;GET FIRST HALF OF USER NAME
MOVEM T1,.A2NAM(T4) ;STORE IT
MOVE T1,L.U2TB(T2) ;AND THE SECOND HALF
MOVEM T1,.A2NAM+1(T4) ;AND STORE THAT
MOVE T1,L.AUTB(T2) ;GET ENTRY LOCATION IN AUXACC
MOVEM T1,L.ACC ;STORE IT
MOVEM T2,L.MTCH ;FLAG A MATCH
TLZ T2,-1 ;ZAP THE LH OF T2
CAME T2,L.RPRG ;IS THIS NEXT TO BE REPLACED?
PJRST .POPJ1 ;NO, JUST RETURN
PJRST INCRPR ;YES, INCRMENT REPLACEMENT REGISTER
;AND RETURN
> ;END OF IFN FTRPPN
IFE FTRPPN,<
SRHAC8: PJRST .POPJ1 ;SKIP BACK
> ;END OF IFE FTRPPN
;+SRHAUX -- Routine to search AUXACC.SYS.
; Starts searching at word specified by in-core index.
; Returns "skip" if entry found, with the second word
; .AUNUM in U2 and next call to RDAUX will
; get first str name.
;-;#3
;CAUTION: THE LOOPS IN THIS ROUTINE ARE STRANGELY NESTED, READ IT
; SLOWLY.
SRHAUX: MOVE T1,L.ACC ;GET SAVED INDEX INTO TABLE
IFN FTRPPN,<
SKIPE L.MTCH ;IS THIS A WINNER?
JRST SRHAU0 ;YUP, WE'VE GOT ALL WE NEED
>
ADD T1,H.ASIZ ;MOVE INTO AUXACC TABLE
MOVE T1,H.TABL(T1) ;AND GET ENTRY
SRHAU0: HLRZM T1,L.ACC+2 ;SAVE # OF WORD TO RETURN
HRRZM T1,L.ACC+1 ;SAVE # OF CURRENT BLOCK
PUSHJ P,INPAUX ;GO READ THE BLOCK
MOVE T2,Q.PPN(Q) ;GET USER'S PPN
TRNE T2,1B18 ;FUNNY NUMBER?
HRRI T2,777776 ;YES, GET STANDARD FLAG FOR IT
JRST SRHAU2 ;AND JUMP INTO THE LOOP
SRHAU1: HLRZ T3,U1 ;GET ENTRIES PROJ # IN T3
HLRZ T1,T2 ;GET USER'S PROJ # IN T1
CAMN T1,T3 ;ARE THEY THE SAME PROJECT?
JRST SRHAU3 ;YES, CHECK IT OUT
CAMG T1,T3 ;NO, IT USER'S BIGGER?
POPJ P, ;NO, USER'S IS SMALLER, ENTRY IS NOT THERE
SRHAU2: PUSHJ P,AUXSCN ;GET THE NEXT ENTRY
POPJ P, ;EOF, NO ENTRY!!
PJUMPE U1,SRHAU4 ;NO ENTRY?
CAMN U1,T2 ;EXACT MATCH?
PJRST SRHAU5 ;YES, HOW LUCKY
JRST SRHAU1 ;NO, LOOP TILL WE GET THERE
SRHAU3: TRC U1,-1 ;TRICK THE PROG NUMBER
TRCN U1,-1 ;TRICK BACK AGAIN
PJRST SRHAU5 ;ALL 1'S IS WILDCARD, RETURN
JRST SRHAU2 ;AND LOOP
IFN FTRPPN,<
SRHAU4: MOVE T1,L.RPRG ;LOAD THE REPLACEMENT REGISTER
SKIPN L.MTCH ;WAS THIS A MATCH
CLEARM L.PPTB(T1) ;NO, CLEAR THE PPN WORD
POPJ P, ;RETURN
SRHAU5: SKIPE L.MTCH ;WAS THIS A MATCH?
PJRST .POPJ1 ;YES, JUST SKIP BACK
MOVEI T1,L.AUTB ;NO, ADDRESS OF AUX STORE TABLE
ADD T1,L.RPRG ;ADD THE REPLACEMENT REGISTER
PUSHJ P,BILAUS ;STORE THE CURRENT WORD,,BLOCK
;AND FALL INTO INCREMENT ROUTINE
;ROUTINE TO INCREMENT THE REPLACMENT REGISTER
INCRPR: AOS T1,L.RPRG ;INCREMENT AND LOAD
IDIVI T1,NPPNRM ;DIVIDE BY MAX
MOVEM T2,L.RPRG ;STORE RESULT MOD NPPNRM
PJRST .POPJ1 ;AND SKIP BACK
> ;END OF IFN FTRPPN
IFE FTRPPN,<
SRHAU4: POPJ P,
SRHAU5: PJRST .POPJ1
> ;END OF IFE FTRPPN
;+MAKSL -- Routine To Generate a Search List
; Call with RDAUX ready to read user's first structure
; name and U2 containg number of words from .AUNUM.
; Calls MAKPTH to setup UFD and SFD
; and if MAKPTH says it's OK, put the structure
; in my Search List.
;-;#3
MAKSL: MOVEI T1,.FSDSL ;STRUUO CODE
SETOB T2,T3 ;MY JOB, MY PPN
MOVX T4,DF.SRM ;DELETE ALL STRUCTURES
MOVE T5,[4,,T1] ;ARG TO STRUUO
STRUUO T5, ;ZAP THE S/L
JFCL ;CAN'T SAY WE DIDN'T TRY!
MOVEI T5,L.SL2+1 ;WHERE TO START STORING ARGS
MOVE U1,U2 ;COPY WORD COUNT INTO U1
IDIVI U1,.UBKS ;CONVERT TO # STRS
MOVE T4,U1 ;A COUNTER
MOVE T3,U1 ;LATER ARGUMENT TO STRUUO
MAKSL1: PUSHJ P,RDAUX ;GET STRUCTURE NAME
JRST ACTERR ;ITS SUPPOSED TO BE THERE
MOVEM U1,(T5) ;STORE STRUCTURE NAME
CLEARM 1(T5) ;2ND WORD OF TRIPLET IS 0
PUSHJ P,MAKPTH ;MAKE UFD AND SFD
JRST MAKSL4 ;MAKPTH SAYS DON'T USE THIS ONE
PUSHJ P,RDAUX ;GET STATUS BITS
JRST ACTERR ;??
MOVEM U1,2(T5) ;STORE THEM
MAKSL2: ADDI T5,3 ;POINT TO NEXT ENTRY
SKIPA
MAKSL4: SOS T3 ;ONE LESS FOR STRUUO
SOJG T4,MAKSL1 ;AND LOOP FOR THEM ALL
MOVEM T3,L.SL2 ;SAVE NUM OF STRS
MOVEI T1,L.SL2 ;LOAD ADDRESS OF BLOCK
MOVEI T2,SLLEN+.PTPPN(T1) ;POINT TO PATH BLOCK
HRLI T2,Q.IDDI(Q) ;SETUP TO BLT THE PATH
BLT T2,SLLEN+.PTPPN+5(T1) ;BLT THE FULL PATH
MOVEI T2,<.PTSCN>B35 ;/NOSCAN
MOVEM T2,L.SL2+SLLEN+.PTSWT ;STORE SWITCH
PJRST SETSRC ;SET THE S/L, PATH AND RETURN
;+MAKPTH -- Routine to create UFD and SFD on a str.
; Call with U1 containing structure name.
;-;#3
;CALL:
; PUSHJ P,MAKPTH
; RETURN HERE IF CAN'T DO IT (AUXACC IS SCANNED TILL NEXT ENTRY)
; RETURN HERE NORMALLY
;NON-SKIP RETURN IMPLIES THAT STR SHOULD NOT BE PUT IN S/L
MAKPTH: PUSHJ P,CLRUUO ;CLEAR THE UUO BLOCK
MOVEI P1,.IODMP ;USE DUMP MODE
MOVE P2,U1 ;GET STR NAME
MOVEM P2,L.UFIN+1 ;SAVE FOR STRUUO TO LOCK UFD
CLEAR P3, ;NO BUFFERS
OPEN UFD,P1 ;OPEN THE CHANNEL
JRST MAKPT8 ;CAN'T DO IT
MOVEI P1,.RBAUT ;START SETTING UP UUOBLK
MOVEM P1,RIBCNT ;FIRST WORD
MOVE P1,Q.PPN(Q) ;HIS PPN IS FILENAME
MOVEM P1,RIBNAM ;STORE IT
MOVEM P1,L.UFIN+2 ;SAVE FOR STRUUO TO LOCK UFD
MOVSI P1,'UFD'
MOVEM P1,RIBEXT ;STORE EXTENSION
MOVE P1,L.MFPP ;PUT IT IN MFDPPN
MOVEM P1,RIBPPN
PUSHJ P,RDAUX ;READ RESERVED QUOTA
JRST ACTERR ;ERROR
PUSHJ P,RDAUX ;IGNORE RSVD QTA GET FCFS QUOTA
JRST ACTERR ;??
MOVEM U1,RIBQTF ;AND STORE IT
PUSHJ P,RDAUX ;GET LOG-OUT QUOTA
JRST ACTERR ;??
MOVEM U1,RIBQTO ;STORE THAT
MOVX U1,RP.DIR ;GET DIRECTORY BIT
MOVEM U1,RIBSTS ;PUT INTO RIBSTS
SKIPN P1,Q.IDDI+1(Q) ;GET SFD NAME FOR LATER
JRST MAKPT1 ;NO PATH
MOVSI P2,'SFD' ;THE EXTENSION
CLEAR P3,
MOVE P4,Q.PPN(Q) ;AND USER'S PPN
MAKPT1: PUSHJ P,SETUFL ;SET THE UFD INTERLOCK
LOOKUP UFD,L.UUBK ;LOOKUP THE UFD
JRST MAKPT2 ;IT'S NOT THERE! GO ENTER IT
JRST MAKPT4 ;ITS THERE, GO MAKE AN SFD
MAKPT2: ENTER UFD,L.UUBK ;ENTER THE UFD
JRST MAKPT4 ;MAYBE ITS THERE!, GO TRY FOR SFD
USETO UFD,2 ;MAKE 1 BLOCK
MAKPT4: CLOSE UFD, ;CLOSE UFD OFF
PJUMPE P1,MAKPT5 ;[1052] RETURN IF NO SFD
ENTER UFD,P1 ;ENTER THE SFD
JFCL ;DON'T WORRY NOW
MAKPT5: RELEASE UFD, ;[1052] RELEASE CHANNEL
PJRST .POPJ1 ;AND RETURN
MAKPT8: MOVEI P1,.UBKS-1 ;SETUP TO READ THE REST OF THE ENTRY
MAKP81: PUSHJ P,RDAUX ;READ A WORD
JRST ACTERR ;ERROR
SOJG P1,MAKP81 ;AND LOOP
POPJ P, ;AND RETURN
;SETUFL -- ROUTINE TO SET UFD INTERLOCK
;SETUFL WORKS AS A CO-ROUTINE WITH ITS CALLER. IF IT IS CALLED,
; IT SETS THE INTERLOCK AND CALLS THE CALLER, SO WHEN THE
; CALLER RETURNS THE INTERLOCK IS CLEARED FIRST.
;THIS IS USED SO THAT THE INTERLOCK IS CLEARED BEFORE RETURNING AND
;JOBINT IS RESTORED.
SETUFL: MOVEI T1,.FSULK ;LOCK CODE
MOVEM T1,L.UFIN ;STORE IN STRUUO BLOCK
MOVE T1,.JBINT ;LOAD JOBINT
CLEARM .JBINT ;DISABLE ^C WHILE WE HAVE INTERLOCK
EXCH T1,(P) ;SAVE JOBINT ADR AND LOAD RET PC
MOVEM T1,1(P) ;SAVE RET PC 1 PAST P
MOVEI T1,^D100 ;NO. TIMES TO TRY INTERLOCK
SETUF1: MOVE T2,[3,,L.UFIN] ;LOAD ARG TO STRUUO
STRUUO T2, ;DO THE UUO
SKIPA ;IT FAILED
JRST SETUF2 ;WIN, RETURN (SORT OF)
MOVEI T2,1 ;SLEEP FOR 1 SEC
SLEEP T2, ;ZZZ
SOJG T1,SETUF1 ;AND TRY AGAIN
;FORGET IT!!
SETUF2: PUSHJ P,@1(P) ;RETURN TO USER
JRST CLRUFL ;HERE IF HE POPJ'ED
AOS -1(P) ;HERE IF HE .POPJ1'ED
;AND FALL INTO CLRUFL
;CLRUFL -- ROUTINE TO CLEAR UFD INTERLOCK
CLRUFL: MOVEI T1,.FSUCL ;UNLOCK CODE
MOVEM T1,L.UFIN ;STORE IT
MOVE T2,[3,,L.UFIN]
STRUUO T2, ;DO THE UUO
SKIPA ;CANT??
JRST CLRUF1 ;OK, RETURN
TELL OPR,CCI% ;CAN'T CLEAR IT
JRST ABEND ;AND DIE
CLRUF1: POP P,.JBINT ;RESTORE JOBINT
POPJ P, ;AND RETURN
;+DOACCT -- Routine to setup and do all the accounting for a
; job. Call with the PPN in Q.PPN. Does all
; the ACCT.SYS and AUXACC stuff, checks the Password,
; and sets the Search-List.
;-
;CALL:
; PUSHJ P,DOACCT
; RETURN HERE ON ERROR (T1 CONTAINS ADDRESS OF ERROR MESSAGE)
; RETURN HERE OTHERWISE
DOACCT: MOVE T1,Q.PPN(Q) ;GET THE PPN
MOVEM T1,Q.IDDI(Q) ;STORE IN PATH BLOCK
IFN FTRPPN,<
CLEARM L.MTCH ;NO MATCH YET ON THIS ONE
>
CLEAR T1, ;TO CLEAR Q.IDDI+1
LDB T2,P.UNI ;GET THE UNIQUENESS
CAIE T2,.QIUSD ;UNIQUE SFD?
JRST DOACC0 ;NO, CONTINUE
PUSHJ P,FUNNY ;MAKE A FUNNY NAME
TLO T1,'SF ' ;AND MAKE AN OBVIOUS NAME
DOACC0: MOVEM T1,Q.IDDI+1(Q) ;AND STORE IN THE PATH BLOCK
SKIPL L.PRIV ;IS ME PRIVILEGED?
PJRST .POPJ1 ;NO, JUST RETURN
DOACC1: PUSHJ P,SRHACC ;SEARCH FOR THE PPN
PJRST E$IPP ;ITS NOT THERE!!
MOVEI T2,L.UUBK ;LOAD INDEX REGISTER
DOACC2: MOVE T1,.A2PRF(T2) ;GET THE PROFILE WORD
TXNN T1,A2.BTC ;CAN IT LOGIN AS BATCH JOB?
PJRST E$CLB ;GUESS NOT!!
TXNN T1,A2.BPS ;DOES IT NEED A PASSWORD?
JRST DOACC4 ;NO, CONTINUE
PUSHJ P,CDRASC ;YES, GET A CARD
PJRST E$PWR ;EOF!!
MOVE B,[POINT 7,L.CARD,6]
PUSHJ P,S$SIX ;GET THE KEYWORD
PJRST E$PWR ;BAD ONE!!
HLRZS T1 ;SWAP HALVES
CAIE T1,'PAS' ;SEE IF PART OF PASSWORD
PJRST E$PWR ;NOPE!!
CLEAR T1, ;CLEAR FOR RESULT
MOVE T3,[POINT 6,T1] ;POINTER FOR RESULT
DOACC3: ILDB C,B ;LOOP FOR PASSWORD, GET A CHAR
SUBI C,40 ;CONVERT TO SIXBIT
SKIPGE C ;WAS IT A CONTROL CHAR?
JRST DOAC3A ;YES, STOP LOOPING
IDPB C,T3 ;DEPOSIT A CHAR
TLNE T3,770000 ;GOT SIX CHARS?
JRST DOACC3 ;NO, LOOP SOME MORE
DOAC3A: CAME T1,.A2PSW(T2) ;SEE IF A GOOD PASSWORD
PJRST E$IPP ;LOSE!!
DOACC4: MOVE T1,.A2PRF(T2) ;GET THE PROFILE WORD
TXNN T1,A2.BNM ;NAME REQURED FOR BATCH?
JRST DOAC4A ;NO, CONTINUE
SKIPN .A2NAM(T2) ;YES, SEE IF ACCT ENTRY IS ZERO
SKIPE .A2NAM+1(T2) ;CHECK SECOND WORD
SKIPA ;NON-ZERO
JRST DOACC5 ;ZERO!!, DON'T CHECK
MOVE T1,Q.USER(Q) ;GET FIRST HALF GIVEN
CAME T1,.A2NAM(T2) ;MATCH?
PJRST E$IPP ;NO, ERROR
MOVE T1,Q.USER+1(Q) ;GET SECOND HALF
CAME T1,.A2NAM+1(T2) ;MATCH??
PJRST E$IPP ;NO!
JRST DOACC5 ;ITS OK!!
DOAC4A: SKIPE Q.USER(Q) ;DID HE SPECIFY NAME SWITCH?
JRST DOACC5 ;YES, DON'T PUT IN OFFICIAL NAME
MOVE T1,.A2NAM(T2) ;GET FIRST HALF
MOVEM T1,Q.USER(Q) ;STORE IT
MOVE T1,.A2NAM+1(T2) ;GET SECOND HALF
MOVEM T1,Q.USER+1(Q) ;AND STORE IT
DOACC5: HRRZ T3,Q.PPN(Q) ;GET PROGRAMMER NUMBER
TRNN T3,1B18 ;FUNNY NUMBER?
JRST DOACC6 ;NO, CONTINUE
STAMP STMSG ;YES, STAMP LOG
TELL LOG,PRG% ;AND TELL HIM WHAT IT IS
DOACC6: SKIPN Q.IDDI+1(Q) ;IS THERE AN SFD?
JRST DOACC7 ;NO
STAMP STMSG ;YES, STAMP THE LOG
TELL LOG,SFD% ;YES, TELL HIM
DOACC7: PUSHJ P,SRHAUX ;GET SEARCH AUXACC
JRST DOACC8 ;NO ENTRY!!
PUSHJ P,MAKSL ;MAKE SEARCH LIST AND UFDS
PJRST .POPJ1 ;AND RETURN
DOACC8: MOVEI T1,NAU% ;NO AUXACC ENTRY
PJRST LOGER1 ;LOG THE MSG AND SKIP BACK
;VARIOUS AND SUNDRY ROUTINES FOR THE ACCOUNTING
;RDACCT -- ROUTINE TO READ A BLOCK
RDACCT: SETOM L.CBLK ;INVALIDATE THE BUFFER FOR AUXACC'ERS
IN ACT,L.ACIO
PJRST .POPJ1 ;INPUT AND RETURN SUCCESFULLY
POPJ P, ;LOSE
;SLEEPR -- Routine to sleep waiting for ACCT.SYS index to be
; built.
SLEEPR: SKIPE H.IDX ;IS THERE AN INDEX?
POPJ P, ;YES, RETURN
MOVEI T2,5 ;LOAD LOOP COUNTER
SLEEP1: MOVEI T1,2 ;# OF MILLISECS TO SLEEP EACH TIME
PUSHJ P,HIBR ;AND DO THE HIBERNATE
SKIPE H.IDX ;DOES IT EXIST?
POPJ P, ;YES, RETURN
SOJG T2,SLEEP1 ;NO, LOOP FOR ANOTHER SLEEP
POPJ P, ;GET IMPATIENT AND RETURN ANYWAY!!
;ERRORS
NOACCT: TELL OPR,CRA%
JRST ABEND
NOCORE: TELL OPR,NCA%
JRST ABEND
ACTERR: TELL OPR,ERA%
JRST ABEND
BADFOR: TELL OPR,BFA%
JRST ABEND
;ROUTINES TO READ AUXACC.SYS
;RDAUX -- ROUTINE TO RETURN THE NEXT WORD IN U1
RDAUX: MOVE U1,L.ACC+2 ;GET INDEX OF NEXT WORD
CAIE U1,200 ;NEED NEXT BLOCK?
JRST RDAUX1 ;NO, ITS IN THIS BLOCK
CLEARB U1,L.ACC+2 ;RESET COUNTS
PUSH P,T1 ;SAVE T1
AOS T1,L.ACC+1 ;INCREMENT BLOCK NUMBER AND LOAD
PUSHJ P,INPAUX ;GO READ THE BLOCK
POP P,T1 ;RESTORE T1
STATZ AUX,IO.EOF!IO.DTE!IO.DER
POPJ P, ;SOME ERROR
RDAUX1: MOVE U1,L.BUF(U1) ;GET THE WORD
AOS L.ACC+2 ;INCREMENT COUNT
PJRST .POPJ1 ;AND RETURN SUCESS
;AUXSCN -- ROUTINE TO SCAN FOR THE BEGINNING OF AN ENTRY
; FIRST WORD OF AN ENTRY CONTAINS -1.
; READS NEXT WORD AFTER THE -1 AND RETURNS IT (COUNT) IN U2.
; READS THIRD WORD (PPN) AND RETURNS IT IN U1.
AUXSCN: PUSHJ P,RDAUX ;READ A WORD
POPJ P, ;EOF
CAME U1,[-1] ;IS IT -1?
JRST AUXSCN ;NO, KEEP LOOKING
PUSHJ P,RDAUX ;READ THE COUNT WORD
POPJ P, ;EOF?
MOVE U2,U1 ;AND SAVE IN U1
PJRST RDAUX ;READ PPN WORD AND RETURN
;INPAUX -- ROUTINE TO DO USETI-INPUT FOR AUXACC. TRIES TO
; AVOID DOING IT, BY CHECKING L.CBLK TO SEE IF THE
; BUFFER CONTAINS WHAT WE WANT ALREADY.
; CALL WITH T1 CONTAINING BLOCK NUMBER
INPAUX: SKIPGE L.CBLK ;AN ACCT.SYS READ SETOMS THIS WORD
JRST INPAU1 ;WE'VE GOT TO READ
CAMN T1,L.CBLK ;IS THE BLOCK RIGHT?
POPJ P, ;YES!!
INPAU1: HRRZM T1,L.CBLK ;SAVE IT FOR NEXT CHECK
USETI AUX,(T1) ;USETI
INPUT AUX,L.ACIO ;INPUT THE BLOCK
POPJ P, ;AND RETURN
> ;END IFN FTUUOS (FROM WAY-WAY BACK)
IFN FTJSYS,<
;+DOACCT -- Routine to setup and do all accounting for a job.
; Call with User name string in L.UNAM.
;-
;CALL:
; PUSHJ P,DOACCT
; RETURN HERE ON ERROR
; RETURN HERE OTHERWISE
DOACCT: MOVX T1,RC%EMO ;EXACT MATCH ONLY
HRROI T2,L.UNAM ;POINT TO STRING
RCUSR ;CONVERT IT
TXNE T1,RC%NOM ;NO MTACH?
JRST E$IDP ;YES, TELL HIM
MOVEM T3,L.USNO ;SAVE RETURNED INFO
MOVE T1,[ASCII/PS:</] ;START BUILDING DIRECTORY
MOVEM T1,L.SL2
MOVE T1,[POINT 7,L.UNAM] ;POINT USER NAME
MOVE T2,[POINT 7,L.SL2,27] ;POINT TO DIRECTORY BLOCK
DOACC3: ILDB T3,T1 ;GET A CHARACTER
JUMPE T3,DOACC4 ;DONE ON NULL
IDPB T3,T2 ;DEPOSIT IT
JRST DOACC3 ;LOOP
DOACC4: MOVEI T3,">" ;CLOSE DIRECTORY
IDPB T3,T2 ;STORE IT
MOVEI T3,0 ;AND TERMINATE WITH
IDPB T3,T2 ; A NUL
PUSHJ P,CDRASC ;GET THE NEXT CARD
PJRST E$PWR ;NOT THERE!!
MOVE B,[POINT 7,L.CARD,6] ;SKIP THE $
PUSHJ P,S$SIX ;GET THE KEYWORD
PJRST E$PWR ;NONE?
HLRZS T1 ;GET FIRST 3 CHARS
CAIE T1,'PAS' ;IS IT PASSWORD?
PJRST E$PWR ;NO, LOSE
MOVEI T1,L.UPSW ;POINT TO A BLOCK
PUSHJ P,S$STRG ;AND GET THE STRING
MOVX T1,RC%EMO ;EXACT MATCH
HRROI T2,L.SL2 ;POINT TO THE STRING
RCDIR ;GET DIRECTORY NUMBER
TXNE T1,RC%NOM ;BETTER BE A MATCH!!
JRST E$IDP ;NO??
MOVE T1,T3 ;COPY DIR NO INTO T1
MOVEI T2,L.UDIN ;POINT TO GTDIR BLOCK
MOVEI T3,.CDDAC+1 ;LOAD LENGTH OF BLOCK
MOVEM T3,L.UDIN+.CDLEN ;STORE IT
HRROI T3,L.ACNT ;POINTER TO ACCOUNT BLOCK
SKIPN Q.CNO(Q) ;DID HE SAY /ACCOUNT?
MOVEM T3,L.UDIN+.CDDAC ;NO, GET DEFAULT ACCOUNT
HRROI T3,L.DPSW ;AND PLACE TO STORE PSW
GTDIR ;GET DIRECTORY INFO
ERJMP E$IDP ;LOSE?
MOVEI T1,L.ACNT ;POINT TO ACCOUNT BLOCK
MOVEM T1,Q.CNO(Q) ;YES, STORE IT FOR QMANGR
SKIPE L.ACNT ;IS THERE AN ACCOUNT NOW?
JRST DOAC.9 ;YES, KEEP GOING
SETO T1, ;FOR MY JOB
HRROI T2,L.ACNT ;POINT TO BLOCK
GACCT ;GET ACCOUNT FOR SURE
DOAC.9: MOVE T1,[POINT 7,L.UPSW] ;POINT TO USER STRING
MOVE T2,[POINT 7,L.DPSW] ;POINT TO CORRECT ONE
;DOACCT IS CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
DOACC1: ILDB T3,T1 ;GET A CHAR FROM ONE
ILDB T4,T2 ;GET A CHAR FROM THE OTHER
CAME T3,T4 ;COMPARE
PJRST E$IDP ;NOPE!
CAIE T3,0 ;GOT THE NULL?
JRST DOACC1 ;NO, KEEP LOOPING
DOACC2: MOVE T1,L.USNO ;GET THE USER NUMBER
HRROI T2,L.ACNT ;POINT TO THE ACCOUNT STRING
SKIPE Q.CNO(Q) ;SKIP IF NONE GIVEN
VACCT ;VERIFY THE ACCOUNT STRING
ERJMP E$IAS ;INVALID ACCOUNT SPECIFIED
MOVE T1,[3,,T2] ;SETUP AC FOR COMPT.
MOVEI T2,3 ;GET FUNCTION DIR--PPN
SETZ T3, ;RETURN PPN HERE
HRROI T4,L.SL2 ;POINT TO DIRECTORY STRING
COMPT. T1, ;GET THE PPN
PJRST E$IDP ;LOSE
MOVEM T3,Q.IDDI(Q) ;SAVE AS PATH
MOVEI T1,L.UNAM ;POINT TO USER NAME
MOVEM T1,Q.PPN(Q) ;AND STORE FOR QMANGR
MOVEI T1,L.SL2 ;POINT TO CONNECTED DIR
PUSHJ P,SETSRC ;CONNECT ME
PJRST .POPJ1 ;AND RETURN
> ;END IFN FTJSYS
SUBTTL Routines to SET and GET Search-List
IFN FTUUOS,<
;^;+GETSRC and SETSRC are used to get and set SPRINT's
; search list. Both are called with T1 containing the address
; of a block as described below. GETSRC reads the current
; search list and returns it in the specified block. SETSRC
; sets the search-list from the contents of the block.
; Following the searchlist block is a block for the PATH.
; GETSRC reads SPRINT's current PATH into this
; block, and SETSRC sets the PATH from the block.
;-
;CALLS:
; MOVEI T1,ADR OF BLOCK
; PUSHJ P,GETSRC (OR SETSRC)
; ALWAYS RETURN HERE
;++
;THE FORMAT OF THE BLOCK IS AS FOLLOWS:
; !-------------------------------------!
; ! NUMBER OF STRUCTURES !
; !=====================================!
; ! FILE STRUCTURE #1 !
; !-------------------------------------!
; ! 0 !
; !-------------------------------------!
; !RO!NC! !
; !=====================================!
; ! FILE STRUCTURE #2 !
; !-------------------------------------!
; ! 0 !
; !-------------------------------------!
; !RO!NC! !
; !=====================================!
; ! !
; / . /
; / . /
; / . /
; ! !
; !=====================================!
; ! FILE STRUCTURE #N !
; !-------------------------------------!
; ! 0 !
; !-------------------------------------!
; !RO!NC! !
; !=====================================!
;--
DOWN
;GETSRC -- ROUTINE TO RETURN CURRENT SEARCH LIST
GETSRC: PUSH P,T1 ;SAVE ADDRESS OF BLOCK
AOS T1 ;SKIP OVER FIRST WORD FOR COUNT
CLEAR T3, ;CLEAR TO COUNT STRS
SETOM (T1) ;CLEAR TO GET FIRST STR
JRST GETSR2 ;AND JUMP INTO LOOP
GETSR1: MOVE T2,(T1) ;GET RESULT OF LAST JOBSTR
ADDI T1,3 ;POINT TO NEXT 3 WORDS
MOVEM T2,(T1) ;AND USE AS ARGUMENT TO NEXT JOBSTR
GETSR2: MOVSI T2,3 ;3 WORD ARGUMENT
HRRI T2,(T1) ;STARTING THERE
JOBSTR T2, ;DO IT,
HALT . ;???
SKIPN T2,(T1) ;GET THE ANSWER
JRST GETSR4 ;ZERO MEANS WE'RE DONE
AOJE T2,GETSR4 ;SO DOES -1
AOJA T3,GETSR1 ;ELSE LOOP AROUND
GETSR4: POP P,T1 ;RESTORE T1
MOVEM T3,(T1) ;SAVE STR COUNT
MOVEI T1,SLLEN(T1) ;POINT TO PATH BLOCK
HRROI T2,.PTFRD ;FUNC TO READ MY PATH
MOVEM T2,.PTFCN(T1) ;STORE IT
SETZM .PTSWT(T1) ;CLEAR FLAGS
HRLI T1,PTLEN ;LOAD THE LENGTH
PATH. T1, ;READ THE PATH
HALT . ;??
POPJ P, ;AND RETURN
;SETSRC -- ROUTINE TO SET SEARCH LIST
SETSRC: SKIPN (T1) ;ARGUMENT BLOCK CLEAR?
POPJ P, ;YES, RETURN
PUSH P,(T1) ;SAVE FIRST WORD OF BLOCK
MOVEI T2,.FSSRC ;SET S/L FUNCTION
EXCH T2,(T1) ;SWAP THEM
IMULI T2,3 ;3 WORDS/STR
AOS T2 ;PLUS FUNCTION WORD
MOVSS T2 ;PUT IN LH
HRRI T2,(T1) ;ADR OF BLOCK
STRUUO T2, ;DO IT
HALT . ;??
POP P,(T1) ;RESTORE FIRST WORD OF BLOCK
MOVEI T1,SLLEN(T1) ;GET POINTER TO PATH BLOCK
HRROI T2,.PTFSD ;FUNC TO SET PATH
MOVEM T2,.PTFCN(T1) ;STORE IT
HRLI T1,PTLEN ;PUT THE LENGTH IN
PATH. T1, ;SET THE PATH
HALT . ;??
POPJ P, ;AND RETURN
> ;END IFN FTUUOS
IFN FTJSYS,<
;ON TOPS20, BOTH ROUTINES ARE CALLED WITH T1 CONTAINING THE
; ADDRESS OF A BLOCK. GETSRC WILL RETURN THE CURRENT
; CONNECTED DIRECTORY STRING, AND SETSRC SETS THE
; CURRENT DIRECTORY.
GETSRC: PUSH P,T1 ;SAVE BLOCK ADDRESS
HRROI T2,T4 ;-1,,T4 (1 WORD IN T4)
SETO T1, ;MY JOB
MOVEI T3,.JIDNO ;RETURN MY DIRECTORY NUMBER
GETJI ;GET IT
ERJMP SETS.1 ;LOSE!!
POP P,T1 ;GET ADDRESS BACK
TLO T1,-1 ;MAKE A POINTER
MOVE T2,T4 ;GET DIRECTORY NUMBER
DIRST ;CONVERT TO STRING
ERJMP SETS.1 ;LOSE!!
POPJ P, ;WIN AND RETURN
SETSRC: HRRO T3,T1 ;POINT TO THE STRING
SETZ T4, ;NO PASSWORD
SETO T5, ;MY JOB
MOVE T1,[AC%CON+3] ;CONNECT
MOVEI T2,T3 ;AND ADR OF BLOCK
ACCES ;CONNECT
ERJMP SETS.1 ;LOSE?
POPJ P, ;WIN!!
SETS.1: HALT . ;LOSE
> ;END IFN FTJSYS
SUBTTL Queue Manipulation Routines
COMMENT /
;^;++
Queue Manipulation Routines
Manipulation of the queues is handled by 3 pair of routines:
QUEJOB -- QJOBH
QUELOG -- QLOGH
QUEFIL -- QFILH
The first routine in each pair, is a dummy routine which is
in the lowseg, which is used to call the second routine which is in
the hiseg.
The routines are as follows:
QUEJOB - QJOBH Submit current job to Batch
QUELOG - QLOGH Submit LOG file for printing
QUEFIL - QFILH Submit user's file to the proper queue
;--;^
/
DOWN
;+These routines are dummy routines which are used for calling
; the various queueing routines which are in the high-segment.
;
;QUEJOB and QUELOG keep the hisegment around since
; this is the end of a job and we need the hiseg for the
; next job.
;
;QUEJOB is used to queue up a batch job at the successful
;completion of a job.
;
QUEJOB: PUSHJ P,GETHGH ;GET THE HISEG
PJRST QJOBH ;AND CALL THE QJOB ROUTINE
;QUELOG is used to job have the log-file queued, usually when
;a job is aborted.
;
QUELOG: PUSHJ P,GETHGH ;GET THE HISEG
PJRST QLOGH ;AND CALL THE QLOG ROUTINE
;QUEFIL is used to queue a user's file as the result of
;a /QUEUE switch on a $DECK card.
;-;#7
QUEFIL: PUSHJ P,GETHGH ;GET THGE HISEG
PUSHJ P,QFILH ;CALL THE CORRECT ROUTINE
PJRST RELHGH ;RELEAS THE HISEG AND RETURN
UP
;+These are the actual hiseg queue manipulation routines.
;
;QJOBH -- Routine to Create an Input Queue Request if
; F.BTCH is set. If not, Queue up the LOG file.
;
QJOBH: TXZN F,F.BTCH ;IS THE BATCH BIT SET?
JRST QJOBH1 ;NO, JUST PRINT THE LOG FILE
STAMP STSUM ;YES, SUMMARY STAMP
TELL LOG,[ASCIZ /Batch Input Request Created
/]
PUSHJ P,CLSLOG ;RELEAS THE LOG FILE
IFN FTJSYS,<
MOVE T1,[3,,T2] ;3 ARGS IN T2
MOVE T2,[CTL,,5] ;CHANNEL,,FUNCTION
MOVE T3,[POINT 7,L.QUE+Q.CSTR]
MOVE T4,[111110,,1] ;JFNS FLAGS
COMPT. T1, ;DO IT
JRST QJOBH0 ;NO STRING
MOVX T1,1B15 ;MAGIC QMANGR STRING FLAG
IORM T1,Q.CMOD(Q) ;STORE IT
> ;END IFN FTJSYS
QJOBH0: RELEAS CTL, ;RELEAS THE CTL FILE
LDB T1,P.UNI ;LOAD THE UNIQUENESS
AOS T1 ;CONVERT TO INTERNAL FORM
DPB T1,P.UNI ;AND RESTORE IT
MOVE T1,[.QSIZE,,L.QUE]
PJRST .QUEER## ;PUSHSEG TO QMANGR AND RETURN
QJOBH1: STAMP STSUM ;SUMMARY STAMP
TELL LOG,[ASCIZ /No Batch Input Request Created
/]
;AND FALL THRU TO QUEUE THE LOG FILE
;QLOGH -- Routine to Create a Print Request for the
; LOG File.
;
QLOGH: CLOSE CTL,CL.RST ;DELETE THE CTL FILE
;[1052] QLOGH 1/2 JHT 2/13/75
RELEASE CTL, ;[1052] RELEASE THE CHANNEL
STAMP STSUM ;STAMP THE LOG
TELL LOG,[ASCIZ /LOG File Submitted for Printing
/]
PUSHJ P,CLSLOG ;CLOSE THE LOG FILE
MOVSI T1,Q.LSTR(Q) ;ADDRESS OF LOG FILE BLOCK
HRRI T1,Q.OSTR(Q) ;TO BE MOVED DOWN A LITTLE
BLT T1,Q.OMOD(Q) ;ZAP
PUSHJ P,STLPQ ;SET STATION GENERIC NAME FOR LPT
MOVEM T1,Q.DEV(Q) ;AND STORE IT
MOVE T1,[BYTE (9) Q.ONOT+1,Q.FMOD+1 (18) 1]
MOVEM T1,Q.LEN(Q) ;NEW QUEUE PARAMETERS
SETZM Q.OSIZ(Q) ;SET DEFAULT LIMIT
CLEARM Q.OFRM(Q) ;CLEARM OUT FORMS TYPE
CLEARM Q.ONOT(Q) ;AND ANNOTATION
SETZM Q.AFTR(Q) ;CLEAR THE AFTER PARAMETER
MOVE T1,[Q.OMOD+1,,L.QUE]
PJRST .QUEER## ;AND CALL THE MANAGER
;QFILH -- Routine to submit user's file to the correct queue.
;-
QFILH: MOVEI T1,Q.OMOD+1 ;LOAD ADDRESS OF BLOCK
PUSHJ P,EXPND ;GET NEEDED CORE
MOVE T2,T1 ;GET OLD JOBFF AS INDEX TO QUEUE AREA
MOVEI T3,(T2) ;SETUP DESTINATION FOR BLT
HRLI T3,(Q) ;SETUP SOURCE POINTER FOR BLT
BLT T3,Q.USER+1(T2) ;SETUP QUEUE HEADER WITH A BLT
PUSHJ P,STLPQ ;SET STATION GENERIC NAME FOR LPT
HLL T1,L.QFN ;PUT DEVICE IN LEFT HALF
MOVEM T1,Q.DEV(T2) ;AND STORE IT
QFILH1: MOVE T1,[BYTE (9) Q.ONOT+1,Q.FMOD+1 (18) 1]
MOVEM T1,Q.LEN(T2) ;STORE Q.LEN WORD
MOVE T1,RIBDEV ;GET DEVICE
MOVEM T1,Q.OSTR(T2) ;AND STORE IT
MOVE T1,FILNAM ;AND FILE NAME
MOVEM T1,Q.ONAM(T2) ;AND STORE IT
HLLZ T1,FILEXT ;GET THE EXTENSION
MOVEM T1,Q.OEXT(T2) ;AND STORE IT
MOVSI T1,FILPTH+2 ;ADDRESS OF DIRECTORY BLOCK
SKIPN FILPTH+2 ;IS IT DEFAULT?
MOVSI T1,Q.IDDI(Q) ;YES, GET THE REAL PATH
HRRI T1,Q.ODIR(T2) ;PLACE TO PUT IT
BLT T1,Q.ODIR+5(T2) ;AND PUT IT THERE
MOVE T1,[010000111101] ;FMOD BITS
MOVEM T1,Q.OMOD(T2) ;STORE THEM
HRRZ T1,DEKBLK ;GET BLKS*COP
MOVEM T1,Q.OSIZ(T2) ;AND STORE IT
SETZM Q.AFTR(Q) ;CLEAR THE AFTER PARAMETER
MOVSI T1,Q.OMOD+1 ;LENGTH OF REQUEST
HRRI T1,(T2) ;ADDRESS OF BLOCK
PUSHJ P,.QUEER## ;CALL THE MANAGER
HLLZS L.QFN ;ZAP RH OF L.QFN
STAMP STMSG ;STAMP THE LOG
TELL LOG,FST% ;FILE SUBMITTED MESSAGE
CLEARM L.QFN ;CLEAR QUEUE WORD
MOVE T1,T2 ;GET JOBFF TO SHRINK TO
PJRST SHRINK ;SHRINK AND RETURN
;STLPQ -- ROUTINE TO GENERATE STATION GENERIC NAME FOR LPT
STLPQ: PUSH P,T2 ;SAVE T2
MOVE T1,L.LOC ;GET STATION NUMBER
JUMPE T1,STLPQ1 ;JUST USE LPT IF ZERO
IDIVI T1,8 ;SPLIT DIGITS
LSH T1,6 ;SHIFT FIRST DIGIT OVER
TRO T1,'S00'(T2) ;PUT BACK TOGETHER
STLPQ1: HRLI T1,'LPT' ;GET GENERIC NAME
POP P,T2 ;RESTORE T2
POPJ P, ;AND RETURN
SUBTTL Core and Segment Handling Routines
DOWN
;^;+SHRINK -- Routine to return core. SHRINK is called
; with the desired JOBFF in T1. SHRINK tries to
; avoid doing the CORE UUO.
;-;#2
; !-------------------------------------------------------!
; ! SHRINK (C) !
; ! +1 ALWAYS !
; ! +2 NEVER !
; !=======================================================!
; ! AC ! CALLED ! RETURNED !
; !-------------------------------------------------------!
; ! T1 ! DESIRED JOBFF ! --- !
; !-------------------------------------------------------!
SHRINK: MOVEM T1,.JBFF ;SAVE JOBFF
IORI T1,777 ;IOR UP TO A PAGE BOUNDARY
CAMN T1,.JBREL ;EQUAL TO JOBREL?
POPJ P, ;YES, DON'T DO CORE UUO.
CORE T1, ;GIVE BACK THE CORE
JFCL ;IGNORE THE ERROR
POPJ P, ;AND RETURN
;+EXPND -- Routine to get some core. EXPND is called with the
; size of the desired block in T1, and returns with
; T1 containing the address of a zeroed block of the
; desired size. If a CORE UUO is necessary and fails,
; a CEC error is given to the operator, and SPRINT
; aborts.
;-;#2
; !-------------------------------------------------------!
; ! EXPND (C) !
; ! +1 ALWAYS !
; ! +2 NEVER !
; !=======================================================!
; ! AC ! CALLED ! RETURNED !
; !-------------------------------------------------------!
; ! T1 ! SIZE OF BLOCK ! ADDRESS OF BLOCK !
; !-------------------------------------------------------!
EXPND: PUSH P,.JBFF ;SAVE JOBFF (AS ADR OF RETURNED BLOCK)
ADDB T1,.JBFF ;UPDATE JOBFF
CAMG T1,.JBREL ;DID WE BREAK INTO A NEW PAGE?
JRST EXPND1 ;NO, DON'T DO CORE UUO
CORE T1, ;YES!
SKIPA ;CAN'T DO IT!!!
JRST EXPND1 ;CORE UUO WON
TELL OPR,CEC% ;ISSUE AND ERROR MESSAGE
JRST ABEND ;AND ABEND
EXPND1: MOVE T1,(P) ;LOAD ADDRESS OF BLOCK
CLEARM (T1) ;CLEAR THE FIRST WORD
HRLS T1 ;MAKE IT ADR,,ADR
ADDI T1,1 ;MAKE IT ADR,,ADR+1 (BLT POINTER)
EXCH T2,.JBFF ;GET NEW JOBFF
BLT T1,-1(T2) ;BLT THE BLOCK TO ZEROES
EXCH T2,.JBFF ;RESTORE T2 AND JOBFF
PJRST T1POPJ ;RETURN WITH T1 CONTAINING ADR OF BLOCK
;GETHGH -- ROUTINE TO GET SPRINT HISEGMENT.
;
;CALL:
; PUSHJ P,GETHGH
; RETURN HERE ALWAYS
;
;GETHGH USES THE HISEGMENT CALLED FOR ON THE ORIGINAL GET-RUN COMMAND.
IFN FTUUOS,<
GETHGH: TXNE F,F.HTOP ;DO I HAVE IT ALREADY?
POPJ P, ;YES, JUST RETURN
PUSH P,T1 ;SAVE THIS
MOVEI T1,L.SAC ;BLT PNTR TO AC SAVE AREA
BLT T1,L.SAC+P ;SAVE ALL ACS
MOVEI T1,L.SGDV ;ADDRESS OF SAVEGET BLOCK
GETSEG T1, ;GET THE SEGMENT
HALT . ;ITS GOT TO BE THERE
MOVSI T1,L.SAC ;BLT POINTER FROM AC SAVE AREA
BLT T1,P ;RESTORE ALL ACS
ON F.HTOP ;WE'VE GOT ONE!!
PJRST T1POPJ ;RESTORE T1 AND RETURN
;RELHGH -- ROUTINE TO RELEASE HISEGMENT
;
;CALL:
; PUSHJ P,RELHGH
; RETURN HERE ALWAYS
RELHGH: TXNN F,F.HTOP ;IS IT GONE ALREADY?
POPJ P, ;YUP, JUST RETURN
PUSH P,T1 ;SAVE T1
MOVSI T1,1 ;SET HISEG SIZE TO 1 WORD
CORE T1, ;DELETE HISEG
POPJ P, ;BE A GOOD LOSER
OFF F.HTOP ;I NO LONGER HAVE IT
PJRST T1POPJ ;RESTORE T1 AND RETURN
> ;END IFN FTUUOS
IFN FTJSYS,<
RELHGH:
GETHGH: POPJ P, ;THEY ARE BOTH DUMMIES
> ;END IFN FTJSYS
SUBTTL JOBINT Traps and Device Error Handler
INTLOC: PUSH P,T1 ;SAVE T1
MOVE T1,L.INTB+3 ;GET ERROR BITS,,CHN
TLNE T1,ER.ICC ;CONTROL-C INTERCEPT?
JRST ICCINT ;YUP, HANDLE IT
TLNE T1,ER.QEX ;QUOTA EXCEEDED?
JRST QTAEX ;YUP GO DO IT
;OTHERWISE ASSUME DEVICE OK ERROR
TLZ T1,-1 ;GET 0,,CHN IN T1
TXNN F,F.JBI ;HAVE WE BEEN HERE BEFORE?
JRST INTLC1 ;NO, CONTINUE
TXNE F,F.BUSY ;IS BUSY ON?
JRST DEVWAT ;YES, GO THE NORMAL ROUTE
JRST INTIDL ;NO, GO THE SPECIAL ROUTE
INTLC1: TXNE F,F.DER ;WAS THERE A DEVICE ERROR?
JRST DEVWAT ;YES, WAIT SOME MORE AND TRY AGAIN
ON F.JBI ;FLAG THAT WE'VE BEEN HERE
TXNE F,F.LCDR ;SKIP IF NOT LOCAL CDR
DEVSTS T1, ;GET CONI WORD
JRST INTLC2 ;GIVE A GENERAL MESSAGE
TXNE T1,CN.RCK!CN.DTM!CN.CME
JRST INTRET ;CATCH THESE ON INPUT ERROR
TXNE T1,CN.PKF ;PICK FAILURE?
TELL OPR,PKF% ;YES, TELL HIM
TXNN F,F.BUSY ;IS BUSY SET?
JRST INTIDL ;NO, JUST POLLING
TXNE T1,CN.HPE ;HOPPER EMPTY/STACKER FULL?
TELL OPR,HPE% ;YUP!!
TXNE T1,CN.STP ;STOP PUSHED?
JRST INTLC3 ;YES, ?DEV NOT READY
JRST DEVWAT ;NO, WAIT AND RETURN
INTLC2: TXNN F,F.BUSY ;IS BUSY SET?
JRST INTIDL ;NO, JUST POLLING
INTLC3: TELL OPR,DNR% ;YES, DEVICE NOT READY
JRST DEVWAT ;SLEEP AND TRY AGAIN
;HERE FOR CONTROL-C INTERCEPT
ICCINT: PUSH P,T2 ;SAVE T2
PUSH P,T3 ;AND T3
MOVEI T1,L.SL2 ;PLACE TO PUT CURRENT S/L
PUSHJ P,GETSRC ;GET IT
MOVEI T1,L.SL1 ;TO RESET BACK TO ORIGINAL S/L
PUSHJ P,SETSRC ;SET IT
MONRT. ;GO TO MONMOD
MOVEI T1,L.SL2 ;S/L BLOCK BEFORE THE MONRET
PUSHJ P,SETSRC ;SET IT THERE
POP P,T3 ;RESTORE T3
POP P,T2 ;AND T2
JRST INTRET ;LET HIM CONTINUE
;HERE FOR QUOTA EXCEEDED
QTAEX: PUSHJ P,E$QTA ;GO TYPE THE ERROR INTO THE LOG
JRST INTIDL ;RE-ENABLE AND POPJ
DEVWAT: PUSHJ P,HIBR10 ;SLEEP FOR 10 SECONDS
INTRET: MOVE T1,L.INTB+2 ;GET RETURN PC
MOVEM T1,L.IPC ;AND SAVE IT
MOVEI T1,CDRIN ;LOAD ADDRESS OF CDR INPUT ROUTINE
TXZE F,F.IN ;CDR INPUT UUO IN PROGRESS?
MOVEM T1,L.IPC ;YES, SAVE THE ADDRESS SO CHKOPR IS
; CALLED
INTRT1: CLEARM L.INTB+2 ;RE-ENABLE INTERRUPT
CLEARM L.INTB+3
POP P,T1 ;AND T1
JRST @L.IPC ;AND RETURN FROM WHENCE WE CAME
;HERE IF JOBINT ON CDR WITH F.BUSY OFF. HOPEFULLY CAUSED BY
;ROUTINE POLLING THE CDR. THIS ROUTINE REENABLES THE INTERRUPT
;AND POPJ'S BACK WHICH WILL PROPAGATE BACK TO THE TOP LEVEL.
INTIDL: CLEARM L.INTB+2 ;REENABLE THE INTERRUPTS
CLEARM L.INTB+3
PJRST T1POPJ ;RESTORE T1 AND RETURN
SUBTTL Useful Routines
;^;+TELFIL -- Routine to print a filespec into the LOG and/or
; CTL files. The filespec is of the form:
;
;: DSKB:FILE.EXT[P,PN,SFD1,...,SFDN]
;:
;Call TFLLOG to type filespec into the LOG,
; TFLCTL for the CTL file, or TELFIL for
; both.
;-;#3
;CALL:
; MOVEI T1,BASE ADR OF DEVICE CONTROL CELLS
; PUSHJ P,TELFIL (OR TFLLOG OR TFLCTL)
; ALWAYS RETURN HERE
TFLLOG: TXOA F,F.QCTL ;QUIET THE CTL FILE
TFLCTL: TXO F,F.QLOG ;QUIET THE LOG
TELFIL: TELL6 BOTH,.CCDEV(T1) ;TYPE THE DEVICE NAME
CHR BOTH,":" ;COLON
TELL6 BOTH,.CCNAM(T1) ;TYPE THE FILENAME
CHR BOTH,"." ;DOT
HLLZ T5,.CCEXT(T1) ;GET THE EXTENSION
TELL6 BOTH,T5 ;AND TYPE IT
SKIPN .CCPPN(T1) ;ANY PPN?
JRST TELFL4 ;NO, RETURN
CHR BOTH,"[" ;START PPN SPEC
HLRZ T5,.CCPPN(T1) ;GET PROJECT NUMBER
JUMPE T5,TELFL1 ;0 MEANS PATH SPEC
RAD08 BOTH,T5 ;TYPE PROJECT NUMBER
CHR BOTH,","
HRRZ T5,.CCPPN(T1) ;GET PROGRAMMER NUMBER
RAD08 BOTH,T5 ;AND TYPE IT
JRST TELFL3 ;CLOSE OFF
TELFL1: HRRZ T1,.CCPPN(T1) ;LOAD PATH BLOCK ADDRESS
HLRZ T5,2(T1) ;GET PROJECT NUMBER
SKIPE T5 ;PROJ=0?
RAD08 BOTH,T5 ;AND TYPE IT
CHR BOTH,"," ;COMMA,
HRRZ T5,2(T1) ;GET PROGRAMMER NUMBER
SKIPE T5 ;PROGRAMER = 0?
RAD08 BOTH,T5 ;AND TYPE IT
MOVEI T5,3(T1) ;SETUP LOOP COUNT STARTING AT PTHBLK + 3
TELFL2: SKIPN (T5) ;IS THERE AN SFD?
JRST TELFL3 ;AND FINISH OFF
CHR BOTH,"," ;YES, TYPE ","
TELL6 BOTH,(T5) ;AND SFD-NAME
CAIGE T5,7(T1) ;ONLY THIS MANY SFDS
AOJA T5,TELFL2 ;AND LOOP AROUND FOR ANOTHER
TELFL3: CHR BOTH,"]" ;CLOSE OFF PPN SPEC
TELFL4: OFF F.QLOG!F.QCTL ;TURN THEM BACK ON
POPJ P, ;AND RETURN
;+HIBR -- Routine to HIBER for a given time. Call
; with desired HIBER time in milliseconds in T1.
; Automatically sets the "wake on TTY input" bit.
; Call HIBR10 to hibernate for 10 seconds.
;-;#3
; !-------------------------------------------------------!
; ! HIBR (C) !
; ! +1 ALWAYS !
; ! +2 NEVER !
; !=======================================================!
; ! AC ! CALLED ! RETURNED !
; !-------------------------------------------------------!
; ! T1 ! SLEEP TIME IN MS ! --- !
; !-------------------------------------------------------!
HIBR10: MOVEI T1,^D10000 ;10000 MILLISECONDS
HIBR: TXO T1,HB.RTL ;SET THE WAKE BIT
HIBER T1, ;AND SLEEP!!
JFCL ;NOTHING WE CAN DO!!
POPJ P, ;AND RETURN
;+CHKOPR -- Routine to see if the Operator has typed anything,
; and if so process it.
;-
;CALL:
; PUSHJ P,CHKOPR
; ALWAYS RETURN HERE
CHKOPR: SKPINL ;A LINE IN?
POPJ P, ;NO, RETURN
CLEARM L.HTOP ;ASSUME WE DON'T HAVE HISEG
TXNE F,F.HTOP ;DO WE HAVE IT?
SETOM L.HTOP ;YES, FLAG IT
PUSHJ P,GETHGH ;GET THE HISEG
PUSH P,L.SCIN ;SAVE ADDRESS OF CURRENT SCANERRS
PUSH P,L.SCLN ;DITTO
PUSHJ P,OPER ;GET THE COMMAND AND DO IT
POP P,L.SCLN ;RESTORE SCANNER ADRS
POP P,L.SCIN ;DITTO
SKIPL L.HTOP ;DID WE HAVE THE HISEG?
PUSHJ P,RELHGH ;YES, RELEASE THE HISEG
POPJ P, ;AND RETURN
;CLRCEL -- ROUTINE TO CLEAR DEVICE CONTROL CELLS
; CALL WITH T1 CONTAINING BASE ADDRESS
CLRCEL: MOVSI T5,.CCDEV(T1) ;SOURCE ADDRESS
HRRI T5,.CCDEV+1(T1) ;DEST ADDRESS
CLEARM .CCDEV(T1) ;PREPARE TO ZAP
BLT T5,.CCEND(T1) ;ZAP!!
POPJ P, ;AND RETURN
;ROUTINE TO CLEAR THE EXTENDED UUO BLOCK
CLRUUO: MOVE T5,[RIBCNT,,RIBCNT+1]
CLEARM RIBCNT ;CLEAR FIRST WORD
BLT T5,RIBAUT ;AND THE REST
POPJ P, ;AND RETURN
ABEND: MOVEI T1,L.SL1 ;ADR OF PRIME S/L
PUSHJ P,SETSRC ;SET IT
EXIT ;AND EXIT
.POPJ1: AOS (P)
.POPJ: POPJ P,8
T1POPJ: POP P,T1
POPJ P,
CRLF: BYTE (7) .CHCRT,.CHLFD,0
CCRLF: BYTE (7) "]",.CHCRT,.CHLFD,0
MONTAB: SIXBIT /-Jan-/
SIXBIT /-Feb-/
SIXBIT /-Mar-/
SIXBIT /-Apr-/
SIXBIT /-May-/
SIXBIT /-Jun-/
SIXBIT /-Jul-/
SIXBIT /-Aug-/
SIXBIT /-Sep-/
SIXBIT /-Oct-/
SIXBIT /-Nov-/
SIXBIT /-Dec-/
SUBTTL Operator Messages
UP
MSG(NST,W,Y,^4SPRINT is not START'ed^4)
MSG(STD,W,Y,^4SPRINT is already START'ed^4 on ^5)
MSG(NSD,E,Y,No Such Device "^5")
MSG(NJA,W,N,^4No Jobs Active^4 )
MSG(ICF,E,Y,^4Command is Illegal for a Fast FORTRAN Job^4)
MSG(CER,E,Y,^4Command Error - Retype Line^4)
MSG(ILC,E,Y,^4"^G" is an Illegal Command^4)
MSG(CCL,W,Y,CCL Entry is Not Supported)
MSG(SPL,W,Y,Device ^5 is Spooled)
MSG(CDI,E,Y,Device ^5 Can't Do Input)
MSG(OIR,M,Y,^4Operator Interaction Required^4])
MSG(RAI,M,Y,Rebuilding Accounting Indices]) ;[1050]
;THE FOLLOWING ARE UNRECOVERABLE ERRORS. SPRINT WILL EXIT AFTER
;TYPING THEM TO THE OPERATOR.
MSG(IOE,E,Y,I/O Error Writing LOG or CTL File)
MSG(CRA,E,Y,Can't Read Accounting File)
MSG(NCA,E,Y,No Core for ACCT.SYS Index)
MSG(ERA,E,Y,Error Reading Accounting File)
MSG(BFA,E,Y,Bad Format for Accounting File)
MSG(ILU,E,Y,Illegal LUUO in SPRINT)
MSG(COD,E,Y,Can't OPEN the DSK)
MSG(CCC,E,N,Can't create CTL or LOG File -)
MSG(CEC,E,Y,Can't Expand Core)
MSG(CCI,E,Y,Can't Clear UFD Interlock)
MSG(NHS,E,Y,No High Segment - Type R SPRINT)
MSG(CEF,E,Y,Can't ENTER Fast-FORTRAN File)
MSG(ROM,E,Y,Remote OPR must run System SPRINT)
SUBTTL DEVICE ERROR MESSAGES
DOWN
DEFINE DEVR%%,<
XLIST
PKF%: ASCIZ /%SPTPKF ^4PICK FAILURE^4 on ^5
^4 Check the next card and press the RESET button
^4/
HPE%: ASCIZ /%SPTHPE ^4HOPPER EMPTY or STACKER FULL^4 on ^5
^4 Correct and press the RESET button
^4/
LIST
SALL
>
DEVR.%: DEVR%%
MSG(RLC,M,Y,Reset the last card and press the RESET button])
MSG(RCK,W,Y,READ CHECK on ^5)
MSG(CME,W,Y,CARD-MOTION Error on ^5)
MSG(DTM,W,Y,DATA MISSED Error on ^5)
MSG(DVE,W,Y,Input Device Error on ^5)
MSG(DNR,M,Y,^4Input Device^4 ^5 Not Ready])
MSG(UIE,E,N,Unreocverable Input Device Error - Status )
SUBTTL Miscellaneous Messages
;FOR THE LOG
DOWN
HOL3%: ASCIN( - Card #^1 in Deck #^3)
;FOR THE OPERATOR
UP
IDLMSG: ASCIN(SPRINT is Idle )
CDJMSG: ASCIC(SPRINT Job Running on ^5)
FFJMSG: ASCIC(Fast FORTRAN Job Running on ^5)
RSTMSG: ASCIC([SPRINT is RESET])
WHTMSG: ASCIN(Card #^0)
PSEMSG: ASCIN([SPRINT is PAUSEing )
ONMSG: ASCIN(on ^5)
;FOR THE CTL FILE
DOWN
CLINE: ASCIN(^ICOMPIL /COMP/)
ELINE: ASCIN(^IEXECUT /REL)
DELLIN: ASCIN(%FIN::^IDELETE )
;**;[1071] Replace @ DUMLIN JNG 23-Oct-75
DUMLIN: ASCIC(^IDUMP) ;[1071]
ERRLIN: ASCIC(%ERR::) ;[1071]
CRFLIN: ASCIC(%FIN::^ICREF)
IFN FTUUOS,<
SETCDR: ASCIC(.SET CDR ^B)
> ;END IFN FTUUOS
IFN FTJSYS,<
SETCDR: ASCIC(@SET CARD-READER-INPUT-SET (TO) ^J^K)
> ;END IFN FTJSYS
SUBTTL User Error Messages
DOWN
MSG(TMH,E,Y,Too Many Hollerith Errors)
MSG(ABO,E,Y,Job Aborted By Operator)
MSG(ICC,E,Y,Illegal Co