Trailing-Edge
-
PDP-10 Archives
-
BB-J711A-BM
-
language-sources/sprint.mac
There are 37 other files named sprint.mac in the archive. Click here to see a list.
TITLE SPRINT DECsystem-10/20 Control Card Interpreter
SUBTTL Larry Samberg/LSS/JHT/JNG/WLH 2 October 79
;
;
;
; COPYRIGHT (c) 1973,1974,1975,1976,1977,1978,1979 BY
; DIGITAL EQUIPMENT CORPORATION, MAYNARD, MA.
;
; 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.
SALL ;Generate clean listing
SEARCH GLXMAC ;Get GLXLIB symbols
PROLOGUE(SPRINT)
SEARCH QSRMAC ;Get QUASAR symbols
SEARCH ORNMAC ;GET ORION SYMBOLS (WTO STUFF)
TOPS20 <SEARCH ACTSYM>
TOPS10 <SEARCH ACCSYM>
; Version Information
SPTVER==104 ;Major Version Number
SPTMIN==0 ;Minor Version Number
SPTEDT==4073 ;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
RELOC
; TABLE OF CONTENTS FOR SPRINT
;
;
; SECTION PAGE
; 1. Revision History.......................................... 3
; 2. Conditional Assembly Switches And Parameters.............. 4
; 3. Symbol Definitions........................................ 5
; 4. Conditional Assembly Macros............................... 5
; 5. Card Code Conversion Table Generation..................... 7
; 6. FILE-BLOCK Definitions.................................... 13
; 7. ACCT.SYS and AUXACC.SYS Table Definitions................. 14
; 8. Lowsegment Storage Cells.................................. 15
; 9. NON-ZERO storage.......................................... 20
; 10. Entry and Initialization.................................. 21
; 11. Job Setup and Idle Loop................................... 23
; 12. Start up the job.......................................... 26
; 13. $JOB Card................................................. 27
; 14. MAKCTL - Create the CTL File.............................. 30
; 15. MAKLOG - Create the LOG File.............................. 31
; 16. Main Program Loop......................................... 32
; 17. Control Cards
; 17.1 Setup and Dispatch................................ 33
; 17.2 $LANGUAGE......................................... 40
; 17.3 $DECK - $CREATE................................... 43
; 17.4 $RELOC............................................ 44
; 17.5 $INCLUDE.......................................... 45
; 17.6 $DATA - $EXECUTE.................................. 46
; 17.7 $DUMP - $MESSAGE.................................. 48
; 17.8 BATCH Commands.................................... 49
; 17.9 $EOD.............................................. 50
; 17.10 $JOB.............................................. 50
; 17.11 $EOJ.............................................. 50
; 17.12 $SEQUENCE......................................... 50
; 17.13 $TOPS10 - $TOPS20................................. 51
; 18. $JOB Card Switch Subroutines.............................. 52
; 19. Routines To Finish Off a Job.............................. 57
; 20. ABORT - Routine to abort the current job................ 58
; 21. SUMARY - Place summary lines in the LOG file............ 61
; 22. DONE
; 22.1 Release the job................................... 61
; 23. Non-$JOB Card Switch Subroutines.......................... 62
; 24. Process Control Card Switch............................... 64
; 25. SWTOCT - Process octal switch value....................... 65
; 26. SWTDEC - Process decimal switch value..................... 65
; 27. FILENT - Routine to open a user file.................... 66
; 28. LOG File I/O Utilities.................................... 67
; 29. Control File I/O Utilities................................ 68
; 30. MAKFUN - Routine to create a default filename........... 69
; 31. CTLCRD - Routine to copy current card..................... 71
; 32. FBCLOD
; 32.1 File Block Clear LOaD bits........................ 73
; 33. S$OCT - S$DEC
; 33.1 Octal and decimal number scanners................. 74
; 34. S$SIX
; 34.1 Routine to scan off a sixbit word................. 75
; 35. S$ASCZ
; 35.1 Routine to scan an ASCIZ string................. 76
; 36. S$TIM
; 36.1 Routine to return a Time Specification............ 78
; 37. S$DATE
; 37.1 Date-Time Scanner **UNDER RADIX-10**.............. 79
; 38. S$FILE
; 38.1 Routine to scan off a filespec.................... 83
; 39. S$FSPC
; 39.1 Routine to flush leading spaces................... 86
; 40. S$INCH
; 40.1 Routine to get a character........................ 86
; 41. DUMMY Routines to read one character from card............ 87
; 42. CDRCHR - Get a card character............................. 87
; 43. Deck Stacking Routines.................................... 88
; 44. Read a card
; 44.1 CDRASC - in ASCII and 026......................... 91
; 44.2 CDRIMG - in IMAGE................................. 93
; 44.3 CDRBIN - in Checksummed Binary.................... 94
; 45. INFAIL - Input failure from source file................. 96
; 46. FILERR - Error writing user file........................ 96
; 47. Accounting File Handlers.................................. 97
; 48. MAKPTH
; 48.1 Routine to create UFD and SFD on a STR............ 105
; 49. SETUFL
; 49.1 Routine to set UFD interlock...................... 107
; 50. DOACCT - Do all job accounting............................ 108
; 51. Error traps for accounting routines....................... 109
; 52. Routines to SET and GET Search-List....................... 111
; 53. QUASAR CREATE
; 53.1 QUEJOB - Create batch entry....................... 113
; 53.2 QUELOG - LOG file PRINT request................... 114
; 53.3 QUEFIL - User file request........................ 115
; 53.4 Utility subroutines............................... 116
; 54. $TEXT Utilities........................................... 117
; 55. - Interrupt System Database............................... 118
SUBTTL Revision History
; Edit SPR # Comment
; 4000 N/A 1) Make this SPRINT version 104 for
; GALAXY release 4.
; 4001 20-11339 1) Parenthesized switches on the
; $COBOL card on the 20 don't
; produce a reasonable error.
; 4002 10-24080 1) Don't put %ERR:: into CTL file,
; so /OUTPUT:ERROR will work.
; 4003 N/A 1) If /TIME: is the last thing on
; the $JOB card, give the job a
; default time instead of 72 plus
; hours.
; 4004 10-26239 1) Don't create UFD's on any
; structure with a FCFS quota of
; zero.
; 4005 10-25504 1) When SPRINT processes a job that
; doesn't have an AUXACC entry it
; uses the search list from the
; previous job. Make a null search
; list and allow the job to die
; gracefully.
; 4006 N/A 1) Make accounting code more
; efficient.
; 4007 N/A 1) Use PHASE/DEPHASE pseudo-ops to
; define accounting records.
; 2) Replace L.ACC block with CSHIDX
; word and SAVCHR. Avoids
; confusion.
; 3) Remove L.MTCH symbol and
; storage. No longer needed.
; 4) Add QUASAR dispatch table.
; 4010 N/A 1) Process comment cards properly.
; 4011 N/A 1) Fix W$WIDT routine to properly
; save the width argument.
; 4012 N/A 1) Make job card area large enough
; to accomodate full 80-column
; card plus a null for ASCIZ.
; 2) Make SUPPRESS and WIDTH
; combination work correctly.
; 3) Allow SPROUT's header and
; trailer cards to pass through
; the system correctly.
; 4013 N/A 1) After processing a job-control
; card call the "default" suppress
; routine, ie. don't assume the
; default condition is suppress.
; 4014 N/A 1) Start adding ASCII mode support
; 4015 N/A 1) Implement further 4014
; 4016 N/A 1) Do SETNAM UUO to clear JACCT
; bit.
; 2) Allow for wider lines in a
; stream ASCII file.
;
; 4017 N/A 1) Make TOPS10 name switch work
; again.
; 4020 N/A 1) Make mode change switches
; illegal when interpreting ASCII
; mode decks.
;
; 4021 N/A 1) References to .EQOWN converted
; to .EQOID (library change).
; 4022 N/A 1) Enter switches for batch log
; creation, operator intervention
; and user notification.
;
; 4023 N/A 1) Update IB to reflect library
; change.
;
; 4024 N/A 1) Put in USAGE accounting.
;
; 4025 20-11860 1) USAGE accounting. Charge the
; reading of cards to the user who
; is reading the cards not to the
; operator.
;
; 4026 N/A 1) Don't default deletion of the
; input "deck". only delete it if
; either FP.SPL or FP.DEL is set.
;
; 4027 N/A 1) Create a new entry point for the
; FILENT subroutine calling it
; FRCENT. The entry point is
; defined to prevent the library
; from doing the CHKAC JSYS when
; we're trying to write files into
; <SPOOL>.
; 2) Change the "ERROR" option to the
; OUTPUT switch to "ERRORS"(Note
; the plurality).
; 3) Improve error reporting.
; 4) Start allowing for pass-thru of
; certain parameters in the EQ.
; 5) Change the current /WRITE and
; /WRITE-LOG switches to /BATLOG
; and /BATCH-LOG respectively.
; The arguments SUPERSEDE, APPEND
; AND SPOOL Will remain unchanged.
; 6) Do STR Accounting bypass.
; 7) "Remember" the AFTER parameter
; from the NEXTJOB for the CREATE
; message.
; 8) Put IB.PRG back into the IB.
; 9) Make the USAGE entry list work.
; Specifically, remove all
; references to immediate mode
; data (US%IMM). Also, add entries
; that are now required by the
; USAGE JSYS that were missing.
;
; 4030 N/A 1) Get rid of all default items in
; the USAGE Accounting list.
; 2) Make switches work on $LANGUAGE
; card. Problem was that GTJFN
; bumped the byte pointer past the
; slash. Solution was to
; decrement the BP after the
; GTJFN.
;
; 4031 N/A 1) Provide for machine independent
; control files.
; 4032 N/A 1) Make $RELOCATABLE card illegal
; except when taken from card
; reader.
; 2) Suppress Job Information when
; sending WTO's.
; 4033 N/A 1) Allow for multiple Job decks to
; be processed in a single Job
; request. This affects the
; current processing done on
; detection of $EOJ, EOF and $JOB.
; 4034 N/A 1) Implement $LABEL card.
; 2) Modify the $IF card logic to
; examine the first non-blank
; character following the CPAREN
; and if it's a DOLLAR then
; convert it to the system prompt
; character, ie. make the $IF
; card truly system independent.
; 3) Allow the $PASSWORD card to be
; optional when the specified
; directory on the job card
; matches the submitter's
; directory.
; 4035 1) If there is not a blank
; character immediately following
; the language control card then a
; filespec error will result
; because the GTJFN wonT "see" the
; slash character. This fix
; should finish up the problems
; incurred by using GTJFN that
; were started in edit 4030.
; 4036 1) Allow "REQUEST FOR CHECKPOINT"
; messages to be ignored by
; SPRINT.
; 2) Solve the problems involved with
; not resetting the previous
; line's width when scanning blank
; cards.
; 4037 N/A 1) Handle the FP in a different
; way.
; 4040 N/A 1) Stop connecting to user
; directories. Instead, expand all
; FD's.
; 4041 N/A 1) Do fixup to make the destination
; node the same as the originating
; node in the QUOLOG routine.
; 4042 N/A 1) Fix the null filespec problem on
; control cards so that they give
; the proper error in the user's
; log file.
; 4043 N/A 1) Setup FILRFD block correctly.
; 4044 N/A 1) Fix blank card problem in CDRASC
; routine. Character count was not
; being cleared properly.
; 4045 N/A 1) Make first pass at allowing
; mixed-case alphabetics in
; control cards.
; 4046 N/A 1) Make SPRINT run on the 10. This
; includes fixups to handle MACRO
; Assembler incompatibilities.
; 4047 N/A 1) File loading order wasn't being
; cleared on appropriate control
; cards.
; 2) Fix improper handling of CRLF on
; Stream ASCII FILES.
; 4050 N/A 3) Change the format of WTOJ's.
; 4051 N/A 1) Fix manifestation of LOG file
; deletion when OUTPUT:NOLOG is
; specified and the job is not
; submitted to the input spooler.
; 4052 N/A 1) Provide support for a system
; independent control card to
; stack decks into the control
; file, al la $TOPS10.
; 4053 N/A 1) Use S%TBLK routine for scanners.
; 4054 N/A 1) Continue edit 4053 (S%TBLK stuff).
; 4055 N/A 1) Fix bug in switch scanner(S$ASCZ).
; 4056 N/A 1) Report illegal switch arguments
; as well as illegal switches.
; 2) Don't log illegal control cards
; twice.
; 4057 N/A 1) Validate conditional in $IF card.
; 4060 N/A 1) Make S$ASCZ routine clear first
; word of storage area.
; 4061 N/A 1) Remove the S$SIX routine and
; instead use the S%SIXB routine
; in the library.
; 4062 N/A 1) Make $INCLUDE follow the same
; logic as the $language cards.
; 4063 N/A 1) When doing Usage accounting make
; that no extraneous bits appear in
; the sequence number entry.
; 4064 N/A 1) Set the FNDJOB flag sooner.
; 4065 N/A 1) Change error message for Invalid
; Password card.
; 2) Reset byte pointer in the ASCII
; card stacking routine, STASC.
; 4066 N/A 1) Minor fix to S$ASCZ routine. Make
; it accept all digits, (0-9).
; 4067 N/A 1) Move Node from Next Job Message to WTOOBJ
; for Real Readers otherwise use default Node
; 4070 23-Aug-79 1) Queue up Log for User if Job Card is valid
; 4071 27-Aug-79 1) Stopcodes to ORION
; 2) On Null Jobname Use Funny name
; 4072 30-Aug-79 1) SET ONOD field on Creates to Quasar so
; Output will get located properly
; 4073 2-Oct-79 1) Include /TPUNCH /FEET /CPUNCH /CARDS on -20
SUBTTL Conditional Assembly Switches And Parameters
ND NPPNRM,^D15 ;ELSE REMEMBER THIS MANY
;SPRINT will remember the NPPNRM most recently used PPN's,
; thereby not needing to read ACCT.SYS on a match. The
; cost in space is 6*NPPNRM words of table space and
; approximately 50 words of code.
;;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%DFMD,0 ;DEFAULT INPUT MODE
; 0=ASCII
; 1=026
; 2=BCD
ND A%SPRS,0 ;DEFAULT /SUPP-/NOSUPP
; 0=/NOSUPPRESS
; 1=/SUPPRESS
ND .FCTFL,0 ;#0=FACT FILE ACCOUNTING
; 0=NO FACT FILE ACCOUNTING
SUBTTL Symbol Definitions
;Accumulator assignments
B==13 ;UTILITY BYTE POINTER
Q==14 ;INDEX TO QUEUE PARAMETER AREA
F==15 ;FLAG REGISTER
C==16 ;INPUT/OUTPUT CHARACTER
;I/O Device channels
UFD==5 ;FOR LOOKING UP AND CREATING UFDS
SUBTTL Conditional Assembly Macros
DEFINE $SUPPRESS,<IFN A%SPRS,>
DEFINE $NOSUPPRESS,<IFE A%SPRS,>
;MACRO TO SUPPRESS $WTO MACRO'S
;FLAGS (IN ACCUMULATOR F)
F.FATE==1B27 ;ABORTING DUE TO FATAL ERROR
F.BTCH==1B28 ;SUBMIT JOB TO BATCH
F.MAP==1B29 ;/MAP WAS SPECIFIED
F.RSCN==1B34 ;CHARACTER INPUT INHIBIT
F.DOLR==1B35 ;HE SAID /DOLLAR FOR THIS DECK
;USEFUL SYMBOLS
IWPC==^D27 ;IMAGE WORDS/CARD
BWPC==^D26 ;BINARY WORDS/CARD
CPC==^D80 ;COLUMNS/CARD
SMA==^D133 ;MAXIMUM LINE WIDTH FOR ASCII FILES
;IMPORTANT ASCII CHARACTER IMAGES
.IMDOL==2102 ;DOLLAR SIGN
.IM79==5 ;7-9 PUNCH
;SOME RANDOM SYMBOLS
SLLEN==^D36*3 ;LENGTH OF A SEARCH LIST BLOCK
PTLEN==12 ;PATH EXTENSION TO S/L BLOCK
FIL.LN==3 ;NUMBER OF FILES TO DELETE PER LINE
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.
;TABLE FIELD MASKS
CODASC==0,,-1 ;ASCII CHARACTER
COD026==-1,,0 ;026/BCD CHARACTER
;OFFSET TO GENERATE FOR HOLLERITH ERROR
CODHER==100000 ;WILL GENERATE A "\"
;ROW PUNCH DEFINITIONS
..12== 20 ;A 12 PUNCH
..11== 10 ;A 11 PUNCH
..0== 4 ;A 0 PUNCH
..1== 40 ;A 1 PUNCH
..2== 100 ;A 2 PUNCH
..3== 140 ;A 3 PUNCH
..4== 200 ;A 4 PUNCH
..5== 240 ;A 5 PUNCH
..6== 300 ;A 6 PUNCH
..7== 340 ;A 7 PUNCH
..8== 2 ;A 8 PUNCH
..9== 1 ;A 9 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
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 377,<
; CTGEN(\K)
; K==K+1>
K==1
CODTBL: XWD " "," " ;SPACE IS A SPECIAL CASE
XLIST
REPEAT 377,<CTGEN(\K)
K==K+1>
LIST
XWD "\","\" ;FOR HOLLERITH ERRORS
SUBTTL FILE-BLOCK Definitions
.FBFLG==0 ;FLAGS
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.SRH==1B22 ;LOAD IN LIBRARY SEARCH MODE
.FBFD==1 ;BEGINNING OF THE FD
SUBTTL ACCT.SYS and AUXACC.SYS Table Definitions
TOPS10 <
PHASE 0
;ACCT.SYS VERSION 2
.A2PPN: BLOCK 1 ;PROJECT-PROGRAMMER NUMBER
.A2PSW: BLOCK 1 ;PASSWORD
.A2PRV: BLOCK 1 ;PRIVILEGE WORD
.A2NAM: BLOCK 2 ;USER NAME (2 WORDS)
.A2TIM: BLOCK 1 ;TIMES MAY LOG IN
.A2DEV: BLOCK 0 ;DEVICE MAY LOG IN ON
.A3VMP: BLOCK 1 ;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: BLOCK 1 ;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
PHASE 14
.A2CNO: BLOCK 1 ;CHARGE NUMBER
.A2DAT: BLOCK 1 ;EXPIRATION DATE
DEPHASE
;AUXACC.SYS ENTRIES
PHASE 0
.AUBEG: BLOCK 1 ;FIRST WORD, ALWAYS CONTAINS -1
.AUNUM: BLOCK 1 ;NUMBER OF WORDS FOLLOWING
;THIS 1+ IS 5* THE NUMBER OF STRS
.AUPPN: BLOCK 1 ;PROJECT-PROGRAMMER NUMBER
.AUSTR: BLOCK 1 ;STRUCTURE NAME
.AURSV: BLOCK 1 ;RESERVED QUOTA
.AUFCF: BLOCK 1 ;FCFS QUOTA
.AULGO: BLOCK 1 ;LOGOUT QUOTA
.AUSTS: BLOCK 1 ;STATUS BITS
AU.RON==1B0 ;READ-ONLY
AU.NOC==1B1 ;NO-CREATE
DEPHASE
>;; END OF TOPS10 CONDITIONAL CODE
SUBTTL Lowsegment Storage Cells
L.PDL: BLOCK A%PDSZ ;PUSHDOWN LIST
; The following locations are not zeroed or reset with each
; new job.
LOWBEG:
IFE A%DFMD,<L.DMOD:>
IFN A%DFMD,<L.NMOD:>
L.CASC: BLOCK IWPC ;CURRENT CARD IN ASCII
IFE A%DFMD,<L.NMOD:>
IFN A%DFMD,<L.DMOD:>
L.C026: BLOCK IWPC ;CURRENT CARD IN 026
L.CLEN: BLOCK 1 ;CARD LENGTH IN BYTES
L.CSUP: BLOCK 1 ;SUPPRESSED CARD LENGTH
LINCHK: BLOCK 1 ;LINE CHECK FLAG FOR CDRASC
L.BP: BLOCK 1 ;STORED BYTE POINTER FOR $TEXT
L.FUN: BLOCK 1 ;RANDOM (?) NUMBER FOR FUNNY NAMES
L.SLEN==40 ;SYSNAM LENGTH
L.SYSN: BLOCK L.SLEN ;SYSNAM
L.FOB: BLOCK FOB.SZ ;"FILE OPEN BLOCK"
L.SAB: BLOCK SAB.SZ ;"SEND ARGUMENT BLOCK"
CSHIDX: BLOCK 1 ;CACHE INDEX
L.IFN: BLOCK 1 ;IFN FOR INPUT FILE
FNDJOB: BLOCK 1 ;SET UPON SUCCESSFULLY PROCESSING A $JOB CARD
CDRDEV: BLOCK 1 ;PHYSICAL READER FLAG
; Words remembered from the NEXTJOB Message.
L.EQCP: BLOCK EQXSIZ ;COPY OF WHOLE NEXTJOB EQ
ACTSIZ==10 ;DEFAULT SIZE ....MAY BE CHANGED
L.RDR: BLOCK 1 ;THE READER SPECIFIER
L.INF: BLOCK 1 ;COPY OF .FPINF WORD
L.DWID: BLOCK 1 ;CURRENT JOB'S DEFAULT WIDTH
TOPS10 <
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
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.ADAT: BLOCK 1 ;CREATION DATE-TIME OF LAST ACCT.SYS LOOKED AT
L.ASIZ: BLOCK 1 ;SIZE OF ACCT.SYS IN BLOCKS
L.APAG: BLOCK 1 ;ADDRESS OF FIRST PAGE OF ACCT INDICES
L.ANPG: BLOCK 1 ;NUMBER OF PAGES OF ACCT INDICES
L.XDAT: BLOCK 1 ;[1050] CREATION DATE-TIME OF AUXACC.SYS
L.BUF: BLOCK 200 ;UTILITY DISK BUFFER
L.ESIZ: BLOCK 1 ;ENTRY SIZE IN ACCT.SYS
L.MFPP: BLOCK 1 ;MFD PPN
L.AIFN: BLOCK 1 ;IFN FOR ACCT.SYS
L.XIFN: BLOCK 1 ;IFN FOR AUXACC.SYS
> ;END TOPS10
; The following locations are zeroed at the beginning of each
; job.
LOWZER:
L.BRK: BLOCK 1 ;LAST CHR FROM CARD WAS A BREAK
;Note that L.CHOL contains an appropriate byte pointer to the
; current card. Therefore the right-HALF contents is
; either L.CASC or L.C026. Note also that the initial
; default BP is stored in L.DHOL.
L.CHOL: BLOCK 1 ;CURRENT CARD CODE BP
L.DHOL: BLOCK 1 ;DEFAULT CARD CODE BP
L.DPCR: BLOCK 1 ;$DUMP,,/CREF FLAG
L.FBCT: BLOCK 1 ;LOAD NUMBER FOR FILE BLOCKS
L.FBLN: BLOCK 1 ;LIST NAME FOR CREATED FILES
L.IMGT: BLOCK 1 ;IMAGE MODE TERMINATOR
L.JLOG: BLOCK 1 ;JOB GOT LOGGED IN (SORT OF)
L.LGDS: BLOCK 1 ;LOG FILE DISPOSITION
;0=PRESERVE, ELSE DELETE
L.LOAD: BLOCK 1 ;SET TO -1 ON $DATA OR $EXEC CARD
L.LSW: BLOCK 1 ;THE LIST SWITCH
L.MODE: BLOCK 1 ;ADDRESS OF STACKING ROUTINE
L.NHOL: BLOCK 1 ;NUMBER OF HOLLERITH ERRORS
TRLCRD: BLOCK 1 ;NUMBER OF HEADER/TRAILER CARDS PASSED OVER
L.TFLG: BLOCK 1 ;[-1] IF LAST CARD READ WAS HEADER/TRAILER TYPE
L.QFN: BLOCK 1 ;USER SPECIFIED ARG TO /QUEUE:
L.SPRS: BLOCK 1 ;SUPPRESS FLAG (0=OFF)
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.UCHK: BLOCK 1 ;NUMBER OF CHKSUM ERRORS ALLOWED
L.UHOL: BLOCK 1 ;NUMBER HOLLERITH ERRORS ALLOWED
L.UIBC: BLOCK 1 ;NUMBER OF ILL BIN CARDS ALLOWED
L.WIDT: BLOCK 1 ;CARD WIDTH PARAMETER
L.SEQ: BLOCK 1 ;TMP STORAGE FOR SEQUENCE NUMBER
L.USER: BLOCK ^D40/5 ;STORAGE FOR /USER: SWITCH
L.PPN: BLOCK 1 ;STORAGE FOR /PPN: SWITCH
SAVCHR: BLOCK 1 ;SAVED QUOTE CHARACTER
REVDSP: BLOCK 1 ;$TOPS10/20 FLAG WORD
SYSIDP: BLOCK 1 ;SYSTEM INDEPENDENT JOB CARD FLAG
NOPSW: BLOCK 1 ;PASSWORD FLAG
LABADR: BLOCK 10 ;ROOM FOR TEMPORARY LABEL
TOPS10 <
L.CCHK: BLOCK 1 ;CHECKSUM FROM BINARY CARD
L.UFIN: BLOCK 3 ;UFD INTERLOCK BLOCK
> ;END TOPS10
TOPS20 <
L.USNO: BLOCK 1 ;USER NUMBER
L.UDIN: BLOCK 20 ;GTDIR INFORMATION
L.UDIR: BLOCK 14 ;USER DIRECTORY STRING
L.UPSW: BLOCK 10 ;USER SPECIFIED PASSWORD
L.DPSW: BLOCK 10 ;ACTUAL PASSWORD FROM DIRECTORY
> ;END IFN FTJSYS
L.DTM: BLOCK 1 ;DAYTIME
L.RTM: BLOCK 1 ;RUNTIME
JIBFLG: BLOCK 1 ;THE JIB FOR THE CURRENT JOB IS VALID
;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
CDRCNT: BLOCK 1 ;NUMBER OF CARDS READ - THIS JOB
DEKCRD: BLOCK 1 ;NUMBER OF CARDS READ - THIS DECK
FILFD: BLOCK FDXSIZ ;FD FOR USER FILE
FILIFN: BLOCK 1 ;IFN FOR OUTPUT FILE
FILOPN: BLOCK 1 ;-1 IF A FILE IS OPEN
FILSPC: BLOCK 1 ;-1 IF USER TYPED A FILESPEC
TOPS20 <
FILRFD: BLOCK FDXSIZ ;BLOCK FOR REL FILE FD
> ;END IFN FTJSYS
CLFFD: BLOCK FDXSIZ ;BLOCK TO BUILD FD FOR LOG AND CTL
CTLIFN: BLOCK 1 ;IFN FOR CTL FILE
LOGIFN: BLOCK 1 ;IFN FOR LOG FILE
;0=NOT OPEN, #0=OPEN
LOGPAG: BLOCK 1 ;LOG BUFFER PAGE ADDRESS
LOGCNT: BLOCK 1 ;COUNT OF BYTES LEFT IN BUFFER
LOGPTR: BLOCK 1 ;BYTE POINTER TO LOG BUFFER
JOBCRD: BLOCK SMA/5+1 ;ROOM FOR JOB CARD
LOWZSZ==.-LOWZER ;SIZE OF AREA TO ZERO ON EACH JOB
;Extended UUO Block
TOPS10 <
ELBLOK: BLOCK .RBAUT+1 ;ARGUMENT COUNT
> ;END TOPS10
LOWSIZ==.-LOWBEG ;SIZE OF LOWSEG AREA
SUBTTL NON-ZERO storage
;THE HELLO MESSAGE FOR QUASAR
HELLO: $BUILD HEL.SZ
$SET(.MSTYP,MS.TYP,.QOHEL) ;FUNCTION
$SET(.MSTYP,MS.CNT,HEL.SZ) ;MESSAGE LENGTH
$SET(HEL.NM,,<SIXBIT /SPRINT/>)
$SET(HEL.FL,HEFVER,%%.QSR) ;QUASAR VERSION
$SET(HEL.NO,HENNOT,1) ;NUMBER OF OBJECT TYPES
$SET(HEL.NO,HENMAX,1) ;NUMBER OF STREAMS
$SET(HEL.OB,,.OTBIN) ;BATCH INPUT OBJECT
$EOB
TOPS10 <INTVEC==VECTOR>
TOPS20 <INTVEC==LEVTAB,,CHNTAB>
SPTIB: $BUILD IB.SZ
$SET (IB.PRG,,%%.MOD)
$SET (IB.OUT,,T%TTY)
$SET (IB.PIB,,SPTPIB)
$SET (IB.INT,,INTVEC)
$SET (IB.FLG,IP.STP,1) ;STOPCODES TO ORION
$EOB
; SPRINT PID BLOCK DEFINITION
SPTPIB: $BUILD (PB.MNS)
$SET (PB.HDR,PB.LEN,PB.MNS)
$SET (PB.FLG,IP.SPB,1) ;CHECK FOR IP.CFP
$EOB
;THE RESPONSE-TO-SETUP MESSAGE FOR QUASAR
RSETUP: $BUILD RSU.SZ
$SET(.MSTYP,MS.TYP,.QORSU) ;RESPONSE TO SETUP
$SET(.MSTYP,MS.CNT,RSU.SZ) ;MESSAGE SIZE
$SET(RSU.TY,,.OTBIN) ;OBJECT TYPE
$SET(RSU.CO,,%RSUOK) ;DUMMY SETUP CAN'T FAIL
$EOB
DEFNOD: BLOCK 1 ;SETUP DEFAULT NODE
WTOOBJ: $BUILD OBJ.SZ
$SET(OBJ.TY,,.OTRDR) ;SAY I'M A READER
$EOB
TOPS10 <
MONPRT: EXP "."
RELX: SIXBIT/REL/
;IOWD FOR ACCOUNTING FILE READS
L.ACIO: IOWD 200,L.BUF
0
> ;END TOPS10
TOPS20 <
MONPRT: EXP "@"
RELX: XWD -1,[ASCIZ /REL/]
> ;END OF TOPS20 CONDITIONAL ASSEMBLY
;TBLUK table generation macro
DEFINE TB(TEXT,FLAGS),<
XWD [ASCIZ/TEXT/],FLAGS
>
SUBTTL Entry and Initialization
SPRINT: RESET ;RESET THE WORLD
MOVE P,[IOWD A%PDSZ,L.PDL]
TOPS10 <
PJOB S1,0 ;TURN OFF JACCT BIT
MOVSS S1 ;BY DOING APPROPRIATE
HRRI S1,.GTPRG ;GETTAB/SETNAM UUO SEQUENCE.
MOVE S1,[SIXBIT /SPRINT/] ;GETTAB FAILED, BEST GUESS
SETNAM S1,0 ;JACCT BIT TURNED OFF
>;END TOPS10 CONDITIONAL ASSEMBLY
TOPS20 <
HRRZI S1,.MSIIC ;BYPASS MOUNT COUNTS
MSTR ;DO THE FUNCTION
ERJMP .+1 ;IGNORE FOR NOW (INSUFFICIENT PRIVILEGES)
>;END TOPS20 CONDITIONAL ASSEMBLY
MOVEI S1,IB.SZ ;GET IB SIZE
MOVEI S2,SPTIB ;GET ADDRESS
$CALL I%INIT ;AND INITIALIZE THE WORLD
$CALL I%ION ;ENABLE FOR INTERRUPTS
MOVEI S1,LOWSIZ ;SIZE OF DATA AREA
MOVEI S2,LOWBEG ;BEGINNING ADR
$CALL .ZCHNK ;ZERO IT
TOPS10 <
PJOB T1,0 ;GET JOB NUMBER
LSH T1,12 ;*1024
MSTIME T2, ;SO RESTART DOESN'T RESET US
ADD T1,T2 ;MAKE A FUNNY NUMBER
HRRM T1,L.FUN ;AND STORE IT
MOVEI T3,4 ;WORDS -1 IN SYSNAM
MOVSI T1,.GTCNF ;CNFTBL
SPT1: MOVS T2,T1 ;TABLE #,,INDEX
GETTAB T2,0 ;GET NAME
SETZ T2,0 ;THIS REALLY SHOULDN'T HAPPEN
MOVEM T2,L.SYSN(T1) ;STORE IT AWAY
CAILE T3,(T1) ;GOT ALL FIVE?
AOJA T1,SPT1 ;NO, LOOP AROUND
MOVX S1,%LDMFD ;GETTAB TO MFD PPN
GETTAB S1,0 ;GET IT
MOVX S1,<XWD 1,1> ;DEFAULT
MOVEM S1,L.MFPP ;SAVE IT
SETOM L.AIFN ;SAY ACCOUNTING FILES NOT OPEN
SETOM L.XIFN ;..
MOVEI T1,L.SL1 ;BLOCK TO HOLD S/L
PUSHJ P,GETSRC ;GO GET THE SEARCH LIST
> ;END TOPS10
TOPS20 <
MOVNI S1,5 ;GET RUNTIME FOR ENTIRE JOB
RUNTM ;GET IT
MOVE S2,S1 ;SAVE IT
GTAD ;GET TIME AND DATE
ADD S2,S1 ;ADD THEM TOGETHER
HRRM S2,L.FUN ;AND SAVE THE SEED
MOVX S1,'SYSVER' ;GET TABLE # AND LENGTH FOR SYSTEM NAME
SYSGT ;GET IT
HLRE T1,S2 ;GET -VE LENGTH IN T1
MOVN T1,T1 ;AND MAKE IT POSITIVE
CAILE T1,L.SLEN-1 ;BE A LITTLE DEFENSIVE
MOVEI T1,L.SLEN-1 ;..
HRLZ S2,S2 ;GET TABLE#,,0
SPT1: MOVS S1,S2 ;GET INDEX,,TABLE
GETAB ;DO THE GETTAB
SETZ S1, ;STORE A NULL ON FAILURE
MOVEM S1,L.SYSN(S2) ;STORE THE WORD
CAILE T1,(S2) ;DONE?
AOJA S2,SPT1 ;NO, LOOP
> ;END IFN FTJSYS
MOVX S1,HEL.SZ ;LOAD THE SIZE
MOVEI S2,HELLO ;LOAD THE ADR OF THE MSG
PUSHJ P,SNDQSR ;SEND THE MESSAGE
JRST IDLE ;AND GO INTO THE IDLE LOOP
SUBTTL Job Setup and Idle Loop
IDLE: MOVE P,[IOWD A%PDSZ,L.PDL] ;RESET THE STACK
MOVEI S1,LOWZSZ ;SIZE OF AREA TO ZERO
MOVEI S2,LOWZER ;ADDRESS OF FIRST WORD
$CALL .ZCHNK ;ZERO THE AREA
SETZ F,0 ;CLEAR FLAG REGISTER
$CALL C%BRCV ;RECEIVE A MESSAGE
JUMPF IDLE ;NOTHING THERE, LOOP
MOVE T3,S1 ;SAVE MDB ADR AWAY
LOAD T1,MDB.SI(T3),SI.FLG ;GET SPECIAL INDEX FLAG
JUMPE T1,MSGREL ;NONE THERE, NOT FROM QUASAR
LOAD T1,MDB.SI(T3),SI.IDX ;YES, GET THE INDEX
CAXE T1,SP.QSR ;FROM QUASAR?
JRST MSGREL ;NO, IGNORE IT
LOAD T1,MDB.MS(T3),MD.ADR ;GET ADDRESS OF THE MESSAGE
LOAD T2,.MSTYP(T1),MS.TYP ;GET MESSAGE TYPE
MOVSI T3,-MSGNUM ;MAKE AOBJN POINTER
IDLE.1: HLRZ S1,MSGDSP(T3) ;GET MESSAGE CODE
HRRZ S2,MSGDSP(T3) ;GET DISPATCH ADDRESS
CAMN S1,T2 ;A MATCH?
JRST (S2) ;YUP, SURE IS
AOBJN T3,IDLE.1 ;LOOP THRU
$WTOJ(^I/ABTSPR/,<Unknown Message Received^M^JMessage Type-Code is ^O/T2/ -- Message ignored>,WTOOBJ)
MSGREL: $CALL C%REL
JRST IDLE ;GET BACK INTO MAIN STREAM
;Here to process the NEXTJOB message
IDLNEX: PUSHJ P,CLRFOB ;CLEAR THE FOB
SETZM FNDJOB ;CLEAR $JOB CARD FLAG
LOAD S1,.EQLEN(T1),EQ.LOH ;GET LENGTH OF HEADER
ADD S1,T1 ;POINT TO THE FP
IDLN.1: LOAD S2,.FPINF(S1) ;TAKE COPY OF FPINF WORD
MOVEM S2,L.INF ;..
TXNE S2,FP.PCR ;IS IT A REAL READER
JRST IDLN.2 ;YES..
MOVX T2,.OTBIN ;DEFAULT OBJECT TYPE
STORE T2,WTOOBJ+OBJ.TY ;STORE IT
GETLIM T2,.EQLIM(T1),ONOD ;OUTPUT NODE FIELD
STORE T2,WTOOBJ+OBJ.ND ;STORE IT
SETZM CDRDEV ;SET NOT REAL READER ../READER
JRST IDLN.3 ;CONTINUE ON
IDLN.2: MOVX T2,.OTRDR ;NO
STORE T2,WTOOBJ+OBJ.TY ;STORE IT
GETLIM T2,.EQLIM(T1),CNOD ;GET THE NODE NAME
STORE T2,WTOOBJ+OBJ.ND ;STORE IT
SETOM CDRDEV ;SET REAL READER FLAG
IDLN.3: LOAD S2,L.INF,FP.RCF ;GET SPECIFIED RECORDING MODE
CAXN S2,.FPFAI ;AUGMENTED IMAGE?
MOVE T2,[XWD CPC,^D18] ;WIDTH,,BYTE SIZE
CAXE S2,.FPFAS ;FIXED OR STREAM ASCII?
CAXN S2,.FPFSA
MOVE T2,[XWD SMA,^D7] ;WIDTH,,BYTE SIZE
SKIPG T2 ;ONE OF THE ABOVE?
JRST [
$WTOJ(^I/ABTSPR/,<Unknown Recording Mode specified (^D/S2/)>)
JRST RELJOB]
HLRZM T2,L.DWID ;STORE DEFAULT WIDTH
STORE T2,L.FOB+FOB.CW,FB.BSZ ;AND SAVE IT
LOAD S2,.FPLEN(S1),FP.LEN ;GET FP SIZE
ADD S1,S2 ;AND POINT TO THE FD
MOVEM S1,L.FOB+FOB.FD ;AND STORE AWAY
IDLN.4: MOVSI S1,(T1) ;TAKE COPY OF EQ
HRRI S1,L.EQCP ;..
BLT S1,L.EQCP+EQXSIZ-1
SKIPN CDRDEV ;PHYSICAL READER?
JRST IDLN.5 ;NO
MOVEI S1,10 ;SETUP TO
MOVEI S2,L.EQCP+.EQACT ;CLEAR ACCOUNT STRING
$CALL .ZCHNK ;..
IDLN.5: MOVEI S1,FOB.MZ ;LENGTH OF THE BLOCK
MOVEI S2,L.FOB ;AND THE ADDRESS
$CALL F%IOPN ;OPEN THE FILE
JUMPF RELJOB ;???
MOVEM S1,L.IFN ;SAVE THE IFN
$CALL C%REL ;RELEASE THE MESSAGE
MLTJOB: MOVE T1,[POINT 7,L.DMOD] ;GET THE DEFAULT MODE
MOVEM T1,L.DHOL ;SAVE AS DEFAULT
PUSHJ P,STRTJB ;START UP THE JOB
JRST MAIN ;AND GET INTO THE MAIN LOOP
;Here to respond to a SETUP message
IDLSUP: LOAD S1,SUP.UN(T1) ;GET THE OBJECT
STORE S1,RSETUP+RSU.UN ;AND STORE IT
STORE S1,WTOOBJ+OBJ.UN
LOAD S1,SUP.NO(T1) ;GET THE NODE NUMBER
STORE S1,RSETUP+RSU.NO ;AND STORE IT
STORE S1,WTOOBJ+OBJ.ND
MOVEM S1,DEFNOD ;SAVE THE DEFAULT NODE
MOVEI S1,RSU.SZ ;LOAD THE SIZE
MOVEI S2,RSETUP ;AND THE ADDRESS
PUSHJ P,SNDQSR ;SEND IT OFF TO QUASAR
JRST MSGREL ;REENTER IDLE LOOP
;Here on receipt of some TEXT message
IDLTXT: $STOP (UTM,<Unexpected text message received from QUASAR^M^J ^T/.OHDRS+ARG.DA(T1)/>)
;DISPATCH ON MESSAGE TYPE
MSGDSP: XWD .QOSUP,IDLSUP ;SETUP
XWD .QONEX,IDLNEX ;NEXTJOB
XWD .QORCK,MSGREL ;REQUEST FOR CHECKPOINT
XWD MT.TXT,IDLTXT ;TEXT
MSGNUM==.-MSGDSP ;COUNT
SUBTTL Start up the job
;STRTJB is called to start up the job. the "EQ" page is acquired
; and initialized, the logfile gets its introductory
; messages, The first card is scanned for $JOB and JOB card
; processing is done.
STRTJB: $CALL M%GPAG ;GET A PAGE
MOVE Q,S1 ;PUT IT IN AC "Q"
HRLI S1,L.EQCP ;COPY SAVED EQ TO CREATE MESSAGE
BLT S1,EQXSIZ-1(Q) ;..
MOVX S1,.QOCRE ;LOAD "CREATE" CODE
STORE S1,.MSTYP(Q),MS.TYP ;STORE IT
MOVX S1,EQXSIZ ;LENGTH OF HEADER
STORE S1,.EQLEN(Q),EQ.LOH ;AND STORE IT
MOVX S1,.OTBAT ;BATCH OBJECT TYPE
STORE S1,.EQROB+.ROBTY(Q) ;STORE IT IN THE EQ
MOVX S1,%%.QSR ;REQUEST VERSION NUMBER
STORE S1,.EQLEN(Q),EQ.VRS ;STORE IT
MOVEI S1,2 ;NUMBER OF FILES IN REQUEST
STORE S1,.EQSPC(Q),EQ.NUM ;AND STORE IT
PUSHJ P,FUNNY ;GET A FUNNY 4 CHARS
TLO S1,'JB ' ;MAKE A JOB NAME
STORE S1,.EQJBB+JIB.JN(Q) ;YES, USE FUNNY NAME
ZERO .EQSEQ(Q),EQ.NOT ;CLEAR NOTIFY
SKIPE CDRDEV ;PHYSICAL READER?
JRST STRT.1 ;YES
TOPS10< SETZB S1,S2 ;CLEAR BOTH ACS
DMOVEM S1,.EQOWN(Q) ;NO., CLEAR OWNER FIELD
>;END TOPS10
JRST STRT.2 ;ALL SET NOW
STRT.1: MOVX S1,EQLMSZ ;GET THE LIMIT WORD BLOCK SIZE
MOVEI S2,.EQLIM(Q) ;GET THE LIMIT WORD ADDRESS
PUSHJ P,.ZCHNK ;ZERO THE LIMIT WORD BLOCK
STRT.2: $CALL M%GPAG ;GET A PAGE
MOVEM S1,LOGPAG ;SAVE PAGE ADDRESS
HRLI S1,(POINT 7) ;MAKE A BYTE POINTER
MOVEM S1,LOGPTR ;SAVE IT
MOVX S1,PAGSIZ*5 ;GET NUMBER OF BYTES ALLOWED
MOVEM S1,LOGCNT ;STORE IT
$TEXT(LOGTXT,<^M^J^I/STDAT/SPRINT version ^V/[EXP %SPT]/ ^T/L.SYSN/>)
MOVE S1,L.IFN ;GET THE IFN
SETO S2,0
$CALL F%FD ;BUILD AN FD
SKIPE CDRDEV ;PHYSICAL READER
$TEXT(LOGTXT,<^I/STMSG/[Job Input from ^B/WTOOBJ/]>)
SKIPN CDRDEV ;PHYSICAL READER?
$TEXT(LOGTXT,<^I/STMSG/[Job Input from file ^F/(S1)/]>)
$CALL L%CLST ;CREATE A LINKED LIST
MOVEM S1,L.FBLN ;AND SAVE THE LIST NAME
MOVE S1,L.DWID ;LOAD DEFAULT WIDTH
MOVEM S1,L.WIDT ;STORE
SKIPN @L.DHOL ;SEE IF WE ALREADY HAVE A JOB CARD
STRT.3: PUSHJ P,S$NXTC ;READ THE JOB CARD
MOVEI S1,1 ;LOAD CARD COUNT
MOVEM S1,CDRCNT ;SAVE IT
ILDB S1,B ;GET THE FIRST CHARACTER
CAIE S1,"$" ;IS IT A DOLLAR SIGN?
JRST STRT.3 ;NOPE
MOVEI S1,L.TNAM ;POINT TO STRING BLOCK
PUSHJ P,S$ASCZ ;READ THE KEYWORD IN
MOVEI S1,[XWD 1,1
XWD [ASCIZ/JOB/],0]
HRROI S2,L.TNAM ;POINT TO STRING
$CALL S%TBLK ;GOBBLE IT UP
TXNE S2,TL%NOM!TL%AMB ;MATCH?
JRST STRT.3 ;NOPE, LOOP
PJRST JOBLIN ;GO PROCESS JOB CARD
SUBTTL $JOB Card
JOBLIN: SETOM FNDJOB ;REMEMBER WE FOUND A JOB CARD
HRL S1,L.DHOL ;SAVE THE $JOB
HRRI S1,JOBCRD ;CARD AWAY
BLT S1,JOBCRD+SMA/5 ;FOR LATER
PUSHJ P,S$FSPC ;SCAN OFF BLANKS
JUMPF ILLJOB ;EOL MEANS BAD CARD
CAIN C,"/" ;FIRST ITEM A SWITCH?
SETOM SYSIDP ;YUP, SET SYS INDEPENDENT FLAG
PUSHJ P,JOBOS ;GET OPERATING SYSTEM DEP PART
MOVEI S1,A%HLER ;DEFAULT FOR /ERR:HOL
MOVEM S1,L.UHOL ;STORE IT
MOVEI S1,A%CSER ;DEFAULT FOR /ERR:CHKSUM
MOVEM S1,L.UCHK
MOVEI S1,A%ICER ;DEFAULT FOR /ERRO:IBC
MOVEM S1,L.UIBC ;AND STORE IT
MOVEI T1,SW.JOB ;LOAD $JOB SWITCHES
PUSHJ P,DOSWCH ;DO THE SWITCHES
PUSHJ P,JOBVER ;VERIFY JOB DATA
PUSHJ P,DOACCT ;CHECK ACCOUNTING
LOAD S1,L.SEQ,EQ.SEQ ;LOAD STORED SEQ #
LOAD S2,.EQSEQ(Q),EQ.SEQ ;GET USER SPECIFIED
SKIPN S2
STORE S1,.EQSEQ(Q),EQ.SEQ
PUSHJ P,MAKCTL ;MAKE THE CTL FILE
PUSHJ P,MAKLOG ;MAKE A LOG FILE
SETOM L.JLOG ;JOB IS LOGGED IN
$RET
ILLJOB: $TEXT(LOGTXT,<^I/FATAL/?SPTIFJ ^I/ILLJ.1/>)
JSP B,JOBCER
ILLJ.1: ITEXT(<Improperly formatted $JOB Card>)
TOPS20 <
JOBOS: GTAD ;GET CURRENT DATE AND TIME
MOVEM S1,L.DTM ;AND STORE IT
MOVX S1,.FHSLF ;LOAD FORK HANDLE
RUNTM ;GET RUNTIME
MOVNM S1,L.RTM ;AND STORE IT
MOVEI S1,.EQOWN(Q) ;LOAD ADDRESS OF BLOCK
SKIPE SYSIDP ;SYSTEM INDEPENDENT JOB CARD?
$RET ;YES, RETURN
TXO F,F.RSCN ;SET RESCAN FLAG
PUSHJ P,S$ASCZ ;NO, GET A STRING
$RET ;RETURN
>;END OF TOPS20 CONDITIONAL ASSEMBLY
JOBVER: SKIPN SYSIDP ;SYS INDEPENENCE?
$RET ;NO, NORMAL
TOPS20 <
SKIPN L.USER ;USER NAME SPECIFIED?
JRST ILLJOB ;NO BOMBOUT!
MOVSI S1,L.USER ;PREPARE TO MOVE /USER
HRRI S1,.EQOWN(Q) ;NAME SPECIFIED
BLT S1,.EQOWN+7(Q) ;TO THE OWNER BLOCK
>
TOPS10 <
SKIPN S1,L.PPN ;GET SPECIFIED PPN
JRST ILLJOB ;GOTTA HAVE IT
MOVEM S1,.EQOID(Q) ;STORE IT
MOVE S1,L.USER
MOVEM S1,.EQOWN(Q)
MOVE S1,L.USER+1
MOVEM S1,.EQOWN+1(Q)
>
$RET ;AND RETURN
TOPS10 <
JOBOS: $CALL .SAVE1 ;SAVE P1
MOVX T1,%CNDTM ;CURRENT DATE/TIME
GETTAB T1,0 ;GET IT
SETO T1,0 ;ERROR
MOVEM T1,L.DTM ;SAVE IT FOR ACCOUNTING PURPOSES
SETZ T1,0 ;CLEAR AN AC
RUNTIM T1,0 ;GET OUR RUNTIME
MOVNM T1,L.RTM ;SAVE IT FOR RUNTIME COMPUTATION
SKIPE SYSIDP ;SYSTEM INDEPENDENT JOB CARD?
$RET ;YES, RETURN
MOVE P1,B ;SAVE CURRENT BYTE POINTER
TXO F,F.RSCN ;RE-EAT
$JOB.1: PUSHJ P,W$JOBN ;NO, GET JOB NAME
PUSHJ P,GETPPN ;TRY READING IN THE PPN
JUMPT $JOB.2 ;GO PROCESS IF OK
JUMPE P1,NOPPN ;IF 2ND TIME, PUNT
MOVE B,P1 ;RESET THE BYTE POINTER
SETZ P1,0 ;AND CLEAR A FLAG
ADDI B,<EXP L.NMOD-L.DMOD> ;POINT TO THE OTHER MODE
MOVE T1,[POINT 7,L.NMOD] ;MAKE THIS THE DEFAULT
MOVEM T1,L.DHOL ;FOR THE REST OF THE JOB
JRST $JOB.1 ;AND LOOP
$JOB.2: MOVE T1,L.PPN ;GET THE PPN
MOVEM T1,.EQOID(Q) ;RELOCATE
$RET ;RETURN
> ;END TOPS10
NOPPN: $TEXT(LOGTXT,<^I/FATAL/?SPTMPP ^I/NOPP.1/>)
JSP B,JOBCER ;AND ABORT THE JOB
NOPP.1: ITEXT(<Missing Project-Programmer Number on $JOB card>)
IPPNF: $TEXT(LOGTXT,<^I/FATAL/?SPTBFP ^I/IPPN.1/>)
JSP B,JOBCER ;ABORT THE JOB
IPPN.1: ITEXT(<Bad format for Project-Programmer Number on $JOB card>)
GETPPN: CAIE C," " ;WAS BREAK CHAR A SPACE?
JRST GETP.1 ;NO, CHECK FOR PPN OPENER
PUSHJ P,S$FSPC ;YES, FLUSH LEADING SPACES
JUMPF NOPPN ;EOL, NO PPN SPECIFIED
GETP.1: CAIE C,"[" ;OPEN SQUARE BRACKET?
CAIN C,"<" ;NO, OPEN ANGLE BRACKET?
JRST GETP.2 ;A MATCH!!
CAIN C,"(" ;CHECK OPEN PAREN
JRST GETP.2 ;WIN!
$RETF ;LOSE
GETP.2: PUSHJ P,S$OCT ;GET PROJECT NUMBER
JUMPF .RETF ;???
HRLZM T1,L.PPN ;SAVE PROJECT NUMBER
CAIE C,"," ;BREAK ON COMMA?
JRST IPPNF ;NO, BAD FORMAT
PUSHJ P,S$OCT ;GET PROGRAMMER NUMBER
JUMPT GETP.3 ;GOT A NUMBER!
CAIE C,"#" ;IS IT A WILDCARD?
$RETF ;NO, BAD FORMAT
PUSHJ P,CDRCHR ;SKIP TO NEXT CHARACTER
MSTIME T1, ;GET RANDOM NUMBER (RANDOM?)
TXO T1,1B18 ;MAKE IT GT 400000
TXZ T1,1B19!1B20 ;FOLLOW CONVENTION
GETP.3: HRRM T1,L.PPN ;SAVE PROGRAMMER NUMBER
CAIE C," " ;WAS BREAK CHARACTER A SPACE?
JRST GETP.4 ;NO, LOOK FOR CLOSER
PUSHJ P,S$FSPC ;YES, FLUSH SPACES
JUMPF .RETF ;BAD FORMAT FOR PPN
GETP.4: CAIE C,"]" ;CLOSE SQUARE BRACKET?
CAIN C,">" ;OR CLOSE ANGLE BRACKET
$RETT ;YES, WIN!!
CAIE C,")" ;FINALLY, CLOSE PAREN
$RETF ;NO!!!!
$RETT ;YES, RETURN
SUBTTL MAKCTL - Create the CTL File
MAKCTL:
TOPS10 <
MOVEI S1,FDXSIZ ;GET LENGTH
MOVEI S2,CLFFD ;GET ADDRESS
$CALL .ZCHNK ;ZERO THE BLOCK
LOAD S1,.EQJBB+JIB.JN(Q) ;GET JOB NAME
STORE S1,CLFFD+.FDNAM ;AND STORE IT
MOVSI S1,'CTL' ;GET EXTENSION
STORE S1,CLFFD+.FDEXT ;AND STORE IT
MOVEI S1,FDMSIZ ;GET MINIMUM FD SIZE
STORE S1,CLFFD+.FDLEN,FD.LEN ;AND STORE IT
> ;END TOPS10
TOPS20 <
MOVE S1,[POINT 7,CLFFD+.FDSTG]
MOVEM S1,L.BP ;STORE IT AWAY
$TEXT (DEPBP,<^T/L.UDIR/^W/.EQJBB+JIB.JN(Q)/.CTL^0>)
HRRZ S1,L.BP ;GET BP ADDRESS
SUBI S1,CLFFD-1 ;COMPUTE SIZE
STORE S1,CLFFD+.FDLEN,FD.LEN ;AND STORE IT
> ;END IFN FTJSYS
PUSHJ P,CLRFOB ;CLEAR THE FOB OUT
MOVEI S1,CLFFD ;GET ADDRESS OF THE FD
MOVEM S1,L.FOB+FOB.FD ;AND STORE IT
MOVEI S1,7 ;GET THE BYTE SIZE
STORE S1,L.FOB+FOB.CW,FB.BSZ ;AND STORE IT
MOVX S1,FOB.MZ ;GET THE LENGTH OF THE FOB
MOVEI S2,L.FOB ;AND ITS ADDRESS
$CALL F%OOPN ;AND OPEN THE FILE
JUMPF MAKC.1 ;JUMP IF IT FAILED
MOVEM S1,CTLIFN ;SAVE THE IFN
POPJ P, ;AND RETURN
MAKC.1: MOVE P1,S1 ;RELOCATE THE ERROR CODE
$TEXT(LOGTXT,<^I/FATAL/?SPTECC ^I/MAKC.2/>)
JSP B,PROCER
MAKC.2: ITEXT(<Error creating BATCH control (CTL) file, ^E/P1/>)
SUBTTL MAKLOG - Create the LOG File
MAKLOG:
TOPS10 <
MOVEI S1,FDXSIZ ;GET LENGTH
MOVEI S2,CLFFD ;GET ADDRESS
$CALL .ZCHNK ;ZERO THE BLOCK
LOAD S1,.EQJBB+JIB.JN(Q) ;GET JOB NAME
STORE S1,CLFFD+.FDNAM ;AND STORE IT
MOVSI S1,'LOG' ;GET EXTENSION
STORE S1,CLFFD+.FDEXT ;AND STORE IT
MOVEI S1,FDMSIZ ;GET MINIMUM FD SIZE
STORE S1,CLFFD+.FDLEN,FD.LEN ;AND STORE IT
GETLIM S1,.EQLIM(Q),BLOG ;GET /BATLOG ARGUMENT
CAXE S1,%BSPOL ;SPOOLING SPECIFIED?
JRST MAKL.4 ;NO, SO WE'RE ALL SET
PUSHJ P,FUNNY ;GENERATE 4-CHAR FUNNY NAME
TLO S1,'BL ' ;MAKE IT BL????
MOVEM S1,CLFFD+.FDNAM ;STORE AS UNIQUE FILENAME
MOVX S1,<XWD 3,3> ;SPECIFY SPOOLING AREA
MOVEM S1,CLFFD+.FDPPN ;STORE AS OUTPUT PPN
> ;END TOPS10
TOPS20 <
PUSHJ P,FUNNY ;CREATE A RANDOM FILENAME
TLO S1,'BL ' ;MAKE IT 'BLXXXX'
MOVE T1,S1 ;RELOCATE
MOVE S1,[POINT 7,CLFFD+.FDSTG]
MOVEM S1,L.BP ;STORE THE POINTER
GETLIM S1,.EQLIM(Q),BLOG ;GET /BATCH-LOG ARGUMENT
CAXN S1,%BSPOL ;SPOOLED?
$TEXT(DEPBP,<PS:^7/[OCT 74]/SPOOL^7/[OCT 76]/SPR-^O/L.USNO,RHMASK/-^W/T1/.LOG^0>)
CAXE S1,%BSPOL
$TEXT(DEPBP,<^T/L.UDIR/^W/.EQJBB+JIB.JN(Q)/.LOG^0>)
HRRZ S1,L.BP ;GET BP ADDRESS
SUBI S1,CLFFD-1 ;AND COMPUTE LENGTH
STORE S1,CLFFD+.FDLEN,FD.LEN ;AND STORE IT
> ;END IFN FTJSYS
MAKL.4: PUSHJ P,CLRFOB ;CLEAR OUT THE FOB
MOVEI S1,CLFFD ;GET ADDRESS OF THE FD
MOVEM S1,L.FOB+FOB.FD ;AND STORE IT
MOVEI S1,7 ;GET THE BYTE SIZE
STORE S1,L.FOB+FOB.CW,FB.BSZ ;AND STORE IT
MOVEI S1,2 ;GET THE LENGTH OF THE FOB
MOVEI S2,L.FOB ;AND ITS ADDRESS
MOVEI T2,F%AOPN ;ASSUME APPEND MODE
GETLIM T1,.EQLIM(Q),BLOG ;GET /BATCH-LOG ARGUMENT
CAXN T1,%BSCDE ;SPECIFY SUPERSEDE?
MOVEI T2,F%OOPN ;YUP, SO DOIT!
PUSHJ P,(T2) ;CALL APPROPRIATE OPEN ROUTINE
JUMPF MAKL.1 ;JUMP IF IT FAILED
MOVEM S1,LOGIFN ;SAVE THE IFN
MOVE S1,LOGIFN ;GET THE IFN
MOVX S2,PAGSIZ*5 ;GET MAXIMUM BYTE COUNT
SUB S2,LOGCNT ;GET NUMBER TO PRINT
MOVE T1,LOGPAG ;GET ADDRESS OF LOG PAGE
HRLZ S2,S2 ;GET COUNT,,0
HRR S2,T1 ;GET COUNT,,ADDRESS
$CALL F%OBUF ;OUTPUT THE BUFFER
MOVE S1,LOGPAG ;GET THE PAGE ADDRESS
$CALL M%RPAG ;RELEASE IT
SETZM LOGPAG ;CLEAR THE PAGE NUMBER
POPJ P, ;AND RETURN
MAKL.1: SKIPN .EQOID(Q) ;GO THRU NOJOB ALREADY?
JRST MAKL.3 ;YES, NOW WE CAN DIE
MOVE P1,S1 ;RELOCATE ERROR CODE
$TEXT(LOGTXT,<^I/FATAL/?SPTECL ^I/MAKL.2/>)
JSP B,PROCER
MAKL.2: ITEXT(<Error creating BATCH LOG file, ^E/P1/>)
MAKL.3: $STOP(CCL,Cannot create a LOG)
SUBTTL Main Program Loop
;This loop is reached after successfully processing $SEQUENCE,
; $JOB, and $PASSWORD cards.
MAIN: MOVE B,L.DHOL ;LOAD A BYTE POINTER
ILDB T1,B ;AND GET COLUMN 1
CAIE T1,"$" ;CONTROL CARD?
PJRST MAIN.3 ;NO, MUST BE AN ERROR
ILDB T1,B ;GET SECOND COLUMN
CAIL T1,"a" ;CONVERT LOWER CASE
CAIL T1,"z" ; TO UPPER
SKIPA ; IF NECESSARY
TRZ T1,40 ;CONVERT CASING
CAIL T1,"A" ;SEE IF SECOND LETTER IS ALPHABETIC
CAILE T1,"Z" ;BETWEEN A AND Z
JRST MAIN.2 ;NO, EITHER A COMMENT OR AN ERROR
PUSHJ P,CONTRL ;PROCESS CONTROL CARD
JRST MAIN ;NO, READ THE NEXT CARD
MAIN.2: PUSHJ P,LOGCRD ;LOG THE CARD
CAIE T1,"!" ;EXCLAIM?
TOPS10 <
CAIN T1,";" ;OR SEMI?
SKIPA ;YES, IT'S A COMMENT
> ;END TOPS10
JRST ILLCRD ;NO, IT'S AN ERROR
MOVX T1,<"!">B6 ;LOAD AN EXCLAIM
MOVX T2,177B6 ;LOAD A MASK
ANDCAM T2,L.CASC ;TURN OFF CHAR 1
IORM T1,L.CASC ;AND MAKE IT AN EXCLAIM
$TEXT(TXTCTL,<^T/L.CASC/^A>)
PUSHJ P,CDRASC ;READ THE NEXT CARD
JRST MAIN ;AND LOOP AROUND
MAIN.3: PUSHJ P,LOGCRD ;OUTPUT THE CARD TO LOG
$TEXT (LOGTXT,<^I/FATAL/?SPTCNF ^I/MAIN.4/ - Card #^D/CDRCNT/>)
JSP B,CTLCER ;ABORT
MAIN.4: ITEXT (<Control Card not found when expected>)
SUBTTL Control Cards -- Setup and Dispatch
;CONTRL -- Routine to interpret and dispatch control cards
;
;CALL:
; PUSHJ P,CONTRL
; RETURN HERE ALWAYS
CONTRL: PUSHJ P,$EOD ;CLOSE OUT FILE IN PROGRESS
PUSHJ P,W$DFMD ;SETUP DEFAULT HOLLERITH MODE
PUSHJ P,W$NODOLLAR ;RESET /NODOLLARS
PUSHJ P,W$LIST ;RESET /LIST
$SUPPRESS <SETOM L.SPRS>
$NOSUPPRESS <SETZM L.SPRS>
MOVE S1,L.DWID ;DEFAULT WIDTH
STORE S1,L.WIDT ;STORE IT
PUSHJ P,LOGCRD ;LOG THE CARD
MOVE B,L.DHOL ;GET THE BYTE POINTER
IBP B ;POINT PAST THE "$"
TXZ F,F.RSCN ;ALWAYS CLEAR RESCAN FLAG
SETZM L.BRK ;ALWAYS CLEAR BREAK FLAG
MOVEI S1,L.TNAM ;POINT TO BLOCK
PUSHJ P,S$ASCZ ;GATHER THE KEYWORD
TXO F,F.RSCN ;RESCAN THE BREAK LATER ON
MOVEI S1,TBCARD ;POINT TO TABLE
HRROI S2,L.TNAM ;POINT TO THIS KEYWORD
$CALL S%TBLK ;SEE IF WE KNOW ABOUT IT
TXNE S2,TL%NOM!TL%AMB ;DO WE?
JRST ILLCRD ;NO
SUBI S1,TBCARD+1 ;COMPUTE INDEX
MOVE P1,CADRS(S1) ;GET DISPATCH ADDRESS
TXNE P1,CD.BTC ;THIS CARD NEED THE BATCH BIT?
TXO F,F.BTCH ;YES, TURN IT ON!
TXNE P1,CD.CLO ;CLEAR THE LOAD ORDER?
PUSHJ P,FBCLOD ;YUP!!
PUSH P,P1 ;SAVE DISPATCH ADDRESS
PUSHJ P,(P1) ;DISPATCH TO CORRECT ROUTINE
POP P,P1 ;RESTORE DISPATCH AC
TXNE P1,CD.RNC ;NEED TO READ NEXT CARD?
PUSHJ P,CDRASC ;YES, DO SO
POPJ P,0 ;RETURN
ILLCRD: $TEXT(LOGTXT,<^I/FATAL/?SPTICC ^I/ILCMSG/ - card #^D/CDRCNT/>)
JSP B,CTLCER ;ABORT
ILCMSG: ITEXT (<Illegal control card>)
L.TNAM: BLOCK ^D8 ;ROOM FOR CONTROL CARD NAME
;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.RNC==1B2 ;READ NEXT CARD
CD.BTC==1B3 ;THIS IS A SPECIAL BATCH CARD
CD.LAN==CD.BTC!CD.CLO ;DISPATCH BITS FOR ALL $LANG CARDS
DEFINE CNAMES,<
X ALGOL,$ALGOL,CD.LAN
X BACKTO,$$BATCH,CD.BTC!CD.RNC!CD.BTC
X BLISS,$BLISS,CD.LAN
X CHKPNT,$$BATCH,CD.BTC!CD.RNC!CD.BTC
X COBOL,$COBOL,CD.LAN
X CREATE,$CREAT,0
X DATA,$DATA.,CD.BTC
TOPS10 <X DECK,$DECK>
TOPS10 <X DUMP,$DUMP,CD.BTC!CD.RNC>
X EOD,$EOD,CD.RNC
X EOJ,$EOJ
X ERROR,$$BATCH,CD.BTC!CD.RNC!CD.BTC
X EXECUTE,$EXECUTE,CD.BTC!CD.RNC
X FORTRAN,$FORTRAN,CD.LAN
X GOTO,$$BATCH,CD.BTC!CD.RNC!CD.BTC
X IF,$$IF,CD.BTC!CD.RNC
X INCLUDE,$INCLU,CD.CLO
X JOB,$JOB
X LABEL,$LABEL,CD.RNC!CD.BTC
X MACRO,$MACRO,CD.LAN
X MESSAGE,$MESS,CD.RNC
X NOERROR,$$BATCH,CD.BTC!CD.RNC!CD.BTC
X NOOPERATOR,$$BATCH,CD.BTC!CD.RNC!CD.BTC
X OPERATOR,$$BATCH,CD.BTC!CD.RNC!CD.BTC
X PASSWORD,$PASSW,CD.RNC
TOPS10 <X RELOCATABLE,$RELOC,CD.CLO>
X REQUEUE,$$BATCH,CD.BTC!CD.RNC!CD.BTC
X REVIVE,$$BATCH,CD.BTC!CD.RNC!CD.BTC
X SEQUENCE,$SEQUE
X SILENCE,$$BATCH,CD.BTC!CD.RNC!CD.BTC
X SNOBOL,$SNOBOL,CD.LAN
X TOPS,$TOPNTV,CD.BTC
TOPS10 <X TOPS10,$TOPNTV,CD.BTC>
TOPS10 <X TOPS20,$TOPFGN,CD.BTC>
TOPS20 <X TOPS10,$TOPFGN,CD.BTC>
TOPS20 <X TOPS20,$TOPNTV,CD.BTC>
> ;END DEF CNAMES
DEFINE X(A,B,C),<
TB(A,0)>
TBCARD: XWD TB.SIZ,TB.SIZ
CNAMES
TB.SIZ==.-TBCARD-1
DEFINE X(CARD,DISP,BITS<0>),<XALL
EXP DISP+BITS ; CARD
SALL>
CADRS: CNAMES
;SWITCH TABLES
;VALID SWITCHES FOR ALL CARDS
; Y SWITCH NAME,DISPATCH ADR,VALID CARD FLAGS
;
;WHERE VALID CARD FLAGS ARE:
SW.LAN==1B18 ;LANGUAGE CARDS
SW.DEC==1B20 ;$DECK 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.MOD==1B28 ;NON-ASCII MODE SPECIFIER
SW.ALL==SW.LAN!SW.DEC!SW.DAT!SW.TOP
DEFINE SNAMES,<
Y 026,SW.ALL!SW.MOD
Y ACCOUNT,SW.JOB
Y AFTER,SW.JOB
Y ASCII,SW.ALL!SW.MOD
Y ASSISTANCE,SW.JOB
TOPS20 <Y <BATCH-LOG>,SW.JOB,BATCH>
TOPS10 <Y BATLOG,SW.JOB,BATCH>
Y BCD,SW.ALL!SW.MOD
TOPS10 <Y BINARY,SW.DEC!SW.DAT!SW.MOD>
Y CARDS,SW.JOB
TOPS10 <IFN INPCOR,<Y CORE,SW.JOB>>
Y CPUNCH,SW.DEC
Y CREF,SW.LAN
Y DEPEND,SW.JOB
Y DOLLARS,SW.ALL
Y ERRORS,SW.JOB!SW.MOD
Y FEET,SW.JOB
Y HOLLERITH,SW.JOB!SW.MOD
Y IMAGE,SW.DEC!SW.DAT!SW.MOD
Y JOBNAME,SW.JOB
Y LIST,SW.LAN
Y LOCATE,SW.JOB
Y LOGDISPOSITION,SW.JOB
Y MAP,SW.DAT!SW.EXE
TOPS10 <Y NAME,SW.JOB>
Y NODOLLARS,SW.ALL
Y NOLIST,SW.LAN
Y NOMAP,SW.DAT!SW.EXE
Y NORESTARTABLE,SW.JOB
Y NOSUPPRESS,SW.ALL
Y OUTPUT,SW.JOB
Y PAGES,SW.JOB
TOPS10 <Y PLOT,SW.DEC>
Y PPN,SW.JOB
Y PRINT,SW.DEC
Y PRIORITY,SW.JOB
TOPS10 <Y PROTECT,SW.DEC>
Y RESTARTABLE,SW.JOB
Y SEARCH,SW.INC
Y SEQUENCE,SW.JOB
Y SUPPRESS,SW.ALL
Y TIME,SW.JOB
TOPS10 <Y TPLOT,SW.JOB>
Y TPUNCH,SW.DEC
Y UNIQUE,SW.JOB
Y USER,SW.JOB
Y WIDTH,SW.ALL
> ;END DEF SNAMES
DEFINE Y(A,B,C),<
TB(A,0)
>
TBSWIT: XWD SW.SIZ,SW.SIZ
SNAMES
SW.SIZ==.-TBSWIT-1
DEFINE Y(A,B,C),<
XALL
IFB <C>,<XWD B,W$'A>
IFNB <C>,<XWD B,W$'C>
SALL>
;TABLE OF FORM: XWD <VALID CARD FLAGS>,<DISPATCH ADDRESS>
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
; definition is as follows:
; 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
TOPS10 <
L F40,F4 ,F40,R
>
L FORTRAN,FOR,FOR,R
>;END DEFINE LANGS
; Generate Entry Points
DEFINE L(A,B,C,D),<XALL
IFIDN <D> <R> ,<
$'A: HRRZI T1,K
JRST $LANG
K=K+1>
IFIDN <D> <I> ,<
$'A: HRROI T1,K
JRST $LANG
K=K+1>
SALL>
K=0
LANCRD: LANGS
;Now generate table of Extension,,Compile switch
DEFINE L(A,B,C,D),<
TOPS10 <
XWD [SIXBIT /B/],<<SIXBIT /C/>_-^D18>
> ;END TOPS10
TOPS20 <
XWD [XWD -1,[ASCII/B/]],<<SIXBIT /C/>_-^D18>
>;END OF TOPS20 CONDITIONAL ASSEMBLY
>;END DEFINE L
EXTTBL: LANGS
$LANG: MOVEM T1,LANG.A ;SAVE THE INDEX
MOVEI S1,'LN' ;LOAD A PREFIX
PUSHJ P,MAKFUN ;AND MAKE A FUNNY NAME
MOVE T1,LANG.A ;GET THE INDEX BACK
HLRZ S2,EXTTBL(T1) ;GET ADR OF DEFAULT EXTENSION
MOVE S2,(S2) ;GET DEFAULT EXTENSION
PUSHJ P,S$FILE ;GET A FILESPEC
MOVX T1,FB.LDR!FB.DEL ;LOAD THE REL AND DELETE BOTH
SKIPGE LANG.A ;IS IT AN INTERPRETER?
MOVX T1,FB.DEL ;YES, JUST DELETE THE SOURCE
SKIPE FILSPC ;DID THE USER NAME IT?
JRST $LAN.1 ;YES, HE SPECIFIED ONE
PUSHJ P,FILENT ;ENTER THE FILE
JRST $LAN.2 ;MEET AT THE PASS
$LAN.1: TXZ T1,FB.DEL ;TURN OFF DELETE IF IT IS HIS
PUSHJ P,FBENT ;ENTER IT IN THE FILE-BLOCKS
$LAN.2: HRRZ T1,LANG.A ;GET LANGUAGE INDEX
$TEXT(TXTCTL,<^7/MONPRT/COMPILE /COMPILE/^W/EXTTBL(T1),RHMASK/ ^F/FILFD/^A>)
PUSHJ P,S$FSPC ;AND FLUSH LEADING SPACES
JUMPF $LAN.4 ;EOL, GO SEND LISTING SWITCH
TOPS10 <
CAIE C,"(" ;BEGINNING OF PROCESSOR SWITCH?
JRST $LAN.3 ;NO, CHECK FOR SPRINT SWITCHES
MOVEI S1,"(" ;LOAD AN OPEN PAREN
PUSHJ P,TXTCTL ;AND PRINT IT
MOVEI T1,")" ;LOAD THE BREAK CHARACTER
PUSHJ P,CTLCRD ;GO TRANSFER FROM CARD TO CTL
MOVEI S1,")" ;LOAD A CLOSE PAREN
PUSHJ P,TXTCTL ;AND PRINT IT
> ;END OF TOPS10 CONDITIONAL ASSEMBLY
$LAN.3: MOVX T1,SW.LAN ;VALID SWITCHES FOR LANG CARD
PUSHJ P,DOSWCH ;DO THE SWITCHES
$LAN.4: $TEXT(TXTCTL,<^W/L.LSW/>) ;PRINT THE /LIST SWITCH
SKIPN FILSPC ;EXPLICIT FILENAME GIVEN?
PJRST @L.MODE ;NO, GO STACK THE DECK
PUSHJ P,CDRASC ;YES, READ NEXT CARD
POPJ P,0 ;RETURN TO MAIN STREAM
LANG.A: BLOCK 1 ;SAVE LANGUAGE INDEX
SUBTTL Control Cards -- $DECK - $CREATE
$CREAT: MOVEI S1,'CR' ;GET THE PREFIX
PUSHJ P,MAKFUN ;MAKE A NAME
JRST $DEC.1 ;AND SKIP ALTERNATE ENTRY
$DECK: MOVEI S1,'DK' ;GET THE PREFIX
PUSHJ P,MAKFUN ;MAKE A NAME
$DEC.1: SETZ S2,0 ;NO EXTENSION
PUSHJ P,S$FILE ;GET A FILESPEC
MOVX T1,SW.DEC ;LEGAL SWITCHES
PUSHJ P,DOSWCH ;DO THE SWITCHES
SETZ T1,0 ;NOTHING TO REMEMBER
PUSHJ P,FILENT ;ENTER THE FILE
PJRST @L.MODE ;AND GO STACK THE DECK
SUBTTL Control Cards -- $RELOC
TOPS10 <
$RELOC: LOAD S1,L.INF,FP.PCR ;GET JOB INFO
JUMPE S1,$REL.1 ;TEST LEGALITY
MOVEI S1,'RL' ;LOAD A PREFIX
PUSHJ P,MAKFUN ;MAKE A FUNNY NAME
MOVE S2,RELX ;GET DEFAULT EXTENSION
PUSHJ P,S$FILE ;AND GET A FILESPEC
PUSHJ P,W$BINA ;FORCE A /BINARY
MOVX T1,FB.LOD ;LOAD ON NEXT $DATA OR $EXEC
SKIPN FILSPC ;IS IT USER-NAMED?
TXO T1,FB.DEL ;NO, DELETE AT THE END
PUSHJ P,FILENT ;ENTER THE FILE
PJRST @L.MODE ;AND DO STACK THE DECK
COMMENT \
Here to complain about the improper use of the $RELOC card.
This card is allowed only when the job was submitted via
cards. To allow it from disk based jobs, eg. via /READER,
implies the need for mixed mode files.
\
$REL.1: $TEXT(LOGTXT,<^I/FATAL/?SPTRCI ^I/$REL.2/>)
JSP B,CTLCER ;FULLY ABORT
$REL.2: ITEXT (<Improper use of $RELOC>)
>;END OF TOPS10 CONDITIONAL ASSEMBLY
SUBTTL Control Cards -- $INCLUDE
COMMENT \
The $INCLUDE card allows for an optional filespec.
The logic imposed is similar to the $language card
in that if a filespec is supplied the routine
assumes the file already exists on disk and simply
enters the file into the file blocks. If no
filespec is supplied, the routine generates its own,
enters it into the file blocks, and then goes off to
stack the deck which presumably follows.
\
$INCLU: MOVEI S1,'BL' ;DEFAULT PREFIX
PUSHJ P,MAKFUN ;FORM 'BL????'
MOVE S2,RELX ;DEFAULT EXTENSION
PUSHJ P,S$FILE ;READ OUT THE FILESPEC
SETZM L.SRH ;CLEAR SEARCH FLAG
MOVX T1,SW.INC ;VALID SWITCHES FOR $INCLUDE
PUSHJ P,DOSWCH ;SCAN OFF ANY SWITCHES
SETOM L.FBCT ;SET LOAD FLAG
MOVX T1,FB.LOD!FB.DEL ;SET LOAD AND DELETE BITS
SKIPE L.SRH ;DID HE SPECIFY /SEARCH?
TXO T1,FB.SRH ;SURE DID..
SKIPE FILSPC ;DID HE SPECIFY ANY FILESPEC?
JRST $INC.1 ;YES
LOAD S1,L.INF,FP.PCR ;GET JOB INFO
JUMPE S1,$INC.E ;JUMP IF DECK DIDN'T COME FROM READER
PUSHJ P,FILENT ;NO, GO ENTER WITH FORMED FILESPEC
PUSHJ P,W$BINA ;FORCE A /BINARY FOR THE UPCOMING CARDS
PJRST @L.MODE ;GO STACK THE DECK
$INC.1: TXZ T1,FB.DEL ;CLEAR THE DELETE BIT
PUSHJ P,FBENT ;AND ENTER INTO THE FILE BLOCKS
PUSHJ P,CDRASC ;READ THE NEXT CARD
$RETT ;RETURN
COMMENT \
Here to complain about the improper use of the $INCLUDE
card. This card is allowed only when the job was submitted
via cards. To allow it from disk based jobs, eg. via
/READER, implies the need for mixed mode files.
\
$INC.E: $TEXT(LOGTXT,<^I/FATAL/?SPTIUI ^I/$INC.F/>)
JSP B,CTLCER
$INC.F: ITEXT (<Improper use of $INCLUDE>)
SUBTTL Control Cards -- $DATA - $EXECUTE
TOPS10 <
$DATA.: MOVE S1,[XWD FILFD,FILFD+1] ;SETUP A BLT POINTER
SETZM FILFD ;ZERO THE FIRST WORD
BLT S1,FILFD+FDXSIZ-1 ;AND ZERO THE REST
MOVSI S1,'DSK' ;LOAD DEFAULT DEVICE
STORE S1,FILFD+.FDSTR ;STORE IT
PUSHJ P,FUNNY ;GET A FUNNY NAME
HRLZM S1,FILFD+.FDNAM ;SAVE 3 CHARACTER NAME
MOVSI S1,'CDR' ;DEFAULT EXTENSION IS CDR
MOVEM S1,FILFD+.FDEXT ;SAVE IT
LOAD S1,.EQOID(Q) ;GET OUR PPN
STORE S1,FILFD+.FDPPN ;AND STORE IT
MOVX S1,FDMSIZ ;GET MINIMUM SIZE
STORE S1,FILFD+.FDLEN,FD.LEN ;AND STORE IT
$TEXT(TXTCTL,<.SET CDR ^W/FILFD+.FDNAM,LHMASK/>)
> ;END TOPS10
TOPS20 <
$DATA.: SKIPE .EQSIS(Q) ;GENERATE A NAME ALREADY?
JRST $DAT.1 ;YES, CONTINUE ON
PUSHJ P,FUNNY ;NO, GET 4 FUNNY CHARS
TLO S1,'CD ' ;MAKE IT CD????
MOVEM S1,.EQSIS(Q) ;SAVE IN CORRECT PLACE
$DAT.1: MOVE S1,[POINT 7,FILFD+.FDFIL]
MOVEM S1,L.BP ;SETUP BYTE POINTER
$TEXT(DEPBP,<PS:^7/[OCT 74]/SPOOL^7/[OCT 76]/CDR-^O/L.USNO,RHMASK/.^W/.EQSIS(Q)/^0>)
MOVX S1,FDXSIZ ;USE MAXIMUM SIZE
STORE S1,FILFD+.FDLEN,FD.LEN ;AND STORE IT
$TEXT(TXTCTL,<@SET CARD-READER-INPUT-SET (TO) ^W/.EQSIS(Q)/>)
>;END IFN FTJSYS
MOVX T1,SW.DAT ;LEGAL SWITCHES
PUSHJ P,DOSWCH ;DO THE SWITCHES
TOPS20 <
SETZB T1,FILSPC ;CLEAR FLAGS
PUSHJ P,FRCENT ;ENTER THE FILE INVOKING OUR PRIVILEGES
>;END TOPS20 CONDITIONAL ASSEMBLY
TOPS10 <
SETZM FILSPC ;CLEAR FLAGS
MOVX T1,FB.DEL ;GET DELETE BIT
PUSHJ P,FILENT ;ENTER IT
>
PUSHJ P,EXECUT ;PUT IN THE EXECUTE LINE
PJRST @L.MODE ;AND DO THE STACKING
$EXECUTE:
MOVX T1,SW.EXE ;LEGAL SWITCHES
PUSHJ P,DOSWCH ;GET ANY SWITCHES
PJRST EXECUT ;AND GO PUT IN EXECUTE LINE
;Here the $DATA and $EXECUTE cards merge to generate the EXECUTE
; command in the control file.
EXECUT: SKIPE L.FBCT ;ANYTHING TO LOAD?
JRST EXEC.1 ;YES, CONTINUE ON
$TEXT(LOGTXT,<^I/STERR/%SPTNFT No files to load>)
POPJ P, ;AND RETURN
EXEC.1: SETOM L.LOAD ;FLAG THAT WE ARE DOING A LOAD
MOVEI T1,[ASCIZ / /] ;POINT TO A BLANK
TXZE F,F.MAP ;DOES HE WANT A MAP?
MOVEI T1,[ASCIZ %/MAP:LPT:MAP %]
$TEXT(TXTCTL,<^7/MONPRT/EXECUTE^T/0(T1)/^A>)
MOVE S1,L.FBLN ;GET THE LIST NAME
$CALL L%FIRST ;POSITION TO THE BEGINNING
SKIPT ;SKIP IF OK
$STOP(CFF,CAN'T FIND FILES TO LOAD)
SETZ T2,0 ;FLAG NO FILESPECS TYPED
JRST EXEC.3 ;ENTER LOOP WITH FIRST FILESPEC
EXEC.2: MOVE S1,L.FBLN ;GET LIST NAME
$CALL L%NEXT ;GET NEXT FILESPEC
JUMPF CTLEOL
EXEC.3: LOAD T1,.FBFLG(S2) ;GET THE FILE FLAGS
TXNN T1,FB.LOD ;LOADABLE?
JRST EXEC.2 ;NO, TRY THE NEXT
SKIPE T2 ;TYPED SPEC YET?
$TEXT (TXTCTL,<,^A>) ;YUP, SO TYPE A COMMA
$TEXT(TXTCTL,<^F/.FBFD(S2)/^A>) ;NO, JUST LOAD THE FILE
TXNE T1,FB.SRH ;LOAD IN LIBRARY SEARCH MODE?
$TEXT(TXTCTL,</SEARCH^A>) ;YES
SETO T2,0 ;SET FILE TYPED FLAG
JRST EXEC.2 ;LOOP
SUBTTL Control Cards -- $DUMP - $MESSAGE
$DUMP: HRROS L.DPCR ;AND FLAG DUMP LINE NEEDED
POPJ P, ;AND RETURN
$PASSW:$TEXT(LOGTXT,<^I/STERR/%SPTEPF Extra $PASSWORD card found - ignored>)
POPJ P, ;AND RETURN
$MESS: SETZ P1,0 ;CLEAR WAIT-NOWAIT FLAG
PUSHJ P,S$FSPC ;IGNORE BLANKS
TXZ F,F.RSCN ;AND TURN OFF THE RESCAN BIT
CAIE C,"/" ;IS THERE A COMMAND SWITCH?
JRST $MES.1 ;NO, NOWAIT IS DEFAULT
MOVEI S1,SWNAME ;POINT TO STRING BLOCK
PUSHJ P,S$ASCZ ;READ THE KEYWORD IN
MOVEI S1,$MES.3-1 ;POINT TO THE TABLE
HRROI S2,SWNAME ;AND THE SPECIFIED KEYWORD
$CALL S%TBLK ;SEE IF IT'S THERE
TXNE S2,TL%NOM!TL%AMB ;MATCH?
JRST $MES.2 ;NOPE, LOOP
HRRZ P1,(S1) ;GET ARGUMENT
$MES.1: $TEXT(TXTCTL,<^7/MONPRT/PLEASE ^A>)
SETZ T1,0 ;BREAK ON EOL
PUSHJ P,CTLCRD ;COPY THE REST OF THE CARD
MOVEI S1,.CHESC ;LOAD AN ESCAPE
SKIPN P1 ;IS IT NOWAIT?
PUSHJ P,TXTCTL ;YES, PUT IN THE ESCAPE
PJRST CTLEOL ;PUT ON CRLF AND RETURN
$MES.2: $TEXT(LOGTXT,<%SPTIMS Illegal $MESSAGE switch, /NOWAIT assumed>)
JRST $MES.1 ;AND CONTINUE ON
XWD 2,2
$MES.3: TB(NOWAIT,0)
TB(WAIT,1)
SWNAME: BLOCK ^D8 ;ROOM FOR THE SWITCH
SUBTTL Control Cards -- BATCH Commands
; $ERROR - $NOERROR - $IF
; $BACKTO - $CHKPNT - $GOTO
; $NOOPERATOR - $OPERATOR - $REQUEUE
; $REVIVE - $SILENCE
;
;These commands are BATCH commands. They are copied directly
; into the control file with the "$" changed to the
; appropriate monitor prompt character.
$$BATCH:MOVE S1,MONPRT ;GET THE MONITOR PROMPT
ROT S1,-7 ;PUT IT IN BITS 1 THRU 6
MOVX S2,177B6 ;MAKE A MASK FOR 1ST CHARACTER
ANDCAM S2,L.CASC ;MASK OUT THE FIRST CHARACTER
IORM S1,L.CASC ;AND MAKE IT WHAT WE WANT
$TEXT(TXTCTL,<^T/L.CASC/^A>)
POPJ P, ;AND RETURN
$LABEL: PUSHJ P,S$FSPC ;STRIP BLANKS
JUMPF $LAB.1 ;IF EOL, LOSE
TXO F,F.RSCN ;REREAD LAST CHARACTER
MOVEI S1,LABADR ;WHERE TO STORE ASCII LABEL
PUSHJ P,S$ASCZ ;READ IT
$TEXT (TXTCTL,<^T/LABADR/::>) ;WRITE LABEL INTO CTL FILE
$RET ;AND SIMPLY RETURN
$LAB.1: $TEXT (LOGTXT,<^I/STERR/?SPTNLS ^I/$LAB.2/>)
JSP B,CTLCER
$LAB.2: ITEXT (<No label specified on $LABEL Control Card>)
$$IF: PUSHJ P,S$FSPC ;IGNORE BLANKS
SKIPF
CAIE C,"(" ;PROPER DELIMITER?
JRST $$IF.1 ;NO, FAIL
MOVEI S1,AR.NAM ;POINT TO ARGUMENT BLOCK
PUSHJ P,S$ASCZ ;GATHER THE ARGUMENT
MOVEI S1,$IF.A-1 ;POINT TO ARG TABLE
HRROI S2,AR.NAM ;POINT TO STRING AGAIN
$CALL S%TBLK ;TRY FOR A MATCH
CAIN C,")" ;PROPER TERMINATOR?
TXNE S2,TL%NOM!TL%AMB ;VALID ARGUMENT?
JRST $$IF.3 ;NO
PUSHJ P,S$FSPC ;SKIP OVER BLANKS
JUMPF $$IF.1 ;??
CAIE C,"$" ;IS IT A BUCK?
JRST $$BATCH ;NO, NO HELP HERE
MOVE C,MONPRT ;YES, CONVERT TO SYSTEM PROMPT
DPB C,B ;PLANT IN PLACE
MOVEI S1,L.TNAM ;POINT TO STRING BLOCK
PUSHJ P,S$ASCZ ;SEE IF WE KNOW ABOUT THIS GUY
MOVEI S1,TBCARD ;POINT TO TABLE
HRROI S2,L.TNAM ;POINT TO THIS KEYWORD
$CALL S%TBLK ;SEE IF WE KNOW ABOUT IT
TXNE S2,TL%NOM!TL%AMB ;DO WE?
JRST $$IF.1 ;NO
SUBI S1,TBCARD+1 ;COMPUTE OFFSET
MOVE T1,S1 ;RELOCATE
MOVE P1,CADRS(T1) ;GET DISPATCH ADDRESS
TXNN P1,CD.BTC ;SPECIAL BATCH CONTROL CARD?
JRST $$IF.1 ;NO, LOSE
JRST $$BATCH ;GOOD, GO WRITE IT OUT
$$IF.1: $TEXT (LOGTXT,<^I/STERR/?SPTIMF ^I/$$IF.2/>)
JSP B,CTLCER
$$IF.2: ITEXT (<Improper format for $IF control card>)
$$IF.3: $TEXT(LOGTXT,<^I/STERR/?SPTIIC ^I/$$IF.4/>)
JSP B,CTLCER
$$IF.4: ITEXT(<Improper conditional in IF statement>)
XWD 2,2
$IF.A: TB (ERROR,0)
TB (NOERROR,1)
SUBTTL Control Cards -- $EOD
$EOD: MOVE T1,L.DHOL ;LOAD THE DEFAULT BP
MOVEM T1,L.CHOL ;AND SAVE FOR THE NEXT CARD
SKIPN FILOPN ;IS THERE A DECK OPEN?
POPJ P, ;NO, SKIP BACK
SETZM FILOPN ;AND ZERO IT
MOVE S1,FILIFN ;GET THE IFN
$CALL F%REL ;AND RELEASE THE FILE
$TEXT(LOGTXT,<^I/STMSG/File ^F/FILFD/ created - ^D/DEKCRD/ cards read>)
SKIPE L.QFN ;NEED TO QUEUE THE FILE?
PUSHJ P,QUEFIL ;YES, DO IT
POPJ P, ;AND RETURN SUCCESS
SUBTTL Control Cards -- $JOB
SUBTTL Control Cards -- $EOJ
$JOB:
$EOJ: PUSHJ P,TRMJOB ;FINISH UP WITH THIS JOB
MOVE P,[IOWD A%PDSZ,L.PDL] ;RESET STACK
MOVEI S1,LOWZSZ ;CLEAR OUT IMPURE JOB DATA
MOVEI S2,LOWZER ;..
$CALL .ZCHNK
SETZ F,0 ;CLEAR OUT FLAGS
JRST MLTJOB ;TRY REENTRY
SUBTTL Control Cards -- $SEQUENCE
$SEQUE: PUSHJ P,S$DEC ;GET DECIMAL SEQUENCE NUMBER
SKIPT ;SKIP IF OK
SETZ T1,0 ;ELSE LOAD A ZERO
STORE T1,.EQJBB+JIB.SQ(Q),EQ.SEQ
;AND STORE THE SEQUENCE NUMBER
SKIPN T1 ;WAS IT 0?
$TEXT(LOGTXT,<^I/STERR/%SPTISN Illegal sequence number on $SEQUENCE card ignored>)
POPJ P,0 ;RETURN
SUBTTL Control Cards -- $TOPS10 - $TOPS20
$TOPNTV: TDZA T1,T1 ;CLEAR FLAG FOR NATIVE MODE ENTRY
$TOPFGN: SETO T1,0 ;SET FOR "FOREIGN" MODE
MOVEM T1,REVDSP ;STORE
MOVX T1,SW.TOP ;VALID SWITCH BITS
PUSHJ P,DOSWCH ;DO THE SWITCHES
$TOP.1: PUSHJ P,CDRASC ;GET A CARD
MOVE B,L.CHOL ;GET THE BYTE POINTER
ILDB T1,B ;GET COLUMN 1
CAIE T1,"$" ;DOLLAR SIGN?
JRST $TOP.2 ;NO, JUST WRITE IT OUT
ILDB T1,B ;GET COLUMN 2
CAIL T1,"a" ;CONVERT LOWER CASE
CAIL T1,"z" ; TO UPPER
SKIPA ; IF NECESSARY
TRZ T1,40 ;CONVERT CASING
CAIL T1,"A" ;CHECK FOR AN ALPHABETIC
CAILE T1,"Z"
JRST $TOP.2 ;ITS NOT, JUST WRITE THE CARD
JRST $TOP.3 ;IT IS, CHECK A FEW OTHER THINGS
$TOP.2: SKIPE REVDSP ;NATIVE MODE?
JRST $TOP.1 ;NO, IGNORE THIS
MOVE S1,CTLIFN ;GET THE IFN
HRL S2,L.CLEN ;GET CURRENT LENGTH
SKIPE L.SPRS ;SUPPRESS ON?
HRL S2,L.CSUP ;YES, GET SUPPRESSED LENGTH
HRR S2,L.CHOL ;POINT TO THE CORRECT CARD
$CALL F%OBUF ;OUTPUT IT
PUSHJ P,CTLEOL ;AND PUT OUT AN EOL
JRST $TOP.1 ;AND LOOP AROUND
$TOP.3: TXNN F,F.DOLR ;ARE WE STACKING /DOL?
$RET ;NO, $<ALPHA> STOPS US THEN
MOVEI S1,AR.NAM ;POINT TO STRING BLOCK
PUSHJ P,S$ASCZ ;READ IN THE KEYWORD
SKIPN AR.NAM ;TEST FOR NULL
JRST $TOP.2 ;IT'S NULL, JUST DUMP IT OUT
MOVEI S1,CTLCOD-1 ;POINT TO TABLE
HRROI S2,AR.NAM ;POINT TO KEYWORD GATHERED
$CALL S%TBLK ;DO THE WORK
TXNE S2,TL%NOM!TL%AMB ;MATCH?
JRST $TOP.2 ;NO, DUMP IT OUT
$RET ;YES, RETURN
XWD 3,3
CTLCOD: TB(EOD,0)
TB(EOJ,0)
TB(JOB,0)
SUBTTL $JOB Card Switch Subroutines
;/CARDS
W$CARD: JSP T1,SWTDEC ;HANDLE DECIMAL SWITCH VALUE
XWD 0,777777 ;MIN,MAX
STOLIM T1,.EQLIM(Q),SCDP ;INSTRUCTION TO STORE THE RESULTS
;/DEPEND
W$DEPE: JSP T1,SWTDEC ;DECIMAL VALUE
XWD 0,177777 ;MIN,MAX
STOLIM T1,.EQLIM(Q),DEPN ;INSTRUCTION TO STORE THE RESULTS
;/FEET
W$FEET: JSP T1,SWTDEC ;DECIMAL ARGUMENT
XWD 0,777777 ;MIN,MAX
STOLIM T1,.EQLIM(Q),SPTP ;INSTRUCTION TO STORE THE RESULTS
;/LOCATE
W$LOCA: JSP T1,SWTOCT ;HANDLE OCTAL SWITCH VALUE
XWD 1,77 ;MIN,MAX
STOLIM T1,.EQLIM(Q),ONOD ;INSTRUCTION TO STORE THE NODE NUMBER
;/PAGES
W$PAGE: JSP T1,SWTDEC ;DECIMAL ARGUMENT
XWD 0,777777 ;MIN,MAX
STOLIM T1,.EQLIM(Q),SLPT ;INSTRUCTION TO STORE THE RESULTS
;/JOBNAME
W$JOBN: MOVEI S1,AR.NAM ;POINT TO STORAGE
PUSHJ P,S$ASCZ ;READ IT IN
HRROI S1,AR.NAM ;POINT TO IT AGAIN
$CALL S%SIXB ;SIXBITIZE IT
SKIPN S2 ;HAVE A NAME?
$RETF ;NO..RETURN FALSE
STORE S2,.EQJBB+JIB.JN(Q) ;STORE THE JOBNAME
$RETT ;AND RETURN
;/USER:USERNAME
W$USER:
TOPS20<
MOVEI S1,L.USER ;POINT TO TEMP. AREA
PUSHJ P,S$ASCZ ;LOAD THE STRING
>
TOPS10<
MOVEI S1,L.USER ;POINT TO TEMP. AREA
PUSHJ P,S$TENN ;GATHER SPECIFIED NAME
>
$RETT ;RETURN
;/PPN:[PRJ,PRG]
W$PPN: CAIN C,":" ;COLON?
PUSHJ P,S$INCH ;GET THE BRACKET
PUSHJ P,GETPPN ;GO GET THE PPN
$RETT ;RETURN
;/TIME
W$TIME: PUSHJ P,S$TIM ;GET A TIME-SPEC
JUMPF BADTAR ;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
STOLIM T1,.EQLIM(Q),TIME ;STORE AWAY
$RETT
;/ERROR:CHK:IBC:HOL
W$ERRO: PUSHJ P,S$TIM ;GET WHAT LOOKS LIKE A TIME SPEC
JUMPF BADTAR ;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
$RETT
BADTAR: $TEXT (LOGTXT,<^I/STERR/%SPTIAF Illegal argument format on /^T/L.SNAM/ switch, ignored>)
$RETT
;/HOLLERITH
W$HOLL: MOVEI S1,AR.NAM ;WHERE TO COPY THE STRING
PUSHJ P,S$ASCZ
MOVEI S1,W$HO.A-1 ;POINT TO TABLE
HRROI S2,AR.NAM ;AND THE STRING
$CALL S%TBLK ;DO THE SEARCH
TXNE S2,TL%NOM!TL%AMB
$RETF
HRRZ S1,(S1) ;GET THE ARGUMENT
HRLI S1,(POINT 7) ;MAKE IT COMPLETE BP
STORE S1,L.DHOL ;SAVE AS DEFAULT
$RETT
XWD 3,3
W$HO.A: TB (026,L.C026)
TB (ASCII,L.CASC)
TB (BCD,L.C026)
;/AFTER
W$AFTE: PUSHJ P,S$DATE ;GET A DATE TIME SPEC
JUMPF .RETF ;LOSE
STORE T1,.EQAFT(Q) ;STORE THE AFTER PARAM
$RETT ;AND RETURN
TOPS10 <
;/NAME
W$NAME: SETZM .EQOWN(Q) ;CLEAR THE FIRST HALF
SETZM .EQOWN+1(Q) ; AND THE 2ND HALF OF THE USER NAME
MOVE T2,[POINT 6,.EQOWN(Q)]
PUSHJ P,S$FSPC ;FLUSH LEADING SPACES, AND LOAD CHAR
JUMPF .RETT ;JUST RETURN, EOL
CAIE C,42 ;IS IT A DOUBLE QUOTE?
CAIN C,"'" ;OR A SINGLE QUOTE?
JRST W$NA.3 ;YES, GO GET QUOTED STRING
JRST W$NA.2 ;JUMP INTO LOOP
W$NA.1: PUSHJ P,S$INCH ;GET A CHAR
JUMPF .RETT ;EOL, RETURN
W$NA.2: CAIN C,"/" ;BEGINNING OF NEXT SWITCH
$RETT ;YES, RETURN
PUSHJ P,W$NA.6 ;DEPOSIT IT
JRST W$NA.1 ;AND LOOP
;HERE ON A QUOTED STRING
W$NA.3: MOVEM C,SAVCHR ;SAVE QUOTE CHARACTER
W$NA.4: PUSHJ P,S$INCH ;GET A CHARACTER
JUMPF .RETT ;EOL, RETURN
CAMN C,SAVCHR ;IS IT A QUOTE?
JRST W$NA.5 ;YES, GO COUNT IT
PUSHJ P,W$NA.6 ;ELSE, DEPOSIT CHARACTER
JRST W$NA.4 ;AND LOOP AROUND
W$NA.5: PUSHJ P,S$INCH ;GET NEXT CHARACTER
JUMPF .RETT ;EOL FINISHES US OFF
CAME C,SAVCHR ;IS IT A QUOTE?
$RETT ;NO, WE DONE!!
PUSHJ P,W$NA.6 ;YES!,PRINT A QUOTE
JRST W$NA.4 ;AND LOOP AROUND
W$NA.6: CAMN T2,[XWD 600,.EQOWN+1(Q)];DONE?
POPJ P,0 ;YES, NO-OP
SUBI C," " ;CONVERT TO 6BIT
IDPB C,T2 ;DEPOSIT
POPJ P,0 ;AND RETURN
IFN INPCOR,<
;/CORE
W$CORE: PUSHJ P,S$DEC ;GET DECIMAL ARGUMENT
JUMPF ILLSWA ;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: STOLIM T1,.EQLIM(Q),CORE ;STORE VALUE AWAY
$RETT ;AND RETURN
>;END IFN INPCOR
>;END TOPS10
;/PRIO
W$PRIO: JSP T1,SWTDEC ;GET DECIMAL VALUE
XWD 1,MXUPRI ;MIN,MAX
STORE T1,.EQSEQ(Q),EQ.PRI ;INSTR. TO STORE THE PRIORITY VALUE
;/RESTART
W$REST: MOVX T1,%EQRYE ;GET /REST:YES
STOLIM T1,.EQLIM(Q),REST ;AND STORE IT
$RETT ;AND RETURN
;/NORESTART
W$NORE: MOVX T1,%EQRNO ;GET NOT-RESTART
STOLIM T1,.EQLIM(Q),REST ;STORE /RESTART VALUE
$RETT ;AND RETURN
;/SEQUENCE
W$SEQU: JSP T1,SWTDEC ;GET DECIMAL ARGUMENT
XWD 1,777777 ;MIN,MAX
STORE T1,.EQSEQ(Q),EQ.SEQ ;INSTR. TO STORE THE SEQUENCE NUMBER
;/TPLOT
W$TPLO: JSP T1,SWTDEC ;GET DECIMAL ARGUMENT
XWD 0,777777 ;MIN,MAX
STOLIM T1,.EQLIM(Q),SPLT ;INSTR. TO STORE THE PLOTTER LIMITS
;/UNIQUE
W$UNIQ: MOVEI S1,AR.NAM ;WHERE TO COPY THE STRING
PUSHJ P,S$ASCZ
MOVEI S1,W$UN.A-1 ;POINT TO TABLE
HRROI S2,AR.NAM ;AND THE STRING
$CALL S%TBLK ;DO THE SEARCH
TXNE S2,TL%NOM!TL%AMB
$RETF
HRRZ S1,(S1) ;GET THE ARGUMENT
STOLIM S1,.EQLIM(Q),UNIQ
$RETT
XWD 5,5
W$UN.A: TB (0,0)
TB (1,1)
TB (2,2)
TB (NO,0)
TB (YES,1)
;/OUTPUT
W$OUTP: MOVEI S1,AR.NAM ;WHERE TO COPY THE STRING
PUSHJ P,S$ASCZ
MOVEI S1,W$OU.A-1 ;POINT TO TABLE
HRROI S2,AR.NAM ;AND THE STRING
$CALL S%TBLK ;DO THE SEARCH
TXNE S2,TL%NOM!TL%AMB
$RETF
HRRZ S1,(S1) ;GET THE ARGUMENT
STOLIM S1,.EQLIM(Q),OUTP
$RETT
XWD 4,4
W$OU.A: TB (ALWAYS,%EQOLG)
TB (ERRORS,%EQOLE)
TB (LOG,%EQOLG)
TB (NOLOG,%EQONL)
; DELETE
;/LOGDISP:KEEP
; PRESERVE
;Note that this switch(value) is not passed in the NEXTJOB message
;from QUASAR. The switch is only available on the JOB card and sets
;FP.DEL for the log file disposition.
W$LOGD: MOVEI S1,AR.NAM ;WHERE TO COPY THE STRING
PUSHJ P,S$ASCZ
MOVEI S1,W$LO.A-1 ;POINT TO TABLE
HRROI S2,AR.NAM ;AND THE STRING
$CALL S%TBLK ;DO THE SEARCH
TXNE S2,TL%NOM!TL%AMB
$RETF
HRRZ S1,(S1) ;GET THE ARGUMENT
STORE S1,L.LGDS ;STORE AS LOG DISPOSITION
$RETT
XWD 3,3
W$LO.A: TB (DELETE,1)
TB (KEEP,0)
TB (PRESERVE,0)
AR.NAM: BLOCK ^D8 ;ARGUMENT NAME
; /ACCOUNT:
W$ACCO: MOVEI S1,.EQACT(Q) ;POINT TO ACCT. BLOCK
PUSHJ P,S$ASCZ ;AND READ THE STRING INTO IT
$RETT
; YES
; /ASSIST:
; NO
;
W$ASSI: MOVEI S1,AR.NAM ;WHERE TO COPY THE STRING
PUSHJ P,S$ASCZ
MOVEI S1,W$AS.A-1 ;POINT TO TABLE
HRROI S2,AR.NAM ;AND THE STRING
$CALL S%TBLK ;DO THE SEARCH
TXNE S2,TL%NOM!TL%AMB
$RETF
HRRZ S1,(S1) ;GET THE ARGUMENT
STOLIM S1,.EQLIM(Q),OINT
$RETT
XWD 2,2
W$AS.A: TB (NO,.OPINN)
TB (YES,.OPINY)
; SUPERSEDE
; /BATLOG:APPEND
; SPOOL
W$BATC: MOVEI S1,AR.NAM ;WHERE TO COPY THE STRING
PUSHJ P,S$ASCZ
MOVEI S1,W$BA.A-1 ;POINT TO TABLE
HRROI S2,AR.NAM ;AND THE STRING
$CALL S%TBLK ;DO THE SEARCH
TXNE S2,TL%NOM!TL%AMB
$RETF
HRRZ S1,(S1) ;GET THE ARGUMENT
STOLIM S1,.EQLIM(Q),BLOG
$RETT
XWD 3,3
W$BA.A: TB (APPEND,%BAPND)
TB (SPOOL,%BSPOL)
TB (SUPERSEDE,%BSCDE)
SUBTTL Routines To Finish Off a Job
;ENDJOB is called when end-of-file is encountered on the input file.
ENDJOB: SKIPE L.JLOG ;SKIP IF JOB NOT LOGGED IN
JRST ENDJ.2 ;IT WAS, CONTINUE ON
SKIPE FNDJOB ;DID WE FIND ANY $JOB CARDS?
JRST DONE ;YES, NO NEED TO COMPLAIN
$TEXT(LOGTXT,<^I/FATAL/?SPTJNF ^I/ENDJ.1/>)
JSP B,PROCER ;FINISH UP
ENDJ.1: ITEXT(<$JOB card not found>)
ENDJ.2: PUSHJ P,TRMJOB ;FINISH UP THE JOB
JRST DONE ;AND RELEASE THE REQUEST
;TRMJOB -- Routine to finish off a job normally. Puts CREF,
; DUMP, DELETE lines into CTL file, and goes off to queue
; up the job.
TRMJOB: PUSHJ P,$EOD ;END DECK IN PROGRESS IF ANY
$TEXT(LOGTXT,<^I/STSUM/End of job encountered>)
PUSHJ P,SUMARY ;GIVE SUMMARY
$TEXT(TXTCTL,<%FIN::>)
MOVE T1,L.DPCR ;GET DUMP AND CREF FLAGS
SKIPGE T1 ;IS DUMP SIDE (LH) SET?
$TEXT(TXTCTL,<^7/MONPRT/DUMP>) ;YES, SO ENTER DUMP COMMAND
TRNE T1,-1 ;CREF?
$TEXT(TXTCTL,<^7/MONPRT/CREF>)
MOVEI T1,FIL.LN ;NUMBER OF FILES PER LINE
MOVE S1,L.FBLN ;GET LIST NAME
$CALL L%FIRST ;POSITION TO THE BEGINNING
JUMPF TRMJ.3 ;NOTHING THERE, DONE
TRMJ.1: LOAD T2,.FBFLG(S2),FB.DEL ;GET DELETE BIT
JUMPE T2,TRMJ.2 ;JUMP IF NOT TO BE DELETED
CAIN T1,FIL.LN ;FIRST FILESPEC TYPED ON THIS LINE?
$TEXT(TXTCTL,<^7/MONPRT/DELETE ^A>) ;YES, TYPE DELETE COMMAND
CAIE T1,FIL.LN ;INDICATE CONTINUATION IF
$TEXT(TXTCTL,<,^A>) ;NOT THE FIRST
$TEXT(TXTCTL,<^F/.FBFD(S2)/^A>) ;TYPE THE FILESPEC
SOJG T1,TRMJ.2 ;JUMP IF ROOM FOR MORE
PUSHJ P,CTLEOL ;ELSE PUT IN A CRLF
MOVEI T1,FIL.LN ;RESET THE COUNT
TRMJ.2: MOVE S1,L.FBLN ;GET THE LIST NAME
$CALL L%NEXT ;GET THE NEXT FILE
JUMPT TRMJ.1 ;LOOP BACK IF SUCCESSFUL
TRMJ.3: CAIE T1,FIL.LN ;ANYTHING ON THE LINE?
PUSHJ P,CTLEOL ;YES, TYPE A CRLF
PUSHJ P,DOFACT ;DO USAGE ACCOUNTING
PUSHJ P,QUEJOB ;SUBMIT THE JOB
$RET ;AND FINISH UP
SUBTTL ABORT - Routine to abort the current job
;ABORT is called upon detection of a fatal error. ABORT deletes
; all temp files created by the job and queues up the log
; file.
; On entry AC B contains address of ITEXT.
JOBCER: MOVEI T1,[ITEXT(<Job Card Error>)]
JRST ABORT
PSWCER: MOVEI T1,[ITEXT(<Invalid Password Card>)]
JRST ABORT
CTLCER: MOVEI T1,[ITEXT(<Control Card Error>)]
JRST ABORT
ACTCER: MOVEI T1,[ITEXT(<Accounting Error>)]
JRST ABORT
PROCER: MOVEI T1,[ITEXT(<Input Spooling Processor Error>)]
ABORT: MOVE S1,L.IFN ;BUILD COMPLETE FD
SETO S2,0 ;..
$CALL F%FD ;S1 CONTAINS ADDR OF FD
SKIPN JIBFLG ;IF NOT LOGGED IN DO THIS
$WTOJ (^I/(T1)/,<^R/.EQJBB(Q)/^M^J^T/JOBCRD/^I/(B)/>,WTOOBJ)
SKIPE JIBFLG ;IF LOGGED IN DO THIS
$WTOJ (^I/(T1)/,<^R/.EQJBB(Q)/^M^J^I/(B)/>,WTOOBJ)
$TEXT (LOGTXT,<^M^J^J^I/STSUM/Job Aborted due to fatal error>)
TXO F,F.FATE ;SET FATAL ERROR BIT
PUSHJ P,SUMARY ;GIVE THE SUMARY
SKIPN L.JLOG ;JOB LOGGED IN?
JRST ABOR.3 ;NO, DO SPECIAL THINGS
TXZ F,F.BTCH ;NO BATCH JOB HERE
MOVE S1,CTLIFN ;GET THE CONTROL FILE IFN
$CALL F%RREL ;RELEASE AND ABORT
PUSHJ P,QUELOG ;QUEUE UP THE LOG FILE
PUSHJ P,DOFACT ;DO USAGE ACCOUNTING
MOVE S1,FILIFN ;PICK UP AN IFN
SKIPE FILOPN ;IS THERE A DECK OPEN?
$CALL F%RREL ;YES, GET RID OF IT
SETZM FILOPN ;AND CLEAR IFN
MOVE S1,L.FBLN ;GET THE LIST NAME
$CALL L%FIRST ;POSITION TO THE BEGINNING
JUMPF DONE ;DONE IF NONE
ABOR.1: LOAD S1,.FBFLG(S2),FB.DEL ;GET DELETE FLAG
JUMPE S1,ABOR.2 ;JUMP IF NOT TO BE DELETED
MOVEI S1,.FBFD(S2) ;YES, GET ADDRESS OF THE FD
MOVEM S1,L.FOB+FOB.FD ;STORE IN THE FOB
MOVEI S1,^D36 ;GET A RANDOM BYTE SIZE
STORE S1,L.FOB+FOB.CW,FB.BSZ ;AND STORE IT
MOVEI S1,2 ;GET THE LENGTH
MOVEI S2,L.FOB ;GET THE ADR OF THE FOB
$CALL F%DEL ;DELETE THE FILE
ABOR.2: MOVE S1,L.FBLN ;GET THE LIST NAME
$CALL L%NEXT ;GET THE NEXT
JUMPT ABOR.1 ;LOOP FOR MORE
JRST DONE ;ELSE DONE
ABOR.3:
TOPS10 <
SETZM .EQOID(Q) ;CLEAR THE PPN
MOVX T1,'SPRINT' ;MAKE AN INTERESTING NAME
MOVX T2,' ERROR' ;LIKE "SPRINT ERROR"
DMOVEM T1,.EQOWN(Q) ;AND STORE IT
MOVEI T1,L.SL1 ;GET MY ORIG S/L
PUSHJ P,SETSRC ;AND SET IT
>;END TOPS10
;TOPS20 <
; MOVEI S1,10 ;8 WORDS
; MOVEI S2,.EQOWN(Q) ;ADDRESS OF FIRST WORD
; $CALL .ZCHNK ;ZERO OUT THE OWNER NAME
;>;END OF TOPS20 CONDITIONAL ASSEMBLY
PUSHJ P,MAKLOG ;ENTER THE LOG FILE
PUSHJ P,QUELOG ;QUEUE IT UP
JRST DONE ;AND FINISH UP
TOPS20 <
DOFACT: MOVX S1,.FHSLF ;GET FORK HANDLE
RUNTM ;GET RUNTIME
ADDM S1,L.RTM ;GET RUNTIME FOR THE JOB
LOAD S1,L.EQCP+.EQJBB+JIB.SQ,EQ.SEQ ;MAKE SURE SEQ. NUMBER
STORE S1,L.EQCP+.EQJBB+JIB.SQ ;WORD IS BARE...
MOVEI S1,.USENT ;WRITE AN ENTRY
MOVEI S2,ACTLST ;GET ADDRESS OF BLOCK
USAGE ;ACCOUNT FOR THE WORLD
ERCAL DOFA.1 ;FAILED
$RET ;AND RETURN
DOFA.1: MOVX S1,.FHSLF ;PREPARE TO GET THE ERROR
JSYS 12 ;GETER JSYS
HRROI S1,DOFA.3 ;POINT TO BLOCK
MOVEI T1,^D60-1 ;59 CHARS + NULL
ERSTR ;GET THE ERROR STRING
ERJMP DOFA.2
DOFA.2: $WTOJ(^I/ABTSPR/,<Accounting System Failure, ^E/[EXP -2]/>)
$RET
DOFA.3: BLOCK ^D60/5 ;RESERVE nUFF ROOM FOR ERROR
>;END OF TOPS20 CONDITIONAL
TOPS10 <
DOFACT: SETZ T1,0 ;CLEAR AN AC
RUNTIM T1,0 ;GET OUR RUNTIME
ADDM T1,L.RTM ;PRODUCE THIS JOB'S RUNTIME
REPEAT 0,< ;;Until Barb implements it
MOVEI S1,.USENT ;WRITE AN ENTRY
MOVEI S2,ACTLST ;GET ADDRESS OF BLOCK
USAGE ;ACCOUNT FOR THE WORLD
$WTOJ(^I/ABTSPR/,Accounting System Failure)
> ;END OF REPEAT 0
$RET ;AND RETURN
> ;END OF TOPS10 CONDITIONAL ASSEMBLY
ACTLST: USENT. (.UTINP,1,1)
USACT. (<-1,,L.EQCP+.EQACT>) ;ACCOUNT STRING
USTXT. (0) ;SYSTEM/OPERATOR TEXT
USSRT. (L.RTM) ;SPOOLER RUNTIME
USSDR. (0) ;DISK READS
USSDW. (0) ;DISK WRITES
USJNM. (L.EQCP+.EQJBB+JIB.JN) ;JOB NAME
USQNM. ([SIXBIT /INP/]) ;QUEUE NAME
USSDV. (L.EQCP+.EQJBB+JIB.JN) ;ACTUAL INPUT DEVICE
USSSN. (L.EQCP+.EQJBB+JIB.SQ) ;SEQUENCE NUMBER
USSUN. (CDRCNT) ;SPOOLER UNITS (CARDS)
USCRT. (L.DTM) ;DATE/TIME OF REQUEST
USDSP. ([SIXBIT /BATCH/]) ;DISPOSITION
USPRI. (0) ;PRIORITY
USPNM. ([SIXBIT /SPRINT/]) ;PROGRAM NAME (CALLER)
USNM2. (L.EQCP+.EQOWN) ;NAME OF USER
0 ;END OF LIST
SUBTTL SUMARY - Place summary lines in the LOG file
SUMARY: SETZ T1,0 ;CLEAR A COUNTER
SUMA.1: SKIPE @SUMTB1(T1) ;IS IT A ZERO?
$TEXT(LOGTXT,<^I/STSUM/^D/@SUMTB1(T1)/ ^T/@SUMTB2(T1)/>)
CAIGE T1,.NMSMM-1 ;GOT ALL THE SUMMARY MESSAGES?
AOJA T1,SUMA.1 ;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: [ASCIZ /Cards Read/]
[ASCIZ /Hollerith Errors/]
[ASCIZ /Illegal Binary Cards/]
[ASCIZ /Binary Checksum Errors/]
SUBTTL DONE -- Release the job
DONE: MOVE S1,L.IFN
MOVE T1,L.INF ;GET THE .FPINF WORD
MOVEI S2,F%REL ;PREPARE FOR SIMPLE RELEASE
TXNE T1,FP.DEL!FP.SPL ;DELETE IF EITHER SET
MOVEI S2,F%DREL ;DO THE DELETE AND RELEASE
PUSHJ P,(S2) ;..
MOVE S1,L.FBLN ;GET NAME OF FILE LIST
$CALL L%DLST ;AND DELETE THE LIST
RELJOB: MOVX S1,<XWD REL.SZ,.QOREL> ;FIRST WORD OF THE RELEASE
STORE S1,DONE.A+.MSTYP ;AND STORE IT
LOAD S1,L.EQCP+.EQITN ;GET THE JOB'S ITN
STORE S1,DONE.A+REL.IT ;AND STORE IT
MOVX S1,REL.SZ ;LENGTH OF MESSAGE
MOVEI S2,DONE.A ;AND LOCATION
PUSHJ P,SNDQSR ;SEND IT
JRST IDLE ;AND LOOP BACK
DONE.A: BLOCK REL.SZ ;BUILD THE RELEASE MESSAGE
SUBTTL Non-$JOB Card Switch Subroutines
;/ASCII
IFE A%DFMD,<W$DFMD:>
W$ASCI: SKIPA T1,[POINT 7,L.CASC] ;LOAD ASCII MODE POINTER AND SKIP
;/026
IFN A%DFMD,<W$DFMD:>
W$BCD:
W$026: MOVE T1,[POINT 7,L.C026] ;LOAD 026 POINTER
MOVEM T1,L.CHOL ;AND SAVE FOR READ ROUTINE
MOVEI T1,STASC ;LOAD STACKING ROUTINE
MOVEM T1,L.MODE ;AND STORE FOR DISPATCH
$RETT ;AND RETURN
;/BINARY
W$BINA: MOVEI T1,STBIN ;LOAD ROUTINE NAME
MOVEM T1,L.MODE ;AND STORE IT
$RETT ;AND RETURN
;/IMAGE
W$IMAG: MOVEI T1,STIMG ;LOAD ROUTINE NAME
MOVEM T1,L.MODE ;STORE FOR DISPATCH
CAIE C,":" ;ANY ARGUMENT?
JRST W$IMA1 ; NO, TAKE DEFAULT
PUSHJ P,S$DEC
SKIPG T1 ;WAS THERE AN ARG?
W$IMA1: MOVEI T1,2 ;NO, MAKE IT 2
MOVEM T1,L.IMGT ;AND STORE IT
$RETT ;AND RETURN
;/SUPPRESS - /NOSUPPRESS
W$NOSU: SETZM L.SPRS ;CLEAR THE SUPPRESS FLAG
$RETT ;AND RETURN
W$SUPP: SETOM L.SPRS ;SET THE SUPPRESS FLAG
$RETT ;AND RETURN
;/LIST - /NOLIST
W$LIST: SKIPA T1,[SIXBIT "/LIST"]
W$NOLI: SETZ T1,0 ;CLEAR THE LISTING SWITCH
MOVEM T1,L.LSW ;STORE IT
$RETT ;AND RETURN
;/SEARCH
W$SEAR: SETOM L.SRH ;SET THE SEARCH FLAG
$RETT ;AND RETURN
;/PROTECT
W$PROT: JSP T1,SWTOCT ;GET OCTAL SWITCH VALUE
XWD 000,777 ;MIN,MAX
; POINT 9,FILPRV,8 ;WHERE TO PUT IT
JFCL ;DO NOTHING FOR NOW
;/CREF
W$CREF: MOVE T1,[SIXBIT "/CREF"]
MOVEM T1,L.LSW ;STORE /CREF SWITCH
HLLOS L.DPCR ;FLAG IT FOR LATER
$RETT ;AND RETURN
;/WIDTH
W$WIDT: JSP T1,SWTDEC ;GET DECIMAL ARGUMENT
XWD 1,^D80 ;MIN,MAX
DPB T1,[POINT 18,L.WIDT,35] ;POINTER TO RESULTS
;/MAP - /NOMAP
W$NOMA: TXZA F,F.MAP ;TURN OFF MAP BIT
W$MAP: TXO F,F.MAP ;TURN ON A BIT
$RETT ;AND RETURN
;/DOLLAR - /NODOLLAR
W$NODO: TXZA F,F.DOLR ;TURN OFF DOLLAR BIT
W$DOLL: TXO F,F.DOLR ;TURN ON DOLLAR BIT
$RETT ;AND RETURN
;/PRINT
W$PRIN: MOVSI T1,.OTLPT
JRST QSWRET
;/TPUNCH
W$TPUN: MOVSI T1,.OTPTP
JRST QSWRET
;/CPUNCH
W$CPUN: MOVSI T1,.OTCDP
JRST QSWRET
;/PLOT
W$PLOT: MOVSI T1,.OTPLT
QSWRET: MOVEM T1,L.QFN ;STORE DEVICE
$RETT ;AND RETURN
SUBTTL Process Control Card Switch
COMMENT \
DOSWCH is called to process switches on a control card.
Call: S1/ Valid switch bits
DOSWCH parses off each switch scans the switch table and
dispatches to the appropriate switch handler.
\
L.SNAM: BLOCK ^D8 ;ROOM FOR SWITCH
DOSWCH: MOVEM T1,DOSW.A ;VALID SWITCH BITS
DOSW.1: CAIN C,"/" ;DO WE HAVE A SLASH?
JRST DOSW.2 ;YUP, CONTINUE
PUSHJ P,S$INCH ;NO, GET NEXT CHARACTER
JUMPF .RETT ;END OF CARD, RETURN
JRST DOSW.1 ;AND LOOP
DOSW.2: MOVEI S1,L.SNAM ;PLACE TO STORE THE STRING
PUSHJ P,S$ASCZ ;GO GET IT
MOVEI S1,TBSWIT ;POINT TO TABLE
HRROI S2,L.SNAM ;POINT TO THE STRING
$CALL S%TBLK
TXNE S2,TL%NOM!TL%AMB ;VALID SWITCH?
JRST DOSW.5 ;NO, COMPLAIN
SUBI S1,TBSWIT+1 ;CALCULATE OFFSET
MOVEI T2,SADRS ;LOAD ADR OF DISPATCH TABLE
ADD T2,S1 ;ADD IN THE OFFSET
MOVE T3,DOSW.A ;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 DOSW.6 ;HE LOSES
LOAD S1,L.INF,FP.RCF ;GET OUR MODE
CAXN S1,.FPFAI ;AUGMENTED IMAGE?
JRST DOSW.3 ;YES, ALL IS FINE
TRNE T2,SW.MOD ;NO, IS THIS A MODE CHANGE SWITCH?
JRST DOSW.6 ;YES, SO IT'S ILLEGAL!
DOSW.3: PUSHJ P,(T1) ;WIN, DISPATCH!!!
JUMPT DOSW.1 ;AND LOOP FOR NEXT SWITCH
$TEXT (LOGTXT,<^I/STERR/%SPTUSA Unrecognized switch argument "^T/AR.NAM/" to /^T/L.SNAM/, ignored>)
JRST DOSW.1 ;RECOVER
DOSW.5: $TEXT(LOGTXT,<^I/STERR/%SPTURS Unrecognized switch /^T/L.SNAM/, ignored>)
JRST DOSW.1 ;AND LOOP AROUND
DOSW.6: $TEXT(LOGTXT,<^I/STERR/%SPTISW The /^T/L.SNAM/ switch ^A>)
$TEXT(LOGTXT,<is illegal on the $^T/L.TNAM/ card>)
JRST DOSW.1 ;AND LOOP AROUND
DOSW.A: BLOCK 1 ;-TABLE Length,,TABLE ADDRESS
COMMENT \
SWTOCT and SWTDEC are Routines to process octal and decimal
valued switches. Call with T1 containing address of
2-word block as described below.
!=======================================================!
! MINIMUM VALUE ! MAXIMUM VALUE !
!-------------------------------------------------------!
! BYTE POINTER FOR RESULT !
!=======================================================!
\
SUBTTL SWTOCT - Process octal switch value
SWTOCT: MOVEI S1,S$OCT ;LOAD ROUTINE TO CALL
MOVEI S2,[ITEXT(<^O/T3/ and ^O/T4/>)]
JRST SWTNUM ;AND CONTINUE ON
SUBTTL SWTDEC - Process decimal switch value
SWTDEC: MOVEI S1,S$DEC ;LOAD ROUTINE TO CALL
MOVEI S2,[ITEXT(<^D/T3/ and ^D/T4/>)]
;AND FALL INTO SWTNUM
SWTNUM: MOVEM S2,SWTN.B ;SAVE THE ITEXT
CAIN C,"/" ;A SLASH SEEN?
PJRST ILLSWA ;YES, GIVE ERROR
MOVEM T1,SWTN.A ;SAVE CALLING ARGUMENT
PUSHJ P,(S1) ;GET ARGUMENT
JUMPF ILLSWA ;GARBAGE!
MOVE T2,SWTN.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
JRST SWTN.1 ;OUT OF RANGE
XCT 1(T2) ;DEPOSIT THE ARGUMENT
$RETT ;AND RETURN
SWTN.1: $TEXT(LOGTXT,<^I/STERR/%SPTVMB The value on the /^T/L.SNAM/ switch ^A>)
$TEXT(LOGTXT,<must be between ^I/@SWTN.B/, switch ignored>)
$RETT ;AND RETURN
SWTN.A: BLOCK 1 ;TEMPORARY STORAGE
SWTN.B: BLOCK 1 ;TEMPORARY STORAGE
ILLSWA: $TEXT(LOGTXT,<^I/STERR/%SPTISA Illegal syntax for /^W/L.SWCH/ argument, switch ignored>)
$RETF ;AND RETURN
SUBTTL FILENT - Routine to open a user file
;FILENT is called with T1 containing the file-block bits. FRCENT
; is called with the same arguments as FILENT except we
; invoke our privileges to write the file into <SPOOL>.
FRCENT: TDZA S1,S1 ;LOAD ZERO FOR FLAG
FILENT: SETO S1,0 ;SET FLAG FOR STANDARD ENTRY
MOVEM S1,L.FOB+FOB.US ;INITIALIZE THE FOB
MOVEM S1,L.FOB+FOB.CD ;..
PUSHJ P,CLRFOB ;CLEAR THE FOB
SETZM DEKCRD ;CLEAR THE CARD COUNT
MOVEI S1,FILFD ;LOAD ADDRESS OF THE FD
MOVEM S1,L.FOB+FOB.FD ;STORE IN OPEN BLOCK
MOVEI S1,7 ;GET DEFAULT BYTE SIZE
MOVE S2,L.MODE ;GET THE MODE
CAIE S2,STBIN ;IS IT /BINARY
CAIN S2,STIMG ; OR /IMAGE?
MOVEI S1,^D36 ;YES, USE 36 BIT BYTES
STORE S1,L.FOB+FOB.CW,FB.BSZ ;STORE IT
MOVEI S1,1 ;LOAD A BIT
SKIPE FILSPC ;EXPLICIT FILENAME SUPPLIED?
STORE S1,L.FOB+FOB.CW,FB.NFO ;YES,IF FILE ALREADY EXISTS, FAIL
SKIPN L.FOB+FOB.US ;TEST WHETHER WE NEED TO
JRST FILE.1 ; INVOKE OUR PRIVILEGES
TOPS10 <
MOVE S1,.EQOID(Q) ;GET THE PPN
MOVEM S1,L.FOB+FOB.US ;AND SAVE FOR ACCESS CHECK
> ;END TOPS10
TOPS20 <
HRROI S1,.EQOWN(Q) ;POINT TO USER NAME
MOVEM S1,L.FOB+FOB.US ;STORE IT
HRROI S1,L.UDIR ;POINT TO CONNECTED DIRECTORY
MOVEM S1,L.FOB+FOB.CD ;AND STORE IT
> ;END IFN FTJSYS
FILE.1: MOVEI S1,FOB.SZ ;GET ARGBLOCK LENGTH
MOVEI S2,L.FOB ;AND ARGBLOCK ADDRESS
$CALL F%OOPN ;OPEN THE FILE
JUMPF FILE.2 ;JUMP IF WE LOSE
MOVEM S1,FILIFN ;ELSE, STORE THE IFN
SETOM FILOPN ;AND SET "FILE OPEN"
PJRST FBENT ;AND ENTER IN THE FILE BLOCKS
FILE.2: MOVE P1,S1 ;RELOCATE ERROR CODE
$TEXT(LOGTXT,<^I/FATAL/?SPTCCF ^I/FILE.3/>)
JSP B,PROCER
FILE.3: ITEXT(<Error creating file ^F/FILFD/, ^E/P1/>)
SUBTTL LOG File I/O Utilities
LOGTXT: SKIPG LOGIFN ;IS THE LOG OPEN?
JRST LOGT.1 ;NO, DEPOSIT CHAR IN BUFFER
MOVE S2,S1 ;PUT CHARACTER IN S2
MOVE S1,LOGIFN ;GET THE IFN IN S1
$CALL F%OBYT ;OUTPUT THE CHARACTER
JUMPT .RETT ;RETURN IF ALL IS OK
MOVE P1,S1 ;SAVE ERROR CODE
MOVE S1,LOGIFN ;GET LOGs HANDLE
SETO S2,0 ;BUILD AN FD
$CALL F%FD
$WTOJ(<^I/ABTSPR/>,<Error writing user LOG file, [^E/P1/]^M^J^F/(S1)/>)
$STOP(LS2,<Log File OUT Failed>)
LOGT.1: SKIPN LOGPAG ;HAS A PAGE BEEN SETUP?
$STOP(LNI,LOG not initialized)
JUMPE S1,.RETT ;RETURN IF NULL
SOSLE LOGCNT ;ANY ROOM LEFT?
IDPB S1,LOGPTR ;YES, DEPOSIT A CHARACTER
$RETT ;AND RETURN
LOGCLS: MOVE S1,LOGIFN ;GET THE IFN
SETZM LOGIFN ;LOG IS NOT OPEN!
PJRST F%REL ;AND RELEASE IT
LOGCRL: $TEXT(LOGTXT,<^I/STERR/Card is: ^T/L.CASC/^A>)
POPJ P, ;AND RETURN
LOGCRD: $TEXT(LOGTXT,<^I/STCRD/^T/L.CASC/^A>) ;TYPE THE CARD OUT
POPJ P, ;AND RETURN
SUBTTL Control File I/O Utilities
TXTCTL: MOVE T1,S1 ;RELOCATE CHARACTER
LSH T1,^D36-7 ;SHIFT TO TOP 7 BITS
MOVE S2,[XWD 1,T1] ;MAKE POINTER
PJRST CTLSTR
CTLEOL: MOVE S2,[XWD 2,[BYTE (7) .CHCRT,.CHLFD]]
PJRST CTLSTR
CTLSTR: MOVE S1,CTLIFN
$CALL F%OBUF
JUMPT .RETT
MOVE P1,S1 ;RELOCATE ERROR CODE
$TEXT(LOGTXT,<^I/FATAL/?SPTEWC ^I/CTLS.1/>)
JSP B,PROCER
CTLS.1: ITEXT (<Error writing BATCH control (CTL) file, ^E/P1/>)
SUBTTL MAKFUN - Routine to create a default filename
;MAKFUN is called to create a default (Funny) filename for user
; files. MAKFUN is called with S1 containing a 2-character
; prefix for the filename (right-justified in SIXBIT). It
; returns with S1 containing:
; On TOPS10, the default filename in SIXBIT.
; On TOPS20, [POINT 7,FILENAME]
MAKFUN: PUSH P,S1 ;SAVE S1
PUSHJ P,FUNNY ;MAKE FOUR RANDOM CHARACTERS
POP P,S2 ;GET PREFIX BACK
LSH S2,^D24 ;MOVE IT OVER
TOPS10 <
IOR S1,S2 ;OR IN THE FUNNY PART
>;END OF TOPS10 CONDITIONAL ASSEMBLY
TOPS20 <
IOR S2,S1 ;OR IN THE FUNNY PART
MOVE S1,[POINT 7,MAKF.A] ;POINT TO THE BLOCK
MOVEM S1,L.BP ;STORE IT AWAY
$TEXT(DEPBP,<^W/S2/^0>)
MOVE S1,[POINT 7,MAKF.A] ;RETURN THE ANSWER
>;END OF TOPS20 CONDITIONAL ASSEMBLY
$RET ;RETURN
MAKF.A: BLOCK 2 ;BLOCK TO BUILD THE NAME
;FUNNY is a routine to make up a 4-character Funny Name. Returns the
; four characters in SIXBIT, right justified in S1. 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.)
FUNNY: AOS S1,L.FUN ;GET NEXT FUNNY NUMBER
IDIV S1,[DEC 1679616] ;DIVIDE BY 36^4
MOVM S1,S2 ;AND LOAD THE REMAINDER
PUSHJ P,FUNLUP ;MAKE A NAME
JFCL ;IGNORE THE SKIP
TLZ S1,777700 ;MAKE SURE ITS ONLY 4 CHARS
POPJ P, ;AND RETURN
FUNLUP: IDIVI S1,^D36 ;DIVIDE BY 36
HRLM S2,(P) ;STORE DIGIT ON STACK
SKIPE S1 ;FINISHED?
PUSHJ P,FUNLUP ;NO, RECURSE
MOVEI S1,'000' ;PRE-LOAD S1
HLRZ S2,(P) ;LOAD A DIGIT
ADDI S2,20 ;MAKE IT 6BIT
CAILE S2,31 ;NUMERIC?
ADDI S2,7 ;NO, ALPHABETIC, ADD OFFSET
LSH S1,6 ;SHIFT OVER ACCUMULATED NAME
IOR S1,S2 ;OR IN NEXT CHARACTER
AOS 0(P) ;INCREMENT THE PC
POPJ P, ;AND SKIP BACK
SUBTTL CTLCRD - Routine to copy current card
COMMENT %
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: PUSHJ P,S$INCH ;GET A CHARACTER
JUMPF .RETT ;EOL, RETURN
CAIN C,(T1) ;CHECK FOR BREAK
POPJ P, ;GOT IT!! RETURN
LDB S1,B ;REREAD CHARACTER TO PRESERVE CASING
PUSHJ P,TXTCTL ;AND TYPE IT INTO CTL
JRST CTLCRD ;AND LOOP
; CLRFOB -- Routine to clear out the utility file open block
CLRFOB: MOVX S1,FOB.SZ ;FOB SIZE
MOVEI S2,L.FOB ;FOB ADDRESS
$CALL .ZCHNK ;ZERO IT
$RETT ;AND RETURN
COMMENT \
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.
CALL:
PUSHJ P,FBENT
ALWAYS RETURN HERE
\
FBENT: JUMPE T1,.RETT ;IF BITS ARE ZERO, DON'T STORE ANYTHING
$CALL .SAVE2 ;SAVE P1 AND P2
MOVE S1,L.FBLN ;GET THE LIST NAME
$CALL L%LAST ;POSITION TO THE END
MOVEI T2,FILFD ;LOAD ADDRESS OF THE FD
PUSHJ P,FBEN.2 ;DO THAT ONE
TXNN T1,FB.LDR ;LOAD THE REL FILE?
$RETT ;NO, RETURN
SETOM L.FBCT ;FLAG SOMETHING TO LOAD
TXO T1,FB.LOD ;AND SET THE LOAD FLAG
TOPS10 <
MOVEI T2,FILFD ;LOAD THE FD
PUSHJ P,FBEN.2 ;AND COPY IT
MOVSI S2,'REL' ;LOAD AN EXTENSION
STORE S2,.FBFD+.FDEXT(S1) ;STORE IT
$RETT ;AND RETURN
> ;END TOPS10
TOPS20 <
MOVEI T2,FILRFD ;LOAD THE REL FD
PUSHJ P,FBEN.2 ;SETUP THE FD
$RETT ;AND RETURN
>;END IFN FTJSYS
FBEN.2: MOVE S1,L.FBLN ;GET THE LIST NAME
LOAD S2,.FDLEN(T2),FD.LEN ;GET THE LENGTH
ADDI S2,.FBFD ;ADD IN THE OVERHEAD
$CALL L%CENT ;CREATE AN ENTRY
MOVE S1,S2 ;GET THE ADDRESS IN S1
MOVEI S2,.FBFD(S2) ;POINT TO THE FD
HRL S2,T2 ;MAKE A BLT POINTER
LOAD T2,.FDLEN(T2),FD.LEN ;GET THE LENGTH
ADD T2,S1 ;ADD IN THE DESTINATION
BLT S2,-1(T2) ;AND BLT THE ENTRY
MOVEI S2,1 ;LOAD A FLAG
TXNE T1,FB.DEL ;IS DELETE ON?
STORE S2,.FBFLG(S1),FB.DEL ;YES, SET DELETE
TXNE T1,FB.LOD ;IS LOAD ON?
STORE S2,.FBFLG(S1),FB.LOD ;YES, SET IT
TXNE T1,FB.SRH ;IS SEARCH ON?
STORE S2,.FBFLG(S1),FB.SRH ;YUP!
$RETT ;RETURN OK
SUBTTL FBCLOD -- File Block Clear LOaD bits
COMMENT \
FBCLOD is called on each $LANGUAGE, $INCLUDE, and $RELOC
card. If the current remembered files have been loaded
(L.LOAD) then all files are scanned and their "LOAD" bits
are cleared.
\
FBCLOD: SKIPN L.LOAD ;IS LOAD SET?
$RETT ;NO, JUST RETURN
SETZM L.LOAD ;CLEAR THE LOAD WORD
SETZM L.FBCT ;CLEAR THE COUNTER
MOVE S1,L.FBLN ;GET THE LIST NAME
$CALL L%FIRST ;POSITION TO BEGINNING
FBCL.1: ZERO .FBFLG(S2),FB.LOD ;CLEAR THE LOAD FLAG
$CALL L%NEXT ;GET THE NEXT
JUMPT FBCL.1 ;LOOP IF MORE
$RETT ;ELSE, RETURN
SUBTTL S$OCT - S$DEC -- Octal and decimal number scanners.
COMMENT \
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,[EXP 8] ;LOAD AN 8
S$DEC: MOVEI T2,12 ;LOAD A 10
S$NUM: SETZ T1,0 ;CLEAR THE ACCUMULATOR
PUSHJ P,S$FSPC ;FLUSH LEADING SPACES AND GET A CHAR
JUMPF S$NU.3 ;EOL, RETURN -1
CAIL C,"0" ;CHECK RANGE
CAILE C,"0"-1(T2)
$RETF ;FAIL RETURN
JRST S$NU.2 ;OK, SKIP INTO LOOP
S$NU.1: PUSHJ P,S$INCH ;GET A CHARACTER
JUMPF .RETT ;EOL, RETURN OK
CAIL C,"0" ;CHECK THE RANGE
CAILE C,"0"-1(T2)
$RETT ;NOT A NUMBER, JUST RETURN OK
S$NU.2: IMULI T1,(T2) ;SHIFT RADIX POINT OVER ONE
ADDI T1,-"0"(C) ;ADD IN THE NEXT DIGIT
JRST S$NU.1 ;AND LOOP AROUND FOR THE NEXT DIGIT
S$NU.3: SETO T1, ;LOAD A -1
$RETF ;AND FAIL
SUBTTL S$ASCZ -- Routine to scan an ASCIZ string.
COMMENT \
Routine continues scanning and loading characters into the
specified block pointed to by S1 until either a terminating
character is found or more than 38 characters have been scanned.
A terminating character is any character other than one of the
following: 1) Alphabetic (upper or lower case)
2) Numeric (0-9)
3) Hyphen/Minus sign (Code=45 decimal)
Call:
PUSHJ P,S$ASCZ
ALWAYS RETURN HERE
\
S$ASCZ: HRR T1,S1 ;RELOCATE CALLING ARGUMENT
HRLI T1,(POINT 7) ;MAKE A BYTE POINTER
SETZB T2,(T1) ;AND CLEAR A COUNTER
S$AS.1: PUSHJ P,S$INCH ;GET A CHARACTER
JUMPF S$AS.3 ;EOL OR SOMETHING LIKE THAT
MOVE S1,C ;RELOCATE
TRZ S1,40 ;CONVERT LC TO UC
CAIL S1,"A" ;ALPHABETIC?
CAILE S1,"Z"
SKIPA ;NO
JRST S$AS.2 ;OK
CAIL C,"0" ;NUMERIC?
CAILE C,"9"
SKIPA ;NO
JRST S$AS.2 ;OK
CAIE C,"-"
JRST S$AS.3 ;LOSE
S$AS.2: IDPB C,T1 ;ELSE DEPOSIT THE CHAR
CAIGE T2,^D38 ;GOT ENUF?
AOJA T2,S$AS.1 ;NO, GET SOMEMORE
S$AS.3: SETZ T2,0 ;LOAD NULL
IDPB T2,T1 ;DEPOSIT IT
$RET ;AND RETURN
TOPS10 <
S$TENN: HRR T1,S1 ;RELOCATE THE POINTER
HRLI T1,(POINT 6) ;MAKE SIXBIT BYTE PTR
SETZ T2,0 ;CLEAR COUNTER
TENN.1: PUSHJ P,S$INCH ;FETCH A CHARACTER
JUMPF TENN.3 ;ERROR
CAIE C," " ;SPACE OR SLASH?
CAIN C,"/"
JRST TENN.3 ;YES
CAIE C,"""" ;QUOTE CHARACTER?
JRST TENN.2 ;NO
JUMPE T2,TENN.1
TENN.2: CAIL C,"a"
CAILE C,"z"
SKIPA
TRZ C,40 ;CONVERT TO UPPER CASE
SUBI C,40 ;SIXBITIZE
IDPB C,T1
CAIGE T2,^D12
AOJA T2,TENN.1
TENN.3: SETZ T2,0 ;LOAD NULL
IDPB T2,T1 ;DEPOSIT IT
$RET ;AND RETURN
>
SUBTTL S$TIM -- Routine to return a Time Specification
COMMENT \
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.
CALL:
PUSHJ P,S$TIM
RETURN HERE IF TOO MANY ARGS SPECIFIED (# IN T1)
RETURN HERE OTHERWISE
\
S$TIM: $CALL .SAVE1 ;SAVE P1
SETZM L.HRS ;SETZM ANSWERS
SETZM L.MIN ;BEFORE WE ASK THE QUESTIONS
SETZM L.SEC
MOVEI P1,L.SEC ;ADDRESS FOR LAST ARGUMENT
MOVNI T4,3 ;-VE NUMBER OF LEGAL ARGS
PUSHJ P,S$TML ;GO SCAN SOME
JUMPLE T4,.RETT ;WIN BIG
ADDI T4,3 ;CONVERT TO NUMBER OF ARGS
$RETF ;ANY NOTIFY THAT HE LOSES
S$TML: PUSHJ P,S$DEC ;GET A DECIMAL NUMBER
SKIPT ;SKIP ON VALID NUMBER READ
SETZ T1,0 ;MAKE IT ZERO
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,(P1) ;SAVE IT
SOS P1 ;POINTER FOR NEXT ARG
POPJ P, ;AND UNWIND
SUBTTL S$DATE -- Date-Time Scanner **UNDER RADIX-10**.
COMMENT %
.SCDT is called by the /DEADLINE and /AFTER switches to
parse a date-time specification.
Legal date-time specifications are of the form:
[+[HH:[MM]]]
[[DD-MMM]-YY]
[[[DD-MMM]-YY] [HH:[MM]]]
For all month specifications (MMM) a 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.
Note: This routine is only good until 1999
%
RADIX 10 ;*****NOTE WELL*****
S$DATE: MOVE T1,[XWD L.HRS,L.HRS+1]
SETZM L.HRS ;SETUP TO CLEAR RESULTS
BLT T1,L.YRS ;AND DO IT!
PUSHJ P,S$INCH ;GET A CHARACTER
JUMPF DATERR ;FAIL ON 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
JRST DATERR ;NO, LOSE
DATE.1: TXO F,F.RSCN ;SET TO REREAD CHARACTER
PUSHJ P,S$DEC ;GET A DECIMAL NUMBER
JUMPF DATERR ;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
JUMPF DATERR ;LOSE
MOVEM T1,L.SEC ;SAVE THEM
JRST MAKDT ;AND MAKE A DATE
.SCDTR: PUSHJ P,S$TIM ;GET A TIME SPEC
JUMPF DATERR ;FAIL RETURN
SKIPE L.HRS ;ONLY WANT 2 ARGS
JRST DATERR ;HE'S TOO ACCURATE
MSTIME T1, ;GET NOW!!
IDIV T1,[EXP 1000*3600]
ADDM T1,L.MIN ;ADD IN HRS
IDIVI T2,60000 ;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,S$INCH ;GET NEXT CHAR
JUMPF DATERR ;FAIL ON EOL
TXO F,F.RSCN ;RESCAN THE CHARACTER
TRNN C,^O100 ;ALPHABETIC?
JRST .SCDA3 ;ITS NOT, MUST BE NUMBER
MOVEI S1,AR.NAM ;POINT TO STORAGE BLOCK
PUSHJ P,S$ASCZ ;TAKE A COPY
MOVEI S1,MONTAB-1 ;POINT TO TABLE
MOVEI S2,AR.NAM ;AND THE ARGUMENT
$CALL S%TBLK ;TRY FOR A MATCH
TXNE S2,TL%NOM!TL%AMB ;VALID DATE ARG?
JRST DATERR ;NO, FAIL
HRRZ T1,(S1) ;GET MONTH NUMBER (1-12)
.SCDA2: HRRM T1,L.MON ;AND STORE IT
JRST .SCDA4 ;JOIN-UP AT THE PASS
.SCDA3: PUSHJ P,S$DEC ;GET THE MONTH NUMBER
JUMPF DATERR ;BAD FORMAT??
CAIL T1,1 ;MAKE SURE ITS 1-12
CAILE T1,12
JRST DATERR ;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
JUMPF DATERR ;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,S$FSPC ;FLUSH LEADING SPACES
JUMPF 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
JRST DATERR ;NO???
JRST DATE.1 ;YES, GET A TIME
MAKDT: SKIPE L.YRS ;DATE SPECIFIED?
JRST MAKD.2 ;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
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 MAKD.1 ;MOST DEFINITELY, GO ADD A DAY
CAME T1,L.MIN ;IS IT LT OR EQ
JRST MAKD.2 ;ITS LT, DON'T ADD A DAY
CAMG T2,L.SEC ;ARE THE MINUTES PAST
JRST MAKD.2 ;NO, ALL IS WELL
MAKD.1: MOVEI T3,24 ;GOING TO INCREMENT BY 24 HOURS
ADDM T3,L.MIN ;AND DO IT
MAKD.2: MOVE T1,L.MIN ;GET HOURS
IMULI T1,60 ;AND MAKE MINUTES
ADD T1,L.SEC ;ADD MINUTES
SETZ T2,0 ;FOR LOW HALF
ASHC T1,-17 ;MULT BY 2**18
DIVI T1,60*24 ;DIVIDE BY MIN/DAY
MOVEM T1,L.SEC ;AND STORE
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
$RETT ;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*****
DATERR: $TEXT(LOGTXT,<^I/STERR/^I/DTR1/, switch ignored>)
$RETF ;AND FAIL
DTR1: ITEXT (<%SPTBDT Bad date/time on /^W/L.SWCH/>)
XWD ^D12,^D12 ;CONTROL WORD FOR TBLUK
MONTAB: TB(JANUARY,^D1)
TB(FEBRUARY,^D2)
TB(MARCH,^D3)
TB(APRIL,^D4)
TB(MAY,^D5)
TB(JUNE,^D6)
TB(JULY,^D7)
TB(AUGUST,^D8)
TB(SEPTEMBER,^D9)
TB(OCTOBER,^D10)
TB(NOVEMBER,^D11)
TB(DECEMBER,^D12)
SUBTTL S$FILE -- Routine to scan off a filespec.
; Call with S1 containing the default file name (in SIXBIT on
; the -10, ASCII byte pointer on the -20)
; Call with S2 containing the default extension (same format
; as name)
; 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
TOPS10 <
S$FILE: SETZB T4,FILSPC ;CLEAR SPEC FLAGS AND WORD
SETZM FILFD ;CLEAR THE FIRST WORD OF FD BLOCK
MOVE T1,[FILFD,,FILFD+1]
BLT T1,FILFD+FDXSIZ-1 ;CLEAR OUT THE FD
MOVSI T1,'DSK' ;GET DEFAULT DEVICE
STORE T1,FILFD+.FDSTR ;STORE IT
LOAD T1,.EQOID(Q) ;GET USERS PPN
STORE T1,FILFD+.FDPPN ;AND STORE IT
STORE S1,FILFD+.FDNAM ;STORE THE DEFAULT NAME
STORE S2,FILFD+.FDEXT ;STORE THE DEFAULT EXTENSION
MOVEI S1,FDMSIZ ;ASSUME NO SFDS
STORE S1,FILFD+.FDLEN,FD.LEN;STORE THE INITIAL LENGTH
S$FIL1: PUSHJ P,S$FSPC ;SCAN OFF SPACES
TXO F,F.RSCN ;SET APPROPRIATE FLAG
MOVEI S1,AR.NAM ;POINT TO ARGUMENT BLOCK
PUSHJ P,S$ASCZ ;GO GET IT
HRROI S1,AR.NAM ;POINT TO THE BLOCK AGAIN
$CALL S%SIXB ;SIXBITIZE
SKIPN T1,S2 ;RELOCATE AND TEST ARGUMENT
JRST S$FIL4 ;EOL - SUCCESS RETURN
JUMPF S$FIL2 ;NOT ALPHANUMERIC
S$FIL2: CAIN C,":" ;DEVICE SPECIFIED?
JRST S$DEV ;YUP, GO DO IT
JUMPE T1,S$FIL3 ;NULL CANT BE FILENAME
TXOE T4,SC.NAM ;SET NAME FLAG AND SKIP IF 1ST ONE
JRST S$FIL5 ;TWO NAMES ARE ILLEGAL
MOVEM T1,FILFD+.FDNAM ;STORE THE FILENAME
S$FIL3: CAIN C,"." ;EXTENSION COMING?
JRST S$EXT ;YES, DO IT!
CAIE C,"[" ;DIRECTORY SPEC COMING?
CAIN C,74 ;ACCEPT EITHER DELIMETER
JRST S$DIR ;YES, GO GET IT
CAIN C," " ;A BLANK?
JRST S$FIL1 ;YES, TRY SOME MORE
S$FIL4: TXNE T4,SC.NAM ;DID WE FIND A NAME?
SETOM FILSPC ;YES, SET THE FLAG
$RETT ;AND RETURN TRUE
S$DEV: JUMPE T1,S$FIL5 ;NULL DEVICE?
TXOE T4,SC.DEV ;SET DEV FLAG AND SKIP IF NOT DUPLICATE
JRST S$FIL5 ;DUPLICATE DEVICE
MOVEM T1,FILFD+.FDSTR ;STORE DEVICE NAME
JRST S$FIL1 ;AND LOOP FOR MORE STUFF
S$EXT: TXOE T4,SC.EXT ;SET EXT FLAG AND SKIP IF 1ST ONE
JRST S$FIL5 ;NOT THE FIRST TIME!
MOVEI S1,AR.NAM ;POINT TO ARGUMENT BLOCK
PUSHJ P,S$ASCZ ;GO GET IT
HRROI S1,AR.NAM ;POINT TO THE BLOCK AGAIN
$CALL S%SIXB ;SIXBITIZE
HLLZM S2,FILFD+.FDEXT ;STORE THE EXTENSION
JRST S$FIL3 ;AND LOOP FOR MORE
S$DIR: TXOE T4,SC.DIR ;DO WE HAVE A DIRECTORY ALREADY?
JRST S$FIL5 ;YES, LOSE
PUSHJ P,S$OCT ;GET AN OCTAL NUMBER
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 S$FIL5 ;IT ISN'T, ITS GARBAGE
PUSHJ P,S$INCH ;GET NEXT CHARACTER
JUMPF 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,FILFD+.FDPPN ;SAVE PROJECT NUMBER
PUSHJ P,S$OCT ;GET PROG
HRRM T1,FILFD+.FDPPN ;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 S$FIL5 ;NO, MORE GARBAGE
MOVEI P2,FILFD+.FDPAT ;POINT TO FIRST SFD
S$DIR3: MOVEI S1,AR.NAM ;POINT TO ARGUMENT BLOCK
PUSHJ P,S$ASCZ ;GO GET IT
HRROI S1,AR.NAM ;POINT TO THE BLOCK AGAIN
$CALL S%SIXB ;SIXBITIZE
JUMPF S$FIL5 ;LOSE BIG
MOVEM S2,(P2) ;STORE SFD IN PATH BLOCK
INCR FILFD+.FDLEN,FD.LEN ;INCREMENT THE COUNT FIELD
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 S$FIL5 ;NO, LOSE
LOAD T1,FILFD+.FDLEN,FD.LEN ;GET THE LENGTH
CAIGE T1,FDXSIZ ;GREATER THAN MAX?
AOJA P2,S$DIR3 ;NO, WIN
JRST S$FIL5 ;YES, NESTING TO DEEP
S$FIL5: $TEXT(LOGTXT,<^I/FATAL/?SPTFSE ^I/S$ERR5/>)
JSP B,CTLCER ;ABORT
S$ERR5: ITEXT (<File specification error on $^T/L.TNAM/ card>)
>;END TOPS10
TOPS20 <
S$FILE: SETZM FILSPC ;CLEAR SPEC FOUND FILE
DMOVE T1,S1 ;SAVE THE ARGUMENTS
MOVEI S1,.GJCPC+1 ;BLOC SIZE
MOVEI S2,SFIL.A ;BLOCK ADDRESS
$CALL .ZCHNK ;ZERO OUT THE GTJFN BLOCK
MOVEM T1,SFIL.A+.GJNAM ;SAVE DEFAULT NAME
MOVEM T2,SFIL.A+.GJEXT ;SAVE DEFAULT EXTENSION
MOVX S1,GJ%OFG!GJ%XTN ;"JUST PARSE" FLAG
MOVEM S1,SFIL.A+.GJGEN ;SAVE IT
MOVX S1,<XWD .NULIO,.NULIO> ;GET NUL IO DEVICE
MOVEM S1,SFIL.A+.GJSRC ;FOR ADDITIONAL SOURCE
HRROI S1,[ASCIZ /PS/] ;GET DEFAULT DEVICE
MOVEM S1,SFIL.A+.GJDEV ;STORE IT
HRROI S1,.EQOWN(Q) ;POINT TO DIRECTORY
MOVEM S1,SFIL.A+.GJDIR ;STORE
MOVX S1,G1%NLN+2 ;SHORT FILENAMES AND 2 WRDS FOLLOWING
MOVEM S1,SFIL.A+.GJF2 ;AND STORE IT
HRROI S1,FILRFD ;BYTE POINTER FOR USER TYPED
MOVEM S1,SFIL.A+.GJCPP ;AND STORE IT
MOVEI S1,<FDXSIZ*5> ;AND A BYTE COUNT
MOVEM S1,SFIL.A+.GJCPC ;AND STORE IT
SETZM FILRFD ;CLEAR THE WORD
MOVEI S1,SFIL.A ;LOAD ADDRESS OF BLOCK
MOVE S2,B ;RELOCATE BP
PUSHJ P,S$FSPC ;SKIP OVER BLANKS
SETO S2,0 ;INDICATE TASK
ADJBP S2,B ;READJUST BP
GTJFN ;GET THE FILE SPEC
JRST S$FIL2 ;LOSE??
SETO B,0 ;SETUP TO DECREMENT
ADJBP B,S2 ;THE RETURNED BP
MOVE S2,S1 ;PUT JFN IN S2
MOVX S1,177B6 ;PREPARE TO CLEAR TERMINATING CHARACTER
ANDCAM S1,FILRFD ;CLEAR IT OUT
SKIPE S1,FILRFD ;TEST FOR NULL
CAMN S1,[BYTE (7) 0,.CHLFD] ;AND ALSO CRLF
SKIPA
SETOM FILSPC ;HE TYPED A FILENAME
SETZM FILRFD ;CLEAR THE FIRST WORD
HRROI S1,FILFD+.FDSTG ;POINT TO STRING BLOCK
MOVX T1,<XWD 221100,JS%PAF> ;GET THE FIELDS WE WANT
JFNS ;GET THE FILESPEC BACK
TLZ S1,-1 ;ZAP LEFT HALF OF BP
SUBI S1,FILFD+.FDSTG-3 ;GET LENGTH (WITH SOME SLOP)
STORE S1,FILFD+.FDLEN,FD.LEN ;STORE IN PRIME FD
STORE S1,FILRFD+.FDLEN,FD.LEN ;AND REL FILE FD
MOVE S1,S2 ;GET THE JFN BACK
RLJFN ;RELEASE IT
JFCL ;IGNORE THE ERROR RETURN
MOVE S1,[XWD FILFD,FILRFD] ;PREPARE TO TAKE
BLT S1,FILRFD+FDXSIZ-1 ;COPY OF FD
MOVE S1,[POINT 7,FILRFD+.FDSTG];AND START SEARCH
ILDB T1,S1 ;FOR THE DOT
CAIE T1,"." ;FOUND?
JRST .-2 ;NO, KEEP GOING
MOVEM S1,L.BP ;SAVE POINTER FOR $TEXT
$TEXT (DEPBP,<REL^0>) ;AND REPLACE THE EXTENSION
$RET ;AND RETURN
S$FIL1: RLJFN ;RELEASE THE FILE
JFCL ;IGNORE ANY ERROR
S$FIL2: $TEXT(LOGTXT,<^I/FATAL/?SPTFSE ^I/S$ERR2/>)
JSP B,CTLCER ;ABORT
S$ERR2: ITEXT (<File specification error on $^T/L.TNAM/ card>)
SFIL.A: BLOCK .GJCPC+1 ;DEFAULT JFN BLOCK
>;END IFN FTJSYS
SUBTTL S$FSPC -- Routine to flush leading spaces
;Useful scanning routines
;Call:
; PUSHJ P,S$FSPC
; Return here otherwise with first significant char in C
S$FSPC: PUSHJ P,S$INCH ;GET A CHARACTER
JUMPF .RETF ;FAIL, EOL
CAIN C," " ;A SPACE?
JRST S$FSPC ;YES, LOOP
$RETT ;NO, RETURN SUCCESS
SUBTTL S$INCH -- Routine to get a character
; Routine to call the get a character routine for the
; scanners. Checks for continuation characters, comments etc.
;
;Call:
; PUSHJ P,S$INCH
; Return here with character in C
; (Returns FALSE on EOL else TRUE)
S$INCH: TXZE F,F.RSCN ;RESCANNING THIS CHAR?
$RETT ;YES, RETURN TRUE
PUSHJ P,CDRCHR ;CALL CALLER'S ROUTINE
JUMPF .RETF ;FAIL ON EOL
CAIE C,"!" ;START COMMENT FIELD?
CAIN C,";" ;EITHER TYPE!!
POPJ P, ;YES, SAME AS EOL
CAIE C,"-" ;OR CONTINUATION MARK?
$RETT ;NO, RETURN WITH A CHARACTER
PUSH P,B ;SAVE BYTE POINTER
S$IN.1: PUSHJ P,CDRCHR ;GET ANOTHER CHARACTER
JUMPF S$IN.2 ;EOL MEANS IT WAS A CONTINUATION
CAIE C,"!" ;SO DOES A COMMENT
CAIN C,";" ; EITHER TYPE OF COMMENT
JRST S$IN.2 ;SO GO GET IT
CAIN C," " ;IS IT A BLANK?
JRST S$IN.1 ;YES, LOOP FOR NON-BLANK
POP P,B ;ITS NOT A CONTINUATION
MOVEI C,"-" ;SO RESTORE THE HYPHEN
$RETT ;RETURN SUCCESS
S$IN.2: POP P,B ;BRING STACK INTO PHASE
PUSHJ P,S$NXTC ;GET NEXT RECORD
JRST S$INCH ;NOPE, TRY AGAIN
SUBTTL DUMMY Routines to read one character from card
COMMENT %
CDRCHR -- Routine to load one byte from card (L.CASC).
Converts tabs and CR to spaces, and lower to upper case.
Assumes AC B contains a correct byte pointer
Call:
PUSHJ P,CDRCHR
Returns FALSE if EOL else TRUE
%
SUBTTL CDRCHR - Get a card character
CDRCHR: SKIPE L.BRK ;WAS LAST CHARACTER A BREAK?
$RETF ;YES, FAIL RETURN
ILDB C,B ;GET A CHARACTER
CAIN C,.CHCRT ;IGNORE CR'S
JRST .-2 ;GET NEXT CHARACTER
CAIN C,.CHTAB ;DO FIXUP ON TABS
MOVEI C," " ;YES, MAKE A SPACE
CAIN C,.CHLFD ;LINEFEED?
JRST CDRCH1 ;YES, SET BREAK FLAG A NON-SKIP BACK
CAIL C,"a" ;CHECK FOR LOWER CASE
CAILE C,"z" ; I.E. "A"-"Z"
$RETT ;NO, RETURN
SUBI C,40 ;MAKE IT UPPER CASE
$RETT ;AND RETURN
CDRCH1: SETOM L.BRK ;SET BREAK FLAG
MOVEI C," " ;MAKE BREAK CHAR LOOK LIKE A SPACE
$RETF ;AND FAIL
; S$NXTC -- Routine to get a record for scanners reads in a
; card and prints it into the LOG, since it is a control card.
;
;Call:
; PUSHJ P,CDRNXT
; Return here otherwise
S$NXTC: $CALL .SAVET ;SAVE T REGS
MOVE S1,L.DWID ;LOAD DEFAULT WIDTH
MOVEM S1,L.WIDT ;SAVE IT
PUSHJ P,CDRASC ;GET A CARD
PUSHJ P,LOGCRD ;TYPE THE CARD
MOVE B,[POINT 7,L.DMOD]
$RETT ;LOAD NEW BP AND RETURN
SUBTTL Deck Stacking Routines
; Routine to stack a user's Hollerith (ASCII or 026) file.
; Stacks until a control card or an input EOF is found.
STASC: PUSHJ P,CDRASC ;GET ASCII CARD IMAGE
MOVE B,L.CHOL ;GET THE DEFAULT BYTE POINTER
ILDB T1,B ;GET AND COLUMN 1
CAIE T1,"$" ;DOLLAR SIGN?
JRST STAS.2 ;NO, TREAT AS DATA
ILDB T1,B ;GET COLUMN 2
CAIL T1,"a" ;CONVERT LOWER CASE
CAIL T1,"z" ; TO UPPER
SKIPA ; IF NECESSARY
TRZ T1,40 ;CONVERT CASING
CAIL T1,"A" ;CHECK FOR ALPHABETIC
CAILE T1,"Z" ;BETWEEN A AND Z
JRST STAS.1 ;NOT A CONTROL CARD, CHECK OTHERS
JRST STAS.3 ;CONTROL CARD
STAS.1: TXNE F,F.DOLR ;IS /DOLLARS ON?
JRST STAS.2 ;YES, DON'T TRIM ANYTHING OFF!
MOVSI T2,774000 ;MASK FOR FIRST ASCII CHARACTER
CAIN T1,"$" ;IS SECOND CHARACTER A "$"?
ANDCAM T2,L.CASC ;TURN OFF FIRST "$"
STAS.2: MOVE S1,FILIFN ;GET THE IFN
HRL S2,L.CLEN ;GET NUMBER OF BYTES,,0
SKIPE L.SPRS ;SUPPRESS FLAG ON?
HRL S2,L.CSUP ;YES, SO GET SUPPRESSED LENGTH
HRR S2,L.CHOL ;AND THE LOCATION
$CALL F%OBUF ;WRITE OUT THE BUFFER
JUMPF FILERR ;AND LOSE?
MOVE S1,FILIFN ;GET THE IFN
MOVE S2,[2,,[BYTE (7) .CHCRT,.CHLFD]]
$CALL F%OBUF ;PUT IN A CRLF
JUMPF FILERR ;AND LOSE
AOS DEKCRD ;COUNT THE CARD
JRST STASC ;AND GO AROUND FOR ANOTHER
STAS.3: TXNN F,F.DOLR ;IS /DOLLARS ON?
$RET ;NO, $<ALPHA> STOPS US THEN
MOVE C,T1 ;RELOCATE LAST CHARACTER
TXO F,F.RSCN ;SET RESCAN FLAG
MOVEI S1,AR.NAM ;POINT TO STRING BLOCK
PUSHJ P,S$ASCZ ;READ IN THE KEYWORD
SKIPN AR.NAM ;TEST FOR NULL
JRST STAS.2 ;IT'S NULL, JUST DUMP IT OUT
MOVEI S1,CTLCOD-1 ;POINT TO TABLE
HRROI S2,AR.NAM ;POINT TO KEYWORD GATHERED
$CALL S%TBLK ;DO THE WORK
TXNE S2,TL%NOM!TL%AMB ;MATCH?
JRST STAS.2 ;NO, DUMP IT OUT
$RET ;YES, RETURN
;STIMG -- Routine to transfer User's IMAGE mode deck to disk.
; Deck ends on CDR-EOF or Image Terminator.
STIMG: 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
STIM.1: PUSHJ P,CDRIMG ;GET IMAGE MODE CARD
LDB T2,P.CL1I ;GET IMAGE COLUMN 1
CAIE T2,7777 ;FULLY LACED?
JRST STIM.2 ;NO, NOT END OF DECK
LDB T2,T1 ;YES, GET SPECIFIED TERM COLUMN
CAIN T2,7777 ;FULLY LACED?
JRST STIM.3 ;YES, CHECK ALL OTHER COLS FOR ZEROES
STIM.2: AOS DEKCRD ;INCREMENT CARD COUNT
MOVE S1,FILIFN ;GET THE IFN
HRL S2,L.CLEN ;GET COUNT,,0
HRR S2,L.CASC ;GET COUNT,,ADR
$CALL F%OBUF ;WRITE OUT THE CARD
JUMPT STIM.1 ;AND LOOP IF OK
JRST FILERR ;ELSE GIVE UP
STIM.3: PUSH P,L.CASC ;SAVE FIRST WORD
PUSH P,(T1) ;AND WORD WITH TERMINATOR
SETZ T3,0 ;CLEAR A COUNTER
DPB T3,P.CL1I ;ZERO OUT FIRST COLUMN
DPB T3,T1 ;AND TERMINATOR COLUMN
STIM.4: SKIPE L.CASC(T3) ;WORD ZERO?
JRST STIM.5 ;NOT, NOT A TERMINATOR
CAIGE T3,IWPC-1 ;LOOP FOR 27 WORDS
AOJA T3,STIM.4 ;AND AROUND WE GO
POP P,(T1) ;RESTORE TERMINATOR COLUMN
POP P,L.CASC ;AND FIRST COLUMN
PUSHJ P,CDRASC ;READ A CARD
POPJ P, ;AND END THE DECK
STIM.5: POP P,(T1) ;RESTORE TERMINATOR COLUMN
POP P,L.CASC ;RESTORE FIRST COLUMN
JRST STIM.2 ;ITS A DATA CARD!!
TOPS10 <
COMMENT \
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).
\
STBIN: PUSHJ P,CDRBIN ;GET A CARD
JUMPF STBI.1
AOS DEKCRD ;INCREMENT CARD COUNT
MOVE S1,FILIFN ;GET THE IFN
HRL S2,L.CLEN ;GET COUNT,,0
HRR S2,L.CHOL ;GET COUNT,,ADR
$CALL F%OBUF ;WRITE OUT THE CARD
JUMPT STBIN ;AND LOOP IF OK
JRST FILERR ;ELSE GIVE UP
STBI.1: PUSHJ P,CDRASC ;READ A CARD
$RETT
>;END TOPS10
TOPS20 <
STBIN: $STOP(TSB,Tried stacking binary cards)
>;END IFN FTJSYS
;BYTE POINTERS FOR STIMG AND STBIN
P.ICOL: POINT 12,L.CASC,35 ;THIRD BYTE OF WORD
P.CL1I: POINT 12,L.CASC,11 ;FIRST BYTE OF WORD
POINT 12,L.CASC,23 ;SECOND BYTE OF WORD
POINT 12,L.CASC,35 ;THIRD BYTE OF WORD
SUBTTL Read a card -- CDRASC - in ASCII and 026
CDRASC: $CALL .SAVET ;SAVE THE T REGS
SETZM TRLCRD ;CLEAR HEADER/TRAILER CARD COUNT
SETZM L.CSUP ;CLEAR SUPPRESSED LENGTH
SETZM L.CLEN ;CLEAR ACTUAL LENGTH
CDRA.A: SETZM L.TFLG ;CLEAR HEADER/TRAILER FLAG
TXZ F,F.RSCN ;CLEAR RESCAN BIT
SETZM L.BRK ;CLEAR BREAK FLAG
SETZM L.NHOL ;CLEAR # OF HOL ERRORS
SETZM LINCHK ;CLEAR FLAG
LOAD S1,L.INF,FP.RCF
MOVSS S1 ;PUT CODE IN LEFT HALF
MOVSI T1,-MODCNT ;MAKE AOBJN POINTER
TOPSRC: MOVE T2,MODTBL(T1) ;GET TABLE ITEM
HRR S1,MODTBL(T1) ;PLANT THIS ADDRESS FOR COMPARE
CAMN S1,T2 ;MATCH?
JRST (S1) ;YUP, BRANCH
AOBJN T1,TOPSRC ;LOOP FOR ALL
$STOP (URM,<Unknown Recording Mode(^O/S1,LHMASK/) Error in NEXTJOB Message>)
CDR.AI: MOVE S1,L.IFN ;GET THE IFN
$CALL F%CHKP ;GET CURRENT POSITION
ADDI S1,CPC ;POINT TO NEXT CARD
MOVEM S1,CDRA.F ;STORE TO POSITION LATER
MOVEI T1,1 ;START THE COUNTER
MOVE T2,[POINT 7,L.CASC]
MOVE T3,[POINT 7,L.C026]
CDRA.B: MOVE S1,L.IFN ;GET THE IFN
$CALL F%IBYT ;GET A BYTE
JUMPF INFAIL ;???
TXNE S2,1B20 ;WAS IT A HOLLERITH ERROR?
JRST CDRA.G ;YES
CDRA.C: MOVE S1,S2
LSHC S1,-2
LSH S1,-7
LSHC S1,2
LOAD S2,CODTBL(S1),CODASC
IDPB S2,T2
LOAD S2,CODTBL(S1),COD026
CAIN S2,173 ;ALTERNATE "?"?
MOVEI S2,77 ;YES, MAKE IT REAL "?"
CAIN S2,175 ;ALTERNATE ":"?
MOVEI S2,72 ;YES, MAKE IT REAL ":"
IDPB S2,T3 ;DEPOSIT CHARACTER IN BUFFER
CAIE S2,40 ;IS IT A SPACE?
MOVEM T1,L.CSUP ;NO, COUNT IT
MOVEM T1,L.CLEN ;SAVE CURRENT LENGTH
CAMGE T1,L.WIDT ;GOT THEM ALL?
AOJA T1,CDRA.B ;NO, LOOP
MOVEI S1,.CHCRT ;LOAD A CR
IDPB S1,T2 ;STORE IN ONE
IDPB S1,T3 ;STORE IN THE OTHER
MOVEI S1,.CHLFD ;LOAD A LF
IDPB S1,T2 ;STORE IN ONE
IDPB S1,T3 ;STORE IN THE OTHER
CDRA.D: MOVE S1,L.IFN ;GET THE IFN
MOVE S2,CDRA.F ;GET POSITION OF NEXT CARD
$CALL F%POS ;AND POSITION IT
JUMPT CDRA.E ;JUMP IF OK
MOVE S1,L.IFN ;ELSE, GET THE IFN
SETO S2, ;SET EOF
$CALL F%POS ;AND SET EOF FOR NEXT TIME
CDRA.E: AOS CDRCNT ;ONE MORE!
SKIPN L.NHOL ;ANY HOLLERITH ERRORS?
JRST CDRA.I ;NO, PREPARE TO RETURN
$TEXT(LOGTXT,<^I/STERR/%SPTHOL ^D/L.NHOL/ Hollerith errors in card #^D/CDRCNT/>)
AOS DEKCRD ;GIVE THE CORRECT COUNT
SKIPE FILIFN ;ARE WE IN A DECK?
PUSHJ P,CARDID ;YES, GIVE CARD INFO
SOS DEKCRD ;BRING COUNT INTO PHASE AGAIN
PUSHJ P,LOGCRL ;IDENTIFY THE 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
$TEXT(LOGTXT,<^I/FATAL/?SPTTMH ^I/CDR.E1/>)
JSP B,PROCER
CDR.E1: ITEXT (<Too many Hollerith errors>)
CDRA.F: BLOCK 1 ;STORAGE FOR THE POSITION
CDRA.G: ANDI S2,7777 ;CHECK FIRST COLUMN OF CARD
CAXE S2,3776 ;LOOK LIKE A HEADER CARD?
JRST CDRA.H ;NO
MOVE S1,L.IFN ;YES, BUT MAKE SURE
$CALL F%IBYT
JUMPF INFAIL
ANDI S2,7777
CAXE S2,7777 ;NOW, IS IT REALLY?
JRST [AOS L.NHOL
JRST CDRA.H]
AOS TRLCRD ;BY GEORGE IT IS!
SETOM L.TFLG ;SET FLAG
JRST CDRA.D ;AND FINISH UP THIS CARD
CDRA.H: AOS L.NHOL ;COUNT HOLLERITH ERROR
MOVEI S2,CODHER ;LOAD UP STANDARD ERROR CODE
JRST CDRA.C ;AND CONTINUE PROCESSING
CDRA.I: SKIPE L.TFLG ;FLAG SET?
JRST [MOVE S1,L.DWID
MOVEM S1,L.WIDT
JRST CDRA.A]
SKIPN TRLCRD ;ANY TRAILER CARDS PASSED OVER?
POPJ P,0 ;RETURN
SKIPE FILIFN
$TEXT (LOGTXT,<^I/STSUM/^D/TRLCRD/ Header/Trailer cards ignored in file ^F/FILFD/>)
SKIPN FILIFN
$TEXT (LOGTXT,<^I/STSUM/^D/TRLCRD/ Header/Trailer cards ignored>)
POPJ P,0
CDR.SA: MOVE T2,[POINT 7,L.CASC]
MOVEI T1,1 ;SET CHARACTER COUNT
CDRA.K: PUSHJ P,CDRA.L
JUMPL S2,FINLIN ;BREAK OUT ON EOL
IDPB S2,T2
CAXE S2,40
MOVEM T1,L.CSUP
MOVEM T1,L.CLEN
CAMGE T1,L.WIDT
AOJA T1,CDRA.K
FINLIN: SKIPL LINCHK ;DID WE FIND EOL?
PUSHJ P,CDRA.N ;FLUSH REMAINDER FOR LINE
MOVEI S2,.CHCRT
IDPB S2,T2
MOVEI S2,.CHLFD
IDPB S2,T2
SETZ S2,0
IDPB S2,T2
JRST CDRA.E
CDRA.L: SETO S2,0 ;LOAD A NULL
SKIPE LINCHK ;FOUND EOL ALREADY?
$RETT ;YUP, JUST RETURN
CDRA.M: MOVE S1,L.IFN ;NO, LOAD THE FILE HANDLE
$CALL F%IBYT ;AND GET A BYTE
JUMPF INFAIL ;TOO BAD!
CAXN S2,.CHCRT ;IS IT A CARRIAGE RETURN?
JRST CDRA.M ;YES, JUST IGNORE IT
CAXE S2,.CHLFD ;HOW 'BOUT A LINEFEED?
$RETT ;NO, RETURN
SETOM LINCHK ;YES, SET EOL
JRST CDRA.L ;AND RETURN A BLANK
CDR.FA:
$WTOJ(^I/ABTSPR/,<Unsupported Recording Mode specified (^O/[EXP .FPFAS]/)>)
JRST RELJOB
MODTBL: XWD .FPFAI,CDR.AI ;AUGMENTED IMAGE
XWD .FPFSA,CDR.SA ;STREAM ASCII
XWD .FPFAS,CDR.FA ;FIXED ASCII
MODCNT==.-MODTBL ;COUNT FOR AOBJN
CDRA.N: PUSHJ P,CDRA.L ;GET THE NEXT CHARACTER
SKIPL LINCHK ;DONE?
JRST CDRA.N ;NO, LOOP
POPJ P,0 ;YES, RETURN
SUBTTL Read a card -- CDRIMG - in IMAGE
; CDRIMG -- Routine to read one card in Image mode.
;CALL:
; PUSHJ P,CDRIMG
; RETURN HERE ALWAYS
;
; ON NORMAL RETURN 'L.CASC' CONTAINS CARD IMAGE IN
; 12-BIT PACKED BYTES.
CDRIMG: $CALL .SAVET ;SAVE T1 THRU T4
MOVEI T1,CPC ;GET COLUMNS/CARD
MOVE T2,[POINT ^D12,L.CASC] ;SETUP BYTE POINTER
CDRIM1: MOVE S1,L.IFN ;GET THE IFN
$CALL F%IBYT ;GET A BYTE
JUMPF INFAIL ;IO ERROR
IDPB S1,T2 ;DEPOSIT THE BYTE
SOJG T1,CDRIM1 ;AND LOOP
MOVEI T1,IWPC ;LOAD # IMAGE WORD/CARD
MOVEM T1,L.CLEN ;STORE IN COUNT WORD
AOS CDRCNT ;ONE MORE!!
POPJ P, ;AND RETURN
SUBTTL Read a card -- CDRBIN - in Checksummed Binary
TOPS10 <
; 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.CASC'
;
; ON NORMAL RETURN BINARY IS PACKED IN 12-BIT PACKED BYTES IN
; LINE BUFFER 'L.CASC', AND L.CLEN IS SET TO WORD COUNT.
CDRBIN: MOVE S1,L.IFN ;GET THE IFN
$CALL F%IBYT ;GET COLUMN 1
JUMPF INFAIL ;???
ANDI S1,7777 ;GET RID OF AUGMENTATION
TRC S1,.IM79 ;REVERSE ROWS 7 AND 9
TRCE S1,.IM79 ;WERE THEY BOTH ON?
JRST CDRB.5 ;NOPE!!
LSH S1,-6 ;RIGHT JUSTIFY WORD COUNT
MOVEM S1,L.CLEN ;AND STORE IT
MOVE S1,L.IFN ;GET THE IFN
$CALL F%IBYT ;GET COLUMN 2
ANDI S1,7777 ;GET RID OF EXTRA STUFF
MOVEM S1,L.CCHK ;AND STORE THE CHECK SUM
MOVEI T1,^D78 ;NUMBER OF COLUMNS LEFT TO READ
MOVE T2,L.CLEN ;NUMBER OF SIGNIFICANT WORDS
IMULI T2,3 ;CONVERT TO COLUMNS
CDRB.1: MOVE S1,L.IFN ;GET THE IFN
$CALL F%IBYT ;GET A COLUMN
JUMPF INFAIL ;LOSE, I GUESS
IDPB S1,B ;DEPOSIT IT
SOJ T1, ;DECREMENT COUNT OF COLMNS
SOJG T2,CDRB.1 ;AND LOOP FOR SIGNIFICANT ONES
CDRB.2: SOJL T1,CDRB.3 ;DID WE GET ALL 80?
MOVE S1,L.IFN ;GET THE IFN
$CALL F%IBYT ;GET A COLUMN
JUMPF INFAIL ;AND LOSE
JRST CDRB.2 ;AND LOOP FOR THEM ALL
;HERE TO CHECK CHECKSUM AND RETURN
CDRB.3: AOS CDRCNT ;COUNT ANOTHER CARD
MOVN T4,L.CLEN ;GET NEG WORD COUNT
HRLZ T4,T4 ;PUT IN LEFT HALF
ADDI T4,L.CASC ;MAKE AOBJN POINTER
SETZ T3,0 ;ACCUMULATE CHECKSUM HERE
CDRB.4: ADD T3,(T4) ;ADD A WORD
AOBJN T4,CDRB.4 ;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
TXZE T3,77B23 ;
AOS T3
CAMN T3,L.CCHK ;DOES IT MATCH CHECKSUM ON CARD
POPJ P, ;YUP, RETURN
$TEXT(LOGTXT,<^I/STERR/%SPTBCK Binary checksum error in card #^D/CDRCNT/>)
PUSHJ P,CARDID ;AND CARD INFO
AOS T3,L.TCHK ;INCREMENT ERROR COUNT AND LOAD
CAMG T3,L.UCHK ;COMPARE AGAINST MAX
$RETT ;STILL LEGAL
$TEXT(LOGTXT,<^I/FATAL/?SPTTMC ^I/CDR4.E/>)
JSP B,PROCER ;AND ABORT THE JOB
CDR4.E: ITEXT (<Too many binary checksum errors>)
CDRB.5: CAIN S2,.IMDOL ;IS COLUMN 1 AN DOLLAR SIGN?
PJRST CDRB.6 ;YES, CONVERT IT
$TEXT(LOGTXT,<%SPTIBC Illegal binary card, card #^D/CDRCNT/>)
PUSHJ P,CARDID ;WHERE THE CARD IS
AOS T3,L.TIBC ;INCREMENT COUNT
CAMG T3,L.UIBC ;GREATER THAN ALLOWABLE?
PJRST CDRB.6 ;NO, JUST IGNORE CARD
$TEXT(LOGTXT,<^I/FATAL/?SPTTMB ^I/CDR5.E/>)
JSP B,PROCER ;AND DIE
CDR5.E: ITEXT (<Too many illegal binary cards>)
CDRB.6: MOVE S1,L.IFN ;BACKUP A BYTE
MOVE S1,L.IFN ;GET THE HANDLE
$CALL F%CHKP ;AND DETERMINE WHERE WE ARE
JUMPF INFAIL ;LOSE
MOVEI S2,-1(S1) ;BACK OFF BY ONE
MOVE S1,L.IFN ;DO'IT AGAIN
$CALL F%POS ;POSITION FOR REREAD OF LAST BYTE
JUMPF INFAIL ;LOSE
$RETF
>;END TOPS10
SUBTTL INFAIL - Input failure from source file
INFAIL: CAIN S1,EREOF$ ;IS IT END OF FILE?
JRST ENDJOB ;YES, GOOD-BYE
$TEXT(LOGTXT,<^I/FATAL/?SPTERI ^I/INFA.1/>)
JSP B,PROCER
INFA.1: ITEXT (<Error reading input file>)
SUBTTL FILERR - Error writing user file
FILERR: MOVE P1,S1 ;RELOCATE ERROR CODE
$TEXT(LOGTXT,<^I/FATAL/?SPTEWF ^I/FLER.1/>)
JSP B,PROCER ;
FLER.1: ITEXT (<Error writing file ^F/FILFD/, ^E/P1/>)
;HERE TO TYPE OUT "CARD 3 IN FILE FOO.BAR"
CARDID: $TEXT(LOGTXT,<^I/STERR/- Card #^D/DEKCRD/ in file ^F/FILFD/>)
POPJ P, ;AND RETURN
SUBTTL Accounting File Handlers
TOPS10 <
;***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.
/
.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
;FD FOR SYS:AUXACC.SYS
AUXFD: $BUILD FDMSIZ
$SET (.FDLEN,FD.LEN,FDMSIZ)
$SET (.FDSTR,,<SIXBIT/SYS/>)
$SET (.FDNAM,,<SIXBIT/AUXACC/>) ;FILENAME
$SET (.FDEXT,,<SIXBIT/SYS/>) ;EXTENSION
$SET (.FDPPN,,0) ;PPN
$EOB
;FD FOR SYS:ACCT.SYS
ACTFD: $BUILD (FDMSIZ) ;FD SIZE
$SET (.FDLEN,FD.LEN,FDMSIZ) ;
$SET (.FDSTR,,<SIXBIT/SYS/>)
$SET (.FDNAM,,<SIXBIT/ACCT/>) ;FILENAME
$SET (.FDEXT,,<SIXBIT/SYS/>) ;EXTENSION
$SET (.FDPPN,,0) ;PPN
$EOB
;BILDAC -- Routine to build in-core ACCT.SYS index
; and AUXACC.SYS Index.
BILDAC: PUSHJ P,LKACC ;GO CHECK FOR ACCT.SYS CHANGE
JUMPT .POPJ ;TABLES ARE CURRENT
;GET RECORD SIZE STORED IN FIRST WORD OF ACCOUNTING FILE
MOVE S1,L.AIFN ;GET ACCOUNTING IFN
SETZ S2,0 ;POINT TO FIRST WORD
$CALL F%POS ;POSITION
JUMPF ACTERR ;IN CASE IT FAILS
MOVE S1,L.AIFN ;GET OUR IFN AGAIN
$CALL F%IBYT ;GET FIRST WORD FOR ENTRY SIZE
JUMPF ACTERR ;FAILED?
HRRZM S2,L.ESIZ ;SAVE ENTRY SIZE
;ALLOCATE CORE FOR THE PARALLEL TABLES
MOVE S1,L.ASIZ ;GET THE SIZE OF THE FILE
ASH S1,2 ;DOUBLE IT (FOR AUXACC INDEX)
ADDI S1,777 ;FORCE THE DIVIDE TO ROUND UP
IDIVX S1,PAGSIZ ;CONVERT IT TO PAGES
MOVEM S1,L.ANPG ;SAVE NUMBER OF PAGES
$CALL M%AQNP ;GET THE CORE
PG2ADR S1 ;CONVERT TO AN ADDRESS
MOVEM S1,L.APAG ;SAVE THE PAGE ADDRESS
MOVEI T2,200 ;CALCULATE SIZE OF
IDIV T2,L.ESIZ ;RECORD RESIDUE (IT'S IN T3)
MOVEI T1,1 ;POINT TO FIRST PPN RECORD IN FILE
MOVE T2,L.APAG ;LOAD TABLE ADDRESS
BILD.1: MOVE S1,L.AIFN ;GET IFN FOR ACCT.SYS
MOVE S2,T2 ;CALCULATE THE BEGINNING
SUB S2,L.APAG ;BYTE POINTER FOR THE
IMULI S2,200 ;APPROPRIATE PAGE.
ADDI S2,(T1) ;ADD IN COMPUTED OFFSET
$CALL F%POS ;POSITION TO IT
MOVE S1,L.AIFN ;GET IFN AGAIN
$CALL F%IBYT ;GET PPN OF THIS RECORD
JUMPF [CAXE S1,EREOF$
JRST ACTERR
JRST BILAUX ]
SKIPN S2 ;TEST FOR NULL
MOVX S2,.INFIN ;MAKE IT A LARGE NUMBER THEN
MOVEM S2,(T2) ;STORE IN TABLE
SUB T1,T3 ;COMPUTE OFFSET FOR NEXT PAGE
SKIPGE T1 ;DON'T LET IT GO NEGATIVE THOUGH
ADD T1,L.ESIZ ;FIX IT UP IF IT DID
AOJA T2,BILD.1 ;LOOP AROUND
;FALL THRU INTO BILAUX ROUTINE
BILAUX: MOVE T2,L.APAG ;MAKE T2 POINT TO ACCT TABLE
SUBI T2,1 ;MAKE AUX AND ACT TABLES PARALLEL
MOVE T1,L.ASIZ ;GET THE SIZE OF ACCT TABLE
ADD T1,L.APAG ;MAKE T1 POINT TO AUXACC TABLE
MOVEI T4,-1(T1) ;END OF TABLE MARKER
MOVE S1,L.XIFN ;GET THE IFN
SETZB S2,P2 ;INDICATE FIRST BYTE
$CALL F%POS ;AND POSITION
BILAU0: PUSHJ P,AUXSCN ;GET NEXT AUXACC ENTRY
BILAU1: MOVEM P2,(T1) ;SAVE BYTE POINTER
AOS T2 ;INCREMENT ACCT INDEX
CAML T2,T4 ;DONE?
$RETT ;YUP
BILAU2: CAML T2,L.APAG ;DON'T DO COMPARE IF FIRST ENTRY
CAML S2,(T2) ;AUXACC ENTRY .LT. ACCT?
AOJA T1,BILAU1 ;NO, INCREMENT AUXACC PTR
BILAU3: MOVEM P2,(T1) ;SAVE BYTE POINTER IN AUXACC TABLE
PUSHJ P,AUXSCN ;GET NEXT AUXACC ENTRY
SKIPT
MOVX S2,.INFIN ;MAKE IT A LARGE PPN
JRST BILAU2 ;AND REENTER LOOP
COMMENT \
AUXSCN - Routine to scan for the beginning of an entry. First word of
each entry contains a -1. On return P1 = count of STR words
following. The PPN is returned in S2. P2 contains the relative file
byte position of this AUXACC entry. Note, it always points to the
[-1] word.
\
AUXSCN: MOVE S1,L.XIFN ;GET OUR IFN
$CALL F%IBYT ;GET THE NEXT WORD
JUMPF AUXERR ;ERROR
CAME S2,[-1] ;BEGINNING OF NEXT ENTRY?
JRST AUXSCN ;NO, KEEP GOIN'
MOVE S1,L.XIFN ;GET THE IFN
$CALL F%CHKP ;DETERMINE OUR POSITION
MOVEI P2,-1(S1) ;POINT TO THE [-1]
MOVE S1,L.XIFN ;GET OUR IFN AGAIN
$CALL F%IBYT ;GET THE SIZE
MOVE P1,S2 ;RELOCATE IT
MOVE S1,L.XIFN ;THE IFN
$CALL F%IBYT ;GET THE PPN
JUMPF AUXERR ;FALSE RETURN ALWAYS AN ERROR
$RETT
;LKACC -- Routine to determine whether ACCT.SYS has changed
;CALL:
; PUSHJ P,LKACC
; Returns FALSE if table must be rebuilt else TRUE
LKACC: MOVEI P1,1 ;PREPARE AN INDEX
SKIPL L.AIFN ;FIRST TIME THRU?
JRST LKAC.2 ;NO, SEE IF INCORE TABLES VALID
;Here to reopen accounting files and rebuild the in-core
;indeces
LKAC.1: MOVE S1,[EXP AUXFD
EXP ACTFD](P1) ;POINT TO PROPER FD
PUSHJ P,ACTOPN ;AND OPEN THE FILE
MOVEM S1,@[L.XIFN
L.AIFN](P1) ;SAVE THE IFN
MOVX S2,FI.CRE ;GET THE CREATION DATE
$CALL F%INFO ;..
MOVEM S1,@[L.XDAT
L.ADAT](P1) ;SAVE IT
SOJGE P1,LKAC.1 ;LOOP FOR BOTH FILES
MOVE S1,L.AIFN ;DETERMINE SIZE OF ACCT.SYS
MOVX S2,FI.SIZ
$CALL F%INFO ;
IDIVI S1,200
SKIPE S2 ;ROUND UP
AOS S1 ;..
MOVEM S1,L.ASIZ ;SAVE IT
MOVE T1,[XWD L.PPTB,L.PPTB+1] ;ZERO REMEMBERED
SETZM L.PPTB ;ENTRIES
BLT T1,L.PPTB+NPPNRM-1 ;..
$RETF
;HERE TO DETERMINE IF IN-CORE TABLES ARE VALID
LKAC.2: JUMPL P1,.RETT ;WE'RE DONE
MOVE S1,[EXP AUXFD
EXP ACTFD](P1) ;OPEN FILE ON TMP CHANNEL
PUSHJ P,ACTOPN ;..
MOVE P2,S1 ;RELOCATE IFN FOR LATER
MOVX S2,FI.CRE ;GET THE CREATION DATE
$CALL F%INFO ;..
EXCH S1,P2 ;XCHANGE AC'S FOR RELEASE
PUSHJ P,F%RREL ;RELEASE TMP CHANNEL
CAMN P2,@[EXP L.XDAT
EXP L.ADAT](P1) ;INCORE INDECES VALID?
SOJA P1,LKAC.2 ;LOOP FOR BOTH FILES
MOVEI P1,1 ;SETUP INDEX
JRST LKAC.1 ;REBUILD INDECES
COMMENT \
Routine to open either of the accounting files for input.
The data mode is binary and any failures stopcode.
\
ACTOPN: PUSH P,S1 ;SAVE ADDRESS OF THE FD
PUSHJ P,CLRFOB ;ZERO THE FOB BLOCK
POP P,S1 ;RESTORE ADR OF FD
STORE S1,L.FOB+FOB.FD ;SAVE IT IN THE FOB
MOVEI S1,^D36 ;LOAD THE BYTE SIZE
STORE S1,L.FOB+FOB.CW,FB.BSZ ;STORE IT
MOVX S1,FOB.MZ ;SIZE OF THE FOB
MOVEI S2,L.FOB ;STORE IT
$CALL F%IOPN ;OPEN THE FILE
JUMPT .RETT ;RETURN ON SUCCESSFUL OPEN
JRST NOACCT ;GO STOPCODE
COMMENT %
SRHACC -- Routine to search ACCT.SYS for a PPN. Call SRHACC
with the PPN in .EQOID. If the entry is found, S1 contains the
index into the cache.
Call:
PUSHJ P,SRHACC
Return here if entry not found
Return here otherwise
%
SRHACC: PUSHJ P,BILDAC ;GO BUILD AN INDEX IF NECESSARY
MOVE T1,.EQOID(Q) ;GET THE PPN
TRNE T1,1B18 ;IS IT A WILDCARD PPN?
HRRI T1,-2 ;YES, USE STANDARD FLAG (P,,-2)
MOVSI S1,-NPPNRM ;SETUP AOBJN POINTER
CAMN T1,L.PPTB(S1) ;START COMPARING DOWN THE TABLE
JRST [TLZ S1,-1
$RETT ] ;A MATCH!
AOBJN S1,.-2 ;KEEP LOOPING
MOVN T2,L.ASIZ ;GET SIZE OF ACCT.SYS
HRLZS T2 ;PUT IN LH FOR AOBJN POINTER
HRR T2,L.APAG ;AND LOAD START ADDRESS OF TABLE
SRHA.1: CAMGE T1,(T2) ;LOOK FOR A BIGGER ENTRY
JRST SRHA.2 ;FOUND ONE THAT'S BIGGER
AOBJN T2,SRHA.1 ;LOOP FOR ENTIRE TABLE
SRHA.2: MOVEI T2,(T2) ;ISOLATE ADDRESS PORTION
SUB T2,L.APAG ;CONVERT TO RELATIVE INDEX
SUBI T2,1 ;ADJUST FOR RELATIVE BYTE
HRRZM T2,CSHIDX ;SAVE IT AWAY
HRRZ T3,T2 ;TAKE A COPY
IMULI T2,200 ;COMPUTE BYTE NUMBER
ASH T3,7 ;GET NUMBER OF WORDS BEFORE THIS BLOCK
IDIV T3,L.ESIZ ;DIVIDE BY ENTRY SIZE
SUBI T4,1 ;ALLOW FOR THE FORMAT WORD
MOVNS T4 ;AND NEGATE
SKIPGE T4 ;MAKE SURE IT'S POSITVIVE
ADD T4,L.ESIZ ;IT IS NOW!
SRHA.4: MOVE S1,L.AIFN ;GET OUR FILE HANDLE
HRRZ S2,T2 ;CALCULATE BYTE POSITION
ADDI S2,(T4) ;OF NEXT RECORD
$CALL F%POS ;AND CAUSE POSITIONING TO HAPPEN
JUMPF ACTERR ;BOO!
MOVE S1,L.AIFN ;GET OUR IFN AGAIN.........
$CALL F%IBYT ;AND JUMP ON THE NEXT BYTE
JUMPF ACTERR
CAMN S2,T1 ;THIS THE ONE WE'RE LOOKIN' FOR?
JRST SRHA.5 ;SURE IS
ADD T4,L.ESIZ ;STEP TO THE NEXT
CAIG T4,177 ;AND MAKE SURE WE DON'T JUMP THE BLOCK BOUNDARY
JRST SRHA.4 ;JUMP
$RETF ;FALL OVER!
SRHA.5: ADDI T2,(T4) ;POINT TO CURRENT RECORD
MOVSI T4,-SRHATX ;OUTER LOOP CONTROL
JRST SRHA.7 ;SAVE THE PPN WE'VE GOT
SRHA.6: MOVE S1,L.AIFN ;GET THE IFN
HLRZ S2,SRHATB(T4)
ADDI S2,(T2) ;COMPUTE RELATIVE BYTE POSITION
$CALL F%POS ;AND POSITION TO IT
JUMPF ACTERR ;BLAH!
MOVE S1,L.AIFN ;THE INFAMOUS IFN AGAIN
$CALL F%IBYT ;GET THE BYTE
JUMPF ACTERR ;OR AT LEAST TRY
SRHA.7: HRRZ S1,SRHATB(T4) ;GET STORAGE ADDRESS
ADD S1,L.RPRG ;COMPUTE WHERE TO STORE DATUM
MOVEM S2,(S1) ;AND STORE IT AWAY
AOBJN T4,SRHA.6 ;LOOP APPROPRIATELY
MOVE S1,L.RPRG ;LOAD CURRENT REPLACEMENT INDEX
SETZM L.AUTB(S1) ;CLEAR AUXACC POINTER
$RETT ;AND RETURN TO SEQUENCE
;NOTE THAT THIS TABLE SHOULD NOT BE CHANGED AS TO ORDER
;AND POSITION OF .A2PPN ENTRY.
SRHATB: XWD .A2PPN,L.PPTB ;PPN
XWD .A2PSW,L.PSTB ;PASSWORD
XWD .A2NAM,L.UNTB ;FIRST HALF OF NAME
XWD .A2NAM+1,L.U2TB ;SECOND HALF
XWD .A2PRF,L.PRTB ;PROFILE
SRHATX==.-SRHATB ;SIZE OF TABLE
COMMENT \
SRHAUX -- Routine to search AUXACC.SYS. Starts searching at
word specified by in-core index. Returns "TRUE" if entry
found, with the second word .AUNUM in P1 and next call to
RDAUX will get first STR name.
Enter with S1=Replacement register index.
Caution: The loops in this routine are strangely nested, read
it slowly.
\
SRHAUX: MOVE P3,S1 ;SAVE REPL. REG. FOR LATER
SKIPE T1,L.AUTB(S1) ;IS THIS A WINNER?
JRST SRHU.1 ;YUP, WE'VE GOT ALL WE NEED
MOVE T1,CSHIDX ;GET SAVED INDEX INTO TABLE
ADD T1,L.APAG ;GET THE APPROPRIATE
ADD T1,L.ASIZ ;AUXACC
MOVE T1,(T1) ;ENTRY.
SRHU.1: MOVE S1,L.XIFN ;POSITION TO THE
HRRZ S2,T1 ;APPROPRIATE BYTE
$CALL F%POS ;
JUMPF AUXERR
MOVE T2,.EQOID(Q) ;GET USER'S PPN
TRNE T2,1B18 ;FUNNY NUMBER?
HRRI T2,777776 ;YES, GET STANDARD FLAG FOR IT
JRST SRHU.3 ;AND JUMP INTO THE LOOP
SRHU.2: HLRZ T3,S2 ;GET ENTRIES PROJ # IN T3
HLRZ T1,T2 ;GET USER'S PROJ # IN T1
CAMN T1,T3 ;ARE THEY THE SAME PROJECT?
JRST SRHU.4 ;YES, CHECK IT OUT
CAMG T1,T3 ;NO, IT USER'S BIGGER?
$RETF ;NO, USER'S IS SMALLER, ENTRY IS
; NOT THERE.
SRHU.3: PUSHJ P,AUXSCN ;GET THE NEXT ENTRY
MOVEM P2,L.AUTB(P3) ;SAVE THE AUXACC POINTER
JUMPF .RETF ;EOF, NO ENTRY!!
CAMN S2,T2 ;EXACT MATCH?
PJRST SRHU.6 ;YES, HOW LUCKY
JRST SRHU.2 ;NO, LOOP TILL WE GET THERE
SRHU.4: TRC S2,-1 ;TRICK THE PROG NUMBER
TRCN S2,-1 ;TRICK BACK AGAIN
PJRST SRHU.6 ;ALL 1'S IS WILDCARD, RETURN
JRST SRHU.3 ;AND LOOP
SRHU.6: MOVE S1,.EQOID(Q) ;GET REAL PPN
TRNE S1,1B18 ;FUNNY NUMBER?
HRRI S1,-2 ;YES
MOVE S2,L.RPRG ;GET REPL REG AGAIN
CAME S1,L.PPTB(S2) ;
$RETT ;
;Routine to increment the replacement register
AOS T1,L.RPRG ;INCREMENT AND LOAD
IDIVI T1,NPPNRM ;DIVIDE BY MAX
MOVEM T2,L.RPRG ;STORE RESULT MOD NPPNRM
$RETT ;AND SKIP BACK
COMMENT %
MAKSL -- Routine To Generate a Search List Call with RDAUX
ready to read user's first structure name and P1 containing
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.
%
MAKSL: $CALL .SAVE1 ;SAVE P1
MOVEI P3,L.SL2+1 ;WHERE TO START STORING ARGS
MOVE S2,P1 ;COPY WORD COUNT INTO S2
IDIVI S2,.UBKS ;CONVERT TO # STRS
MOVE T4,S2 ;A COUNTER
MOVE T3,S2 ;LATER ARGUMENT TO STRUUO
MAKS.1: MOVE S1,L.XIFN ;GET THE IFN
$CALL F%IBYT ;GET THE STRUCTURE NAME
JUMPF AUXERR
MOVEM S2,(P3) ;STORE STRUCTURE NAME
SETZM 1(P3) ;2ND WORD OF TRIPLET IS 0
PUSH P,P3 ;SAVE P3
PUSHJ P,MAKPTH ;MAKE UFD AND SFD
POP P,P3 ;RESTORE P3
JUMPF MAKS.3 ;MAKPTH SAYS DON'T USE THIS ONE
MOVE S1,L.XIFN ;GET THE IFN
$CALL F%IBYT ;GET THE STATUS BITS
JUMPF AUXERR
MOVEM S2,2(P3) ;STORE THEM
MAKS.2: ADDI P3,3 ;POINT TO NEXT ENTRY
SKIPA
MAKS.3: SOS T3 ;ONE LESS FOR STRUUO
SOJG T4,MAKS.1 ;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,.EQPAT(Q) ;SETUP TO BLT THE PATH
BLT T2,SLLEN+.PTPPN+5(T1) ;BLT THE FULL PATH
MOVX T2,.PTSCN ;/NOSCAN
MOVEM T2,L.SL2+SLLEN+.PTSWT ;STORE SWITCH
PJRST SETSRC ;SET THE S/L, PATH AND RETURN
SUBTTL MAKPTH -- Routine to create UFD and SFD on a STR.
COMMENT \
MAKPTH -- Routine to create UFD and SFD on a STR. Call with S2
containing structure name.
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: MOVE P1,[ELBLOK,,ELBLOK+1]
SETZM ELBLOK ;CLEAR THE FIRST WORD
BLT P1,ELBLOK+.RBAUT ;CLEAR THE WHOLE UUO BLOCK
MOVX P1,.IODMP ;USE DUMP MODE
MOVE P2,S2 ;GET STR NAME
MOVEM P2,L.UFIN+1 ;SAVE FOR STRUUO TO LOCK UFD
SETZ P3,0 ;NO BUFFERS
OPEN UFD,P1 ;OPEN THE CHANNEL
JRST MAKP.5 ;CAN'T DO IT
MOVEI P1,.RBAUT ;START SETTING UP UUOBLK
MOVEM P1,ELBLOK ;FIRST WORD
MOVE P1,.EQOID(Q) ;HIS PPN IS FILENAME
MOVEM P1,ELBLOK+.RBNAM ;STORE IT
MOVEM P1,L.UFIN+2 ;SAVE FOR STRUUO TO LOCK UFD
MOVSI P1,'UFD'
MOVEM P1,ELBLOK+.RBEXT ;STORE EXTENSION
MOVE P1,L.MFPP ;PUT IT IN MFDPPN
MOVEM P1,ELBLOK+.RBPPN
MOVE S1,L.XIFN ;GET THE IFN
$CALL F%IBYT ;READ AND IGNORE RSVD QUOTA
JUMPF AUXERR ;ERROR
MOVE S1,L.XIFN ;GET THE IFN
$CALL F%IBYT ;READ THE FCFS QUOTA
JUMPF AUXERR ;ERROR
MOVEM S2,ELBLOK+.RBQTF ;AND STORE IT
MOVE S1,L.XIFN ;IFN
$CALL F%IBYT ;READ THE LOG-OUT QUOTA
JUMPF AUXERR ;ERROR
MOVEM S2,ELBLOK+.RBQTO ;STORE THAT
MOVX S2,RP.DIR ;GET DIRECTORY BIT
MOVEM S2,ELBLOK+.RBSTS ;SAVE AS FILE STATUS
SKIPN ELBLOK+.RBQTF ;NO LOGGED IN QUOTA?
JRST MAKP.4 ;YES, THEN DON'T MAKE A UFD
SKIPN P1,.EQPAT+1(Q) ;GET SFD NAME FOR LATER
JRST MAKP.1 ;NO PATH
MOVSI P2,'SFD' ;THE EXTENSION
SETZ P3,0
MOVE P4,.EQOID(Q) ;AND USER'S PPN
MAKP.1: PUSHJ P,SETUFL ;SET THE UFD INTERLOCK
LOOKUP UFD,ELBLOK ;LOOKUP THE UFD
JRST MAKP.2 ;IT'S NOT THERE! GO ENTER IT
JRST MAKP.3 ;ITS THERE, GO MAKE AN SFD
MAKP.2: ENTER UFD,ELBLOK ;ENTER THE UFD
JRST MAKP.3 ;MAYBE ITS THERE!, GO TRY FOR SFD
USETO UFD,2 ;MAKE 1 BLOCK
MAKP.3: CLOSE UFD, ;CLOSE UFD OFF
JUMPE P1,MAKP.4 ;[1052] RETURN IF NO SFD
ENTER UFD,P1 ;ENTER THE SFD
JFCL ;DON'T WORRY NOW
MAKP.4: RELEASE UFD, ;[1052] RELEASE CHANNEL
$RETT ;AND RETURN
MAKP.5: MOVEI P1,.UBKS-1 ;SETUP TO READ THE REST OF THE ENTRY
MAKP.6: MOVE S1,L.XIFN ;IFN
$CALL F%IBYT ;READ THE WORD
JUMPF AUXERR ;ERROR
SOJG P1,MAKP.6 ;AND LOOP
$RETF ;AND RETURN
SUBTTL SETUFL -- Routine to set UFD interlock
COMMENT \
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: MOVX T1,.FSULK ;LOCK CODE
MOVEM T1,L.UFIN ;STORE IN STRUUO BLOCK
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: POP P,T1 ;LOAD RETURN ADDRESS
PUSHJ P,(T1) ;CALL HIM BACK
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: MOVX T1,.FSUCL ;UNLOCK CODE
MOVEM T1,L.UFIN ;STORE IT
MOVE T2,[3,,L.UFIN]
STRUUO T2, ;DO THE UUO
$STOP(CCI,Cant clear UFD Interlock)
POPJ P,0 ;OK, RETURN
SUBTTL DOACCT - Do all job accounting
COMMENT \
DOACCT -- Routine to setup and do all the accounting for a
job. Call with the PPN in .EQOID. Does all the ACCT.SYS and
AUXACC stuff, checks the Password, and sets the Search-List.
\
DOACCT: MOVE T1,.EQOID(Q) ;GET THE PPN
MOVEM T1,.EQPAT(Q) ;STORE IN PATH BLOCK
GETLIM T2,.EQLIM(Q),UNIQ ;GET THE UNIQUENESS
SETZ S1,0 ;FOR PATCH SPEC.
CAXE T2,%EQUYE ;UNIQUE SFD?
JRST DO10.A ;NO, CONTINUE
PUSHJ P,FUNNY ;MAKE A FUNNY NAME
TLO S1,'SF ' ;AND MAKE AN OBVIOUS NAME
DO10.A: MOVEM S1,.EQPAT+1(Q) ;AND STORE IN THE PATH BLOCK
PUSHJ P,SRHACC ;SEARCH FOR THE PPN
JUMPF DO10E1 ;IT'S NOT THERE!!
HRRZ P1,S1 ;RELOCATE THE INDEX
MOVE T1,L.PRTB(P1) ;GET THE PROFILE WORD
TXNN T1,A2.BTC ;CAN IT LOGIN AS BATCH JOB?
PJRST DO10E3 ;GUESS NOT!!
TXNN T1,A2.BPS ;DOES IT NEED A PASSWORD?
JRST DO10.F ;NO, CONTINUE
PUSHJ P,CDRASC ;YES, GET A CARD
MOVE B,L.DHOL ;GET THE HOLLERITH BP
ILDB T1,B ;GET THE FIRST CHARACTER
CAIE T1,"$" ;IS IT A $?
JRST PSWCTL ;NO, LOSE
MOVEI S1,L.TNAM ;POINT TO BLOCK
PUSHJ P,S$ASCZ ;COPY THE STRING
SKIPN L.TNAM ;TEST FOR NULL ARG
JRST DO10.B ;IT IS
MOVEI S1,[XWD 1,1
TB(PASSWORD,0)]
HRROI S2,L.TNAM ;POINT TO ARG
$CALL S%TBLK
TXNN S2,TL%NOM!TL%AMB ;MATCH?
JRST DO10.C ;YUP
DO10.B: MOVE T1,L.PPN ;GET SPECIFIED PPN
CAMN T1,L.EQCP+.EQOID ;SAME AS SUBMITTER?
JRST DO10.F ;SURE IS!
JRST DOAC.6 ;NOPE, BLOW IT OUT
DO10.C: $TEXT(LOGTXT,<^I/STCRD/$PASSWORD>)
SETZ T1,0 ;CLEAR FOR RESULT
MOVE T3,[POINT 6,T1] ;POINTER FOR RESULT
DO10.D: ILDB C,B ;LOOP FOR PASSWORD, GET A CHAR
SUBI C,40 ;CONVERT TO SIXBIT
SKIPGE C ;WAS IT A CONTROL CHAR?
JRST DO10.E ;YES, STOP LOOPING
IDPB C,T3 ;DEPOSIT A CHAR
TXNE T3,77B5 ;GOT SIX CHARACTERS?
JRST DO10.D ;NO, LOOP SOME MORE
DO10.E: CAME T1,L.PSTB(P1) ;SEE IF A GOOD PASSWORD
PJRST DOAC.6 ;LOSE!!
DO10.F: MOVE T1,L.PRTB(P1) ;GET THE PROFILE WORD
TXNN T1,A2.BNM ;NAME REQURED FOR BATCH?
JRST DO10.G ;NO, CONTINUE
SKIPN L.UNTB(P1) ;YES, SEE IF ACCT ENTRY IS ZERO
SKIPE L.U2TB(P1) ;CHECK SECOND WORD
SKIPA ;NON-ZERO
JRST DO10.H ;ZERO!!, DON'T CHECK
MOVE T1,.EQOWN(Q) ;GET FIRST HALF GIVEN
CAME T1,L.UNTB(P1) ;MATCH?
PJRST DO10E5 ;NO, ERROR
MOVE T1,.EQOWN+1(Q) ;GET SECOND HALF
CAME T1,L.U2TB(P1) ;MATCH??
PJRST DO10E5 ;NO!
JRST DO10.H ;ITS OK!!
DO10.G: SKIPE .EQOWN(Q) ;DID HE SPECIFY NAME SWITCH?
JRST DO10.H ;YES, DON'T PUT IN OFFICIAL NAME
MOVE T1,L.UNTB(P1) ;GET FIRST HALF
MOVEM T1,.EQOWN(Q) ;STORE IT
MOVE T1,L.U2TB(P1) ;GET SECOND HALF
MOVEM T1,.EQOWN+1(Q) ;AND STORE IT
DO10.H: SKIPN .EQACT(Q) ;ANY ACCOUNT STRING SPECIFIED?
JRST DO10.J ;NO, SKIP THIS TEST ENTIRELY
$CALL M%GPAG ;GET A PAGE
MOVE S2,S1 ;RELOCATE ADDRESS
MOVX S1,UGVAL$ ;VALIDATION CODE
STORE S1,UV$TYP(S2) ;STORE AS MESSAGE TYPE
ZERO UV$ACK(S2) ;FOR NOW CLEAR ACKNOWLEDGEMENT CODE
MOVE S1,L.PPN ;GET PPN FOR USER
STORE S1,UV$PPN(S2) ;STORE IN VALIDATION MESSAGE
HRLI T1,.EQACT(Q) ;RELOCATE SPECIFIED
HRRI T1,UV$ACT(S2) ; ACCOUNT STRING
BLT T1,UV$ACE-1(S2) ;..
ZERO UV$ACE(S2) ;TERMINATE THE MESSAGE WITH NULL
MOVX S1,PAGSIZ ;GET THE SIZE
PUSHJ P,SNDACD ;SEND TO ACTDAE
DO10.I: $CALL C%BRCV ;WAIT FOR AN ANSWER
LOAD T1,MDB.SP(S1) ;GET SENDER'S PID
LOAD T2,MDB.MS(S1),MD.ADR ;GET ADDRESS OF MESSAGE
LOAD T2,UC$RES(T2) ;GET THE ANSWER
CALL C%REL ;RELEASE THE MESSAGE
CAME T1,L.SAB+SAB.PD ;IS IT FROM ACTDAE?
JRST DO10.I ;NO, IGNORE IT
CAXE T2,UGTRU$ ;TRUE?
JRST DOAC.5 ;FAIL
DO10.J: $TEXT(LOGTXT,<^I/STMSG/[SPTBJD Batch job's directory is [^A>)
$TEXT(LOGTXT,<^O/.EQPAT(Q),LHMASK/,^O/.EQPAT(Q),RHMASK/^A>)
SKIPE .EQPAT+1(Q) ;ARE THERE ANY?
$TEXT(LOGTXT,<,^W/.EQPAT+1(Q)/>)
$TEXT(LOGTXT,<]>)
PUSHJ P,CDRASC ;READ NEXT CARD
MOVX T1,.FSDSL ;STRUUO CODE
SETOB T2,T3 ;MY JOB, MY PPN
MOVX T4,DF.SRM ;DELETE ALL STRUCTURES
MOVE S1,[4,,T1] ;ARG TO STRUUO
STRUUO S1,0 ;ZAP THE S/L
JFCL ;CAN'T SAY WE DIDN'T TRY!
MOVE S1,P1 ;LOAD REPL. REG.
PUSHJ P,SRHAUX ;GET SEARCH AUXACC
JUMPT MAKSL ;MAKE SEARCH LIST AND UFD'S
$TEXT(LOGTXT,<^I/STERR/%SPTNAU No AUXACC entry>)
POPJ P, ;AND RETURN
SNDACD: STORE S1,L.SAB+SAB.LN ;STORE THE LENGTH
STORE S2,L.SAB+SAB.MS ;AND THE ADDRESS
MOVX S1,%SIACT ;GET ACCOUNTING
GETTAB S1,0 ;DAEMON'S PID
HALT
STORE S1,L.SAB+SAB.PD ;STORE IT
ZERO L.SAB+SAB.SI
MOVEI S1,SPTPIB ;POINT TO THE PIB
STORE S1,L.SAB+SAB.PB ;STORE IT IN THE SAB
MOVX S1,SAB.SZ
MOVEI S2,L.SAB
$CALL C%SEND ;SEND MESSAGE TO ACTDAE
JUMPT .RETT
$STOP (ASF,ACTDAE Send Failed)
DO10E1: $TEXT(LOGTXT,<^I/FATAL/?SPTIPN ^I/DO10E2/>)
JSP B,ACTCER ;AND DIE
DO10E2: ITEXT (<Invalid directory specification - ^U/.EQOID(Q)/ on Job card>)
DO10E3: $TEXT(LOGTXT,<^I/FATAL/?SPTPNB ^I/DO10E4/>)
JSP B,ACTCER ;
DO10E4: ITEXT (<Specified PPN may not run BATCH jobs>)
DO10E5: $TEXT(LOGTXT,<^I/FATAL/?SPTIUN ^I/DO10E6/>)
JSP B,JOBCER ;
DO10E6: ITEXT (<Illegal or missing User Name>)
SUBTTL Error traps for accounting routines
NOACCT: $STOP(CRA,Cant read accounting files)
ACTERR:
$WTOJ(^I/ABTSPR/,<Error Reading System Accounting Files^M^JError was ^E/[-1]/, File was ^F/ACTFD/>,WTOOBJ)
ACTSTP: $STOP(ERA,Error reading accounting files)
AUXERR: $WTOJ(^I/ABTSPR/,<Error Reading System Accounting Files^M^JError was ^E/[-1]/, File was ^F/AUXFD/>,WTOOBJ)
JRST ACTSTP
BADFOR: $STOP(BFA,Bad format in accounting files)
PSWCTL: $TEXT (LOGTXT,<^I/STERR/ ^I/PSWC.1/>)
JSP B,CTLCER ;ABORT
PSWC.1: ITEXT (<Card following $JOB card not a control card>)
>;END TOPS10 (FROM WAY-WAY BACK)
TOPS20 <
COMMENT \
DOACCT -- Routine to setup and do all accounting for a job.
Call with User name string in L.UNAM.
\
DOACCT: MOVX S1,RC%EMO ;EXACT MATCH ONLY
HRROI S2,.EQOWN(Q) ;POINT TO STRING
RCUSR ;CONVERT IT
TXNE S1,RC%NOM ;MATCH?
JRST DOAC.3 ;NO, TELL HIM
SETOM JIBFLG ;SAY JIB IS VALID
MOVEM T1,L.USNO ;SAVE RETURNED INFO
MOVEM T1,.EQOID(Q) ;SAVE THE OWNER ID
MOVE S1,[POINT 7,L.UDIR] ;LOAD A BYTE POINTER
MOVEM S1,L.BP ;STORE IT
$TEXT(DEPBP,<PS:^7/[74]/^T/.EQOWN(Q)/^7/[76]/^0>)
PUSHJ P,CDRASC ;GET THE NEXT CARD
MOVE B,L.DHOL ;GET THE HOLLERITH BP
ILDB T1,B ;GET THE FIRST CHARACTER
CAIE T1,"$" ;IS IT A $?
JRST MAIN.3 ;NO, LOSE
MOVEI S1,L.TNAM ;POINT TO BLOCK
PUSHJ P,S$ASCZ ;TAKE A COPY
SKIPN L.TNAM ;TEST FOR NULL ARGUMENT RETURN
JRST DOAC.2 ;CONTINUE VALIDATION
MOVEI S1,[XWD 1,1
TB(PASSWORD,0)]
HRROI S2,L.TNAM ;POINT TO KEYWORD
$CALL S%TBLK
TXNE S2,TL%NOM!TL%AMB ;MATCH?
JRST DOAC.2 ;NO
$TEXT(LOGTXT,<^I/STCRD/$PASSWORD>)
MOVEI S1,L.UPSW ;POINT TO A BLOCK
PUSHJ P,S$ASCZ ;AND GET THE STRING
PUSHJ P,CDRASC ;ALWAYS READ THE NEXT CARD
DOAC.1: MOVX S1,RC%EMO ;EXACT MATCH
HRROI S2,L.UDIR ;POINT TO THE STRING
RCDIR ;GET DIRECTORY NUMBER
TXNE S1,RC%NOM ;BETTER BE A MATCH!!
JRST DOAC.3 ;NO??
MOVE S1,T1 ;COPY DIR NO INTO S1
MOVEI S2,L.UDIN ;POINT TO GTDIR BLOCK
HRROI T1,.EQACT(Q) ;
SKIPN .EQACT(Q) ;
MOVEM T1,L.UDIN+.CDDAC ;
MOVEI T1,.CDDAC+1 ;
MOVEM T1,L.UDIN+.CDLEN ;
HRROI T1,L.DPSW ;AND PLACE TO STORE PSW
GTDIR ;GET DIRECTORY INFO
ERJMP DOAC.3 ;LOSE?
MOVE S1,[XWD L.DPSW,L.UPSW] ;SET UP TO TRANSFER
SKIPE NOPSW ;PASSWORD IF FLAG SET
BLT S1,L.UPSW+7 ;ITs SET
HRROI S1,L.UPSW ;POINT TO USER STRING
HRROI S2,L.DPSW ;POINT TO CORRECT ONE
$CALL S%SCMP ;STRING COMPARE ROUTINE
JUMPN S1,DOAC.6 ;JUMP IF NO MATCH
MOVE S1,L.USNO
HRROI S2,.EQACT(Q) ;
SKIPE .EQACT(Q) ;
VACCT ;
ERJMP DOAC.5 ;
$RET ;RETURN
DOAC.2: SKIPE CDRDEV ;PHYSICAL READER?
JRST MSGIMP ;GENERATE AN ERROR
HRROI S1,L.EQCP+.EQOWN ;COMPARE DIRECTORIES
HRROI S2,.EQOWN(Q) ;..
PUSHJ P,S%SCMP ;..
JUMPN S1,MSGIMP ;JUMP IF DIFFERENT
SETOM NOPSW ;SET PASSWORD FLAG
JRST DOAC.1 ;BACK INTO PHASE
DOAC.3: $TEXT(LOGTXT,<^I/FATAL/?SPTUUN ^I/DOA.3A/>)
JSP B,JOBCER
DOA.3A: ITEXT (<Unrecognized User Name "^T/.EQOWN(Q)/" on the $JOB card>)
>;END TO TOPS20 CONDITIONAL ASSEMBLY
MSGIMP: $TEXT(LOGTXT,<^I/FATAL/?SPTIMP ^I/DOA.4A/>)
JSP B,ACTCER ;
DOA.4A: ITEXT (<Incorrect or missing Password card>)
DOAC.5: $TEXT(LOGTXT,<^I/FATAL/?SPTIAS ^I/DOA.5A/>)
JSP B,ACTCER ;
DOA.5A: ITEXT (<Illegal Account String "^T/.EQACT(Q)/">)
DOAC.6: $TEXT(LOGTXT,<^I/FATAL/?SPTIMP ^I/DOA.4A/>)
JSP B,PSWCER ;
DOA.6A: ITEXT (<Specified password incorrect for user>)
SUBTTL Routines to SET and GET Search-List
TOPS10 <
COMMENT \
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! !
; !=====================================!
;--
;GETSRC -- Routine to return current search list
GETSRC: PUSH P,T1 ;SAVE ADDRESS OF BLOCK
AOS T1 ;SKIP OVER FIRST WORD FOR COUNT
SETZ T3,0 ;CLEAR TO COUNT STRS
SETOM (T1) ;CLEAR TO GET FIRST STR
JRST GETS.2 ;AND JUMP INTO LOOP
GETS.1: 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
GETS.2: MOVSI T2,3 ;3 WORD ARGUMENT
HRRI T2,(T1) ;STARTING THERE
JOBSTR T2, ;DO IT,
JRST GETS.4 ;LOSE BIG!!
SKIPN T2,(T1) ;GET THE ANSWER
JRST GETS.3 ;ZERO MEANS WE'RE DONE
AOJE T2,GETS.3 ;SO DOES -1
AOJA T3,GETS.1 ;ELSE LOOP AROUND
GETS.3: POP P,T1 ;RESTORE T1
MOVEM T3,(T1) ;SAVE STR COUNT
MOVEI T1,SLLEN(T1) ;POINT TO PATH BLOCK
MOVX 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
GETS.4: $STOP(CRS,Cant read searchlist)
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
MOVX 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
JRST SETSR1 ;LOSE BIG!!
POP P,(T1) ;RESTORE FIRST WORD OF BLOCK
MOVEI T1,SLLEN(T1) ;GET POINTER TO PATH BLOCK
MOVX T2,.PTFSD ;FUNC TO SET PATH
MOVEM T2,.PTFCN(T1) ;STORE IT
HRLI T1,PTLEN ;PUT THE LENGTH IN
PATH. T1, ;SET THE PATH
SETSR1: $STOP(CSS,Cant set searchlist)
POPJ P, ;AND RETURN
>;END TOPS10
SUBTTL QUASAR CREATE -- QUEJOB - Create batch entry
QUEJOB: TXZN F,F.BTCH ;IS THE BATCH BIT SET?
JRST QUEJ.1 ;NO, JUST PRINT THE LOG FILE
GETLIM S1,L.EQCP+.EQLIM,CNOD ;GET READER STATION NAME
SKIPE CDRDEV ;PHYSICAL READER INPUT
STOLIM S1,.EQLIM(Q),ONOD ;THEN MAKE IT THE DESTINATION NODE ALSO
TOPS20<
MOVE S1,[POINT 7,.EQCON(Q)] ;FILL OUT CONNECTED DIRECTORY
MOVEM S1,L.BP ;..
$TEXT (DEPBP,<PS:^7/[74]/^T/.EQOWN(Q)/^7/[76]/^0>)
>
$TEXT(LOGTXT,<^I/STSUM/Batch job submitted>)
MOVE S1,CTLIFN ;GET THE CONTROL FILE IFN
MOVEI S2,EQXSIZ(Q) ;AND WHERE TO PUT IT
PUSHJ P,INCFIL ;INCLUDE IN THE MESSAGE
MOVX T1,FP.DEL ;GET DELETE BIT
IORM T1,.FPINF(S1) ;AND SET IT
MOVE S1,LOGIFN ;GET THE LOG IFN
PUSHJ P,INCFIL ;AND INCLUDE IT
SUB S2,Q ;SUB START TO GET LENGTH
STORE S2,.MSTYP(Q),MS.CNT ;STORE TOTAL MESSAGE LENGTH
MOVX T1,FP.FLG ;GET LOG FILE BIT
TOPS20 <
SKIPE L.LGDS ;/DISP:DEL?
TXO T1,FP.DEL ;YES, SET THE BIT
GETLIM S2,.EQLIM(Q),BLOG ;GET BATCH-LOG ARG
CAXN S2,%BSPOL ;SPOOLED?
TXO T1,FP.SPL ;YUP
IORM T1,.FPINF(S1) ;AND STORE IT
MOVX T1,%BAPND ;LOAD APPEND CODE
CAXN S2,%BSCDE ;SUPERSEDE?
>
TOPS10 <
GETLIM S2,.EQLIM(Q),BLOG
CAXE S2,%BSPOL
SKIPE L.LGDS ;/DISP:DEL?
TXO T1,FP.DEL ;YES, SET THE BIT
IORM T1,.FPINF(S1) ;AND STORE IT
MOVX T1,%BAPND ;LOAD APPEND CODE
>;END TOPS10 CONDITIONAL ASSEMBLY
STOLIM T1,.EQLIM(Q),BLOG ;YES, MAKE IT APPEND
PUSHJ P,LOGCLS ;CLOSE THE LOG FILE
MOVE S1,CTLIFN ;GET THE CTL IFN
$CALL F%REL ;RELEASE IT
MOVX S1,PAGSIZ ;LOAD THE MESSAGE SIZE
MOVE S2,Q ;AND THE ADDRESS
PJRST SNDQSR ;SEND THE MESSAGE
QUEJ.1: MOVE S1,CTLIFN ;GET CTL FILE IFN
$CALL F%RREL ;ABORT THE FILE
$TEXT(LOGTXT,<^I/STSUM/No Batch job submitted>)
JRST QUELOG ;AND QUEUE UP THE LOG FILE
SUBTTL QUASAR CREATE -- QUELOG - LOG file PRINT request
QUELOG: GETLIM S1,.EQLIM(Q),OUTP ;GET THE /OUTPUT SWITCH
TXNN F,F.FATE ;WAS THERE A FATAL ERROR?
CAXE S1,%EQOLE ;NO, DID HE WANT LOG ON ERROR ONLY?
SKIPA ;FATAL ERROR, ALWAYS GIVE LOG
JRST QUEL.3 ;OUTPUT:ERROR, BUT NO ERROR
$TEXT(LOGTXT,<^I/STSUM/LOG file submitted for printing>)
MOVE S1,LOGIFN ;GET THE LOG FILE IFN
MOVEI S2,EQXSIZ(Q) ;AND WHERE TO PUT IT
PUSHJ P,INCFIL ;INCLUDE THE LOG FILE
SUB S2,Q ;SUBT START ADR FOR LENGTH
STORE S2,.MSTYP(Q),MS.CNT ;AND STORE MESSAGE LENGTH
MOVX S2,FP.FLG ;GET LOG FILE BIT
GETLIM T1,.EQLIM(Q),BLOG ;GET BATCH-LOG ARG
CAXN T1,%BSPOL ;SPOOLED?
TXO S2,FP.SPL ;YUP, TRANSFER THAT INFO
SKIPE L.LGDS ;CHECK DISPOSITION
TXO S2,FP.DEL ;DELETE IT
IORM S2,.FPINF(S1) ;AND SET THE BITS
PUSHJ P,LOGCLS ;CLOSE THE LOG FILE
MOVX S1,.OTLPT ;LOAD THE PRINTER OBJECT
STORE S1,.EQROB+.ROBTY(Q) ;STORE AS DESIRED DESTINATION
SKIPN CDRDEV ;REAL READER ?
JRST QUEL.1 ;NO..
GETLIM S1,L.EQCP+.EQLIM,CNOD ;GET THE ORIGINATING NODE
JRST QUEL.2 ;GO ON
QUEL.1: GETLIM S1,.EQLIM(Q),ONOD ;GET THE OUTPUT FIELD
SKIPN S1 ;NON-ZERO
MOVE S1,DEFNOD ;NO..GET DEFAULT NODE
QUEL.2: STORE S1,.EQROB+.ROBND(Q) ;YES, STORE AS DESTINATION NODE
MOVX S1,EQLMSZ ;LOAD A COUNT
MOVEI S2,.EQLIM(Q) ;AND AN ADDRESS
$CALL .ZCHNK ;ZERO THE LIMIT WORDS
MOVX S1,'SPRINT' ;MIGHT AS WELL PUT IN A NOTE
STOLIM S1,.EQLIM(Q),NOT1 ;STORE 1ST HALF
MOVX S1,' LOG ' ; TO MAKE IT EASIER FOR HIM
STOLIM S1,.EQLIM(Q),NOT2 ;STORE 2ND HALF
MOVEI S1,^D15 ;LOAD A SMALL PAGE LIMIT
STOLIM S1,.EQLIM(Q),OLIM ;STORE OUTPUT LIMIT
ZERO .EQAFT(Q) ; DITTO DITTO
MOVEI T1,1 ;LOAD NUMBER OF FILES
STORE T1,.EQSPC(Q),EQ.NUM ;AND STORE IT
MOVX S1,PAGSIZ ;SEND A PAGE
MOVE S2,Q ;STARTING THERE
PJRST SNDQSR ;AND SEND THE MESSAGE
QUEL.3: GETLIM S2,.EQLIM(Q),BLOG ;GET BATCH-LOG ARG
MOVEI T1,F%REL ;ASSUME STANDARD CLOSE
CAXE S2,%BSPOL ;IF ITs SPOOLED
SKIPE L.LGDS ;OR DISP:DELETE
MOVEI T1,F%RREL ;THEN DELETE IT
MOVE S1,LOGIFN ;GET THE IFN IN ANY CASE
PUSHJ P,(T1) ;CALL APPROPRIATE ROUTINE
SETZM LOGIFN ;CLEAR OUT THE IFN
MOVE S1,Q ;GET PAGE ADDRESS
PJRST M%RPAG ;RELEASE PAGE AND RETURN
SUBTTL QUASAR CREATE -- QUEFIL - User file request
QUEFIL: $CALL M%ACQP ;GET A FREE PAGE
MOVE T1,S1 ;SAVE THE PAGE NUMBER
PG2ADR T1 ;AND MAKE AN ADDRESS
MOVS T2,Q ;GET ADR OF JOB PAGE
HRR T2,T1 ;AND THE NEW PAGE
BLT T2,EQHSIZ-1(T1) ;AND BLT THE HEADER
HLLZ S1,L.QFN ;GET THE DEVICE
STORE S1,.EQROB+.ROBTY(T1) ;AND STORE IT
MOVX S1,EQLMSZ ;LOAD BLOCK LENGTH
MOVEI S2,.EQLIM(T1) ;AND BLOCK ADDRESS
$CALL .ZCHNK ;AND ZERO THE BLOCK
MOVE S1,FILIFN ;GET THE IFN
MOVEI S2,EQHSIZ(T1) ;AND WHERE TO PUT IT
PUSHJ P,INCFIL ;INCLUDE THE FILE
SUB S2,T1 ;SUBTRACT START ADDRESS
STORE S2,.MSTYP(T1),MS.CNT ;STORE MESSAGE SIZE
MOVEI S1,1 ;LOAD NUMBER OF FILES
STORE S1,.EQSPC(T1),EQ.NUM ;AND STORE IT
MOVEI S1,EQHSIZ ;LOAD CREATE HEADER SIZE
STORE S1,.EQLEN(T1),EQ.LOH ;AND STORE IT
MOVX S1,PAGSIZ ;SEND A PAGE
MOVE S2,T1 ;GET THE ADDRESS
PJRST SNDQSR ;AND SEND IT
SUBTTL QUASAR CREATE -- Utility subroutines
;SNDQSR -- Routine to send a message to QUASAR
; Call with S1/ length
; S2/ address
SNDQSR: STORE S1,L.SAB+SAB.LN ;STORE THE LENGTH
STORE S2,L.SAB+SAB.MS ;AND THE ADDRESS
MOVEI S1,SP.QSR ;GET SPECIAL INDEX
TXO S1,SI.FLG ;FLAG IT
MOVEM S1,L.SAB+SAB.SI ;STORE IT
MOVEI S1,SAB.SZ ;GET SAB SIZE
MOVEI S2,L.SAB ;GET SAB ADDRESS
$CALL C%SEND ;SEND THE MESSAGE
JUMPT .POPJ ;RETURN IF OK
;ELSE GIVE A SEND FAILURE
;Here when a send to QUASAR fails
SNDFAI: $STOP(QSF,QUASAR send failed)
; INCFIL -- Include a file into a CREATE message
;Call with S1 containing the IFN
; S2 containing the adr of the 1st FD WORD
; Creates FP and FD and returns S1 containing the address of
; the FP and S2 containing the address of the first free word.
INCFIL: MOVE T1,S2 ;SAVE FP ADDRESS
MOVEI S2,FPMSIZ ;GET FP SIZE
STORE S2,.FPLEN(T1),FP.LEN ;STORE IT
MOVEI S2,1 ;GET A STARTING POINT
STORE S2,.FPFST(T1) ;STORE IT
STORE S2,.FPINF(T1),FP.FCY ;AND A COPIES FIELD
SETO S2, ;GET FULL FILESPEC
$CALL F%FD ;GET FROM GLXFIL
LOAD S2,.FDLEN(S1),FD.LEN ;GET THE LENGTH OF THE FD
HRL S1,S1 ;START MAKING A BLT POINTER
HRRI S1,FPMSIZ(T1) ;POINT TO WHERE TO PUT IT
ADDI S2,FPMSIZ(T1) ;POINT TO THE NEXT FP
BLT S1,-1(S2) ;BLT THE FD
MOVE S1,T1 ;GET RETURN AC
POPJ P, ;AND RETURN
SUBTTL $TEXT Utilities
; Routine to deposit the character in S1 (as called from
; $TEXT) according to the Byte-Pointer in L.BP
DEPBP: IDPB S1,L.BP ;DEPOSIT THE BYTE
$RETT ;AND RETURN TRUE
FATAL: ITEXT(<^M^J^J^C/[-1]/ STERR >)
STDAT: ITEXT(<^C/[-1]/ STDAT >)
STMSG: ITEXT(<^C/[-1]/ STMSG >)
STERR: ITEXT(<^C/[-1]/ STERR >)
STCRD: ITEXT(<^C/[-1]/ STCRD >)
STSUM: ITEXT(<^C/[-1]/ STSUM >)
ABTSPR: ITEXT (<Input Spooling Processor Error>)
SUBTTL - Interrupt System Database
TOPS10 <
VECTOR: BLOCK 4 ;START OF VECTOR BLOCK
> ;END TOPS10 CONDITIONAL
TOPS20 <
LEVTAB: EXP LEV1PC ;WHERE TO STORE LEVEL 1 INT PC
EXP LEV2PC ;WHERE TO STORE LEVEL 2 INT PC
EXP LEV3PC ;WHERE TO STORE LEVEL 3 INT PC
LEV1PC: BLOCK 1 ;LVL 1 INTERRUPT PC STORED HERE
LEV2PC: BLOCK 1 ;LVL 2 INTERRUPT PC STORED HERE
LEV3PC: BLOCK 1 ;LVL 3 INTERRUPT PC STORED HERE
CHNTAB: BLOCK ^D36 ;A NULL INTERRUPT DISPATCH TABLE
> ;END TOPS20 CONDITIONAL assembly
END SPRINT