Trailing-Edge
-
PDP-10 Archives
-
scratch
-
10,7/unscsp/sprout/sprout.mac
There are 33 other files named sprout.mac in the archive. Click here to see a list.
TITLE SPROUT -- Spooling PRocessor for OUTput - Version 4
SUBTTL D.A. Lewine - L.S. Samberg/PJT/DPM/NT/CTK/LWS 20-mar-84
;
;
;
; COPYRIGHT (c) 1975,1976,1977,1978,1979,1980,1981,1982,1986 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.
SEARCH GLXMAC ;SEARCH GLXLIB SYMBOLS
SEARCH QSRMAC ;GET QUASAR SYMBOLS
SEARCH ORNMAC ;GET OPERATOR SYMBOLS
PROLOGUE(SPROUT) ;DO STANDARD PROLOG
;VERSION INFORMATION
SPOVER==4 ;MAJOR VERSION NUMBER
SPOMIN==0 ;MINOR VERSION NUMBER
SPOEDT==2543 ;EDIT LEVEL
SPOWHO==0 ;WHO LAST PATCHED
%SPO==<BYTE (3)SPOWHO(9)SPOVER(6)SPOMIN(18)SPOEDT>
;STORE VERSION NUMBER IN JOBVER
LOC 137
.JBVER:: EXP %SPO ;SPROUT VERSION
RELOC 0
COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1971,1986. ALL RIGHTS RESERVED.
\;END COPYRIGHT MACRO
SUBTTL Table of contents
; TABLE OF CONTENTS FOR SPROUT
;
;
; SECTION PAGE
; 1. Table of contents......................................... 2
; 2. Revision History.......................................... 3
; 3. Constants (Conditional and Unconditional)................ 4
; 4. MACROS.................................................... 5
; 5. Special Forms Handling Parameters......................... 6
; 6. Flag Definitions.......................................... 8
; 7. Job Parameter Area........................................ 9
; 8. Random Impure Storage..................................... 12
; 9. Resident JOB DaTABase..................................... 13
; 10. Non-zero daTABase......................................... 14
; 11. $TEXT Utilities and common Messages....................... 15
; 12. Program Initialization.................................... 16
; 13. Idle Loop................................................. 17
; 14. Deschedule Process........................................ 18
; 15. Do the Job................................................ 19
; 16. Process a File............................................ 20
; 17. End of Job................................................ 21
; 18. FILDIS Routine to KEEP/DELETE requested files............ 21
; 19. CHKQUE Routine to process IPCF messages.................. 22
; 20. CHKOBJ Routine to validate QUASAR/ORION/OPR MSG Object block 23
; 21. FNDOBJ Routine to establish STREAM context............... 24
; 22. GETBLK Routine to return next argument from an OPR/ORION message 25
; 23. NEXTJOB Message from QUASAR............................... 26
; 24. User CANCEL Request....................................... 27
; 25. UPDATE Routine to send status update...................... 28
; 26. CHKPNT Routine to send checkpoint message................. 29
; 27. SETUP/SHUTDOWN Message.................................... 30
; 28. Response to setup message................................. 31
; 29. Operator CANCEL command................................... 32
; 30. Operator STOP command..................................... 33
; 31. Operator CONTINUE command................................. 33
; 32. Operator RESPONSE command................................. 33
; 33. Operator REQUEUE command.................................. 34
; 34. CLRMSG and SNDQSR routines................................ 35
; 35. Accounting routines....................................... 37
; 36. FORMS - Setup Forms for a job............................. 40
; 37. Forms switch Subroutines.................................. 44
; 38. Plotter only switches..................................... 45
; 39. I/O Subroutines for SPFORM.INI............................ 46
; 40. INPOPN - Routine to open the input file................... 48
; 41. INPBUF - Read a buffer from the input file................ 49
; 42. INPBYT - Read a byte from the input file.................. 49
; 43. INPERR - Handle an input failure.......................... 49
; 44. INPFEF - Force end-of-file on next input.................. 49
; 45. INPREW - Rewind the input file............................ 49
; 46. OUTGET - OPEN the output device........................... 50
; 47. OUTBYT - Deposit a byte in the output buffer.............. 53
; 48. OUTOUT - Routine to output a buffer....................... 54
; 49. DEVERR - Handle Output Device Errors...................... 55
; 50. OUTREL - Release output device............................ 56
; 51. OUTWON - Wait for on-line................................. 57
; 52. OUTFLS Routine to flush output buffers.................... 58
; 53. Card punch service
; 53.1 Dispatch table.................................... 59
; 53.2 Checkpoint text generation........................ 60
; 53.3 File processing................................... 61
; 53.4 File headers...................................... 67
; 53.5 File trailers..................................... 68
; 53.6 Banners........................................... 69
; 53.7 Word punching..................................... 70
; 53.8 Letters........................................... 71
; 53.9 Byte output....................................... 72
; 54. Plotter service
; 54.1 Dispatch table.................................... 73
; 54.2 Checkpoint text generation........................ 74
; 54.3 File processing................................... 75
; 54.4 Devout output errors.............................. 77
; 54.5 Banners........................................... 78
; 54.6 File headers...................................... 79
; 54.7 File trailers..................................... 80
; 54.8 Job trailers...................................... 81
; 54.9 Solid lines....................................... 82
; 54.10 Dashed lines...................................... 83
; 54.11 Job information plotting.......................... 84
; 54.12 Alignment and testing............................. 85
; 54.13 Pen calibration................................... 86
; 54.14 Compute chracter size............................. 87
; 54.15 Letters........................................... 88
; 54.16 Line segments..................................... 89
; 54.17 Rotation and XY20 translation..................... 91
; 54.18 Pen movement generation........................... 92
; 54.19 Character set..................................... 94
; 55. Paper tape punch service
; 55.1 Dispatch table.................................... 99
; 55.2 Checkpoint text generation........................ 100
; 55.3 File processing................................... 101
; 55.4 Banners........................................... 106
; 55.5 File headers...................................... 107
; 55.6 File trailers..................................... 108
; 55.7 Trailers.......................................... 109
; 55.8 Blank folds....................................... 110
; 55.9 Letters........................................... 111
; 55.10 Byte output....................................... 112
; 56. Character Bit Array for 5 X 7 Character Matrix............ 113
; 57. Common Utilities.......................................... 115
; 58. Interrupt Module.......................................... 118
; 59. IPCF and DEVICE Interrupt service for TOPS10.............. 122
; 60. IPCF and DEVICE interrupt service for TOPS20.............. 123
SUBTTL Revision History
Comment\
2000 First GALAXY-10 Field-Test release, June, 1975.
2100 Make this version 2, August, 1976.
First field-test release of GALAXY release 2, Jan 1977
2400 MAKE THIS VERSION 4, APRIL 1977.
(NOTE: RELEASE 3 OF GALAXY WAS TOPS20 ONLY AND DID NOT INCLUDE SPROUT)
INSERT CHANGES FOR NEW FP/FD.
2401 START CONVERTING TO USE GLXLIB INSTEAD OF CSP??? AND SBS???.
2402 FIX UP AC CONVENTIONS TO BE COMPATIBLE WITH GLXLIB.
2403 MAKE SPROUT INTO A SINGLE SEGMENT AND DO A CODE CLEANUP.
2404 START MERGING IN GLXFIL USAGE FOR THE INPUT FILE.
2405 MORE OF 2404 AND START REPLACING LUUOS WITH $TEXTS.
2406 MAKE MORE USE OF $TEXT.
2407 MANY MINOR BUG FIXES AND CHANGES.
2410 SOME MAJOR CODE CLEANUP.
2411 START MAJOR RE-WORK OF SPROUT TO MAKE MORE USE OF GLXLIB AND TO
TALK WITH THE NEW OPERATOR INTERFACE.
2412 CHANGE IMAGE MODE ON THE CDP TO IGNORE EACH 81ST BYTE READ
FROM DISK SO THAT IT IS COMPATIBLE WITH SPRINT AND PIP.
2413 DONT ENFORCE LIMITS ON PTP AND PLT SINCE THE LIMITS ARE DIRECTLY
DERIVABLE FROM THE FILE-SIZE.
2414 DO SOME CODE CLEANUP.
2415 Code Cleanup and add plotter and card letter routines
2416 Added Forms processing for SPFORM.INI File
2417 Added MSGFLG and Changed interrupt and Scheduling code
to set/check msgflg for IPCF messages
2420 Added code to check length of message for DEP6BP and DEPBP
2421 Removed msgflg (twas a bad idea)
2422 Fixed OUTOUT and DEVERR for TOPS10
2423 Fixed ACTION operator message processing
2424 Fixed Offline device interrupt code
2425 Updated to new library and message formats
2426 Added preliminary accounting parameters
Added two pass scheduling algorithm to allow mulitple
devices to operate in parallel on TOPS20
2427 Fixed bug in INPOPN regarding access checks
Moved impure interrupt stuff to impure storage
Added call to I%HOST to get local node name
2430 Changed all message processing to use ac M
Changed scheduling loop to WAIT instead of SLEEP
when no jobs are scheduable
2431 Added correct mulitple stream runtime accounting code
2432 Put IB.PRG back into IB
2433 add Mount Bypass
2434 Add WTOR kill code (AWC)
2435 Fix a $TEXT bug - IQN Stopcode (AWC)
2436 Put in Null routines for TOPS10 accounting
2437 Fix Plotter Banner Header and Trailer code
2440 Add plotter limit check code
2441 MAKE 8 BIT PAPER TAPE OUTPUT BYTE SIZE
2442 Add usage accounting for TOPS-10 (DPM)
2443 Use new feature IB.DET to detach from FRCLIN (DPM)
2444 Delete IB.DET (GLXLIB defaults to detach)
2445 Change reference of symbol z to ZZ [QAR 10-04715]
2446 Add missing (S2) in DVINTR rouine [QAR 10-4903]
2447 Close SPFORM.INI before returning from FRMSWI [QAR 10-4855]
2450 Call OUTOUT after outputing trailers (SPR 20-14682)
Make # chars per fanfold 85 not 90 (SPR 20-14680)
Fix spelling error & FRMFD length error (SPR 20-14911)
2451 Get the correct owners name based on type of system.
2452 Fix OUTOUT so we don't loose output done interrupts
2453 Adjust J$XPOS and J$YPOS before clipping output per limits
2454 Always call file trailer routine during file processing
2455 Add support for /DISP:RENAME
2456 Account for X plotter usage
2457 Compute minimum character size (YMAX-YMIN)/90
2460 Have SPROUT generate own checkpoints
2461 Make cryptic error messages more explicit.
2462 Position pen at EOF before printing error message. General
cleanup of job/file headers and trailers.
2463 Add missing entries in PLT dispatch table for /TAPE:BINARY.
2464 Add accounting support for the plotter.
2465 Don't do things like JRST .+3
2466 Remove edit 2456. Plotter usage is accounted for in minites, not
amount of paper.
2467 Clear up /BANNER/HEADER/TRAILER problems with plotter. Edit 2457
made the switch arguments nearly useless. Don't allow arguments
for the plotter.
2470 SPFORM.INI switch arguments were sometimes stored in half-words,
and later full-word multiplies were done. That produces strange
results in banners, headers and trailers.
2471 Remove /GUIDE, /ORIGIN and /SIZE switches from SPFORM.INI since
they didn't work and it was unclear how they should work. Replace
the "+" guide marks with a line across the paper. Always ram the
pen into the stops prior to starting a new job instead of setting
the origin where ever the operator left the pen.
2472 Remove SPFORM.INI switch defaulting since it could never work
correctly for all switches all the time (some switches take
multiple arguments).
2473 Remove TOPS-20 fork code since it never worked & will never be made to.
2474 Fix limit clipping so plots don't overwrite banners and trailers.
2475 If we get an I/O error on the plotter, complain but continue the
job, since plotters aren't supposed to get output errors.
2476 Always clear PSF%DO (device off-line bit) when the operator issues
a continue command. This can't hurt anything and will be a win while
driving a PTP. The PTP gives only off-line interrupts, but no on-line
interrupts.
2477 Add PTP accounting and fix up checkpoint messages a bit.
2500 Insure plotter trailers won't clip.
2501 Fix PTP banners, header and trailers so characters don't get mangled.
2502 Process /BANNER, /HEADER and /TRAILER switches for all devices like
it is done for PLTs. Also, add NOTE:foo to CDP and PTP banners since
they tell me it's documented that way.
2503 Fix problem with J$XLIM growing with every plot done.
2504 Use symbol FTFACT from GALGEN dialogue and remove references to FTOACT.
2505 Fix up CDP headers and trailers.
2506 Do both a status update and a checkpoint prior to asking about
limit exceeded action.
2507 Don't call EOF routines twice. Remove extra call at FILE.2+ a few.
2510 Clean up /NOTE switch processing a bit.
2511 Fix bug in PTPBYT that caused S1 and S2 to get trashed.
2512 Default /SPU value to 1 if not set in SPFORM.INI
2513 Make sure T1 is set up before calling BLKFLD to punch blank folds
off paper tape.
2514 Correct the calculation of the number of minutes of plotting time.
2515 Fix compiler errors on TOPS20 by putting TOPS10 refs under conditional
2516 Store sixbit device name on TOPS-20 so accounting doesn't get
screwed up. Also accumulate the number of feet plotted. Clean up
other assorted accounting bugs.
2517 Clean up TOPS-20 card banners, headers and trailers.
2520 Zap output buffer after doing SOUT.
2521 Clarify $WTOR responses as 'ABORT' or 'PROCEED' only.
2522 Fix UP-DOWN RIGHT-LEFT confusion. QAR 10-06785
2523 Add file name info to Cannot Access File message QAR 10-06759
2524 Correct checking for a null /NOTE switch.
Terminate job banner text properly.
Terminate note text with a NUL when processing job banners.
Requeue reason text may never gets to the error buffer. Fix it.
2525 Fix logic bug in SPFORM.INI parsing.
2526 Fix some bad error messages.
GCO: 1298
2527 Remove two extraneous intructions at the end of routine P$CHKS.
GCO: 1319
2530 Fix a bug that would not allow plots to be output if
/HEADER was not specified.
GCO: 1320
2531 Several very trivial fixes which don't really deserve seperate
edit numbers.
1) Put OUTSOK under TOPS-20 conditional since it's only needed for
that system.
2) Remove some extraneous symbols: J$FMSP, FOB. Put
FILNAM under TOPS20 conditional.
3) Fix OUTOUT on the -10 to not save S1/S2 if it is called from
itself.
GCO: 1341
2532 Fix a bug that keeps the last buffer from being output
to the plotter. It may be an obscure monitor bug that has
to be worked around.
;BEGIN CODE MAINTENANCE
2533 Fix bug in FILDIS. The /DELETE switch was improperly processed,
when the job was ABORTED by OPR, the file was deleted.
SPR 20-17944/CTK 1-MAR-83
2534 Use reasonable defaults for /MAX, /MIN, and /SPU even when they're
not specified in SPFORM.INI.
SPR 10-33412 13-Oct-83 /LWS
2535 In DEVERR, requeue current request before shutting down the
stream.
SPR 10-34545 23-Feb-84 /LWS
2536 Fix coding bug where T2 was confused for S2.
SPR 10-34569 GCO 10012 20-Mar-84 /LWS
2537 The defaults setup in Edit 2534 are not used if SPFORM.INI
doesn't exist, or no line in SPFORM.INI matches plot request.
Rearrange calculations based on defaults and/or SPFORM.INI
switches so they are always done. This edit REQUIRES edit 2534.
SPR 10-CS00004 GCO 10082 24-Aug-84 /LWS
2540 When the operator says ABORT PLOTTER x /PURGE don't RESDV. the
plotter. /PURGE means abort the job now and don't do any extra output.
SPR 10-34867 GCO 10096 19-Sep-84 /LWS
2541 SPROUT doesn't handle hung devices or CPU failures. Add the code
so it knows what to do.
SPR 10-35031 GCO 10135 8-Jan-85 /LWS
2542 SPROUT's SPFORM.INI processing doesn't let the operator know
what's going on if the file's missing or no matching forms type,
etc.
SPR 10-35035 GCO 10145 10-Jan-85 /LWS
2543 SPROUT doesn't properly report KCS, disk reads, files processed,
connect time or the account string to ACTDAE. Add code to do so.
SPR 10-35319 GCO 10273 12-Aug-85 /DRB
End of revision history
\
SUBTTL Constants (Conditional and Unconditional)
;ACCUMULATORS
M==12 ;MESSAGE ADDRESS
S==13 ;STATUS FLAGS
J==14 ;BASE ADDRESS OF CONTEXT DATA
C==15 ;I/O CHARACTER
E==16 ;POINTER TO CURRENT FP
;SYSTEM DEPENDENT PARAMETERS
DEFINE FACT,<IFN FTFACT>
SYSPRM PTPBSZ,^D36,^D8 ;OUTPUT BYTESIZE FOR PTP
;RANDOM CONSTANTS
ND PDSIZE,100 ;SIZE OF PUSHDOWN LIST
ND FACTSW,-1 ;-1 TO INCLUDE ACCOUNTING
ND NSTRMS,5 ;NUMBER OF STREAMS
ND ACCTSW,1 ;TURN ACCOUNTING ON/OFF
ND TXT$LN,^D50 ;LENGTH OF JOB TEXT BUFFER
ND ERR$LN,^D20 ;LENGTH OF JOB ERROR TEXT BUFFER
ND NBFRS,2 ;NUMBER OF BUFFERS TO CREATE
ND NJBPGS,3 ;NUMBER OF JOB PAGES TO CREATE
ND CKPTIM,^D120 ;# of seconds between chkpnts
XP MSBSIZ,50 ;SIZE OF A MESSAGE BLOCK
;CHECKPOINT BLOCK OFFSETS
XP CKFIL,0 ;NUMBER OF FILES COMPLETED
XP CKCOP,1 ;NUMBER OF COPIES COMPLETED
XP CKPAG,2 ;NUMBER OF UNITS OF LAST COPY
XP CKTPP,3 ;NUMBER OF TOTAL UNITS processed
XP CKFLG,4 ;CHECKPOINT FLAGS
XP CKFREQ,1B0 ;REQUED BY OPERATOR
XP CKFCHK,1B1 ;JOB WAS CHECKPOINTED
;DEVICE DISPATCH TABLE OFFSETS
XP DHEAD,0 ;ADDRESS OF FILE HEADER ROUTINE
XP DTAIL,1 ;ADDRESS OF FILE TRAILER (EOF) ROUTINE
XP DNAME,2 ;DEVICE GENERIC NAME IN 6BIT
XP DBYTE,3 ;OUTPUT BYTE SIZE
XP DPROC,4 ;ADDRESS OF FILE processing ROUTINE
XP DBANN,5 ;ADDRESS OF JOB BANNER ROUTINE
XP DEOJ,6 ;ADDRESS OF JOB TRAILER (EOJ) ROUTINE
XP DLETR,7 ;ADDRESS OF CHARACTER processing ROUTINE
XP DERR,10 ;ADDRESS OF ERROR HANDLER
XP DACCT,11 ;ADDRESS OF END ACCOUTING ROUTINE
XP DCHKP,12 ;ADDRESS OF CHECKPOINT TEXT ROUTINE
CONT. (Constants) ;FORCE NEW LISTING PAGE
; Card punch constants
;
XP CPC,^D80 ;CHARACTERS PER CARD
; Plotter constants
;
XP PNUP,40 ;RAISE PEN
XP PNDN,20 ;LOWER PEN
XP PEN2,14 ;SELECT PEN 2
XP PEN3,03 ;SELECT PEN 3
XP CNGP,17 ;CHANGE PENS
XP XYU,10 ;-X MOVE UP
XP XYD,4 ;+X MOVE DOWN
XP XYL,2 ;+Y MOVE LEFT
XP XYR,1 ;-Y MOVE RIGHT
XP XYUL,XYL!XYU ;-X+Y MOVE UP+LEFT
XP XYDL,XYL!XYD ;+X+Y MOVE DOWN+LEFT
XP XYUR,XYR!XYU ;-X-Y MOVE UP+RIGHT
XP XYDR,XYR!XYD ;+X-Y MOVE DOWN+RIGHT
XP PLTPEN,^D9 ;# TICS FOR PLOT PEN UP/DOWN
XP PLTMOV,1 ;# TICS FOR PEN MOVEMENT
XP CHRPLN,^D90 ;# CHARACTERS PER LINE MAXIMUM
;**;[2534] Default values for maximum X and Y (inches) and default values
;**;[2534] for /SPS (steps/sec) and /SPU (steps/unit) 13-Oct-83 /LWS
XP DFXMAX,^D36 ;[2534] 36 INCH WIDTH DEFAULT
XP DFYMAX,^D12 ;[2534] 12 INCH HEIGHT DEFAULT
XP DFSPS,^D200 ;[2534] 200 STEPS/SEC DEFAULT
XP DFSPU,^D100 ;[2534] 100 STEPS/UNIT DEFAULT
; Paper tape punch constants
;
XP CHPFLD,^D85 ;CHARACTERS PER FOLD OF PTP
XP FRMPFT,^D120 ;FRAMES PER FOOT OF TAPE
SUBTTL MACROS
DEFINE LP(SYM,VAL,FLAG),<
IF1,<
XLIST
IFNDEF J...X,<J...X==1000>
IFDEF SYM,<PRINTX ?PARAM SYM USED TWICE>
SYM==J...X
J...X==J...X+VAL
IFNDEF ...BP,<...BP==1B0>
IFNDEF ...WP,<...WP==0>
REPEAT VAL,<
IFIDN <FLAG><Z>,<LPZ(\...WP,...BP)>
...BP==...BP_<-1>
IFE ...BP,<
...BP==1B0
...WP==...WP+1
> ;;END IFE ...BP
> ;;END REPEAT VAL
IFL 2000-J...X,<PRINTX ?PARAMETER AREA LONGER THAN A PAGE>
LIST
SALL
> ;END IF1
IF2,<
.XCREF
J...X==SYM
.CREF
SYM==J...X
> ;END IF2
> ;END DEFINE LP
DEFINE LPZ(A,B),<
IFNDEF ...Z'A,<...Z'A==B>
IFDEF ...Z'A,<...Z'A==...Z'A!B>
> ;END DEFINE LPZ
SUBTTL Special Forms Handling Parameters
;FORMS SWITCHES:
;FOR ALL DEVICES
; /BANNER BANNER WILL BE OUTPUT
; /TRAILER TRAILER WILL BE OUTPUT
; /HEADER HEADER WILL BE OUTPUT
; /NOTE:AA TYPE NOTE TO THE OPERATOR
;FOR PLOTTER ONLY
; /SPS:NN STEPS PER SECOND (PLOTTER SPEED)
; /SPU:NN STEPS PER UNIT (FACTOR OF ALL XX AND YY)
; /MAXIMUM:XX:YY FORMS LIMIT IN X AND Y AXIS (UNITS)
; /MINIMUM:XX:YY FORMS LIMIT IN X AND Y AXIS (UNITS)
;IN THE ABOVE AND BELOW EXPLANATIONS:
; NN IS A DECIMAL NUMBER
; SS IS A 1-6 CHARACTER STRING
; AA IS A STRING OF 1 TO 50 CHARACTERS
; OO IS AN OCTAL NUMBER
; XX INTEGER UNIT NUMBER IN X AXIS
; YY INTEGER UNIT NUMBER IN Y AXIS
;LOCATION SPECIFIERS
; ALL ALL DEVICES
; LOC ALL DEVICES AT THE LOCAL NODE
; REM ALL REMOTE DEVICES
;NOTE: SPROUT WILL USE THE FIRST ENTRY WHICH MEETS THE LOCATION
; SPECIFICATION FOR ITS DEVICE.
; SPROUT ACCEPTS FORMS SPECIFICATIONS FOR ALL THREE DEVICES
; ALTHOUGH SOME SWITCHES ARE LEGAL ONLY FOR PLOTTERS
; IF SPFORM.INI DOESN'T EXIST OR NO MATCH IS FOUND, DEFAULTS
; ARE AS FOLLOWS FOR PLOTTERS ONLY:
; PLT:ALL NORMAL/MAXIMUM:36:12/MINIMUM:0:0/SPS:200/SPU:100
;TYPICAL SPFORM.INI FORMS SPECIFICATION
; CDP NORMAL/BANNER:6/HEADER:1/TRAILER:6-
; /NOTE:Load NORMAL Cards in Card Punch
;
; PLT NORMAL/BANNER/HEADER/TRAILER-
; /MINIMUM:0:0/MAXIMUM:60:40/SPU:200
; /NOTE:Set Plotter Controls to 200 Steps per inch
DEFINE SWITCHES,<
FF BANNER
FF TRAILER
FF HEADER
FF NOTE
FF SPS
FF SPU
FF MINIMUM
FF MAXIMUM
>
;GENERATE TABLE OF SWITCH NAMES
DEFINE FF(A),<
XLIST
<<SIXBIT /A/>&777777B17>+S$'A
LIST
SALL
>
FFNAMS: SWITCHES
F$NSW==.-FFNAMS ;NUMBER OF SWITCHES
SUBTTL Flag Definitions
DSKOPN==1B2 ;DISK DATA READ GOING ON
RQB==1B3 ;JOB HAS BEEN REQUED
ABORT==1B5 ;THE SHIP IS SINKING
SKPFIL==1B8 ;SKIP FUTURE COPIES OF THIS FILE COMPLETELY
GOODBY==1B9 ;IN JOB TERMINATION SEQUENCE
NOSTRM==1B10 ;NOT IN STREAM CONTEXT
SUBTTL Job Parameter Area
LP J$$BEG,0 ;BEGINNING OF PARAMETER AREA
;REQUEST PARAMETERS
LP J$RFLN,1 ;NUMBER OF FILES IN REQUEST
LP J$RLIM,1,Z ;JOB LIMIT IN PAGES
LP J$RTIM,1 ;START TIME OF JOB
LP J$RNFP,1,Z ;NUMBER OF FILES processed
LP J$RNCP,1,Z ;NUMBER OF COPIES OF CURRENT FILE
LP J$RNPP,1,Z ;NUMBER OF PAGES IN CURRNET FILE
LP J$RACS,20 ;CONTEXT ACS
LP J$RPDL,PDSIZE ;CONTEXT PUSHDOWN LIST
;DEV PARAMETERS
LP J$LBUF,1 ;ADDRESS OF DEV BUFFER
LP J$LBRH,1 ;BUFFER RING HEADER
LP J$LBPT,1 ;BUFFER BYTE POINTER
LP J$LBCT,1 ;BUFFER BYTE COUNT
LP J$TBCT,1 ;TOTAL BYTE COUNT FOR DEVICE
LP J$LIOA,1 ;-1 IF WE ARE IN A SOUT OR OUT
LP J$LREM,1 ;-1 IF WE ARE A REMOTE DEVICE
LP J$LSER,1 ;ADDRESS OF DEVICE SERVICE DISPATCH
TOPS10 <
LP J$LJFN,1 ;DEV I/O CHANNEL (OR JFN)
LP J$LDEV,1 ;DEVICE NAME (SIXBIT)
LP J$LIOS,2 ;DEVICE STATUS
LP J$LIOE,1 ;-1 IF DEVICE ERROR
> ;END TOPS10 CONDITIONAL
TOPS20 <
LP J$LJFN,1 ;JFN FOR THE DEV
LP J$LDEV,2 ;DEVICE NAME STRING
LP J$LIOS,2 ;DEVICE STATUS
LP J$LIOE,1 ;-1 IF DEVICE ERROR
LP J$LIBP,1 ;INITIAL BYTE POINTER
LP J$LIBC,1 ;INITIAL BYTE COUNT FOR BUFFERS
> ;END TOPS20 CONDITIONAL
;CURRENT FORMS PARAMETERS
LP J$FIFN,1 ;TEMPORARY IFN FOR FORM FILE
LP J$FORM,1 ;CURRENT FORMS TYPE
LP J$FPFM,1 ;PREVIOUS FORMS TYPE
LP J$FPLT,1 ;FORMS TYPE FOR PLOTTER
;STORAGE FOR CURRENT FORMS SWITCHS
DEFINE FF(X) <LP J$F'X,1>
LP J$FCUR,0 ;ORIGIN OF CURRENT SWITCH VALUES
SWITCHES ;ONE ENTRY PER SWITCH
;MISCELLANY
LP J$XFOB,FOB.SZ ;A FILE OPEN BLOCK
LP J$XTBF,TXT$LN,Z ;$TEXT BUFFER FOR OUTPUT DEVICE
LP J$XERR,ERR$LN,Z ;$TEXT BUFFER FOR ERROR MESSAGES
;CARD PUNCH VARIABLES
LP J$XCD1,1 ;1 SCRATCH LOCATION FOR CDP OUTPUT
LP J$CMSK,1 ;SPECIAL MASK FOR BLOCK CARD LETTERS
LP J$XCHB,40 ;CHECKSUM BLOCK
;PLOTTER VARIABLES
LP J$PAUS,1 ;PAUSE FOR EVERY FORM
LP J$XPOS,1 ;CURRENT PLOTTER X COORDINATE
LP J$XORG,1 ;ORIGINAL X MINIMUM
LP J$XLIM,1,Z ;HIGHEST XSTEP SEEN THIS PLOT
LP J$XMIN,1 ;X MINIMUM POINT IN FORM
LP J$XMAX,1 ;X MAXIMUM POINT IN FORM
LP J$YPOS,1 ;CURRENT PLOTTER Y COORDINATE
LP J$YLIM,1 ;HIGHEST YSTEP SEEN THIS PLOT
LP J$YMIN,1 ;MINIMUM Y POINT IN FORM
LP J$YMAX,1 ;MAXIMUM ALLOWABLE Y COORDINATE
LP J$ROTA,1 ;GRID ROTATION (0-3)
LP J$PPOS,1 ;PEN POSITION (UP 0 DOWN -1)
LP J$CSIZ,1 ;CHARACTER SIZE
LP J$XBAS,1 ;CHARACTER X BASE
LP J$YBAS,1 ;CHARACTER Y BASE
LP J$FUDG,1 ;CHARACTER WIDTH FUDG
LP J$SPTR,1 ;POINTER TO CHARACTER SEGMENT BYTES
LP J$STEP,1 ;STEP FUNCTION DETERMINES MOVEMENT
; Paper tape punch variables
;
LP J$TFRM,1,Z ;FRAMES OF TAPE PUNCHED
;ACCOUNTING BLOCK
LP J$PTPM,1 ;PLOTTER TICS PER MINUTE
LP J$PTIC,1,Z ;ACCOUNTING FOR PLOTTER
LP J$APRT,1,Z ;NUMBER OF PAGES processed
LP J$ADRD,1,Z ;DISK BLOCKS READ.
LP J$APRI,1,Z ;JOBS PRIORITY
LP J$ARTM,1,Z ;JOBS RUN TIME (CPU)
;**;[2543] Insert 1 line at J$ARTM+1. 12-Aug-85 /DRB
LP J$AKCT,1,Z ;[2543] JOB'S KILO-CORE TICS
LP J$ASEQ,1,Z ;JOBS SEQUENCE NUMBER
LP J$AFXC,1,Z ;TOTAL FILES processed (FILES*COPIES)
LP J$ADSP,1,Z ;DISPOSITION (SIXBIT)
LP J$AQUE,1,Z ;QUEUE NAME (SIXBIT)
;DISK FILE PARAMETERS
LP J$DIFN,1 ;THE IFN
LP J$DFDA,1 ;THE FD ADDRESS
LP J$DBPT,1 ;BUFFER BYTE POINTER
LP J$DBCT,1 ;BUFFER BYTE COUNT
LP J$DBSZ,1 ;INPUT BYTE SIZE
LP J$DMOD,1 ;I/O MODE OF DISK FILE
LP J$DSPN,1 ;SPOOLED FILE NAME IF ANY
LP J$DSPX,1 ;SPOOLED FILE EXTENTION
LP J$$END,1 ;END OF PARAMETER AREA
J$$LEN==J$$END ;LENGTH OF PARAMETER AREA
;NOW GENERATE A BIT TABLE OF WHICH WORDS IN THE JOB DATA PAGE TO ZERO
; ON A NEW JOB
ZTABLE: ;PUT TABLE HERE
DEFINE ZTAB(A),<
IFNDEF ...Z'A,<...Z'A==0>
EXP ...Z'A
> ;END DEFINE ZTAB
ZZ==0
REPEAT <^D512+^D35>/^D36,<
XLIST
ZTAB(\ZZ)
ZZ==ZZ+1
LIST
> ;END REPEAT
SUBTTL Random Impure Storage
PDL: BLOCK PDSIZE ;PUSHDOWN LIST
LOWBEG: ;BEGINNING OF AREA TO CLEAR ON STARTUP
L.JOB: BLOCK 1 ;SPROUT job number
L.TTY: BLOCK 1 ;SPROUT node,,line
L.LIN: BLOCK 1 ;SPROUT line number
L.CON: BLOCK 1 ;SPROUT conntect time in seconds
MESSAG: BLOCK 1 ;ADDRESS OF RECEIVED MESSAGE
BLKADR: BLOCK 1 ;ADDRESS OF CURRENT ARG IN MESSAGE
MSGBLK: BLOCK MSBSIZ ;BLOCK FOR BUILDING MESSAGES
TEXTBP: BLOCK 1 ;BYTE POINTER FOR $TEXT ROUTINES
TEXTBC: BLOCK 1 ;BYTE COUNT OF CURRENT TEXT BUFFER
SAB: BLOCK SAB.SZ ;SEND ARGUMENT BLOCK
ACTFLG: BLOCK 1 ;-1 IF WE ARE DOING ACCOUNTING
ACTRNN: BLOCK 1 ;OLD SPOOLER RUNTIME
;**;[2543] Insert 1 line at ACTRNN+1. 12-Aug-85 /DRB
ACTKCT: BLOCK 1 ;[2543] SPOOLER KCT
ACTPAG: BLOCK 1 ;OLD STREAM PAGE BLOCK ADDRESS
CNTSTA: BLOCK 1 ;CENTRAL STATION IDENTIFIER
TOPS20 <
FILNAM: BLOCK 10 ;ROOM FOR A TOPS-20 FILENAME
> ;END TOPS20 CONDITIONAL
SUBTTL Resident JOB DaTABase
STREAM: BLOCK 1 ;(LH) -1 WHILE IN STREAM CONTEXT
; 0 WHILE IN SCHED CONTEXT
;(RH) CURRENT STREAM NUMBER
JOBPAG: BLOCK NSTRMS ;ADDRESS OF A THREE PAGE BLOCK
; ONE FOR REQUEST, ONE FOR JOB PARAMS, ONE FOR BUFFER
JOBOBA: BLOCK NSTRMS ;TABLE OF OBJECT BLOCK ADDRESSES
JOBSTW: BLOCK NSTRMS ;JOB STATUS WORD
JOBACT: BLOCK NSTRMS ;-1 IF STREAM IS ACTIVE, 0 OTHERWISE
JOBOBJ: BLOCK 3*NSTRMS ;LIST OF SETUP OBJECTS
JOBWAC: BLOCK NSTRMS ;WTOR ACK CODE (TIME SETUP WAS RECIEVED)
JOBCHK: BLOCK NSTRMS ;Stream checkpoint indicator
;Contains the time for the next chkpnt
; or 0 if one is requested
LOWEND==.-1
TOPS10 <
VECTOR: BLOCK 0 ;BEGINNING OF INTERRUPT VECTOR
VECIPC: BLOCK 4 ;IPCF INTERRUPT BLOCK
VECDEV: BLOCK 4*NSTRMS ;DEVICE INTERRUPT BLK
ENDVEC==.-1 ;END OF INTERRUPT VECTOR
> ;END TOPS10 CONDITIONAL
TOPS20 <
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
> ;END TOPS20 CONDITIONAL
;SCHEDULER FLAGS
PSF%OB==1B1 ;OUTPUT BLOCKED
PSF%DO==1B2 ;DEVICE IS OFF-LINE
PSF%ST==1B3 ;STOPPED BY OPERATOR
PSF%OR==1B4 ;OPERATOR RESPONSE WAIT
PSF%NP==1B5 ;GO TO NEXT PROCESS
DEFINE $DSCHD(FLAGS),<
$CALL DSCHD
XLIST
JUMP [EXP FLAGS]
LIST
SALL
> ;END DEFINE $DSCHD
SUBTTL Non-zero daTABase
TOPS10 <INTVEC==VECTOR>
TOPS20 <INTVEC==LEVTAB,,CHNTAB>
IB: $BUILD IB.SZ
$SET (IB.PRG,,%%.MOD) ;PROGRAM NAME IS SPROUT
$SET (IB.PIB,,PIB) ;SET UP PIB ADDRESS
$SET (IB.INT,,INTVEC) ;POINT TO INTERRUPT VECTOR
$SET (IB.FLG,IP.STP,1) ;STOP CODES TO ORION
$EOB
PIB: $BUILD (PB.MNS)
$SET (PB.HDR,PB.LEN,PB.MNS) ;PIB LENGTH,,0
$SET (PB.FLG,IP.PSI,1) ;PSI ON
$SET (PB.INT,IP.CHN,0) ; CHANNEL 0
$SET (PB.SYS,IP.BQT,-1) ;MAX IPCF QUOTAS
$EOB
HELLO: $BUILD HEL.SZ
$SET(.MSTYP,MS.TYP,.QOHEL) ;MESSAGE TYPE
$SET(.MSTYP,MS.CNT,HEL.SZ) ;MESSAGE LENGTH
$SET(HEL.NM,,<'SPROUT'>) ;PROGRAM NAME
$SET(HEL.FL,HEFVER,%%.QSR) ;QUASAR VERSION
$SET(HEL.NO,HENNOT,3) ;NUMBER OF OBJ TYPES
$SET(HEL.NO,HENMAX,NSTRMS) ;MAX NUMBER OF JOBS
$SET(HEL.OB,,.OTPTP) ;PAPERTAPE PUNCH
$SET(HEL.OB+1,,.OTCDP) ;CARD PUNCH
$SET(HEL.OB+2,,.OTPLT) ;PLOTTER
$EOB
FRMFOB: $BUILD FOB.SZ ;FILE OPEN BLOCK FOR SPFORM.INI
$SET (FOB.FD,,FRMFD) ;POINT TO FILE DESCRIPTOR
$SET (FOB.CW,FB.BSZ,7) ;SET FILE BYTE SIZE TO 7
$SET (FOB.CW,FB.LSN,1) ;AND STRIP LINE SEQUENCE NUMBERS
$EOB
TOPS10 <
FRMFD: XWD FFD$LN,0 ;FILE DESCRIPTOR LENGTH
SIXBIT /SYS/ ;DEVICE
SIXBIT /SPFORM/ ;FILENAME
SIXBIT /INI/ ;EXTENSION
EXP 0 ;PPN
FFD$LN==.-FRMFD ;COMPUTE FD LENGTH
> ;END TOPS10 CONDITIONAL
TOPS20 <
FRMFD: XWD FFD$LN,0 ;FILE DESCRIPTOR LENGTH
ASCIZ /SYS:SPFORM.INI/
FFD$LN==.-FRMFD ;COMPUTE FD LENGTH
> ;END TOPS20 CONDITIONAL
SUBTTL $TEXT Utilities
;**;[2542] Change DEPBP /LWS
;HERE ARE SOME TEXT-OUTPUT-ROUTINES
DEP6BP: SUBI S1," " ;CONVERT TO ASCII
DEPBP: SOSL TEXTBC ;CHECK BYTE COUNT
IDPB S1,TEXTBP ;[2542] STORE BYTE
$RETT ;AND RETURN
SUBTTL Program Initialization
SPROUT: JFCL ;NO CCL ENTRY
RESET ;CLEAR ALL ACTIVE I/O
MOVE P,[IOWD PDSIZE,PDL]
MOVEI S1,IB.SZ ;GET SIZE OF IB
MOVEI S2,IB ;GET ADDR OF IB
$CALL I%INIT ;START UP THE WORLD
MOVEI S1,<LOWEND-LOWBEG>+1 ;LOAD LENGTH OF RESIDENT IMPURE DATA
MOVEI S2,LOWBEG ;AND ITS ADDRESS
$CALL .ZCHNK ;AND ZERO IT OUT
$CALL INTINI ;INITIALIZE THE INTERRUPT SYSTEM
IFN ACCTSW,<
SETOM ACTFLG ;UNLESS HE DOESN'T WANT IT
PUSHJ P,ACTINI ;SET UP ACCOUNTING DATA
> ;END IFE ACCTSW
TOPS20 <
HRRZI S1,.MSIIC ;BYPASS MOUNTS
MSTR
ERJMP .+1
> ;END TOPS20 CONDITIONAL
$CALL I%ION ;TURN ON INTERRUPTS
MOVEI T1,HELLO ;GET HELLO MESSAGE
$CALL SNDQSR ;SEND IT
TOPS10< MOVSI S1,.STSPL ;PULL A SETUUO TO
SETUUO S1, ; CLEAR ANY SPOOLING BITS
JFCL ;IGNORE THE ERROR
>
$CALL I%HOST ;GET LOCAL HOST STUFF
;**;[2536] Change 1 line and delete 1 line at SPROUT+30L. /LWS
MOVEM S2,CNTSTA ;[2536] SAVE NUMBER AS CENTRAL STATION
JRST MAIN ;AND GO!!!!
SUBTTL Idle Loop
MAIN: MOVE P,[IOWD PDSIZE,PDL] ;SETUP A NEW PDL
HRROS STREAM ;SET SCHEDULER CONTEXT
$CALL CHKQUE ;PROCESS MESSAGES
MOVX P2,PSF%NP ;GET NEXT PASS FLAG
MAIN.1: MOVSI P1,-NSTRMS ;SET UP DISPATCH AC
MAIN.2: SKIPN JOBACT(P1) ;IS THIS STREAM ACTIVE ???
JRST MAIN.3 ;NO,,GET THE NEXT STREAM.
HRROM P1,STREAM ;YES -- SAVE NUMBER (IN SCHED CONTEXT)
MOVE J,JOBPAG(P1) ;GET ADDRESS OF JOB PAGES
PUSHJ P,CHKPNT ;CHECKPOINT JOB IF NECESSARY
SKIPN JOBSTW(P1) ;IS THE STREAM BLOCKED ???
JRST MAIN.4 ;NO -- SETUP STREAM CONTEXT
MAIN.3: ANDCAM P2,JOBSTW(P1) ;CLEAR NEXT PASS BIT
AOBJN P1,MAIN.2 ;TRY NEXT STREAM
TXZE P2,PSF%NP ;ON SECOND PASS?
JRST MAIN.1 ;NOT YET..TRY AGAIN
;HERE IF NO STREAM IS RUNNABLE
MOVEI S1,0 ;SNOOZE FOR INTERRUPT
$CALL I%SLP ;GO WAIT
$CALL CHKQUE ;PROCESS MESSAGES
JRST MAIN.1 ;AND TRY AGAIN
MAIN.4: CAME J,ACTPAG ;SAME STREAM?
$CALL ACTRNT ;NO..INIT RUNTIME VALUES
MOVEM J,ACTPAG ;SAVE THIS AS ACCOUNTING PAGE
HRLZI 0,J$RACS+1(J) ;SET UP STREAM CONTEXT BLT
HRRI 0,1 ;START WITH AC 1
BLT 0,17 ;RESTORE THE ACS
HRRZS STREAM ;SET STREAM CONTEXT
POPJ P, ;AND RESTORE STREAM PC
;NOTE: Stream is now active and will return via DSCHD (see next page)
SUBTTL Deschedule Process
;DSCHD is called by the $DSCHD macro to cause the "current" stream to
; be un-scheduled. The call is:
;
; $DSCHD(flags)
;
;which generates:
;
; PUSHJ P,DSCHD
; JUMP [EXP flags]
DSCHD: HRROS STREAM ;SET SCHED CONTEXT
MOVEM 0,J$RACS(J) ;SAVE AC 0
MOVEI 0,J$RACS+1(J) ;PLACE TO PUT AC 1
HRLI 0,1 ;SETUP THE BLT POINTER
BLT 0,J$RACS+17(J) ;SAVE STREAM ACS
HRRZ S1,0(P) ;GET ADDRESS OF "JUMP [FLAGS]"
MOVE S1,@0(S1) ;GET THE FLAGS
HRRZ S2,STREAM ;GET STREAM NUMBER
IORM S1,JOBSTW(S2) ;SET THE FLAGS
JRST MAIN ;AND GO LOOP
SUBTTL Do the Job
DOJOB: $CALL FORMS ;GET FORMS MOUNTED
MOVE S1,J$LSER(J) ;GET DEVICE DISPATCH TABLE
PUSHJ P,DBANN(S1) ;AND DO A BANNER IF NECESSARY
LOAD E,.EQLEN(J),EQ.LOH ;GET LENGTH OF HEADER
ADD E,J ;POINT TO FIRST FILE
MOVE T1,.EQCHK+CKFIL(J) ;YES, GET NUMBER OF FILES DONE
MOVEM T1,J$RNFP(J) ;STORE FOR NEXT CHECKPOINT
DOJO.1: SOJL T1,DOJO.2 ;DECREMENT AND JUMP IF SKIPED ENUF
;**;[2543] Insert 2 lines at DOJO.1+1. 12-Aug-85 /DRB
LOAD S1,.FPINF(E),FP.FCY ;[2543] GET THE COPIES IN THIS REQUEST
ADDM S1,J$AFXC(J) ;[2543] ADD TO THE TOTAL COUNT
PUSH P,T1 ;ELSE, SAVE T1
$CALL NXTFIL ;BUMP E TO NEXT SPEC
POP P,T1 ;RESTORE T1
JUMPF ENDJOB ;FINISH OFF IF DONE
JRST DOJO.1 ;LOOP SOME MORE
DOJO.2: MOVE T1,.EQCHK+CKCOP(J) ;GET NUMBER OF COPIES processed
MOVEM T1,J$RNCP(J) ;SAVE FOR NEXT CHECKPOINT
;**;[2543] Insert 1 line at DOJO.2+2. 12-Aug-85 /DRB
ADDM S1,J$AFXC(J) ;[2543] ADD TO THE TOTAL FILE COUNT
DOJO.4: MOVE S1,STREAM ;Get the stream number
SETZM JOBCHK(S1) ;Ask for a checkpoint
PUSHJ P,CHKPNT ;CHECKPOINT JOB
$CALL FILE ;NO, Process THE FILE
TXNE S,RQB+ABORT ;HAVE WE BEEN REQUEUED OR WORSE?
JRST ENDJOB ;YES, END NOW!!
$CALL NXTFIL ;BUMP TO NEXT FILE
JUMPT DOJO.4 ;AND LOOP
JRST ENDJOB ;AND FINISH UP
NXTFIL: SETZM J$RNCP(J) ;CLEAR COPIES processed
SOSG J$RFLN(J) ;DECREMENT FILE COUNT
$RETF ;NO MORE, DONE
LOAD T1,.FPLEN(E),FP.LEN ;GET THE FP LENGTH
ADD E,T1 ;BUMP TO THE FD
LOAD T1,.FDLEN(E),FD.LEN ;GET THE FD LENGTH
ADD E,T1 ;BUMP TO THE NEXT FP
AOS J$RNFP(J) ;ONE MORE FILE DOWN
$RETT ;AND RETURN
SUBTTL Process a File
FILE: TXNE S,ABORT ;HAS JOB BEEN ABORTED?
$RETT ;YES..JUST RETURN AND CLEAN UP
$CALL INPOPN ;NO..OPEN THE FILE
JUMPF .POPJ ;RETURN IF NO FILE
FILE.1: $CALL INPREW ;REWIND THE INPUT FILE
MOVE S1,J$LSER(J) ;GET DISPATCH ADDRESS
PUSHJ P,DHEAD(S1) ;AND DO HEADER
MOVE S1,J$LSER(J) ;GET DISPATCH ADDRESS
PUSHJ P,DPROC(S1) ;AND PROCESS THE FILE
MOVE S1,J$LSER(J) ;GET ADDRESS OF DEVICE DISPATCH
PUSHJ P,DTAIL(S1) ;AND DO A FILE TRAILER
TXNE S,ABORT!SKPFIL!RQB ;ABORTED OR SKIPPED OR REQUEUED?
JRST FILE.2 ;YES, CONTINUE ON
;**;[2543] Insert 1 line at FILE.1+9. 12-Aug-85 /DRB
AOS J$AFXC(J) ;[2543] ADD 1 TO THE TOTAL FILE COUNT
AOS S1,J$RNCP(J) ;INCREMENT AND LOAD COPIES WORD
LOAD S2,.FPINF(E),FP.FCY ;GET TOTAL NUMBER TO Process
CAMGE S1,S2 ;processed ENOUGH?
JRST FILE.1 ;NO LOOP
FILE.2: MOVE S1,J$DIFN(J) ;GET THE IFN
TXZE S,DSKOPN ;CLEAR AND CHECK FILE OPEN BIT
$CALL F%REL ;CLOSE AND RELEASE
POPJ P, ;AND RETURN
SUBTTL End of Job
ENDJOB: TXO S,GOODBY ;FLAG EOJ SEQUENCE
MOVE S1,J$LSER(J) ;GET DEVICE DISPATCH TABLE
$CALL DEOJ(S1) ;DO A TRAILER IF NECESSARY
TOPS10 <
$CALL OUTWAT ;OUTPUT AND WAIT UNTIL DONE
> ;;END TOPS10
TOPS20 <
$CALL OUTOUT ;FORCE EVERYTHING OUT
> ;;END TOPS20
HRRZ S1,STREAM ;POINT TO CURRENT STREAM
$WTOJ (End,^R/.EQJBB(J)/,@JOBOBA(S1))
$CALL QRELEASE ;RELEASE THE JOB
$CALL ACTEND ;DO FINAL ACCOUNTING
HRRZ S1,STREAM ;GET STREAM NUMBER
SETZM JOBACT(S1) ;NOT BUSY
TOPS20 <
PUSHJ P,OUTOUT ;FORCE OUTPUT
> ;;END TOPS20
JRST MAIN ;AND LOOP TO THE BEGINNING
QRELEA: TXNE S,RQB ;REQUEUEING?
JRST QREQUE ;YES..GO REQUE IT
$CALL FILDIS ;DISPOSE OF SPOOLED FILES
MOVX S1,REL.SZ ;NO..RELEASE IT
MOVX S2,.QOREL
$CALL CLRMSG ;INIT MESSAGE
LOAD S1,.EQITN(J) ;GET THE ITN
STORE S1,REL.IT(T1) ;STORE IT
PJRST SNDQSR ;SEND IT OFF AND RETURN
QREQUE: MOVX S1,REQ.SZ ;GET REQUE MESSAGE SIZE
MOVX S2,.QOREQ ;AND REQUE FUNCTION
$CALL CLRMSG ;INIT MESSAGE
LOAD S1,.EQITN(J) ;GET THE ITN
STORE S1,REQ.IT(T1) ;STORE IT
LOAD S1,J$RNFP(J) ;GET NUMBER OF FILES processed
STORE S1,REQ.IN+CKFIL(T1) ;STORE IT
LOAD S1,J$RNCP(J) ;GET COPIES processed
STORE S1,REQ.IN+CKCOP(T1) ;STORE IT
MOVX S1,RQ.HBO ;GET HOLD BY OPERATOR
STORE S1,REQ.FL(T1) ;STORE IN FLAG WORD
PJRST SNDQSR ;SEND THE MESSAGE TO QUASAR
SUBTTL FILDIS Routine to KEEP/DELETE requested files
FILDIS: LOAD E,.EQLEN(J),EQ.LOH ;GET THE HEADER LENGTH.
ADD E,J ;POINT TO FIRST FILE .
LOAD T1,.EQSPC(J),EQ.NUM ;GET THE NUMBER OF FILES.
FILD.1: LOAD T2,.FPINF(E) ;GET THE FILE INFO BITS.
LOAD S2,.FPLEN(E),FP.LEN ;GET THE FILE INFO LENGTH.
ADD E,S2 ;POINT TO FILE SPEC.
MOVE T3,E ;PUT FD ADDRESS INTO T3 (FOB).
LOAD S2,.FPLEN(E),FD.LEN ;GET THE FD LENGTH.
ADD E,S2 ;POINT TO NEXT FILE.
DMOVE S1,[EXP 1,T3] ;GET F%DEL PARMS.
;**;[2533]REVAMP CODE AT FILD.1:+7L CTK/16-DEC-82
TXNE T2,FP.DEL ;[2533]/DELETE SPECIFIED ???
TXNE S,ABORT ;[2533]IS ABORT SET ???
TXNE T2,FP.SPL ;[2533]SPOOL FILE ???
PUSHJ P,F%DEL ;[2533]YES,,DELETE THE FILE.
SOJG T1,FILD.1 ;GO PROCESS THE NEXT FILE.
$RETT ;RETURN.
SUBTTL CHKQUE Routine to process IPCF messages
CHKQUE: $SAVE <STREAM> ;PRESERVE CURRENT STREAM
CHKQ.1: SETZM MESSAG ;ZERO MESSAGE ADDRESS
SETZM BLKADR ;CLEAR ARG ADDRESS
$CALL C%RECV ;RECEIVE A MESSAGE
JUMPF .POPJ ;RETURN IF NO MESSAGES
CHKQ.2: LOAD S2,MDB.SI(S1) ;GET SPECIAL INDEX WORD
TXNN S2,SI.FLG ;IS THERE AN INDEX THERE?
JRST CHKQ.5 ;NO, IGNORE IT
ANDX S2,SI.IDX ;AND OUT THE INDEX
CAIE S2,SP.OPR ;IS IT FROM OPR?
CAIN S2,SP.QSR ;IS IT FROM QUASAR?
SKIPA ;YES -- CONTINUE ON
JRST CHKQ.5 ;NO -- IGNORE IT
LOAD M,MDB.MS(S1),MD.ADR ;GET THE MESSAGE ADDRESS
MOVEM M,MESSAG ;SAVE ADDRESS
LOAD S1,.MSTYP(M),MS.TYP ;GET THE MESSAGE TYPE
MOVSI T2,-NMSGT ;NO -- SEARCH QUASAR TYPES
CHKQ.3: HRRZ T1,MSGTBL(T2) ;GET A MESSAGE TYPE
CAMN S1,T1 ;MATCH?
JRST CHKQ.4 ;YES, WIN
AOBJN T2,CHKQ.3 ;NO, LOOP
JRST CHKQ.5 ;UNKNOWN TYPE -- IGNORE IT
CHKQ.4: HLRZ T1,MSGTBL(T2) ;GET THE ROUTINE ADDRESS
MOVX S,NOSTRM ;ASSUME NO STREAM CONTEXT
$CALL CHKOBJ ;SET UP STREAM CONTEXT
JUMPF CHKQ.5 ;BAD NEWS..GET NEXT MESSAGE
PUSHJ P,0(T1) ;DISPATCH
TXNN S,NOSTRM ;IN STREAM CONTEXT?
MOVEM S,J$RACS+S(J) ;YES..SAVE STATUS REG
CHKQ.5: $CALL C%REL ;RELEASE MESSAGE
CHKQ.6: JRST CHKQ.1 ;GET NEXT MESSAGE
MSGTBL: XWD KILL,.QOABO ;ABORT MESSAGE
XWD NXTJOB,.QONEX ;NEXTJOB
XWD SETUP,.QOSUP ;SETUP
XWD OACCAN,.OMCAN ;CANCEL
XWD OACREQ,.OMREQ ;REQUEUE THE CURRENT JOB
XWD OACSTP,.OMPAU ;STOP FOR A WHILE
XWD OACCON,.OMCON ;CONTINUE FROM STOP
XWD OACRSP,.OMRSP ;RESPONSE TO WTOR
NMSGT==.-MSGTBL
SUBTTL CHKOBJ Routine to validate QUASAR/ORION/OPR MSG Object block
;CALL: S1/ MESSAGE TYPE
; M/ MESSAGE ADDRESS
;
;RET: STREAM/STREAM NUMBER
; J/DATA BASE ADDRESS
; S/STATUS BITS
CHKOBJ: $SAVE <T1,T2,T3,T4> ;SAVE THE TEMPORARIES
MOVSI T1,-NMSGO ;GET REPEAT COUNT
CHKO.1: HLRZ S2,MSGOBJ(T1) ;GET A MESSAGE TYPE
CAMN S1,S2 ;IS THIS IT?
JRST CHKO.3 ;YES..PROCESS IT
AOBJN T1,CHKO.1 ;NO..TRY THE NEXT
CAIGE S1,.OMOFF ;OPR/ORION MESSAGE?
$RETF ;NO..WE LOOSE
CHKO.2: PUSHJ P,GETBLK ;GET A MESSAGE BLOCK
JUMPF .RETF ;NO MORE,,THATS AN ERROR
CAIE T1,.OROBJ ;IS THIS THE OBJECT BLOCK ???
JRST CHKO.2 ;NO,,GET THE NEXT MSG BLOCK
MOVE S1,T3 ;GET THE BLOCK DATA ADDRESS IN S1.
JRST CHKO.4 ;GO FIND THE OBJECT BLOCK
CHKO.3: HRRZ S1,MSGOBJ(T1) ;GET THE MESSAGE OFFSET
JUMPE S1,.RETT ;RETURN IF NOT MAPPABLE
ADDI S1,0(M) ;ADD MESSAGE ADDRESS
JRST CHKO.4 ;MEET AT THE PASS.
CHKO.4: PUSHJ P,FNDOBJ ;GO FIND THE OBJECT BLOCK.
JUMPF .RETF ;NOT THERE,,THATS AN ERROR.
$RETT ;RETURN.
;TABLE FORMAT FOR NON STANDARD MESSAGES
; Message type,,Message offset to object block (or 0 if none)
MSGOBJ: .QOABO,,ABO.TY ;QUASAR ABORT MESSAGE
.QORCK,,RCK.TY ;QUASAR REQUEST CHECKPOINT
.QONEX,,.EQROB ;QUASAR NEXTJOB MESSAGE
.QOSUP,,0 ;QUASAR SETUP/SHUTDOWN MESSAGE
.OMRSP,,0 ;OPR/ORION RESPONSE?
NMSGO==.-MSGOBJ ;NUMBER OF TYPES
SUBTTL FNDOBJ Routine to establish STREAM context
;ACCEPTS S1/ Address of object block
;RETURNS TRUE J/ Address of context data
; S/ Context status bits
; STREAM/ Context stream
; FALSE Object not found
FNDOBJ: MOVE T1,.ROBTY(S1) ;GET OBJECT TYPE
MOVE T2,.ROBAT(S1) ;GET UNIT NUMBER
MOVE T3,.ROBND(S1) ;AND NODE NUMBER
SETZ T4, ;CLEAR AN INDEX REGISTER
FNDO.1: MOVE S2,T4 ;GET THE INDEX
IMULI S2,3 ;MULTIPLY BY OBJECT BLCK SIZE
CAMN T1,JOBOBJ+OBJ.TY(S2) ;COMPARE
CAME T2,JOBOBJ+OBJ.UN(S2) ;COMPARE
JRST FNDO.2 ;NOPE
CAMN T3,JOBOBJ+OBJ.ND(S2) ;COMPARE
JRST FNDO.3 ;WIN, SETUP THE CONTEXT
FNDO.2: ADDI T4,1 ;INCREMENT
CAIL T4,NSTRMS ;THE END OF THE LINE?
$RETF ;LOOSE
JRST FNDO.1 ;OK, LOOP
FNDO.3: HRROM T4,STREAM ;SAVE STREAM NUMBER
MOVE J,JOBPAG(T4) ;GET ADDRESS OF DATA
MOVE S,J$RACS+S(J) ;GET STREAMS 'S'
CAME J,ACTPAG ;SAME ACCOUNTING PAGE?
$CALL ACTRNT ;NO..DO RUNTIME ACCOUNTING
MOVEM J,ACTPAG ;SAVE ACCOUNTING PAGE
$RETT ;AND RETURN
SUBTTL GETBLK Routine to return next argument from an OPR/ORION message
;CALL: M/ MESSAGE ADDRESS
;
;RET: T1/ BLOCK TYPE
; T2/ BLOCK LENGTH
; T3/ BLOCK DATA ADDRESS
GETBLK: SOSGE .OARGC(M) ;SUBTRACT 1 FROM THE BLOCK COUNT
$RETF ;NO MORE,,RETURN
SKIPN S1,BLKADR ;GET THE PREVIOUS BLOCK ADDRESS
MOVEI S1,.OHDRS+ARG.HD(M) ;NONE THERE,,GET FIRST BLOCK ADDRESS
LOAD T1,ARG.HD(S1),AR.TYP ;GET THE BLOCK TYPE
LOAD T2,ARG.HD(S1),AR.LEN ;GET THE BLOCK LENGTH
MOVEI T3,ARG.DA(S1) ;GET THE BLOCK DATA ADDRESS
ADD S1,T2 ;POINT TO THE NEXT MESSAGE BLOCK
MOVEM S1,BLKADR ;SAVE IT FOR THE NEXT CALL
$RETT ;RETURN TO THE CALLER
SUBTTL NEXTJOB Message from QUASAR
NXTJOB: HRR S1,J ;GET 0,,DEST
HRR S2,M ;GET ADDRESS OF MESSAGE
HRL S1,S2 ;GET SOURCE,,DEST
LOAD S2,.MSTYP(S2),MS.CNT ;GET LENGTH OF MESSAGE
ADDI S2,-1(J) ;GET ADR OF END OF BLT
BLT S1,(S2) ;BLT THE DATA
HRRZ S1,STREAM ;GET STREAM NUMBER
SETOM JOBACT(S1) ;MAKE THE STREAM ACTIVE
SETZM JOBSTW(S1) ; AND NOT BLOCKED
MOVEI S1,J$RPDL-1(J) ;POINT TO CONTEXT PDL
HRLI S1,-PDSIZE ;AND THE LENGTH
PUSH S1,[EXP DOJOB] ;PUSH THE FIRST ADR ON THE STACK
MOVEM S1,J$RACS+P(J) ;AND STORE THE PDL
SETZB S,J$RACS+S(J) ;CLEAR FLAGS AC
MOVEI S1,J$$BEG(J) ;PREPARE TO ZERO SELECTED WORDS JOB AREA
MOVSI S2,-^D15 ;AOBJN POINTER TO BIT TABLE
NXTJ.2: MOVEI T1,^D36 ;BIT COUNTER FOR THIS WORD
MOVE T2,ZTABLE(S2) ;GET A WORD FROM BIT TABLE
NXTJ.3: JUMPE T2,NXTJ.4 ;DONE IF REST OF WORD IS ZERO
JFFO T2,.+1 ;FIND THE FIRST 1 BIT
ADD S1,T3 ;MOVE UP TO THE CORRESPONDING WORD
SETZM 0(S1) ;AND ZERO IT
SUB T1,T3 ;REDUCE BITS LEFT IN THIS WORD
LSH T2,0(T3) ;SHIFT OFFENDING BIT TO BIT 0
TLZ T2,(1B0) ;AND GET RID OF IT
JRST NXTJ.3 ;AND LOOP
NXTJ.4: ADD S1,T1 ;ACCOUNT FOR THE REST OF THE WORD
AOBJN S2,NXTJ.2 ;AND LOOP
LOAD S1,.EQSPC(J),EQ.NUM ;GET NUMBER OF FILES
MOVEM S1,J$RFLN(J) ;STORE IT
GETLIM T1,.EQLIM(J),OLIM ;GET PAGE LIMIT
MOVEM T1,J$RLIM(J) ;SAVE IT
$CALL I%NOW ;GET TIME OF DAY
MOVEM S1,J$RTIM(J) ;SAVE IT AWAY
HRRZ S1,STREAM ;POINT TO CURRENT STREAM
$WTOJ (Begin,^R/.EQJBB(J)/,@JOBOBA(S1))
LOAD S1,.EQSEQ(J),EQ.IAS ;GET INVALID ACCOUNT BIT
STORE S1,S,ABORT ;ABORT IF SET
$CALL ACTBEG ;START ACCOUNTING
$RETT ;AND RETURN
SUBTTL User CANCEL Request
KILL: TXOE S,GOODBY!ABORT ;SET SOME BITS
$RETT ;IF WE LEAVING, IGNORE IT ANYWAY
HRRZ S1,STREAM ;GET THE STREAM NUMBER
MOVX S2,PSF%OR ;GET OPERATOR RESPONSE BIT
TDNE S2,JOBSTW(S1) ;ARE WE WAITING FOR OPR RESPONSE ???
$KWTOR (JOBWAC(S1)) ;YES,,KILL IT !!!
ANDCAM S2,JOBSTW(S1) ;AND CLEAR THE WAIT BIT
$CALL INPFEF ;SET END OF FILE ALSO
HRRZ S1,STREAM ;POINT TO STREAM
$WTOJ (<Cancel request queued by user ^U/ABO.ID(M)/>,<^R/.EQJBB(J)/>,@JOBOBA(S1))
PUSHJ P,SETEBF ;SET UP ERROR BUFFER
$TEXT (DEPBP,<? Canceled by user ^U/ABO.ID(M)/^0>)
$RETT ;AND RETURN
SUBTTL UPDATE Routine to send status update
; Generate status update messages
;
UPDATE: $SAVE <S1,S2,T1,T2> ;SAVE SOME ACS
MOVX S1,STU.SZ ;GET STATUS UPDATE SIZE
MOVX S2,.QOSTU ; AND TYPE
$CALL CLRMSG ;INIT THE MESSAGE AND T1
MOVX T2,%RESET ;DEFAULT TO RESET
HRRZ S1,STREAM ;GET THE STREAM NUMBER
MOVE S1,JOBPAG(S1) ;GET ADDRESS OF JOB DATA PAGES
MOVE S2,J$RACS+S(S1) ;GET STREAM'S AC 'S'
TXNE S2,RQB ;REQUEUING JOB ?
MOVX T2,%REQUE ;YES
TXNE S2,ABORT ;ABORTING JOB ?
MOVX T2,%CNCLG ;YES
HRRZ S1,STREAM ;GET THE STREAM NUMBER
MOVE S2,JOBSTW(S1) ;GET THE JOBS STATUS WORD
TXNE S2,PSF%OR ;ARE WE WAITING FOR OPR RESPONSE ???
MOVX T2,%OREWT ;YES,,SAY SO
TXNE S2,PSF%ST ;ARE WE STOPPED ???
MOVX T2,%STOPD ;YES,,SAY SO
TXNE S2,PSF%DO ;ARE WE OFFLINE ???
MOVX T2,%OFLNE ;YES,,SAY SO
MOVEM T2,STU.CD(T1) ;SAVE THE STATUS
HRLZ T2,JOBOBA(S1) ;GET THE OBJECT BLOCK ADDRESS
HRRI T2,STU.RB(T1) ;GET DESTINATION ADDRESS
BLT T2,STU.RB+OBJ.SZ-1(T1) ;COPY THE OBJ BLK OVER TO THE MSG
$CALL SNDQSR ;SEND IT OFF
$RET
SUBTTL CHKPNT Routine to send checkpoint message
; Send checkpoint job message to QUASAR. This routine calls the device
; dependant service routines to generate half of the ASCIZ text that gets
; displayed by QUASAR in queue listings.
;
CHKPNT: MOVE S1,STREAM ;GET THE STREAM NUMBER
SKIPN JOBACT(S1) ;NEED TO CHECKPOINT ?
POPJ P, ;NO - RETURN
$CALL I%NOW ;GET THE CURRENT TIME
MOVE TF,S1 ;SAVE IT TEMPORARILY
MOVE S2,STREAM ;GET THE STREAM NUMBER
SUB S1,JOBCHK(S2) ;GET CHECKPOINT INTERVAL
SKIPGE S1 ;TIME TO CHECKPOINT YET ?
POPJ P, ;NO - RETURN
ADDI TF,CKPTIM*3 ;COMPUTE TIME OF NEXT CHECKPOINT
MOVEM TF,JOBCHK(S2) ;STORE FOR NEXT PASS THROUGH HERE
CHKP.0: MOVX S1,CHE.SZ ;GET SIZE OF CHECKPOINT MESSAGE
MOVX S2,.QOCHE ;AND CHECKPOINT TYPE
PUSHJ P,CLRMSG ;INIT MESSAGE AND T1
MOVX S1,CH.FCH!CH.FST ;GET CHECKPOINT AND STATUS FLAGS
STORE S1,CHE.FL(T1) ;AND STORE THEM
MOVE S1,J$RNFP(J) ;GET NUMBER OF FILES
MOVEM S1,CHE.IN+CKFIL(T1) ;STORE IT
MOVE S1,J$RNCP(J) ;GET NUMBER OF COPIES
MOVEM S1,CHE.IN+CKCOP(T1) ;AND STORE IT
MOVE S1,J$APRT(J) ;GET NUMBER OF CARDS, ETC
MOVEM S1,CHE.IN+CKTPP(T1) ;AND STORE IT
LOAD S1,.EQITN(J) ;GET JOBS ITN
MOVEM S1,CHE.IT(T1) ;STORE IT
MOVEI S1,CHE.ST(T1) ;GET ADDRESS OF STATUS AREA
HRLI S1,(POINT 7,0) ;MAKE IT A BYTE POINTER
MOVEM S1,TEXTBP ;SAVE BYTE POINTER
MOVEI S1,STSSIZ*5-1 ;MAXIMUMUM CHARACTER COUNT
MOVEM S1,TEXTBC ;FOR DEPBP
CHKP.1: $TEXT (DEPBP,<Started at ^C/J$RTIM(J)/, ^A>)
MOVE S1,J$LSER(J) ;GET ADDRESS OF DEVICE DISPATCH
PUSHJ P,DCHKP(S1) ;GENERATE DEVICE DEPENDANT TEXT
HRRZ S1,TEXTBP ;GET THE BYTE POINTER
SUBI S1,MSGBLK-1 ;SUBTRACT START POINT
STORE S1,.MSTYP(T1),MS.CNT ;SAVE THE ACTUAL LENGTH
PJRST SNDQSR ;SEND IT AND RETURN
SUBTTL SETUP/SHUTDOWN Message
SETUP: LOAD S2,SUP.FL(M) ;GET THE FLAGS
TXNE S2,SUFSHT ;IS IT A SHUTDOWN?
JRST [MOVEI S1,SUP.TY(M) ;GET OBJECT ADDRESS
$CALL FNDOBJ ;FIND IT
JRST SHUTDN] ;AND SHUT IT DOWN
SETZ T2, ;CLEAR A LOOP REG
SETU.1: SKIPN JOBPAG(T2) ;A FREE STREAM?
JRST SETU.2 ;YES!!
CAIGE T2,NSTRMS-1 ;NO, LOOP THRU THEM ALL?
AOJA T2,SETU.1 ;NO, KEEP GOING
$STOP(TMS,Too many setups)
SETU.2: HRRZM T2,STREAM ;SAVE THE STREAM NUMBER
$CALL I%NOW ;USE SETUP TIME AS ACK STAMP
MOVEM S1,JOBWAC(T2) ;SAVE CODE FOR $WTOR
MOVEI S1,NJBPGS ;NUMBER OF PAGES NEEDED
$CALL M%AQNP ;GET THEM
PG2ADR S1 ;CONVERT TO AN ADDRESS
MOVEM S1,JOBPAG(T2) ;AND SAVE IT
MOVE J,S1 ;PUT IT IN J
MOVEM J,J$RACS+J(J) ;SAVE J AWAY
MOVEI S1,2000(J) ;DEV BUFFER ADDRESS
MOVEM S1,J$LBUF(J) ;STORE IT
MOVE S2,T2 ;COPY OVER THE STREAM NUMBER
IMULI T2,OBJ.SZ ;GET OFFSET OF OBJECT BLOCK
ADDI T2,JOBOBJ ;ADD IN THE BASE
MOVEM T2,JOBOBA(S2) ;STORE OBJECT ADDRESS
MOVE S2,T2 ;GET DESTINATION OF BLT INTO S2
HRLI S2,SUP.TY(M) ;MAKE A BLT POINTER
BLT S2,OBJ.SZ-1(T2) ;BLT THE OBJECT BLOCK
$CALL OUTGET ;GET THE OUTPUT DEVICE
$CALL RSETUP ;SEND RESPONSE TO SETUP
HRRZ S2,STREAM ;GET OUR STREAM NUMBER
$WTO (^T/@SETMSG(S1)/,,@JOBOBA(S2)) ;TELL THE OPERATOR
CAIN S1,%RSUOK ;ALL IS OK?
$RETT ;YES, RETURN
JRST SHUTDN ;NO, SHUT IT DOWN
SETMSG: [ASCIZ /Started/]
[ASCIZ /Not available right now/]
[ASCIZ /Does not exist/]
SUBTTL Response to setup message
;CALL S1/ Setup response code
;RETURNS S1/ Setup response code
RSETUP: $SAVE <S1> ;PRESERVE S1 ACROSS CALL
MOVE T2,S1 ;SAVE THE SETUP CONDITION CODE.
MOVX S1,RSU.SZ ;GET RESPONSE TO SETUP SIZE
MOVX S2,.QORSU ; AND TYPE
$CALL CLRMSG ;INIT MESSAGE AND T1
STORE T2,RSU.CO(T1) ;STORE THE RESPONSE CODE
MOVE S1,STREAM ;GET STREAM NUMBER
MOVS S1,JOBOBA(S1) ;GET OBJADR,,0
HRRI S1,RSU.TY(T1) ;AND PLACE TO MOVE IT TO
BLT S1,RSU.TY+OBJ.SZ-1(T1) ;AND MOVE THE OBJECT BLOCK
PJRST SNDQSR ;SEND IT OFF AND RETURN
;SHUTUP is called to shutdown the object and return to MAIN loop
;Here if something terrible happens to the device
SHUTUP: MOVE P,[IOWD PDSIZE,PDL] ;POINT TO MAIN PDL
MOVEI S1,%RSUDE ;GET DEVICE DOES NOT EXIST CODE
$CALL RSETUP ;TELL QUASAR
MOVE S1,J$LJFN(J) ;[2541] GET THE CHANNEL NUMBER
RESDV. S1, ;[2541] RESET THE DEVICE
JFCL ;[2541] SHUT DOWN NO MATTER WHAT
$CALL SHUTIN ;[2541] SHUT DOWN THE STREAM
JRST MAIN ;ONWARD AND UPWARD
;SHUTDN is called to shutdown the object running in the current STREAM
SHUTDN: $CALL OUTREL ;RELEASE THE OBJECT
SHUTIN: MOVE S2,J ;[2541] GET THE JOBPAG ADDRESS
ADR2PG S2 ;CONVERT TO A PAGE NUMBER
MOVEI S1,NJBPGS ;LOAD THE NUMBER OF PAGES
$CALL M%RLNP ;RETURN THEM
HRRZ S1,STREAM ;GET THE STREAM NUMBER
SETZM JOBPAG(S1) ;CLEAR THE PAGE WORD
SETZM JOBACT(S1) ;AND THE ACTIVE WORD
MOVX S,NOSTRM ;MAKE NO STREAM CONTEXT
$RETT ;AND RETURN
SUBTTL Operator CANCEL command
OACCAN: $SAVE <P1,P2> ;PRESERVE SOME ACS
PUSHJ P,INPFEF ;FORCE EOF
TXO S,GOODBY!ABORT ;LIGHT THE ABORT FLAG
PUSHJ P,SETEBF ;SET UP ERROR TEXT BUFFER
HRRZ S1,STREAM ;GET THE STREAM NUMBER
MOVX S2,PSF%OR ;GET OPERATOR RESPONSE BIT
TDNE S2,JOBSTW(S1) ;ARE WE WAITING FOR OPR RESPONSE ???
$KWTOR (JOBWAC(S1)) ;YES,,KILL IT !!!
ANDCAM S2,JOBSTW(S1) ;AND CLEAR THE WAIT BIT
$ACK (<Abort request queued>,<^R/.EQJBB(J)/>,@JOBOBA(S1),.MSCOD(M))
PUSHJ P,UPDATE ;UPDATE STATUS TO QUASAR
$TEXT (DEPBP,<? Aborted by the operator^A>) ;INITIAL MESSAGE
SETZ P1,P2 ;ASSUME NOT PURGED
OACC.1: PUSHJ P,GETBLK ;GET A MESSAGE BLOCK
JUMPF OACC.2 ;NO MORE,,FINISH UP
CAIN T1,.ORREA ;IS THIS THE REASON BLOCK ???
MOVEI P1,0(T3) ;YES..SAVE ADDRESS OF REASON
CAIE T1,.CANTY ;IS THIS THE CANCEL TYPE BLOCK ???
JRST OACC.1 ;NO,,SKIP IT AND GET NEXT BLOCK
MOVE S1,0(T3) ;YES - LOAD THE CANCEL TYPE
CAIE S1,.CNPRG ;IS IT /PURGE ???
JRST OACC.1 ;NO,,PROCESS THE NEXT MSG BLK
$TEXT (DEPBP,< (purged)^A>) ;YES
SETO P2, ;FLAG PURGING JOB
JRST OACC.1 ;GO BACK
OACC.2: SKIPN P1 ;DID HE GIVE A REASON?
$TEXT (DEPBP,<. No reason given.^0>) ;NO
SKIPE P1 ;NO?
$TEXT (DEPBP,<. Reason: ^T/0(P1)/.^0>) ;YES
JUMPE P2,.POPJ ;RETURN IF NOT PURGING
MOVE S1,J$DIFN(J) ;GET THE FILE IFN.
TXZE S,DSKOPN ;DONT CLOSE IF ITS NOT OPEN.
PUSHJ P,F%REL ;ELSE,,CLOSE IT OUT.
$CALL ACTEND ;DO FINAL ACCOUNTING
$CALL QRELEASE ;RELEASE THE STREAM
HRRZ S1,STREAM ;GET THE STREAM NUMBER
SETZM JOBACT(S1) ;INDICATE NOT ACTIVE
;**;[2540] Delete 3 lines at OACC.2+12L. /LWS
POPJ P, ;RETURN
SUBTTL Operator STOP command
OACSTP: MOVX S2,PSF%ST ;LOAD THE STOP BIT
HRRZ S1,STREAM ;GET THE STREAM NUMBER
IORM S2,JOBSTW(S1) ;SET IT
$ACK (<Stopped>,,@JOBOBA(S1),.MSCOD(M)) ;TELL OPR
PUSHJ P,UPDATE ;UPDATE STATUS TO QUASAR
$RETT ;AND RETURN
SUBTTL Operator CONTINUE command
OACCON: MOVX S2,PSF%ST!PSF%DO ;LOAD STOP AND DEVICE OFF-LINE FLAGS
HRRZ S1,STREAM ;GET THE STREAM NUMBER
ANDCAM S2,JOBSTW(S1) ;CLEAR IT
$ACK (<Continued>,,@JOBOBA(S1),.MSCOD(M)) ;TELL OPR
PUSHJ P,UPDATE ;UPDATE STATUS TO QUASAR
$RETT ;AND RETURN
SUBTTL Operator RESPONSE command
OACRSP: MOVE S2,.MSCOD(M) ;GET WTOR ACK CODE.
MOVSI S1,-NSTRMS ;CREATE AOBJN AC.
RESP.1: CAME S2,JOBWAC(S1) ;COMPARE ACK CODES..
JRST [AOBJN S1,RESP.1 ;NOT EQUAL,,CHECK NEXT STREAM.
$RETT ] ;NOT THERE,,FLUSH THE MSG.
MOVX S2,PSF%OR ;GET "OPERATOR-RESPONSE" WAIT BIT
ANDCAM S2,JOBSTW(S1) ;AND CLEAR IT
MOVE J,JOBPAG(S1) ;GET THE STREAM DB ADDRESS.
$CALL SETTBF ;POINT TO TEXT BUFFER
MOVEI S1,.OHDRS+ARG.DA(M) ;POINT TO THE OPERATOR RESPONSE.
$TEXT (DEPBP,<^T/0(S1)/^0>) ;MOVE RESPONSE TO TEXT BUFFER
PUSHJ P,UPDATE ;UPDATE STATUS TO QUASAR
$RETT ;AND RETURN
SUBTTL Operator REQUEUE command
OACREQ: TXNE S,GOODBY ;IS IT TOO LATE FOR THIS ???
$RETT ;YES..JUST RETURN
PUSHJ P,INPFEF ;FORCE AN INPUT EOF
TXO S,RQB!ABORT ;SET ABORT AND REQUEUED
MOVE S1,STREAM ;GET THE STREAM NUMBER
$ACK (<Requeue request queued>,<^R/.EQJBB(J)/>,@JOBOBA(S1),.MSCOD(M))
PUSHJ P,UPDATE ;UPDATE STATUS TO QUASAR
$CALL SETEBF ;POINT TO TEXT BUFFER
HRRZ S1,STREAM ;GET THE STREAM NUMBER
MOVX S2,PSF%OR ;GET OPERATOR RESPONSE BIT
TDNE S2,JOBSTW(S1) ;ARE WE WAITING FOR OPR RESPONSE ???
$KWTOR (JOBWAC(S1)) ;YES,,KILL IT !!!
ANDCAM S2,JOBSTW(S1) ;AND CLEAR THE WAIT BIT
$TEXT (DEPBP,<?Requeued by operator ^A>)
SETZ P1, ;MESSAGE GIVEN
OACR.1: PUSHJ P,GETBLK ;GET A MESSAGE BLOCK
JUMPF OACR.3 ;NO MORE,,RETURN
CAIN T1,.REQTY ;IS THIS THE REQUEST TYPE BLOCK ???
JRST OACR.2 ;YES,,GO PROGESS IT
CAIN T1,.ORREA ;IS THIS THE REASON BLOCK ???
MOVEI P1,0(T3) ;GET THE MESSAGE
JRST OACR.1 ;PROCESS THE NEXT MSG BLOCK
OACR.2: MOVE S1,0(T3) ;PICK UP THE REQUEUE CODE.
SETZ S2, ;ZERO AC 2
CAXN S1,.RQCUR ;/CURRENT?
MOVEI S2,[ASCIZ/ Job will restart at current position/]
JUMPN S2,OACR.1 ;FINISH UP
SETZM J$RNPP(J) ;CLEAR CURRENT PAGE NUMBER
CAXN S1,.RQBCP ;BEGINNING OF COPY?
MOVEI S2,[ASCIZ /Job will restart at current copy/]
JUMPN S2,OACR.1 ;AND CONTINUE ON
SETZM J$RNCP(J) ;CLEAR CURRENT COPY NUMBER
CAXN S1,.RQBFL ;FROM BEGINING OF FILE?
MOVEI S2,[ASCIZ /Job will restart at current file/]
JUMPN S2,OACR.1 ;AND CONTINUE ON
SETZM J$RNFP(J) ;CLEAR FILE COUNT
MOVEI S2,[ASCIZ /Job will restart at beginning/]
JRST S2,OACR.1 ;AND GO OUTPUT IT
OACR.3: SKIPN P1 ;A REASON?
$TEXT (DEPBP,<. No reason given.>)
SKIPE P1 ;LIST THEM ALL
$TEXT (DEPBP,<. Reason: ^T/0(P1)/.>)
SKIPE S2
$TEXT (DEPBP,<. ^T/0(S2)/.^A>)
MOVEI S1,.CHNUL ;END THE MESSAGE
$CALL DEPBP
$RETT
SUBTTL CLRMSG and SNDQSR routines
;CLRMSG can be called to setup the length and type of a message
;CALL S1/ Length of Message
; S2/ Message type
;RETURNS T1/ Address of message
CLRMSG: MOVEI T1,MSGBLK ;GET ADDRESS FOR RETURN
STORE S1,.MSTYP(T1),MS.CNT ;STORE THE LENGTH
STORE S2,.MSTYP(T1),MS.TYP ;STORE THE TYPE
CAILE S2,MSBSIZ ;SIZE OK?
$STOP (MSZ,Message size too large)
SUBI S1,.MSFLG ;DECREMENT COUNT TO CLEAR
MOVEI S2,.MSFLG(T1) ;FIRST WORD TO CLEAR
PJRST .ZCHNK ;CLEAR AND RETURN
;SNDQSR is called to send a message to QUASAR
;CALL T1/ Message address
SNDQSR: MOVX S1,SP.QSR ;GET QUASAR CODE
TXO S1,SI.FLG ;SET SPECIAL INDEX FLAG
STORE S1,SAB+SAB.SI ;AND STORE IT
SETZM SAB+SAB.PD ;CLEAR THE PID WORD
LOAD S1,.MSTYP(T1),MS.CNT ;GET MESSAGE LENGTH
TRNN T1,777 ;CHECK FOR PAGE MESSAGE
MOVEI S1,1000 ;GET 1 PAGE MESSAGE SIZE
STORE S1,SAB+SAB.LN ;SAVE IT
STORE T1,SAB+SAB.MS ;SAVE THE MESSAGE ADDRESS
MOVEI S1,SAB.SZ ;LOAD THE SIZE
MOVEI S2,SAB ;AND THE ADDRESS
$CALL C%SEND ;SEND THE MESSAGE
JUMPT .RETT ;AND RETURN
$STOP(QSF,Send to QUASAR FAILED)
FRMLEX: GETLIM S1,.EQLIM(J),FLEA ;GET FORMS-LIMIT-EXCEED ACTION
CAIN S1,.STCAN ;SEE IF CANCEL
JRST OUTCAN ;IT WAS, DO IT
CAIN S1,.STIGN ;SEE IF IGNORE
JRST OUTIGN ;YES, DOUBLE THE LIMIT
;DEFAULT TO ASK IF NOT CANCEL OR IGNORE
OUTASK: HRRZ S1,STREAM ;GET OUR STREAM
SETZM JOBCHK(S1) ;REQUEST A CHECKPOINT
PUSHJ P,CHKPNT ;GET IT
HRRZ S1,STREAM ;GET OUR STREAM
MOVX S2,PSF%OR ;GET 'OPR RESP WAIT' FLAG
IORM S2,JOBSTW(S1) ;STORE IT
PUSHJ P,UPDATE ;UPDATE STATUS TO QUASAR
$WTOR (Output limit exceeded,<^I/OLEMSG/>,@JOBOBA(S1),JOBWAC(S1))
$DSCHD (PSF%OR) ;WAIT FOR RESPONSE
TXNE S,ABORT ;WERE WE CANCELLED ???
PJRST OUTIGN ;YES,,ASSUME IGNORE
MOVEI S1,OLEANS ;POINT TO ANSWER TABLE
HRROI S2,J$XTBF(J) ;POINT TO ANSWER
$CALL S%TBLK ;LOOKUP THE ANSWER
TXNE S2,TL%NOM+TL%AMB ;FIND IT OK?
JRST OUTASK ;NOPE..TRY AGAIN
HRRZ S1,(S1) ;GET THE ADDRESS
PJRST 0(S1) ; AND GO TO IT
OUTCAN: MOVEI S1,[ITEXT (<Output limit exceeded>)]
$CALL PUTERR ;Process IT
$CALL INPFEF ;FORCE EOF ON NEXT INPUT
TXO S,ABORT ;LIGHT ABORT
HRRZ S1,STREAM
$WTO (Canceled,<^R/.EQJBB(J)/>,@JOBOBA(S1)) ;NOTIFY
$RETT ;AND RETURN
OUTIGN: MOVX S1,.INFIN ;GET MAXIMUM LIMIT
MOVEM S1,J$RLIM(J) ;SAVE IT
$RETT ;AND TRY SOME MORE
OLEANS: $STAB
KEYTAB (OUTCAN,ABORT) ;ABORT (CANCEL)
KEYTAB (OUTIGN,PROCEED) ;PROCEED (IGNORE)
$ETAB
OLEMSG: ITEXT <^R/.EQJBB(J)/^T/@OLETXT/>
OLETXT: [ASCIZ/
Type 'RESPOND <number> ABORT' to terminate the job now
Type 'RESPOND <number> PROCEED' to allow the job to continue outputing/]
SUBTTL Accounting routines
; Routine to set up data for usage accounting
;
ACTINI: MOVX S1,-1 ;-1 For us
MOVX S2,JI.JNO ;Function code
$CALL I%JINF ;Get our job number
MOVEM S2,L.JOB ;Store it
MOVE S1,[ASCII/D/] ;DEFAULT TO DETACHED
MOVEM S1,L.TTY ;SAVE THE DESIGNATOR
TOPS10 < ;TOPS-10 ONLY
GETLIN S1, ;GET OUR TTY NUMBER
TLNN S1,-1 ;ARE WE DEATCHED ???
$RETT ;YES,,SKIP THIS
GTNTN. S1, ;GET OUR LINE NUMBER
$RETT ;YES,,SKIP THIS
SETOM S2 ;GET A -1
TRMNO. S2, ;GET OUR TTY NUMBER
$RETT ;YES,,SKIP THIS
GETLCH S2 ;GET OUR LINE CHARACTERISTICS
MOVE TF,[ASCII/T/] ;DEFAULT TO A TTY
TXNE S2,GL.ITY ;ARE WE A PTY ???
MOVE TF,[ASCII/P/] ;YES,,MAKE US 'PTY'
TXNE S2,GL.CTY ;ARE WE THE CTY ???
MOVE TF,[ASCII/C/] ;YES,,MAKE US 'CTY'
MOVEM TF,L.TTY ;SAVE THE TERMINAL DESIGNATOR
HRRZM S1,L.LIN ;SAVE THE LINE NUMBER
$RETT ;RETURN
> ;END OF TOPS-10 CONDITIONAL
TOPS20 < ;TOPS-20 ONLY
$RETT ;RETURN
> ;END OF TOPS-20 CONDITIONAL
ACTBEG: SKIPN ACTFLG ;ACCOUNTING?
$RETT ;NO..JUST RETURN
LOAD S1,.EQSEQ(J),EQ.SEQ ;GET SEQUENCE NUMBER
STORE S1,J$ASEQ(J) ;STORE IT
LOAD S1,.EQSEQ(J),EQ.PRI ;GET EXTERNAL PRIORITY
STORE S1,J$APRI(J) ;STORE IT
MOVE S1,J$LSER(J) ;GET DISPATCH ADDRESS
MOVE S1,DNAME(S1) ;GET DEVICE (QUEUE) NAME
MOVEM S1,J$AQUE(J) ;SAVE FOR ACT END
SETZM J$PTIC(J) ;CLEAR PLOTTER ACCOUNTING
$RETT ;RETURN
ACTEND: SKIPN ACTFLG ;ARE WE DOING ACCT?
$RETT ;NO,,RETURN NOW.
LOAD S1,.EQSEQ(J),EQ.IAS ;GET THE INVALID ACCT STRING BIT
JUMPN S1,.RETT ;IF LIT,,THEN JUST RETURN
MOVE S1,J$LSER(J) ;GET DISPATCH ADDRESS
PUSHJ P,DACCT(S1) ;DO FINAL ACCOUNTING
MOVX S2,'NORMAL' ;ASSUME NORMAL DISPOSITION
TXNE S,RQB ;REQUED?
MOVX S2,'REQUED' ;YES
TXNE S,ABORT ;ABORTED?
MOVX S2,'CANCEL'
MOVEM S2,J$ADSP(J) ;STORE DISPOSITION
$CALL ACTRNT ;DO FINAL RUNTIME ACCOUTING
SETZM ACTPAG ;CLEAR THE PAGE ADDRESS
;**;[2543] Insert 14 lines at ACTEND+14. 12-Aug-85 /DRB
PUSHJ P,I%NOW ;[2543] GET THE CURRENT TIME
SUB S1,J$RTIM(J) ;[2543] GET TICS OF CONNECT TIME
IDIVI S1,3 ;[2543] CONVERT TO SECONDS
MOVEM S1,L.CON ;[2543] SAVE THE CONNECT TIME
TOPS10< MOVX T1,%CNSTS ;[2543] GET THE
GETTAB T1, ;[2543] SYSTEM STATES WORD
SETZ T1, ;[2543] ASSUME NO STATE?
TXNE T1,ST%CYC ;[2543] 50HZ CLOCK?
SKIPA T1,[^D50] ;[2543] YES GET JIFFIES/SEC
MOVEI T1,^D60 ;[2543] NO, GET DEFAULT VALUE
MOVEI S1,^D100 ;[2543] CONVERT
MUL S1,J$AKCT(J) ;[2543] KCT TO
DIV S1,T1 ;[2543] KCS*100
MOVEM S1,J$AKCT(J) ;[2543] STORE FOR ACCOUNTING
MOVE S1,[.NDRNN,,S2] ;GET CONVERT TO NAME FCT CODE
MOVEI S2,2 ;A BLOCK LENGTH OF 2
MOVE T1,.EQROB+.ROBND(J) ;GET THE NODE NUMBER
FACT< HRLZM T1,FACTBL+3 > ;STORE NODE NUMBER NOW
NODE. S1, ;CONVERT IT
SKIPA ;SKIP ON AN ERROR
MOVEM S1,.EQROB+.ROBND(J) ;SAVE THE NODE NAME
MOVX S1,<ACTLEN,,ACTLST> ;SET UP AC
QUEUE. S1, ;MAKE A USAGE ENTRY
PUSHJ P,ACTE.1 ;FAILED,,TELL OPR
FACT< MOVE S1,L.LIN ;GET LINE NUMBER
LDB S2,[POINT 7,L.TTY,6] ;GET TERMINAL DESIGNATOR
CAIN S2,"C" ;ON THE CTY
MOVEI S1,7777 ;YES, CTY DESIGNATOR
CAIN S2,"D" ;DETACHED
MOVEI S1,7776 ;YES, FLAG THAT INSTEAD OF LINE NUMBER
LSH S1,6 ;PUT IN BITS 18-29
HRL S1,L.JOB ;INSERT JOB NUMBER
IOR S1,[251000,,13] ;ADD FACT TYPE AND NUMBER OF WORDS
MOVEM S1,FACTBL+0 ;STORE IN BLOCK
MOVE S1,.EQOID(J) ;GET PPN
MOVEM S1,FACTBL+1 ;STORE
SETZM FACTBL+2 ;DAEMON FILLS IN THE DATE/TIME
MOVE S1,[%CNSER] ;CPU SERIAL NUMBER
GETTAB S1, ;ASK FOR IT
SETZ S1, ;USE 0 IF CAN'T FIND IT
HLLZ S2,J$AQUE(J) ;GET QUEUE NAME
TLZ S2,77 ;CLEAR JUNK
IOR S1,S2 ;INSERT QUEUE NAME
IORM S1,FACTBL+3 ;NODE NUMBER ALREADY STORED FROM ABOVE
MOVE S1,J$ARTM(J) ;RUN TIME IN MILLISECONDS
MOVEM S1,FACTBL+4 ;STORE
SETZM FACTBL+5 ;*** CORE TIME INTERGRAL
MOVE S1,J$ADRD(J) ;DISK READS
MOVEM S1,FACTBL+6 ;STORE
SETZM FACTBL+7 ;NO DISK WRITES
MOVE S1,J$LDEV(J) ;DEVICE NAME
MOVEM S1,FACTBL+10 ;STORE
MOVE S1,J$ASEQ(J) ;SEQUENCE NUMBER
MOVEM S1,FACTBL+11 ;STORE
MOVE S1,J$APRT(J) ;NUMBER OF PAGES PRINTED
MOVEM S1,FACTBL+12 ;STORE
MOVE S1,[14,,FACTBL-1] ;DAEMON ARGUMENT
DAEMON S1, ;MAKE THE FACT ENTRY
JRST ACTE.1 ;REPORT THE FAILURE
> ;END FACT ACCOUNTING
> ;END TOPS10 ACCOUNTING
TOPS20< MOVX S1,.USENT ;WRITE AN ENTRY
MOVEI S2,ACTLST ;POINT TO THE LIST
USAGE ;DO THE JSYS
ERJMP ACTE.1 ;ON AN ERROR,,TELL THE OPERATOR
> ;END OF TOPS-20 CONDITIONAL
$RETT ;RETURN WHEN DONE
ACTE.1: MOVE S1,STREAM ;GET THIS STREAM NUMBER
$WTO (System Accounting Failure,<^R/.EQJBB(J)/>,@JOBOBA(S1))
$RETT ;RETURN
ACTRNT: SKIPN ACTFLG ;Accounting turned on ?
$RETT ;No - return
SETO S1, ;-1 Means us
MOVX S2,JI.RTM ;Function code
$CALL I%JINF ;Get our runtime
ADDM S2,ACTRNN ;Store accumulated time
MOVNS S2 ;Negate actual runtime
EXCH S2,ACTRNN ;INIT FOR NEXT PASS
SKIPE S1,ACTPAG ;GET LAST PROCESSES PAGE ADDRESS
ADDM S2,J$ARTM(S1) ;ACCUMULATE TOTAL
;**;[2543] Insert 8 lines at ACTRNT+10. 12-Aug-85 /DRB
TOPS10< HRROI S2,.GTKCT ;[2543] GET OUR
GETTAB S2, ;[2543] KILO-CORE TICS
SETZ S2, ;[2543] ASSUME NONE IF ERROR
ADDM S2,ACTKCT ;[2543] STORE ACCUMULATED KCT
MOVNS S2 ;[2543] NEGATE ACTUAL KCT
EXCH S2,ACTKCT ;[2543] INIT FOR NEXT PASS
SKIPE S1 ;[2543] SKIP IF NO PROCESS PAGE
ADDM S2,J$AKCT(S1) ;[2543] ACCUMULATE TOTAL FOR THIS STREAM
>;END TOPS10
$RETT ;RETURN
SEARCH ACTSYM ;SEARCH THE ACCOUNTING UNV
ACTLST: USENT. (.UTOUT,1,1,0)
USJNO. (L.JOB) ;JOB NUMBER
USTAD. (-1) ;CURRENT DATE/TIME
USTRM. (L.TTY) ;TERMINAL DESIGNATOR
USLNO. (L.LIN) ;TTY LINE NUMBER
USPNM. (<SIXBIT/SPROUT/>,US%IMM) ;PROGRAM NAME
USPVR. (%SPO,US%IMM) ;PROGRAM VERSION
USAMV. (-1) ;ACCOUNTING MODULE VERSION
USNOD. (.EQROB+.ROBND(J)) ;NODE NAME
;**;[2543] Change 3 lines at ACTLST+9. 12-Aug-85 /DRB
TOPS20< USACT. (<POINT 7,.EQACT(J)>) ;[2543] ACCOUNT STRING POINTER
>;END TOPS20
TOPS10< USOAC. (<POINT 7,.EQACT(J) >) ;[2543] ACCOUNT STRING POINTER
>;END TOPS10
USSRT. (J$ARTM(J)) ;RUN TIME
TOPS10< USSCI. (J$AKCT(J)) ;[2543] CORE-TIME INTEGRAL
>;END TOPS10
USSDR. (J$ADRD(J)) ;DISK READS
USSDW. (0,US%IMM) ;DISK WRITES
USJNM. (.EQJOB(J)) ;JOB NAME
USQNM. (J$AQUE(J)) ;QUEUE NAME
USSDV. (J$LDEV(J)) ;DEVICE NAME
USSSN. (J$ASEQ(J)) ;JOB SEQUENCE NUMBER
USSUN. (J$APRT(J)) ;TOTAL PAGES processed
USSNF. (J$AFXC(J)) ;TOTAL FILES processed
USCRT. (.EQAFT(J)) ;CREATION DATE/TIME OF REQUEST
USSCD. (J$RTIM(J)) ;SCHEDULED DATE/TIME
USFRM. (J$FORM(J)) ;FORMS TYPE
USDSP. (J$ADSP(J)) ;REQUEST DISPOSITION
USTXT. (<POINT 7,J$XERR(J)>) ;EXTRA TEXT
USPRI. (J$APRI(J)) ;JOB PRIORITY
USORI. (.EQRID(J)) ;USER REQUEST ID
USOCN. (L.CON) ;CONNECT TIME
TOPS10< ;TOPS-10 ONLY
USPPN. (.EQOID(J)) ;USER PPN
USNM1. (.EQOWN(J)) ;USER NAME 1 (TOPS10)
USNM3. (.EQOWN+1(J)) ;USER NAME 1 (TOPS10)
ACTLEN==.-ACTLST ;LENGTH OF BLOCK
> ;END OF TOPS-10 CONDITIONAL
TOPS20< USNM2. (<POINT 7,.EQOWN(J)>) ;USER NAME (TOPS20)
0 ;END OF LIST
> ;END OF TOPS-20 CONDITIONAL
FACT< EXP .FACT ;DAEMON WRITE FACT FILE FUNCTION
FACTBL: BLOCK 13 > ;FACT BLOCK FILLED IN
SUBTTL FORMS - Setup Forms for a job
FORMS: GETLIM S1,.EQLIM(J),FORM ;GET THE FORMS TYPE
CAMN S1,J$FORM(J) ;EXACTLY THE SAME?
$RETT ;YES, JUST RETURN
;**;[2542] Change code after FORMS+3L. /LWS
PUSHJ P,SETTBF ;[2542] SETUP TEXT BUFFER OPR RESPONSE
SKIPN S2,J$FORM(J) ;GET FORMS TYPE
MOVX S2,FRMNOR ;USE NORMAL IF NULL
XOR S1,S2 ;GET COMMON PART
AND S1,[EXP FRMSK1] ;AND IT WITH THE IMPORTANT PART
GETLIM S2,.EQLIM(J),FORM ;GET FORMS TYPE
EXCH S2,J$FORM(J) ;SAVE IT
MOVEM S2,J$FPFM(J) ;SAVE OLD ONES
JUMPE S1,FORM.1 ;[2542] NO NEED TO CHANGE FORMS.
FORM.0: HRRZ S1,STREAM ;[2542] GET STREAM NUMBER
$WTOR (<Please load forms type '^W/J$FORM(J)/'>,<^I/FRMMSG/>,@JOBOBA(S1),JOBWAC(S1)) ;[2542]
$DSCHD (PSF%OR) ;[2542] WAIT FOR RESPONSE
TXNE S,ABORT ;[2542] ABORTED?
$RETT ;[2542] YES, JUST RETURN
MOVEI S1,FRMANS ;[2542] GET POINTER TO ANSWER TABLE
PUSHJ P,GETANS ;[2542] GET DISPATCH ADDRESS
JUMPT (S1) ;[2542] DISPATCH IF OK
PUSHJ P,SETTBF ;[2542] CLEAR BUFFER FOR OPR RESPONSE
JRST FORM.0 ;[2542] INVALID ANSWER, ASK AGAIN.
FORM.1: HRLZI S1,J$FCUR(J) ;GET START OF SWITCH STORAGE
HRRI S1,J$FCUR+1(J) ;MAKE BLT POINTER
SETZM J$FCUR(J) ;CLEAR THE FIRST WORD
BLT S1,J$FCUR+F$NSW-1(J) ;CLEAR THE BLOCK
FORM.2: $CALL FRMINI ;READ THE SPFORM.INI FILE.
MOVEI S1,J$XERR(J) ;[2542] GET POINTER TO ERROR TEXT
HRLI S1,(POINT 7,0) ;[2542] MAKE INTO BYTE POINTER
CAMN S1,TEXTBP ;[2542] ANY TEXT?
$RETT ;[2542] NO, RETURN
FORM.3: HRRZ S1,STREAM ;[2542] GET STREAM NUMBER
$WTOR (<^T/J$XERR(J)/>,<^I/FERMSG/>,@JOBOBA(S1),JOBWAC(S1)) ;[2542] SEND THE WTOR.
$DSCHD (PSF%OR) ;WAIT FOR OPERATOR RESPONSE.
TXNE S,ABORT ;[2542] ABORTED?
$RETT ;RETURN...
MOVEI S1,FERANS ;[2542] NO, GET ADDRESS OF CHOICE BLOCK
PUSHJ P,GETANS ;[2542] LOOK FOR MATCH
JUMPT (S1) ;[2542] DISPATCH
PUSHJ P,SETTBF ;[2542] SET BUFFER AGAIN
JRST FORM.3 ;[2542] ASK AGAIN
FORM.4: TXO S,RQB!ABORT ;[2542] REQUEUE THE JOB
MOVE S1,J$FPFM(J) ;[2542] GET PREVIOUS FORMS TYPE
MOVEM S1,J$FORM(J) ;[2542] RESTORE IT
HRRZ S1,STREAM ;[2542] GET STREAM
$WTOJ (<Requeuing job>,^R/.EQJBB(J)/,@JOBOBA(S1)) ;[2542] SEND THE WTOR.
$RETF ;[2542] RETURN
;[2542] ERROR MESSAGES TO OPR AND RESPONSE CHOICE BLOCKS
FRMMSG: ITEXT (<^R/.EQJBB(J)/^T/@FRMTXT/>) ;[2542]
FRMTXT: [ASCIZ/
Type 'RESPOND <number> PROCEED' to continue when ready/] ;[2542]
FRMANS: $STAB ;[2542]
KEYTAB (FORM.1,PROCEED) ;[2542]
$ETAB ;[2542]
FERMSG: ITEXT (<^R/.EQJBB(J)/^T/@FERTXT/>) ;[2542]
FERTXT: [ASCIZ/
Type 'RESPOND <number> REQUEUE' to requeue the job
Type 'RESPOND <number> PROCEED' to continue anyway/] ;[2542]
FERANS: $STAB ;[2542]
KEYTAB (.RETT,PROCEED) ;[2542]
KEYTAB (FORM.4,REQUEUE) ;[2542]
$ETAB ;[2542]
;**;[2542] Add GETANS routine and WTOR text
;GETANS - Compare operator responses to WTOR's with what's expected.
;
; Call: S1 = Address of response choice block
; Returns TRUE S1 = Dispatch address from response choice block
; FALSE No match
GETANS: HRROI S2,J$XTBF(J) ;[2542] POINT TO ANSWER
$CALL S%TBLK ;[2542] LOOKUP THE ANSWER
TXNE S2,TL%NOM+TL%AMB ;[2542] FIND IT OK?
$RETF ;[2542] NOPE..TRY AGAIN
PUSHJ P,SETTBF ;[2542] RESET TEXT BUFFER
HRRZ S1,(S1) ;[2542] GET THE ADDRESS
$RETT ;[2542] RETURN IT
FRMINI: $SAVE <T1,T2,T3,T4> ;PRESERVE TEMPORARIES
PUSHJ P,SETEBF ;[2542] GO SET UP ERROR TEXT BUFFER
MOVE S1,J$LSER(J) ;GET DEVICE DISPATCH ADDRESS
MOVE T3,DNAME(S1) ;GET DEVICE NAME
;**;[2534] Rework code some to default plotter forms values. 13-Oct-83 /LWS
CAME T3,[SIXBIT/PLT/] ;[2534] IS DEVICE A PLOTTER?
JRST FRMI.0 ;[2534] NO, SKIP OVER PLOTTER DEFAULTING
SETOM J$FPLT(J) ;YES -- SET SWITCH FLAG
MOVEI S1,DFXMAX ;[2534] GET DEFAULT X MAXIMUM
MOVEM S1,J$XMAX(J) ;[2524] AND STORE IT
MOVEI S1,DFYMAX ;[2534] GET DEFAULT Y MAXIMUM
MOVEM S1,J$YMAX(J) ;[2534] AND STORE IT
MOVEI S1,DFSPS ;[2534] GET DEFAULT STEPS/SEC
MOVEM S1,J$FSPS(J) ;[2534] AND STORE IT
MOVEI S1,DFSPU ;[2534] GET DEFAULT STEPS/UNIT
MOVEM S1,J$FSPU(J) ;[2534] AND STORE IT
SETZM J$XORG(J) ;[2534] SET MINIMUM X AND
SETZM J$YMIN(J) ;[2534] Y VALUES
;**;[2537] Insert code before FRMI.0. /LWS
PUSHJ P,FRMI.0 ;[2537] GO GET SPFORM.INI VALUES
MOVE T1,J$FSPU(J) ;[2537] GET /SPU MULTIPLIER
IMULM T1,J$XORG(J) ;[2537] ADJUST X MINIMUM
IMULM T1,J$XMAX(J) ;[2537] ADJUST X MAXIMUM
IMULM T1,J$YMIN(J) ;[2537] ADJUST Y MINIMUM
IMULM T1,J$YMAX(J) ;[2537] ADJUST Y MAXIMUM
MOVE T1,J$FSPS(J) ;[2537] GET STEPS PER SECOND
IMULI T1,^D60 ;[2537] COMPUTE STEPS PER MINUTE
MOVEM T1,J$PTPM(J) ;[2537] STORE IT
PUSHJ P,P$CHKS ;[2537] COMPUTE CHARACTER SIZE
IMULI T1,^D8 ;[2537] ALLOW 8 LINES FOR TRAILER
MOVNS T1 ;[2537] NEGATE IT
ADDM T1,J$XMAX(J) ;[2537] LEAVE ROOM FOR TRAILER
$RETT ;[2537] RETURN
FRMI.0: DMOVE S1,[EXP FOB.SZ,FRMFOB] ;[2534] POINT TO FILE OPEN BLOCK
$CALL F%IOPN ;AND OPEN FORM INI FILE
JUMPF FILERR ;[2542] GO SET ERROR TEXT IF PROBLEMS
MOVEM S1,J$FIFN(J) ;SAVE IFN OF FORM INI FILE
FRMI.1: $CALL FH$SIX ;READ FIRST WORD OF LINE
JUMPF FRMI3A ;[2542] EXIT ON EOF
CAME T1,T3 ;MATCH OBJECTS DEVICE TYPE
CAMN T1,J$LDEV(J) ;OR ACTUAL DEVICE NAME?
JRST FRMI.3 ;YES -- CHECK FORMS TYPE
FRMI.2: $CALL FH$EOL ;NO -- LOOK FOR END OF LINE
JUMPT FRMI.1 ;[2542] DO NEXT LINE
PJRST FRMI3A ;[2542] COMPLAIN
FRMI.3: $CALL FH$SIX ;GET THE FORMS NAME
JUMPF FRMI3A ;[2542] EOF!!
GETLIM T2,.EQLIM(J),FORM ;GET FORMS
CAMN T1,T2 ;MATCH??
JRST FRMI.4 ;YES!!
$CALL FH$EOL ;[2542] END THE LINE
JUMPT FRMI.1 ;[2542] LOOK FOR FORMS ON NEW LINE
FRMI3A: GETLIM T2,.EQLIM(J),FORM ;[2542] GET FORMS TYPE AGAIN
$TEXT (DEPBP,<Forms ^W/T2/ not found in SPFORM.INI for ^W/J$LDEV(J)/^0>) ;[2542]
PJRST FRMIEX ;[2542] CLOSE FILE AND RETURN
FRMI.4: CAIN C,"/" ;BEGINNING OF SWITCH?
JRST FRMSWI ;YES, LOCATOR IS "ALL"
CAIN C,":" ;BEGINNING OF LOCATOR?
JRST FRMI.5 ;YES, GO GET IT
CAIN C,.CHLFD ;EOL?
JRST FRMI.1 ;YES, GO THE NEXT LINE
$CALL FH$CHR ;ELSE, GET A CHARACTER
JUMPT FRMI.4 ;[2542] AND LOOP
PJRST FRMERR ;[2542] BAD FILE FORMAT
FRMI.5: $CALL FH$SIX ;GET A LOCATOR
JUMPF FRMIEX ;EOF!!
JUMPE T1,FRMI.6 ;MAYBE PAREN??
JRST FRMI.7 ;AND DO THE LIST
FRMI.6: CAIN C,"/" ;A SWITCH?
JRST FRMSWI ;YES!
CAIN C,"(" ;A LIST?
JRST FRMI.7 ;YES -- PROCESS IT
FRMERR: HRRZ S1,STREAM ;NO -- GET THE STREAM NUMBER.
$TEXT (DEPBP,<SPFORM.INI format error^0>) ;[2542] TELL OPR
FRMIEX: MOVE S1,J$FIFN(J) ;CLOSE FILE
$CALL F%REL
$RETT
FILERR: $TEXT (DEPBP,<SPFORM.INI problems, ^E/S1/^0>) ;[2542] SET TEXT
$RETF ;[2542] RETURN
FRMI.7: HLRZ T2,T1 ;GET THE FIRST THREE CHARS
CAIN T2,'ALL' ;IS IT "ALL"?
JRST FRMSWI ;YES, STOP CHECKING
CAIN T2,'LOC' ;IS IT LOCAL?
SKIPGE J$LREM(J) ;YES, ARE WE?
SKIPA ;NO, NO
JRST FRMSWI ;YES, YES!
CAIE T2,'REM' ;[2542] DOES IT SAY "REMOTE"?
SKIPA ;[2542] NO
SKIPL J$LREM(J) ;[2542] YES, ARE WE REMOTE
CAMN T1,J$LDEV(J) ;COMPARE TO OUR DEVNAM
JRST FRMSWI ;MATCH!!
FRMI.8: CAIN C,.CHLFD ;BREAK ON EOL?
JRST FRMI.1 ;YES, GET NEXT LINE
CAIE C,"/" ;IS IT A SLASH?
CAIN C,")" ;NO, CLOSE PAREN?
JRST FRMI.2 ;YES, GET THE NEXT LINE
$CALL FH$SIX ;ELSE, GET THE NEXT LOCATOR
JUMPF FRMI.9 ;[2542] EOF, COMPLAIN
SKIPE T1 ;[2542] NOT ANOTHER LOCATOR
JRST FRMI.7 ;AND LOOP AROUND
FRMI.9: GETLIM T2,.EQLIM(J),FORM ;[2542] GET FORMS TYPE AGAIN
$TEXT (DEPBP,<No 'locators' in SPFORM.INI match ^W/J$LDEV(J)/, forms ^W/T2/^0>) ;[2542]
PJRST FRMIEX ;[2542] CLOSE FILE AND RETURN
;GET HERE IF THIS LINE IS FOR US
FRMSWI: CAIN C,.CHLFD ;WAS THE LAST CHARACTER A LINEFEED?
;**;[2537] Replace 1 line at FRMSWI+1L. /LWS
$RETT ;[2537] YES, RETURN
CAIN C,"/" ;ARE WE AT THE BEGINNING OF A SWITCH?
JRST FRMS.1 ;YES, DO IT!
$CALL FH$CHR ;NO, GET A CHARACTER
JUMPF FRMIEX ;EOF!!
JRST FRMSWI ;AND LOOP AROUND
FRMS.1: $CALL FH$SIX ;GET THE SWITCH
JUMPF FRMIEX ;EOF!!
JUMPN T1,FRMS.2 ;JUMP IF WE'VE GOT SOMETHING
CAIN C,.CHLFD ;EOL?
JRST FRMIEX ;YES, RETURN
JRST FRMSWI ;ELSE, KEEP TRYING
FRMS.2: MOVE T4,T1 ;SAVE SWITCH NAME FOR LATTER
HLLZS T1 ;GET FIRST THREE CHARACTERS OF SWITCH
MOVSI T2,-F$NSW ;MAKE AOBJN POINTER
FRMS.3: HLLZ T3,FFNAMS(T2) ;GET A SWITCH NAME
CAMN T3,T1 ;MATCH??
JRST FRMS.4 ;YES, DISPATCH
AOBJN T2,FRMS.3 ;NO, LOOP
MOVE T1,T4 ;GET SWITCH NAME
HRRZ S1,STREAM ;GET THE STREAM NUMBER.
$WTOJ (SPFORM.INI Error,<Unrecognized SWITCH ^W/T1/ found.>,@JOBOBA(S1))
JRST FRMSWI ;AND LOOP
FRMS.4: HRRZ T3,FFNAMS(T2) ;GET DISPATCH ADDRESS
PUSHJ P,0(T3) ;GO!!
JUMPF FRMERR ;REPORT FAILURE AND GIVE UP
JRST FRMSWI ;AND LOOP
SUBTTL Forms switch Subroutines
S$BANN: SETOM J$FBAN(J) ;SET A FLAG
POPJ P, ;AND RETURN
S$TRAI: SETOM J$FTRA(J) ;SET A FLAG
POPJ P, ;AND RETURN
S$HEAD: SETOM J$FHEA(J) ;SET A FLAG
POPJ P, ;AND RETURN
S$NOTE: $TEXT(DEPBP,<Note: ^A>) ;PREFIX NOTE
S$NOT1: $CALL FH$CHR ;GET A CHARACTER
JUMPF S$NOT2 ;EOF, FINISH UP!!
CAIE C,"/" ;STOP ON SLASH
CAIGE C,40 ;OR CONTROL CHARACTERS
JRST S$NOT2 ;FINISH UP
IDPB C,TEXTBP ;DEPOSIT BYTE
JRST S$NOT1 ;LOOP UNTIL DONE
S$NOT2: $TEXT(DEPBP,<^M^J^A>) ;ADD A CRLF
$RETT ;RETURN.
SUBTTL Plotter only switches
S$SPS: SKIPN J$FPLT(J) ;IS DEVICE A PLOTTER?
$RETF ;NO
PUSHJ P,FH$DEC ;GET STEPS PER SECOND
MOVEM T1,J$FSPS(J) ;STORE IT
$RETT ;RETURN
S$SPU: SKIPN J$FPLT(J) ;IS DEVICE A PLOTTER?
$RETF ;NO -- ERROR RETURN
$CALL FH$DEC ;GET STEPS PER UNIT
MOVEM T1,J$FSPU(J) ;AND SAVE IT
$RETT
S$MINI: SKIPN J$FPLT(J) ;IS DEVICE A PLOTTER?
$RETF ;NO -- INVALID SWITCH
;**;[2534] Remove 2 lines at S$MIN+2L. 13-Oct-83 /LWS
$CALL FH$DEC ;GET DECIMAL INTEGER
MOVEM T1,J$XORG(J) ;STORE X MINIMUM
CAIE C,":" ;IS Y ARGUMENT SPECIFIED?
$RETT ;NO -- RETURN
$CALL FH$DEC ;GET DECIMAL INTEGER
MOVEM T1,J$YMIN(J) ;STORE Y MINIMUM
$RETT ;AND RETURN
S$MAXI: SKIPN J$FPLT(J) ;IS DEVICE A PLOTTER?
$RETF ;NO -- INVALID SWITCH
;**;[2534] Remove 3 lines at S$MAXI+2L. 13-Oct-83 /LWS
$CALL FH$DEC ;GET DECIMAL INTEGER
MOVEM T1,J$XMAX(J) ;STORE X MAXIMUM
CAIE C,":" ;IS Y ARGUMENT SPECIFIED?
$RETT ;NO -- RETURN
$CALL FH$DEC ;GET DECIMAL INTEGER
MOVEM T1,J$YMAX(J) ;STORE Y MAXIMUM
$RETT ;AND RETURN
SUBTTL I/O Subroutines for SPFORM.INI
;ROUTINE TO RETURN A SIXBIT WORD IN T1
;RETURNS WITH WORD IN T1. SKIPS NORMALLY, NON-SKIP ON EOF.
FH$SIX: SETZ T1, ;CLEAR FOR RESULT
MOVE T2,[POINT 6,T1] ;POINTER FOR RESULT
FH$SX1: $CALL FH$CHR ;GET A CHARACTER
JUMPF .RETF ;FAIL IF EOF
CAIL C,140 ;LOWER CASE?
SUBI C,40 ;YES -- CONVERT TO UPPER
CAIL C,"A" ;CHECK FOR ALPHA
CAILE C,"Z"
SKIPA ;ITS NOT!!
JRST FH$SX2 ;IT IS, DEPOSIT IT
CAIL C,"0" ;CHECK FOR NUMBER
CAILE C,"9"
$RETT ;NO REASONALBE
FH$SX2: SUBI C,40 ;CONVERT TO SIXBIT
TLNE T2,770000 ;GET SIX YET?
IDPB C,T2 ;NO, DEPOSIT ANOTHER
JRST FH$SX1 ;AND LOOP AROUND
;ROUTINE TO RETURN 1 CHARACTER IN ACCUMULATOR C
FH$CHR: MOVE S1,J$FIFN(J) ;GET FORM FILE IFN
$CALL F%IBYT ;READ A BYTE
JUMPF .RETF ;FAIL -- ASSUME EOF
CAIN S2,"-" ;CONTINUED ON NEXT LINE?
JRST [$CALL FH$EOL ;YES -- FIND END OF LINE
JRST FH$CHR] ;AND GET NEXT CHARACTER
MOVE C,S2 ;PUT BYTE IN CHARACTER AC
CAIE C,.CHTAB ;CONVERT TABS
CAIN C,.CHCRT ;AND CARRIAGE RETURNS
MOVEI C,40 ;INTO SPACES
CAIE C,.CHFFD ;CONVERT FORM FEEDS
CAIN C,.CHVTB ;AND VERTICAL TABS
MOVEI C,.CHLFD ;INTO LINEFEED
$RETT ;ITS NOT
;ROUTINE TO SEARCH FOR EOL IN SPFORM.INI
FH$EOL: $CALL FH$CHR ;GET A CHARACTER
JUMPF .RETF ;FAIL IF EOF
CAIE C,.CHLFD ;EOL?
JRST FH$EOL ;NO, LOOP
$RETT ;YES, RETURN!
;ROUTINE TO PICK UP A DECIMAL NUMBER
FH$DEC: SETZ T1, ;PLACE TO ACCUMULATE RESULT
FH$DE1: $CALL FH$CHR ;GET A CHARACTER
JUMPF .RETF ;EOF, RETURN
CAIL C,"0" ;CHECK THE RANGE
CAILE C,"9" ;0-9
POPJ P, ;RETURN
IMULI T1,12 ;SHIFT A PLACE
ADDI T1,-"0"(C) ;ADD IN A DIGIT
JRST FH$DE1 ;AND LOOP AROUND
SUBTTL INPOPN - Routine to open the input file
;INPOPN IS CALLED WITH AC "E" POINTING TO THE FP AREA FOR THE FILE
; TO BE OPENED.
INPOPN: MOVEI S1,FOB.SZ ;GET THE FOB SIZE
MOVEI S2,J$XFOB(J) ;AND THE FOR ADDRESS
$CALL .ZCHNK ;ZERO IT OUT
LOAD S1,.FPLEN(E),FP.LEN ;GET THE FP LENGTH
ADD S1,E ;GET THE FD ADDRESS
MOVEM S1,J$DFDA(J) ;SAVE THE ADDRESS
STORE S1,J$XFOB+FOB.FD(J) ;SAVE IN THE FOB
MOVEI S1,^D36 ;USE FULL WORDS
STORE S1,J$XFOB+FOB.CW(J),FB.BSZ ;AND SAVE THE BYTE SIZE
MOVEM S1,J$DBSZ(J) ;SAVE AS INPUT BYTESIZE
LOAD S1,.EQSEQ(J),EQ.PRV ;GET SENDERS PRIV BIT
JUMPN S1,INPO.1 ;IF SET, AVOID ACCESS CHECK
LOAD S1,.FPINF(E),FP.SPL ;LIKEWISE IF SPOOLED
JUMPN S1,INPO.1 ; ...
TOPS20 < HRROI S1,.EQOWN(J)> ;GET THE OWNERS NAME ON TOPS-20
TOPS10 < LOAD S1,.EQOID(J)> ;GET THE OWNERS NAME ON TOPS-10
STORE S1,J$XFOB+FOB.US(J) ;SAVE IT
TOPS20 <
HRROI S1,.EQCON(J) ;GET CONNECTED DIRECTORY
STORE S1,J$XFOB+FOB.CD(J) ;AND SAVE IT
> ;END TOPS20 CONDITIONAL
INPO.1: MOVEI S1,FOB.SZ ;GET FOB SIZE
MOVEI S2,J$XFOB(J) ;AND ADDRESS
$CALL F%IOPN ;OPEN THE FILE
JUMPF INPO.3 ;JUMP IF FAILED
MOVEM S1,J$DIFN(J) ;ELSE, SAVE THE IFN
TXO S,DSKOPN ;TURN ON FILE-OPEN FLAG
MOVX S2,FI.MOD ;CODE FOR MODE..
$CALL F%INFO ;GET MODE OF THE FILE
MOVEM S1,J$DMOD(J) ;STORE IT
MOVE S1,J$DIFN(J) ;GET THE IFN
MOVX S2,FI.SPL ;FOR SPOOLED NAME
$CALL F%INFO ;FIND IT OUT
MOVEM S1,J$DSPN(J) ;STORE IT
TOPS10 <
SETZM J$DSPX(J) ;Clear spooled file extension
LOAD S1,.FPINF(E),FP.REN ;GET RENAME BIT
JUMPE S1,.RETT ;DONE IF NOT /DISP:RENAME
MOVE S1,.FPONM(E) ;Get old file name
MOVEM S1,J$DSPN(J) ;Save as spooled file name
MOVE S1,.FPOXT(E) ;Get original file extension
MOVEM S1,J$DSPX(J) ;Save as spooled file extension
> ;End TOPS10 conditional
$RETT ;AND RETURN
INPO.3: MOVEI S1,[ITEXT (<Cannot access file; ^E/[-1]/ File: ^F/@J$DFDA(J)/>)]
$CALL PUTERR ;AND TYPE ERROR MESSAGE
$RETF
SUBTTL INPBUF - Read a buffer from the input file
INPBUF: MOVE S1,J$DIFN(J) ;GET THE IFN
$CALL F%IBUF ;GET A BUFFERFUL
JUMPF INPERR ;LOSE
MOVEM S1,J$DBCT(J) ;SAVE THE BYTE COUNT
MOVEM S2,J$DBPT(J) ;AND THE BYTE POINTER
;**;[2543] Insert 1 line at INPBUF+5. 12-Aug-85 /DRB
AOS J$ADRD(J) ;[2543] ADD 1 TO BUFFER READ COUNT
MOVEI S1,^D36 ;GET BITS/WORD
IDIV S1,J$DBSZ(J) ;GET BYTES/WORD
IMULM S1,J$DBCT(J) ;ADJUST BYTE COUNT ACCORDINGLY
MOVE S1,J$DBSZ(J) ;GET BYTE SIZE
STORE S1,J$DBPT(J),BP.SIZ ;AND ADJUST THE BYTE POINTER
$RETT ;AND RETURN
SUBTTL INPBYT - Read a byte from the input file
INPBYT: SOSGE J$DBCT(J) ;SKIP IF ANYTHING LEFT IN BUFFER
JRST INPB.1 ;GET ANOTHER BUFFER
ILDB C,J$DBPT(J) ;GET A BYTE
$RETT ;AND RETURN
INPB.1: $CALL INPBUF ;GET ANOTHER BUFFER
JUMPF .RETF ;LOSE (PROBABLY EOF)
JRST INPBYT ;AND LOOP
SUBTTL INPERR - Handle an input failure
INPERR: CAXN S1,EREOF$ ;WAS IT EOF?
$RETF ;WAS JUST RETURN
MOVEI S1,[ITEXT (<File input error; ^E/[-1]/>)]
$CALL PUTERR ;AND PUT AN ERROR OUT
TXO S,SKPFIL ;SKIP THE REST OF THE FILE
$RETF ;AND RETURN
SUBTTL INPFEF - Force end-of-file on next input
INPFEF: MOVE S1,J$DIFN(J) ;GET THE IFN
SETOB S2,J$DBCT(J) ;CLEAR BYTE COUNT AND SET EOF POS
TXNE S,DSKOPN ;IS THE SPOOL FILE OPEN ???
$CALL F%POS ;YES,,POSITION IT
$RETT ;AND RETURN
SUBTTL INPREW - Rewind the input file
INPREW: MOVE S1,J$DIFN(J) ;GET THE IFN
TXNE S,DSKOPN ;IS THE SPOOL FILE OPEN ???
$CALL F%REW ;YES,,REWIND IT
SETOM J$DBCT(J) ;AND SET THE BYTE COUNT
$RETT ;AND RETURN
SUBTTL OUTGET - OPEN the output device
;THIS ROUTINE OPENS THE SPECIFIED OUTPUT DEVICE, AND SETS UP A BUFFER RING
TOPS10 <
OUTGET: HRRZ S1,STREAM ;GET THE STREAM NUMBER
MOVE S1,JOBOBA(S1) ;GET OBJECT BLOCK ADDRESS
MOVE S1,OBJ.TY(S1) ;GET OBJECT TYPE
SETZ S2, ;AND CLEAR AN AC
CAXN S1,.OTPTP ;IS IT A PAPERTAPE PUNCH?
MOVEI S2,T$DISP ;YES!!
CAXN S1,.OTCDP ;NO, HOW ABOUT A CARD PUNCH?
MOVEI S2,C$DISP ;WIN!!
CAXN S1,.OTPLT ;TRY FOR A PLOTTER
MOVEI S2,P$DISP ;AND GET THE PLOTTER DISPATCH
JUMPE S2,OUTDDE ;DONT KNOW ABOUT IT
MOVEM S2,J$LSER(J) ;SAVE IT
MOVEI S1,J$LDEV(J) ;ADDRESS OF WHERE TO PUT DEVNAM
HRLI S1,(POINT 6,0) ;MAKE IT A BYTE POINTER
MOVEM S1,TEXTBP ;SAVE IT
MOVEI S1,6 ;MAXIMUM CHARACTER COUNT
MOVEM S1,TEXTBC
HRRZ S1,STREAM ;GET THE STREAM NUMBER
MOVE S1,JOBOBA(S1) ;GET OBJECT BLOCK ADDRESS
$TEXT(DEP6BP,<^W3/DNAME(S2)/^O2R0/OBJ.ND(S1)/^O1/OBJ.UN(S1)/^A>)
MOVE T1,J$LDEV(J) ;GET THE DEVICE NAME
DEVNAM T1, ;GET ITS PHYSICAL NAME
JRST OUTDDE ;LOSE?
MOVEM T1,J$LDEV(J) ;AND SAVE IT
MOVX T1,.IOIMG+UU.PHS+UU.AIO
;IMAGE+PHONLY+NBIO
MOVE T2,J$LDEV(J) ;OUTPUT DEVICE NAME
MOVSI T3,J$LBRH(J) ;BUFFER HEADER
MOVE S1,STREAM ;GET OUR STREAM NUMBER
MOVEM S1,J$LJFN(J) ;SAVE AS THE STREAM NUMBER
LSH S1,^D23 ;PUT IN THE RIGHT PLACE
IOR S1,[OPEN T1] ;MAKE IT AN INSTRUCTION
XCT S1 ;AND EXECUTE IT
JRST OUTDNA ;LOSE GIVE ERROR
CONT. (OUTGET) ;FORCE NEW LISTING PAGE
MOVE S1,J$LSER(J) ;GET DEVICE DISPATCH ADDRESS
MOVE S1,DBYTE(S1) ;GET OUTPUT BYTE SIZE
STORE S1,J$LBRH+1(J),BP.SIZ ;STORE IT
MOVX S1,PSF%OB!PSF%DO ;GET OUTPUT-BLOCKED AND DEVICE OFFLINE
HRRZ S2,STREAM ;AND STREAM NUMBER
ANDCAM S1,JOBSTW(S2) ;AND CLEAR THE CONDITIONS
MOVE T1,J$LJFN(J) ;LOAD CHANNEL NUMBER
WHERE T1, ;GET OUR STATION NUMBER
SETZ T1,
TLZ T1,-1 ;CLEAR STATION FLAGS
CAME T1,CNTSTA ;IS THIS CENTRAL STATION?
SETOM J$LREM(J) ;NO -- SET REMOTE
MOVEI S1,T1 ;LOAD ADDRESS OF ARGBLOCK FOR DEVSIZ
MOVX T1,.IOIMG ;GET IMAGE MODE
MOVE T2,J$LJFN(J) ;GET THE CHANNEL
DEVSIZ S1, ;DO THE DEVSIZ
JRST OUTDNA ;LOSE
MOVEI T1,PAGSIZ ;LOAD PAGE SIZE
IDIVI T1,(S1) ;GET NUMBER OF BUFFER TO CREATE
MOVE S1,J$LBUF(J) ;GET ADDRESS OF BUFFER PAGE
EXCH S1,.JBFF ;SWAP WITH JOBFF
MOVE S2,J$LJFN(J) ;GET CHANEL NUMBER
LSH S2,^D23 ;POSITION IT
IOR S2,[OUTBUF 0(T1)] ;BUILD THE OUTBUF
XCT S2 ;AND DO IT
MOVEM S1,.JBFF ;RESTORE JOBFF
$CALL INTCNL ;CONNECT TO INTERRUPTS
MOVX S1,%RSUOK ;LOAD OK CODE
$RETT ;AND RETURN
> ;END TOPS10 CONDITIONAL
TOPS20 <
OUTGET: $SAVE <P1,P2> ;PRESERVE P1 AND P2
HRRZ S1,STREAM ;GET OUR STREAM
MOVE P1,JOBOBA(S1) ;P1 POINTS TO OUR OBJECT BLOCK
MOVE S1,OBJ.TY(P1) ;GET OBJECT TYPE
SETZ P2, ;P2 POINTS TO DISPATCH ADDRESS
CAXN S1,.OTCDP ;CARD PUNCH?
MOVEI P2,C$DISP ;YES -- LOAD DISPATCH ADDRESS
CAXN S1,.OTPLT ;PLOTTER ?
MOVEI P2,P$DISP ;YES -- LOAD DISPATCH ADDRESS
CAXN S1,.OTPTP ;PAPER TAPE PUNCH?
MOVEI P2,T$DISP ;YES -- LOAD DISPATCH ADDRESS
JUMPE P2,OUTDDE ;UNKNOWN OBJECT TYPE
MOVEM P2,J$LSER(J) ;SAVE DISPATCH ADDRESS
MOVE S1,[POINT 7,J$LDEV(J)] ;POINT TEXT TO DEVICE STRING
MOVEM S1,TEXTBP
MOVEI S1,^D10 ;GET A STRING LENGTH
MOVEM S1,TEXTBC ;AND SAVE IT
$TEXT (DEPBP,<P^W3/DNAME(P2)/^O1/OBJ.UN(P1)/:^0>) ;FORM STRING
MOVX S1,GJ%FOU!GJ%SHT ;LOAD GTJFN FLAGS
HRROI S2,J$LDEV(J) ;POINT TO THE DEVICE STRING
GTJFN ;AND GET A JFN
ERJMP OUTDDE ;DEVICE DOESNT EXIST!!
MOVEM S1,J$LJFN(J) ;WIN, SAVE THE JFN
MOVX S2,OF%WR+OF%OFL ;GET OPENF BITS
MOVE T1,DBYTE(P2) ;GET DEVICE BYTE SIZE
STORE T1,S2,OF%BSZ ;AND STORE FOR OPENF
OPENF ;OPEN IT
ERJMP OUTDNA ;NOT AVAILBLE NOW
HRROI S1,J$LDEV(J) ;POINT TO ASCIZ DEVICE NAME
$CALL S%SIXB ;CONVERT IT TO SIXBIT
MOVEM S2,J$LDEV(J) ;REPLACE ASCIZ NAME
MOVE S1,J$LBUF(J) ;GET BUFFER PAGE ADDRESS
HRLI S1,440000 ;MAKE POINTER WITH ZERO BYTE SIZE
STORE T1,S1,BP.SIZ ;STORE ACTUAL BYTE SIZE
MOVEM S1,J$LBPT(J) ;AND SAVE THE POINER
MOVEM S1,J$LIBP(J) ;AND AS INITIAL POINTER
MOVEI S1,^D36 ;LOAD BITS/WORD
IDIV S1,T1 ;COMPUTE BYTES/WORD
IMULI S1,PAGSIZ ;COMPUTE BYTES/PAGE
MOVEM S1,J$LBCT(J) ;AND SAVE IT
MOVEM S1,J$LIBC(J) ;AND AS INITIAL COUNT
$CALL OUTSTS ;GET DEVICE STATUS
MOVX S2,PSF%DO ;DEVICE OFFLINE FLAG
HRRZ T1,STREAM ;GET STREAM NUMBER
ANDCAM S2,JOBSTW(T1) ;CLEAR THE VALUE
TXNN S1,MO%OL ;IS IT OFF-LINE?
JRST OUTSOK ;NO..CONTINUE
IORM S2,JOBSTW(T1) ;YES, SET FLAG
$CALL OUTWON ;SEND THE OFFLINE MESSAGE
JRST OUTSOK ;CONTINUE ON OK
OUTSOK: $CALL INTCNL ;CONNECT UP THE DEV
MOVX S1,%RSUOK ;LOAD THE CODE
$RETT ;AND RETURN
> ;END TOPS20 CONDITIONAL
OUTDNA: MOVX S1,%RSUNA ;NOT AVAILABLE RIGHT NOW
$RETF ;AND RETURN
OUTDDE: MOVX S1,%RSUDE ;NEVER AVAILABLE
$RETF ;RETURN
SUBTTL OUTBYT - Deposit a byte in the output buffer
;CALL WITH CHARACTER IN ACCUMULATOR 'C'.
OUTBYT: SOSGE J$LBCT(J) ;DECREMENT THE BYTE COUNT
JRST OUTB.1 ;BUFFER FULL, ADVANCE IT
IDPB C,J$LBPT(J) ;DEPOSIT THE CHARACTER
AOS J$TBCT(J) ;ADVANCE TOTAL BYTE COUNT
$RETT ;AND RETURN
OUTB.1: $CALL OUTOUT ;ADVANCE BUFFERS
JRST OUTBYT ;AND TRY AGAIN
SUBTTL OUTOUT - Routine to output a buffer
TOPS10 <
OUTOUT: $SAVE <S1,S2> ;SAVE SOME ACS
OUTO.1: MOVE S1,STREAM ;Get our stream number
MOVX S2,PSF%OB ;Assume we are blocked
IORM S2,JOBSTW(S1) ; waiting for output done
MOVE S1,J$LJFN(J) ;GET THE CHANNEL NUMBER
LSH S1,^D23 ;POSITION IT
TLO S1,(OUT 0,0) ;MAKE IT AN OUTPUT UUO
XCT S1 ;AND DO IT
JRST [MOVE S1,STREAM ;We won! Clear blocked bit
ANDCAM S2,JOBSTW(S1) ; so we are runnable
$RETT]
OUTERR: PUSHJ P,OUTSTS ;READ DEVICE STATUS
JUMPT [$DSCHD (0) ;ASSUME OUTPUT BLOCKED
JRST OUTO.1] ;RETRY OUTPUT
$CALL DEVERR ;PROCESS DEVICE ERROR
JUMPT OUTO.1 ;RETRY OUTPUT IF CORRECTED
JRST MAIN ;STREAM IS SHUTDOWN
OUTWAT: $CALL OUTOUT ;OUTPUT THE BUFFER
OUTW.1: $CALL OUTSTS ;GET THE STATUS
TXNN S1,IO.ACT ;DONE?
$RETT ;YES, RETURN
$DSCHD (0) ;FORCE A SCHEDULING RUN
JRST OUTW.1 ;TRY AGAIN
> ;END TOPS10 CONDITIONAL
TOPS20 <
OUTOUT: $SAVE <T1,T2,T3,T4> ;PRESERVE TEMPORARIES
MOVE S1,J$LJFN(J) ;GET DEV JFN
MOVE S2,J$LIBP(J) ;GET POINTER TO BUFFER
SKIPGE T1,J$LBCT(J) ;GET REMAINING BYTE COUNT
SETZ T1, ;MUST BE .GE. 0
SUB T1,J$LIBC(J) ;GET NEG. BYTE COUNT
JUMPE T1,OUTO.2 ;DONE -- RESET BUFFER HEADER
OUTO.1: HRRZ T2,STREAM ;GET STREAM
SETOM J$LIOA(J) ;SET I/O ACT
SKIPE JOBSTW(T2) ;BLOCKED?
JRST OUTINT ;YES -- POSTPONE SOUT
SOUTR ;DUMP THE BUFFER
ERJMP OUTERR ;PROCESS ERROR
OUTO.2: SETZM J$LIOA(J) ;CLEAR I/O ACT
MOVE S1,J$LIBC(J) ;GET INITIAL BYTE COUNT
MOVEM S1,J$LBCT(J) ;RESET BUFFER COUNT
MOVE S1,J$LIBP(J) ;GET INITIAL BYTE POINTER
MOVEM S1,J$LBPT(J) ;RESET BUFFER POINTER
HRRZ T1,J$LIBP(J) ;GET START ADDRESS OF BUFFER
HRLZ T2,T1 ;COPY IT
HRRI T2,1(T1) ;MAKE A BLT POINTER
SETZM (T1) ;CLEAR THE FIRST WORD
BLT T2,PAGSIZ-1(T1) ;CLEAR THE BUFFER
$DSCHD (PSF%NP) ;PICK UP AGAIN AFTER SCHEDULE
$RETT ;AND FINALLY RETURN
OUTERR: SETOM J$LIOE(J) ;SET ERROR FLAG
OUTINT: SETZM J$LIOA(J) ;CLEAR IO ACTIVE
MOVEM S2,J$LBPT(J) ;SAVE THE CURRENT POINTER
MOVEM T1,J$LBCT(J) ;SAVE NUMBER OF CHARACTERS LEFT
SKIPE JOBSTW(J) ;DEVICE OFF-LINE?
$CALL OUTWON ;POSSIBLY. GO CHECK
SKIPE J$LIOE(J) ;ERROR?
$CALL OUTSTS ;READ DEVICE STATUS
SKIPT ;ERROR?
$CALL DEVERR ;YES -- PROCESS IT
JUMPF MAIN ;STREAM HAS BEEN SHUTDOWN
MOVE S1,J$LJFN(J) ;RESTORE DEVICE JFN
MOVE S2,J$LBPT(J) ;RESTORE POINTER
MOVE T1,J$LBCT(J) ;RESTORE COUNT
JRST OUTO.1 ;RESTART SOUT
> ;END TOPS20 CONDITIONAL
SUBTTL DEVERR - Handle Output Device Errors
DEVERR: MOVE S1,J$LIOS(J) ;GET IO STATUS
MOVE S2,J$LSER(J) ;GET ADDRESS OF SERVICE ROUTINES
PUSHJ P,DERR(S2) ;DO ERROR ROUTINE
JUMPT .POPJ ;ERROR CORRECTED -- RETURN
HRRZ S1,STREAM ;POINT TO CURRENT STREAM
$WTO (Device I/O Error,^R/.EQJBB(J)/,@JOBOBA(S1))
SKIPE S1,J$DIFN(J) ;[2535] GET IFN OF OPENED FILE
$CALL F%REL ;[2535] RELEASE IT
PUSHJ P,QREQUE ;[2535] REQUEUE THE REQUEST
JRST SHUTUP ;SHUT IT DOWN AND GO TO MAIN
;OUTSTS reads the device status into location J$LIOS and into
; accumulator S1.
TOPS10 <
OUTSTS: MOVE S1,J$LJFN(J) ;GET DEVICE CHANNEL
LSH S1,^D23 ;POSITION IT
IOR S1,[GETSTS J$LIOS(J)] ;FORM GETSTS
XCT S1 ;AND DO IT
MOVE S1,J$LIOS(J) ;GET THE STATUS
TXNE S1,IO.ERR ;ACTUAL ERROR?
$RETF ;YES -- GIVE FALSE RETURN
$RETT ;RETURN TO CALLER
> ;END TOPS10 CONDITIONAL
TOPS20 <
OUTSTS: $SAVE <T1,T2,T3,T4> ;SAVE T1-T4
MOVE S1,J$LJFN(J) ;GET DEV JFN
MOVX S2,.MORST ;READ STATUS FUNCTION
MOVEI T1,T2 ;ADDRESS OF ARG BLOCK
MOVEI T2,3 ;LENGTH OF ARG BLOCK
SETZB T3,T4 ;CLEAR ANSWER
MTOPR ;GET THE STATUS
ERJMP .+1 ;IGNORE THE ERROR
DMOVEM T3,J$LIOS(J) ;SAVE THE ERROR STATUS
MOVE S1,T3 ;COPY THE STATUS TO S1
TXNE S1,MO%RLD+MO%FER+MO%SER+MO%HE ;ACTUAL ERROR?
$RETF ;YES -- GIVE FALSE RETURN
$RETT ;NO -- GIVE TRUE RETURN
> ;END TOPS20 CONDITIONAL
SUBTTL OUTREL - Release output device
TOPS10 <
OUTREL: MOVE S1,J$LJFN(J) ;GET THE CHANNEL NUMBER
LSH S1,^D23 ;SHIFT IT OVER
TLO S1,(RELEAS) ;MAKE A RELEASE UUO
XCT S1 ;EXECUTE IT
$RETT ;AND RETURN
> ;END TOPS10 CONDITIONAL
TOPS20 <
OUTREL: MOVE S1,J$LJFN(J) ;GET THE JFN
CLOSF ;RELEASE THE DEVICE
$RETF ;ERROR..RETURN FALSE
$RETT
> ;END TOPS20 CONDITIONAL
SUBTTL OUTWON - Wait for on-line
;On the -10, this routine should only be gotten to by DEBRKing to it
; on a device off-line interrupt. On the -20, it can be called
; from anywhere.
TOPS10 <
OUTWON: PUSH P,S1 ;SAVE S1
PUSH P,S2 ;SAVE S2
HRRZ S1,STREAM ;POINT TO CURRENT STREAM
$WTO (Device went off-line,,@JOBOBA(S1))
PUSHJ P,UPDATE ;UPDATE STATUS TO QUASAR
$DSCHD(0) ;BLOCK FOR DEVICE ON-LINE
POP P,S2 ;RESTORE S2
POP P,S1 ;RESTORE S1
JRST @J$LIOA(J) ;AND CONTINUE ON
> ;END TOPS10 CONDITIONAL
TOPS20 <
OUTWON: MOVX S2,PSF%DO ;DEVICE OFFLINE FLAG
HRRZ S1,STREAM ;AND THE STREAM NUMBER
TDNN S2,JOBSTW(S1) ;IS IT OFF-LINE?
POPJ P, ;NO, JUST RETURN
PUSHJ P,UPDATE ;UPDATE STATUS TO QUASAR
$WTO (Device went off-line,,@JOBOBA(S1))
$DSCHD(0) ;BLOCK FOR DEVICE ONLINE
POPJ P, ;NO, RETURN
> ;END TOPS20 CONDITIONAL
SUBTTL OUTFLS Routine to flush output buffers
;OUTFLS IS CALLED TO FLUSH OUTPUT TO THE DEVICE WHICH HAS ALREADY BEEN
; BUFFERED (AND POSSIBLE SENT TO THE DEVICE).
TOPS10 <
OUTFLS: PUSHJ P,INTDCL ;DISCONNECT DEVICE INTERRUPTS
MOVE S1,J$LJFN(J) ;LOAD THE CHANNEL NUMBER
RESDV. S1, ;RESET THE CHANNEL
JFCL ;??
PJRST OUTGET ;AND REINIT THE LPT
> ;END TOPS10 CONDITIONAL
TOPS20 <
OUTFLS: $SAVE <T1> ;PRESERVE AN AC
MOVE S1,J$LJFN(J) ;GET OUTPUT JFN
MOVX S2,.MOFLO ;LOAD FLUSH FUNCTION
MOVEI T1,0 ;AND ZERO ARGUMENTS
MTOPR ;FLUSH THE BUFFERS
ERCAL OUTF.1 ;ON AN ERROR,,SHUT IT DOWN AND RESET IT
MOVE S1,J$LIBC(J) ;INITIAL WORDS IN BUFFER
MOVEM S1,J$LBCT(J) ;RESET BUFFER COUNT
MOVE S1,J$LIBP(J) ;GET INITIAL POINTER
MOVEM S1,J$LBPT(J) ;AND SAVE IT
MOVEI S1,%RSUOK ;LOAD GOOD RETURN CODE
$RETT ;RETURN
OUTF.1: MOVX S1,CZ%ABT ;GET THE ABORT BITS.
ADD S1,J$LJFN(J) ;ADD THE JFN
CLOSF ;CLOSE THE DEVICE
ERJMP .+1 ;IGNORE AN ERROR
PJRST OUTGET ;SET THE DEVICE UP AGAIN
> ;END TOPS20 CONDITIONAL
SUBTTL Card punch service -- Dispatch table
C$DISP: JRST C$HEAD ;(0) FILE HEADER
JRST C$EOF ;(1) FILE TRAILER
SIXBIT /CDP/ ;(2) GENERIC DEVICE NAME
EXP ^D12 ;(3) OUTPUT BYTE SIZE
JRST C$PROC ;(4) PROCESS A FILE
JRST C$BANN ;(5) JOB BANNER
JRST C$TRAI ;(6) JOB TRAILER
JRST C$LETR ;(7) LETTER DEVICE
JRST .RETF ;(10) ERROR PROCESSOR
JRST .RETT ;(11) ACCOUNTING
JRST C$CHKP ;(12) CHECKPOINT TEXT GENERATION
SUBTTL Card punch service -- Checkpoint text generation
C$CHKP: $SAVE <P1,P2> ;SAVE SOME ACS
MOVE P1,J$APRT(J) ;GET CARD COUNT
MOVE P2,J$RLIM(J) ;GET LIMIT
CAMN P2,[.INFIN] ;+INFINITY ?
JRST C$CHK1 ;YES
CAMG P1,J$RLIM(J) ;OPERATOR ALLOW LIMIT TO EXCEED ?
$TEXT (DEPBP,<punched ^D/P1/ of ^D/J$RLIM(J)/ cards^0>)
CAMLE P1,J$RLIM(J) ;OPERATOR ALLOW LIMIT TO EXCEED ?
C$CHK1: $TEXT (DEPBP,<punched ^D/P1/ cards (limit exceeded)^0>)
POPJ P, ;RETURN
SUBTTL Card punch service -- File processing
C$PROC: LOAD S1,.FPINF(E),FP.FPF ;GET PAPER FORMAT
CAILE S1,CDROUL ;WITHIN RANGE?
JRST BADMOD ;NO, LOSE
JUMPN S1,@C$ROUT-1(S1) ;YES, DISPATCH IF NON-ZERO
MOVEI S1,C$MTAB ;GET ADDRESS OF MODE TABLE
MOVEI S2,C$ROUT ;GET ADDRESS OF ROUTINE TABLE
PJRST DSPMOD ;AND DISPATCH BASED ON MODE
;TABLE OF processing ROUTINES
C$ROUT: EXP CDASC ;ASCII
EXP CD026 ;026
EXP CDBIN ;CHECKSUMMED BINARY
EXP CDASC ;ASCII
EXP CDIMA ;IMAGE AND IMAGE BINARY
CDROUL==.-C$ROUT ;LENGTH OF ROUTINE TABLE
;MODE TABLE
C$MTAB: BYTE (3) 1,1,0,0,0,0,0,0,5,0,0,5,3,0,3,3
; ! CARD-PUNCH MODE -- IMAGE !
; ! !
; ! In IMAGE mode, each group of 27 (decimal) words !
; ! read from disk is divided into 81 12-bit bytes !
; ! the first 80 of which are punched one per column, !
; ! and the 81st is ignored. !
; ! !
; !=======================================================!
; ! Column 1 ! Column 2 ! Column 3 !
; !-------------------------------------------------------!
; ! Column 4 ! Column 5 ! Column 6 !
; !-------------------------------------------------------!
; ! !
; \ . \
; \ . \
; \ . \
; ! !
; !-------------------------------------------------------!
; ! Column 76 ! Column 77 ! Column 78 !
; !-------------------------------------------------------!
; ! Column 79 ! Column 80 ! Ignored !
; !=======================================================!
CDIMA: MOVEI T1,^D12 ;GET 12 BIT BYTES FROM DISK
MOVEM T1,J$DBSZ(J) ;SAVE BYTE-SIZE
CDIM.1: MOVEI T2,CPC ;SET UP COL COUNTER
CDIM.2: $CALL INPBYT ;GET A CHARACTER
JUMPF CDIM.3 ;FINISH CARD AT EOF
PUSHJ P,CDPBYT ;PUNCH IT
SOJG T2,CDIM.2 ;JUMP IF CARD NOT FULL
$CALL OUTCDP ;IF FULL,OUTPUT CARD
$CALL INPBYT ;IGNORE BYTE 81
JUMPF .RETT ;THIS SHOULD NEVER REALLY HAPPEN!!
JRST CDIM.1 ;AND THEN LOOP FOR MORE
CDIM.3: CAIE T2,CPC ;IS THERE ANYTHING ON THE CARD?
$CALL OUTCDP ;YES, FORCE OUT PARTIAL CARD
$RETT ;RETURN
; ! CARD-PUNCH MODE -- BINARY !
; ! !
; ! In BINARY mode, each group of 26 (decimal) words read !
; ! from disk (fewer for last buffer) is split into 78 !
; ! 12-bit bytes and punched one byte per column starting !
; ! in column 3 and continuing to column 80. Column 1 !
; !contains the actual word count in rows 12 through 3 and!
; ! rows 7 and 9 punched. Column 2 contains a 12-bit !
; ! folded checksum. !
; ! !
; !=======================================================!
; !Byte 1 - Column 3!Byte 2 - Column 4 !Byte 3 - Column 5 !
; !-------------------------------------------------------!
; !Byte 4 - Column 6!Byte 5 - Column 7 !Byte 6 - Column 8 !
; !-------------------------------------------------------!
; ! !
; \ . \
; \ . \
; \ . \
; ! !
; !-------------------------------------------------------!
; !Byte 76-Column 78!Byte 77-Column 79 !Byte 78-Column 80 !
; !=======================================================!
CDBIN: MOVEI S1,^D26 ;LOAD MAXIMUM BLOCK SIZE
$CALL CHKSUM ;GET A CHECKSUMMED BLOCK
JUMPF .RETT ;DONE ON EOF
DMOVE T1,S1 ;SAVE THE RETURNED VALUES
MOVE C,S1 ;GET THE BLOCKSIZE
LSH C,6 ;PUT IN HIGH 6 OF 12 BITS
IORI C,5 ;ADD ROWS 7 AND 9
PUSHJ P,CDPBYT ;AND PUNCH COLUMN 1
MOVE C,T2 ;GET THE CHECKSUM
PUSHJ P,CDPBYT ;AND PUNCH COLUMN 2
IMULI T1,3 ;CONVERT WORDS TO COLUMNS
MOVE T2,[POINT 12,J$XCHB(J)] ;LOAD A BYTE POINTER
CDBI.1: ILDB C,T2 ;GET A BYTE
PUSHJ P,CDPBYT ;PUNCH IT
SOJG T1,CDBI.1 ;LOOP FOR THE BLOCK
$CALL OUTCDP ;FORCE OUT THE CARD
JRST CDBIN ;AND LOOP
; ! CARD-PUNCH MODE -- ASCII & 026 !
; ! !
; ! In ASCII and 026 modes, each word read from disk !
; ! is treated as 5 7-bit ASCII characters, each of which !
; ! is converted to the appropriate Hollerith code and !
; ! punched in one card column. !
; ! !
; !=======================================================!
; ! Byte 1 ! Byte 2 ! Byte 3 ! Byte 4 ! Byte 5 ! !
; !=======================================================!
CDASC: SKIPA T1,[MOVE C,TBLASC(T2)] ;GET CORRECT TABLE ENTRY
CD026: MOVE T1,[MOVE C,TBL026(T2)] ;GET 026 ENTRY
MOVEM T1,J$XCD1(J) ;AND SAVE FOR LATER EXECUTION
MOVEI T1,7 ;READ 7 BIT BYTES FROM DISK
MOVEM T1,J$DBSZ(J) ;SAVE BYTE SIZE
CDAS.1: MOVEI T1,0 ;START IN COLUMN 0
CDAS.2: $CALL INPBYT ;GET A BYTE
JUMPF CDAS.5 ;EOF, FINISH UP
JUMPE C,CDAS.2 ;IGNORE NULLS
CAIN C,.CHCRT ;IS IT A CARRIAGE RETURN?
MOVEI C," " ;YES, MAKE IT A SPACE
CAIN C,.CHLFD ;IS IT A LINEFEED?
JRST CDAS.6 ;YES, ON TO NEXT CARD
CAIN C,.CHTAB ;IS IT A VERTICAL TAB?
JRST CDAS.3 ;YES, GO HANDLE IT
$CALL CDAS.4 ;ELSE, JUST PUNCH
JRST CDAS.2 ;AND LOOP
CDAS.3: MOVEI C," " ;LOAD A SPACE
$CALL CDAS.4 ;AND PUNCH IT
TRNE T1,7 ;AT A TAB STOP?
JRST CDAS.3 ;NO, LOOP
JRST CDAS.2 ;YES, NEXT CHARACTER
CDAS.4: CAIL T1,CPC ;PUNCH 80 YET?
AOJA T1,.RETT ;YES, IGNORE THE CHARACTER
MOVE T2,C ;GET CHAR IN T2
IDIVI T2,3 ;GET THE OFFSET INTO TABLE IN T2
XCT J$XCD1(J) ;GET THE CORRECT WORD
IMULI T3,^D12 ;MULT REMAINDER BY 12 FOR SHIFT
LSH C,-^D24(T3) ;AND GET DESIRED BYTE
PUSHJ P,CDPBYT ;PUNCH IT
AOJA T1,.RETT ;INCREMENT AND RETURN
CDAS.5: JUMPE T1,.RETT ;EOF ON EMPTY CARD, JUST RETURN
CDAS.6: MOVEI C,0 ;ELSE, LOAD A SPACE
SKIPN T1 ;SKIP IF SOMETHING ON THE CARD ALREADY
PUSHJ P,CDPBYT ;ELSE, PUT SOMETHING IN THE BUFFER
$CALL OUTCDP ;FORCE OUT THE CARD
JRST CDAS.1 ;AND ON TO THE NEXT CARD
;CAST OF CHARACTERS IN IMAGE FORMAT INDEXED BY ASCII VALUE
TBLASC: BYTE (12) 5403,4401,4201 ;NULL ^A ^B
BYTE (12) 4101,0005,1023 ;^C ^D ^E
BYTE (12) 1013,1007,2011 ;^F ^G ^H
BYTE (12) 4021,1021,4103 ;TAB LF VT
BYTE (12) 4043,4023,4013 ;FF CR ^N
BYTE (12) 4007,6403,2401 ;^O ^P ^Q
BYTE (12) 2201,2101,0043 ;^R ^S ^T
BYTE (12) 0023,0201,1011 ;^U ^V ^W
BYTE (12) 2003,2403,0007 ;^X ^Y ^Z
BYTE (12) 1005,2043,2023 ;^[ ^\ ^]
BYTE (12) 2013,2007,0000 ;^^ ^_ SPACE
BYTE (12) 4006,0006,0102 ;! " #
BYTE (12) 2102,1042,4000 ;$ % &
BYTE (12) 0022,4022,2022 ;' ( )
BYTE (12) 2042,4012,1102 ;* + ,
BYTE (12) 2000,4102,1400 ;- . /
BYTE (12) 1000,0400,0200 ;0 1 2
BYTE (12) 0100,0040,0020 ;3 4 5
BYTE (12) 0010,0004,0002 ;6 7 8
BYTE (12) 0001,0202,2012 ;9 : ;
BYTE (12) 4042,0012,1012 ;< = >
BYTE (12) 1006,0042,4400 ;? @ A
BYTE (12) 4200,4100,4040 ;B C D
BYTE (12) 4020,4010,4004 ;E F G
BYTE (12) 4002,4001,2400 ;H I J
BYTE (12) 2200,2100,2040 ;K L M
BYTE (12) 2020,2010,2004 ;N O P
BYTE (12) 2002,2001,1200 ;Q R S
BYTE (12) 1100,1040,1020 ;T U V
BYTE (12) 1010,1004,1002 ;W X Y
BYTE (12) 1001,4202,1202 ;Z [ \
BYTE (12) 2202,2006,1022 ;] ^ _
;FOLLOWING ALPHABETICS ARE SMALL LETTERS
BYTE (12) 0402,5400,5200 ;' A B
BYTE (12) 5100,5040,5020 ;C D E
BYTE (12) 5010,5004,5002 ;F G H
BYTE (12) 5001,6400,6200 ;I J K
BYTE (12) 6100,6040,6020 ;L M N
BYTE (12) 6010,6004,6002 ;O P Q
BYTE (12) 6001,3200,3100 ;R S T
BYTE (12) 3040,3020,3010 ;U V W
BYTE (12) 3004,3002,3001 ;X Y Z
BYTE (12) 5000,6000,3000 ;
BYTE (12) 3400,0000,0000 ;
;CAST OF CHARACTERS IN IMAGE FORMAT INDEXED BY ASCII VALUE
TBL026: BYTE (12) 5403,4401,4201 ;NULL ^A ^B
BYTE (12) 4101,0003,1023 ;^C ^D ^E
BYTE (12) 1013,1007,2011 ;^F ^G ^H
BYTE (12) 4021,1021,4103 ;TAB LF VT
BYTE (12) 4043,4023,4013 ;FF CR ^N
BYTE (12) 4007,6403,2401 ;^O ^P ^Q
BYTE (12) 2201,2101,0013 ;^R ^S ^T
BYTE (12) 0023,0201,0011 ;^U ^V ^W
BYTE (12) 2003,2403,0007 ;^X ^Y ^Z
BYTE (12) 1005,2043,2023 ;^[ ^\ ^]
BYTE (12) 2013,2007,0000 ;^^ ^_ SPACE
BYTE (12) 4006,1022,1012 ;! " #
BYTE (12) 2102,1006,2006 ;$ % &
BYTE (12) 0012,1042,4042 ;' ( )
BYTE (12) 2042,4000,1102 ;* + ,
BYTE (12) 2000,4102,1400 ;- . /
BYTE (12) 1000,0400,0200 ;0 1 2
BYTE (12) 0100,0040,0020 ;3 4 5
BYTE (12) 0010,0004,0002 ;6 7 8
BYTE (12) 0001,2202,1202 ;9 : ;
BYTE (12) 4012,0102,2012 ;< = >
BYTE (12) 4202,0042,4400 ;? @ A
BYTE (12) 4200,4100,4040 ;B C D
BYTE (12) 4020,4010,4004 ;E F G
BYTE (12) 4002,4001,2400 ;H I J
BYTE (12) 2200,2100,2040 ;K L M
BYTE (12) 2020,2010,2004 ;N O P
BYTE (12) 2002,2001,1200 ;Q R S
BYTE (12) 1100,1040,1020 ;T U V
BYTE (12) 1010,1004,1002 ;W X Y
BYTE (12) 1001,2022,0006 ;Z [ \
BYTE (12) 4022,0022,0202 ;] ^ _
;FOLLOWING ALPHABETICS ARE SMALL LETTERS
BYTE (12) 0402,5400,5200 ;' A B
BYTE (12) 5100,5040,5020 ;C D E
BYTE (12) 5010,5004,5002 ;F G H
BYTE (12) 5001,6400,6200 ;I J K
BYTE (12) 6100,6040,6020 ;L M N
BYTE (12) 6010,6004,6002 ;O P Q
BYTE (12) 6001,3200,3100 ;R S T
BYTE (12) 3040,3020,3010 ;U V W
BYTE (12) 3004,3002,3001 ;X Y Z
BYTE (12) 5000,6000,3000 ;
BYTE (12) 3400,0000,0000 ;
SUBTTL Card punch service -- File headers
C$HEAD: SKIPN J$FHEA(J) ;HEADER ALLOWED?
$RETT ;NO -- RETURN
LOAD S1,.FPINF(E),FP.NFH ;GET NO FILE HEADER BIT
JUMPN S1,.RETT ;RETURN IF NOT WANTED
MOVEI C,4001 ;SPECIAL MASK FOR FILE CARDS
MOVEM C,J$CMSK(J) ;SAVE FOR C$LETR
MOVE S1,J$DFDA(J) ;POINT TO FD
SKIPN S2,J$DSPN(J) ;SPOOL NAME?
TOPS10< MOVE S2,.FDNAM(S1) > ;NO -- USE FILE NAME
TOPS20<
MOVX S1,GJ%SHT!GJ%OFG ;PARSE ONLY, SHORT JFN
MOVE S2,J$DFDA(J) ;GET FD ADDRESS
HRROI S2,.FDSTG(S2) ;POINT TO START OF FILESPEC
GTJFN ;GET A JFN
ERJMP .POPJ ;ASSUME A SPOOLED FILE
MOVE S2,[POINT 7,FILNAM] ;POINT TO FILENAME STORAGE
EXCH S1,S2 ;S1:= POINTER, S2:= JFN
MOVE T1,[FILNAM,,FILNAM+1] ;SET UP BLT
SETZM FILNAM ;CLEAR THE FIRST WORD
BLT FILNAM+7 ;CLEAR THE ENTIRE BLOCK
MOVX T1,1B8 ;WANT FILENAME ONLY
JFNS ;GET IT
HRROI S1,FILNAM ;POINT TO THE FILENAME
$CALL S%SIXB ;CONVERT TO SIXBIT
>
MOVEI S1,[ITEXT<^W6/S2/>] ;POINT TO NAME
PJRST C$WORD ;PUNCH CARD AND RETURN
SUBTTL Card punch service -- File trailers
C$EOF: MOVEI S1,^D80 ;PUNCH EOF CARD
MOVEI C,7417 ;TOP FOUR AND BOTTOM FOUR ROWS
PUSHJ P,CDPREP ;PUNCH EOF CARDS
PJRST OUTOUT ;FORCE OUTPUT
SUBTTL Card punch service -- Banners
C$BANN: SKIPN J$FBAN(J) ;GET COUNT OF BANNER CARDS
$RETT ;RETURN IF ZERO
MOVEI C,4003 ;MASK FOR JOB CARDS
MOVEM C,J$CMSK(J) ;SAVE FOR C$LETR
MOVEI S1,[ITEXT<BEGIN:>]
PJRST CTRA.1 ;FALL INTO COMMON CODE
C$TRAI: SKIPN J$FTRA(J) ;GET TRAILER COUNT
$RETT ;RETURN IF ZERO
MOVEI C,4003 ;MASK FOR JOB CARDS
MOVEM C,J$CMSK(J) ;SAVE FOR C$LETR
MOVEI S1,[ITEXT<END: >]
CTRA.1: $CALL C$WORD
MOVEI S1,[ITEXT<^W6/.EQJOB(J)/>]
$CALL C$WORD
MOVEI S1,[ITEXT <REQ-ID >]
PUSHJ P,C$WORD
MOVEI S1,[ITEXT<#^D5R0/.EQJBB+JIB.ID(J)/>] ;REQUEST ID
$CALL C$WORD
MOVEI S1,[ITEXT<USER: >]
$CALL C$WORD
$CALL SETTBF ;POINT TO TEXT BUFFER
TOPS10 < ;TOPS-10 ONLY
MOVEI S1,[ITEXT <^W6/.EQJBB+JIB.NM(J)/>] ;USER NAME (WORD 1)
PUSHJ P,C$WORD ;PUNCH IT
MOVEI S1,[ITEXT <^W6/.EQJBB+JIB.NM+1(J)/>] ;USER NAME (WORD 2)
PUSHJ P,C$WORD ;PUNCH IT
MOVEI S1,[ITEXT <^O6R /.EQOID(J),LHMASK/>] ;PROJECT NUMBER
PUSHJ P,C$WORD ;PUNCH IT
MOVEI S1,[ITEXT <^O6L /.EQOID(J),RHMASK/>] ;PROGRAMMER NUMBER
PUSHJ P,C$WORD ;PUNCH IT
> ;END TOPS-10 CONDITIONAL
TOPS20 <
MOVE TF,[POINT 6,FILNAM] ;GET BYTE POINTER
MOVEM TF,TEXTBP ;STORE THE BYTE POINTER
MOVEI TF,TXT$LN*^D12 ;GET BYTE COUNT
MOVEM TF,TEXTBC ;AND SAVE IT
SETZM FILNAM+0 ;CLEAR A WORD
SETZM FILNAM+1 ;CLEAR ANOTHER WORD
$TEXT (DEP6BP,<^T/.EQOWN(J)/^A>) ;ALLOW UP TO 12 CHARACTER NAMES
MOVEI S1,[ITEXT <^W6/FILNAM+0/>] ;WORD 1
PUSHJ P,C$WORD ;OUTPUT IT
MOVEI S1,[ITEXT <^W6/FILNAM+1/>] ;WORD 2
SKIPE FILNAM+1 ;IS THERE A SECOND WORD?
PUSHJ P,C$WORD ;OUTPUT IT
PUSHJ P,SETTBF ;RESET BYTE POINTER AND COUNT
>
GETLIM T1,.EQLIM(J),NOT1 ;GET /NOTE VALUE (WORD 1)
GETLIM T2,.EQLIM(J),NOT2 ;GET /NOTE VALUE (WORD 2)
SKIPN T1 ;RETURN IF BOTH
JUMPE T2,.RETT ; WORDS ARE ZERO
MOVEI S1,[ITEXT<NOTE: >]
PUSHJ P,C$WORD ;PUNCH IT
GETLIM T1,.EQLIM(J),NOT1 ;GET /NOTE VALUE (WORD 1)
MOVEI S1,[ITEXT<^W6/T1/>]
PUSHJ P,C$WORD ;PUNCH IT
GETLIM T1,.EQLIM(J),NOT2 ;GET /NOTE VALUE (WORD 2)
JUMPE T1,.RETT ;RETURN IF NO SECOND WORD
MOVEI S1,[ITEXT<^W6/T1/>]
PJRST C$WORD ;PUNCH LAST CARD AND RETURN
SUBTTL Card punch service -- Word punching
;C$WORD
;Call S1/ Address of Itext to punch as 6 Character word on card
; Also J$CMSK Specifies Extra Rows to punch with Characters
C$WORD: $CALL SETTBF ;SET POINTERS TO TEXT BUFFER
$TEXT(DEPBP,<^I/(S1)/^0>) ;STORE STRING IN BUFFER
MOVEI S1,0 ;GET A NULL
DPB S1,[POINT 7,J$XTBF+1(J),13] ;TRUNCATE TO SIX CHARACTERS
MOVEI C,3776 ;FIRST COLUMN WITH ROUNDED CORNERS
PUSHJ P,CDPBYT
MOVEI C,7777 ;SECOND COLUMN FULLY LACED
PUSHJ P,CDPBYT
MOVEI S1,3 ;NEXT 3 COLUMNS WITH SPECIAL MASK
MOVE C,J$CMSK(J)
PUSHJ P,CDPREP
$CALL STRING ;COLUMNS 6-77 FOR CHARACTERS
MOVE C,J$CMSK(J) ;COLUMN 78 SPECIAL MASK
PUSHJ P,CDPBYT
MOVEI C,7777 ;COLUMN 79 FULLY LACED
PUSHJ P,CDPBYT
MOVEI C,3776 ;COLUMN 80 ROUNDED CORNERS
PUSHJ P,CDPBYT
PJRST OUTOUT ;PUNCH CARD AND RETURN
SUBTTL Card punch service -- Letters
;C$LETR
;Call with Ascii character to Punch in S1
;Punches Characters as 10 12 bit Frames followed by 2 blank frames
;Character is Punched in Rows 0 thru 6. The Contents of J$CMSK is
;ORED with the Column Punch to identify the Card as a Job or File card.
C$LETR: CAIL S1,40 ;CAN WE PUNCH THIS CHARACTER?
CAILE S1,177
POPJ P,0 ;NO -- RETURN
CAILE S1,"_" ;UPPER CASE ?
SUBI S1,40 ;NO -- CONVERT TO UPPER
MOVEI S1,CHRTAB-40(S1) ;POINT TO CHARACTER BITS
HRLI S1,(POINT 7,0) ;MAKE BYTE POINTER
MOVSI S2,-5 ;PUNCH AS 5 DUPLICATED FRAMES
CLET.1: ILDB C,S1 ;GET SEGMENT BITS
LSH C,3 ;CENTER ON CARD
IOR C,J$CMSK(J) ;INCLUDE MASK FOR SPECIAL ROWS
PUSHJ P,CDPBYT ;PUNCH FIRST FRAME
PUSHJ P,CDPBYT
AOBJN S2,CLET.1 ;REPEAT 10 FRAMES
MOVEI S1,2
MOVE C,J$CMSK(J) ;PUNCH SPECIAL ROWS
PJRST CDPREP ;PUNCH CARDS AND RETURN
SUBTTL Card punch service -- Byte output
; AC 'C' contains the byte to output
;
CDPBYT: PJRST OUTBYT ;OUTPUT THE BYTE
; Force card out
;
OUTCDP: PUSHJ P,OUTOUT ;FORCE CARD OUT
AOS S1,J$APRT(J) ;COUNT ANOTHER ONE
CAMLE S1,J$RLIM(J) ;OVER LIMIT?
PUSHJ P,FRMLEX ;HANDLE LIMIT EXCEEDED
POPJ P, ;RETURN
; Repeat the byte in AC 'C'
; Call: MOVE S1,repeat count
; MOVE C,byte to output
; PUSHJ P,CDPREP
;
CDPREP: PUSH P,P1 ;SAVE P1
MOVE P1,S1 ;GET COUNT
PUSHJ P,PTPBYT ;OUTPUT A BYTE
SOJG P1,.-1 ;AND LOOP
POP P,P1 ;RESTORE P1
POPJ P, ;RETURN
SUBTTL Plotter service -- Dispatch table
P$DISP: JRST P$HEAD ;(0) FILE HEADER
JRST P$EOF ;(1) FILE TRAILER
SIXBIT /PLT/ ;(2) GENERIC DEVICE NAME
EXP ^D6 ;(3) OUTPUT BYTE SIZE
JRST P$PROC ;(4) PROCESS A FILE
JRST P$BANN ;(5) JOB BANNER
JRST P$TRAI ;(6) JOB TRAILER
JRST P$LETR ;(7) LETTER PROCESSER
JRST P$DERR ;(10) DEVICE ERROR PROCESSOR
JRST .RETT ;(11) ACCOUNTING
JRST P$CHKP ;(12) CHECKPOINT TEXT GENERATION
SUBTTL Plotter service -- Checkpoint text generation
P$CHKP: $SAVE <P1,P2,P3> ;SAVE SOME ACS
MOVE P1,J$PTIC(J) ;GET # TICS FOR JOB
IDIV P1,J$PTPM(J) ;T1:= MINUTES, T2:= FRACTION
IMULI P2,^D1000 ;MAKE IT DECIMAL
IDIV P2,J$PTPM(J) ;T2:= DECIMAL FRACTION OF A MINUTE
MOVE P3,J$RLIM(J) ;GET LIMIT
CAMN P3,[.INFIN] ;+INFINITY ?
JRST P$CHK1 ;YES
CAMG P1,J$RLIM(J) ;OPERATOR ALLOW LIMIT TO EXCEED ?
$TEXT (DEPBP,<plotted ^D/P1/.^D3L0/P2/ of ^D/J$RLIM(J)/ minutes^0>)
CAMLE P1,J$RLIM(J) ;OPERATOR ALLOW LIMIT TO EXCEED ?
P$CHK1: $TEXT (DEPBP,<plotted ^D/P1/.^D3L0/P2/ minutes (limit exceeded)^0>)
POPJ P, ;RETURN
SUBTTL Plotter service -- File processing
P$PROC: LOAD S1,.FPINF(E),FP.FPF ;GET PAPER FORMAT
CAILE S1,PLROUL ;WITHIN RANGE?
JRST BADMOD ;NO, LOSE
JUMPN S1,@P$ROUT-1(S1) ;YES, DISPATCH IF NON-ZERO
MOVEI S1,P$MTAB ;GET ADDRESS OF MODE TABLE
MOVEI S2,P$ROUT ;GET ADDRESS OF ROUTINE TABLE
PJRST DSPMOD ;AND DISPATCH BASED ON MODE
P$ROUT: EXP PLTSIX ;/PLOT:IMAGE (6 BIT)
EXP PLTSVN ;/PLOT:ASCII (7 BIT)
EXP PLTSIX ;/PLOT:BINARY (6 BIT)
PLROUL==.-P$ROUT ;LENGTH OF ROUTINE TABLE
;MODE TABLE
P$MTAB: BYTE (3) 2,2,0,0,0,0,0,0,1,0,0,1,1,1,1,1
; !=======================================================!
; ! !
; ! PLOTTER MODE -- 6 BIT !
; ! !
; ! In 6bit mode, each word read from disk is treated as !
; ! 6 6-bit bytes each of which is sent to the plotter !
; ! !
; !=======================================================!
; ! Byte 1 ! Byte 2 ! Byte 3 ! Byte 4 ! Byte 5 ! Byte 6 !
; !=======================================================!
;
;
;
; !=======================================================!
; ! !
; ! PLOTTER MODE -- 7 BIT !
; ! !
; !In 7 bit mode, each word read from disk is treated as 5!
; ! 7-bit bytes each of which is truncated to 6 bits and !
; ! sent to the plotter !
; ! !
; !=======================================================!
; ! Byte 1 ! Byte 2 ! Byte 3 ! Byte 4 ! Byte 5 ! !
; !=======================================================!
PLTSVN: SKIPA T1,[7] ;7 BIT BYTES FROM DISK
PLTSIX: MOVEI T1,6 ;6 BIT BYTES FROM DISK
MOVEM T1,J$DBSZ(J) ;AND STORE THE BYTE SIZE
PLTLUP: $CALL INPBYT ;GET A BYTE
JUMPF PLTLP0 ;EXIT LOOP IF AT EOF
JUMPE C,PLTLUP ;GET NEXT IF NULL
PUSHJ P,PLTBYT ;WRITE THE CHARACTER OUT
MOVE T1,J$PTIC(J) ;GET TICS PLOTTED
IDIV T1,J$PTPM(J) ;CONVERT TO MINUTES
CAMLE T1,J$RLIM(J) ;STILL IN RANGE?
PUSHJ P,FRMLEX ;NO - COMPLAIN
JRST PLTLUP ;AND LOOP
PLTLP0: MOVE T1,J$PTIC(J) ;GET TICS PLOTTED
IDIV T1,J$PTPM(J) ;CONVERT TO MINUTES
MOVE T3,J$PTPM(J) ;GET TICS PER MINUTE
IDIVI T3,2 ;GET HALF
CAMLE T2,T3 ;NEED TO ROUND UP?
ADDI T1,1 ;YES
MOVEM T1,J$APRT(J) ;STORE THE ANSWER
POPJ P, ;RETURN
SUBTTL Plotter service -- Devout output errors
; *** Note ***
; I/O bus XY10 plotters do not generate output errors. Unfortunately,
; TOPS-10 sometimes gets a little confused and the OUT UUO takes the
; error return. Just siz we're nice guys, we'll bitch at the operator
; just to he can count the number of times the -10 screws up, and we'll
; continue the plotter. If we ever have a supported plotter that can
; tell us about real I/O errors, the $RETT must be replaced by a POPJ P,
; so the job will be flushed down the old porclain facility.
;
P$DERR: HRRZ S1,STREAM ;POINT TO CURRENT STREAM
$WTO (<I/O error ^O6R0/J$LIOS(J),RHMASK/>,,@JOBOBA(S1))
$RETT ;RETURN, IGNORING THE ERROR
SUBTTL Plotter service -- Banners
P$BANN: PUSHJ P,P$CPEN ;RE-CALIBRATE THE PEN
SKIPN J$FBANN(J) ;BANNER WANTED?
POPJ P, ;NO - JUST RETURN
PUSH P,J$PTIC(J) ;DON'T CHARGE FOR PLOTTER OVERHEAD
MOVEI S1,[ASCIZ |Start|] ;GET LINE IDENTIFIER
PUSHJ P,PLTJOB ;PLOT JOB INFORMATION
BANN.1: PUSHJ P,P$CHKS ;COMPUTE CHARACTER SIZE
ADD T1,J$XPOS(J) ;POINT TO NEXT LINE
MOVE T2,J$YMIN(J) ;GET MINIMUM Y POSITION
MOVEI T3,3 ;PEN UP
PUSHJ P,PLOT ;MOVE THE PEN
PUSHJ P,SETTBF ;SET UP TEXT BUFFER
$TEXT (DEPBP,< Limit: ^D/J$RLIM(J)/, Forms: ^W/J$FORM(J)/^A>)
BANN.2: GETLIM T1,.EQLIM(J),NOT1 ;GET /NOTE VALUE (WORD 1)
GETLIM T2,.EQLIM(J),NOT2 ;GET /NOTE VALUE (WORD 2)
SKIPN T1 ;CHECK WORD 1
SKIPE T2 ;CHECK WORD 2
$TEXT (DEPBP,<, Note: ^W6/T1/^W/T2/^A>) ;YES
MOVEI S1,.CHNUL ;GET A <NUL>
PUSHJ P,DEPBP ;STORE IT
PUSHJ P,STRING ;PLOT STRING
POP P,J$PTIC(J) ;RESTORE # PLOTTER TICS
POPJ P, ;RETURN
SUBTTL Plotter service -- File headers
P$HEAD: PUSH P,J$PTIC(J) ;DON'T CHARGE FOR PLOTTER OVERHEAD
PUSHJ P,P$DASH ;SEPARATE FROM BANNER OR LAST FILE
SKIPN J$FHEA(J) ;HEADER ALLOWED?
PJRST P$HEA1 ;NO..POSITION TO ORIGIN
LOAD S1,.FPINF(E),FP.NFH ;GET NO FILE HEADER BIT
JUMPN S1,P$HEA1 ;SKIP IF NOT WANTED
PUSHJ P,P$CHKS ;COMPUTE CHARACTER SIZE
$CALL SETTBF ;SETUP TO PRINT STIRNG
MOVE S1,J$DIFN(J) ;GET FILE IFN
MOVEI S2,FI.CRE ;GET CREATION DATE TIME
$CALL F%INFO
MOVEI S2,[ITEXT (<>)] ;ASSUME NOT /DISPOSE:RENAME
SKIPE J$DSPN(J) ;WAS IT /DISPOSE:RENAME ?
MOVEI S2,[ITEXT (< (^W/J$DSPN(J)/.^W/J$DSPX(J)/)>)] ;YES
$TEXT (DEPBP,<* File: ^F/@J$DFDA(J)/^I/(S2)/ created:^H/S1/ *^0>)
PUSHJ P,STRING ;PLOT TEXT
P$HEA1: PUSHJ P,P$CHKS ;COMPUTE CHARACTER SIZE
IMULI T1,4 ;LEAVE THIS MUCH SPACE
ADD T1,J$XPOS(J) ;OFFSET BY CURRENT POSITION
MOVE T2,J$YMIN(J) ;GET MINIMUM Y POSITION
MOVEI T3,3 ;PEN GOES UP
PUSHJ P,PLOT ;POSITION PEN
MOVE T1,J$XPOS(J) ;GET CURRENT X POSITION
MOVEM T1,J$XMIN(J) ;UPDATE NEW MINIMUM
POP P,J$PTIC(J) ;RESTORE # PLOTTER TICS
POPJ P, ;RETURN
SUBTTL Plotter service -- File trailers
P$EOF: PUSHJ P,P$CHKS ;COMPUTE CHARACTER SIZE
ADD T1,J$XLIM(J) ;POSITION BEYOND THE HIGHEST X STEP
MOVE T2,J$YMIN(J) ;GO BACK TO THE MARGIN
MOVEI T3,3 ;WITH PEN UP
PUSHJ P,PLOT ;POSITION PEN
PJRST OUTOUT ;DUMP WHAT WE HAVE
SUBTTL Plotter service -- Job trailers
P$TRAI: PUSHJ P,P$DASH ;SEPARATE FROM LAST FILE
PUSH P,J$PTIC(J) ;DON'T CHARGE FOR PLOTTER OVERHEAD
SKIPN J$FTRA(J) ;TRAILER ALLOWED?
JRST P$TRA3 ;NO
SKIPN J$XERR(J) ;ANY ERROR TEXT ?
JRST P$TRA0 ;NO - ONWARD
PUSHJ P,P$CHKS ;COMPUTE CHARACTER SIZE
ADD T1,J$XPOS(J) ;POINT TO NEXT LINE
MOVE T2,J$YMIN(J) ;GET MINIMUM Y POSITION
MOVEI T3,3 ;PEN UP
PUSHJ P,PLOT ;POSITION PEN
PUSHJ P,SETTBF ;SET UP TEXT BUFFER
$TEXT (DEPBP,<^T/J$XERR(J)/^0>) ;INCLUDE ERROR TEXT
PUSHJ P,STRING ;PLOT ERROR TEXT
P$TRA0: MOVEI S1,[ASCIZ |End|] ;GET LINE IDENTIFIER
PUSHJ P,PLTJOB ;PLOT JOB LINE
P$TRA1: PUSHJ P,P$CHKS ;COMPUTE CHARACTER SIZE
ADD T1,J$XPOS(J) ;POINT TO NEXT LINE
MOVE T2,J$YMIN(J) ;GET MINIMUM Y POSITION
MOVEI T3,3 ;PEN UP
PUSHJ P,PLOT ;POSITION PEN
PUSHJ P,SETTBF ;SET UP TEXT BUFFER
LOAD T1,.EQSPC(J),EQ.NUM ;GET NUMBER OF FILES
MOVEI T2,[ITEXT (<file>)] ;ASSUME 1 FILE
CAIE T1,1 ;WAS IT
MOVEI T2,[ITEXT (<files>)] ;NO
$TEXT (DEPBP,< Summary: ^D/T1/ ^I/(T2)/^A>)
P$TRA2: MOVE T1,(P) ;GET # TICS FOR JOB
IDIV T1,J$PTPM(J) ;T1:= MINUTES, T2:= FRACTION
IMULI T2,^D1000 ;MAKE IT DECIMAL
IDIV T2,J$PTPM(J) ;T2:= DECIMAL FRACTION OF A MINUTE
$TEXT (DEPBP,< plotted in ^D/T1/.^D3L0/T2/ minutes^0>)
PUSHJ P,STRING ;PLOT TEXT
P$TRA3: PUSHJ P,P$CHKS ;COMPUTE CHARACTER SIZE
IMULI T1,2 ;LEAVE THIS MUCH SPACE
ADD T1,J$XPOS(J) ;OFFSET BY CURRENT POSITION
PUSHJ P,P$LINE ;PLOT SEPARATOR
PUSHJ P,P$CHKS ;COMPUTE CHARACTER SIZE
IMULI T1,2 ;POINT TO NEXT LINE
ADD T1,J$XPOS(J) ;OFFSET BY CURRENT POSITION
MOVE T2,J$YMIN(J) ;GET MINIMUM Y POSITION
MOVEI T3,3 ;PEN UP
PUSHJ P,PLOT ;POSITION PEN
POP P,J$PTIC(J) ;RESTORE # PLOTTER TICS
MOVE T1,J$PTIC(J) ;GET # TICS
IDIV T1,J$PTPM(J) ;GET MINUTES OF PLOTTER TIME
MOVEM T1,J$APRT(J) ;STORE IT
POPJ P, ;RETURN
SUBTTL Plotter service -- Solid lines
; This routine does the following:
; 1. Position to the next line
; 2. Plot a solid line
; 3. Position to the next line
;
P$LINE: PUSHJ P,P$CHKS ;COMPUTE CHARACTER SIZE
ADD T1,J$XPOS(J) ;POINT TO NEXT LINE
MOVE T2,J$YMIN(J) ;GET MINIMUM Y POSITION
MOVEI T3,3 ;PEN UP
PUSHJ P,PLOT ;POSITION PEN
MOVE T1,J$XPOS(J) ;DON'T TOUCH X POSITION
MOVE T2,J$YMAX(J) ;GET MAXIMUM Y VALUE
MOVEI T3,2 ;PEN DOWN
PUSHJ P,PLOT ;PLOT A LINE
LINE.1: PUSHJ P,P$CHKS ;COMPUTE CHARACTER SIZE
IMULI T1,2 ;LEAVE SOME SPACE
ADD T1,J$XPOS(J) ;POSITION TO NEXT LINE
MOVE T2,J$YMIN(J) ;GET MINIMUM Y VALUE
MOVEI T3,3 ;PEN UP
PUSHJ P,PLOT ;POSITION PEN AT START OF NEXT LINE
PUSHJ P,OUTOUT ;DUMP BUFFERS
POPJ P, ;RETURN
SUBTTL Plotter service -- Dashed lines
; This routine works like P$LINE
;
P$DASH: PUSHJ P,P$CHKS ;COMPUTE CHARACTER SIZE
ADD T1,J$XPOS(J) ;POINT TO NEXT LINE
MOVE T2,J$YMIN(J) ;GET MINIMUM Y POSITION
MOVEI T3,3 ;PEN UP
PUSHJ P,PLOT ;POSITION PEN
DASH.1: PUSHJ P,P$CHKS ;COMPUTE CHARACTER SIZE
ADD T1,J$YPOS(J) ;ADD TO Y POSITION
CAML T1,J$YMAX(J) ;GONE TOO FAR ?
JRST LINE.1 ;YES - FINISH UP
MOVE T2,T1 ;PUT IN PROPER PLACE
MOVE T1,J$XPOS(J) ;GET X POSITION
MOVEI T3,2 ;PEN DOWN
PUSHJ P,PLOT ;PLOT A LINE
DASH.2: PUSHJ P,P$CHKS ;COMPUTE CHARACTER SIZE
ADD T1,J$YPOS(J) ;ADD TO Y POSITION
CAML T1,J$YMAX(J) ;GONE TOO FAR ?
JRST LINE.1 ;YES - FINISH UP
MOVE T2,T1 ;PUT IN PROPER PLACE
MOVE T1,J$XPOS(J) ;GET X POSITION
MOVEI T3,3 ;PEN UP
PUSHJ P,PLOT ;PLOT A LINE
JRST DASH.1 ;GO BACK AND DO IT AGAIN
SUBTTL Plotter service -- Job information plotting
; Here to job information for banner and trailer lines
; Call: MOVEI S1,[ASCIZ |Start|] ;OR [ASCIZ |Stop|]
; PUSHJ P,PLTJOB
;
PLTJOB: PUSH P,S1 ;SAVE TEXT POINTER
PUSHJ P,P$CHKS ;COMPUTE CHARACTER SIZE
IMULI T1,2 ;MOVE OUT A BIT
ADD T1,J$XPOS(J) ;OFFSET BY CURRENT POSITION
MOVE T2,J$YMIN(J) ;GET MINIMUM Y POSITION
MOVEI T3,3 ;PEN UP
PUSHJ P,PLOT ;POSITION PEN
PUSHJ P,SETTBF ;SET UP TEXT BUFFER
MOVE T1,.EQJBB+JIB.JN(J) ;GET JOB NAME
MOVE T2,.EQJBB+JIB.ID(J) ;GET REQUEST ID
POP P,T3 ;RESTORE TEXT POINTER
$TEXT (DEPBP,<* ^T/(T3)/ Job ^W/T1/ req #^D/T2/ ^H/[-1]/ ^T/(T3)/ *^0>)
PUSHJ P,STRING ;PLOT STRING
PUSHJ P,P$CHKS ;COMPUTE CHARACTER SIZE
IMULI T1,^D4 ;GET STARTING POSITION
ADD T1,J$XPOS(J) ;OFFSET BY CURRENT POSITION
MOVE T2,J$YMIN(J) ;GET MINIMUM Y POSITION
MOVEI T3,3 ;PEN UP
PUSHJ P,PLOT ;MOVE THE PEN
PUSHJ P,SETTBF ;SET UP POINTERS TO THE BUFFER
PUSHJ P,P$CHKS ;COMPUTE CHARACTER SIZE
IMULI T1,3 ;COMPUTE NEW CHARACTER SIZE
MOVEM T1,J$CSIZ(J) ;STORE IT
;PLOT THE USERS NAME
TOPS10< DMOVE T3,.EQOWN(J)
$TEXT (DEPBP,< ^W6/T3/^W/T4/ ^P/.EQOID(J)/^0>) >
TOPS20< $TEXT (DEPBP,< ^T/.EQOWN(J)/^0>) >
PUSHJ P,STRING ;PLOT THE STRING
PUSHJ P,P$CHKS ;COMPUTE CHARACTER SIZE
ADD T1,J$XPOS(J) ;POINT TO NEXT LINE
MOVE T2,J$YMIN(J) ;GET MINIMUM Y POSITION
MOVEI T3,3 ;PEN UP
PUSHJ P,PLOT ;POSITION PEN
POPJ P, ;RETURN
SUBTTL Plotter service -- Alignment and testing
REPEAT 0,<
; Routine to test character plots
;
P$TEST: $SAVE <P1> ;SAVE P1
PUSHJ P,SETTBF ;SET UP TEXT BUFFER
PUSHJ P,P$CPEN ;CALIBRATE THE PEN
MOVEI C,.CHNUL ;START WITH <NUL>
TEST.1: PUSH P,C ;SAVE CHARACTER
PUSHJ P,STRING ;OUTPUT TEXT
PUSHJ P,P$CHKS ;COMPUTE CHARACTER SIZE
IMULI T1,2 ;WANT DOUBLE HEIGHT CHARACTERS
MOVEM T1,J$CSIZ(J) ;REMEMBER IT
ADD T1,J$XPOS(J) ;OFFSET BY CURRENT POSITION
MOVE T2,J$YMIN(J) ;GET MINIMUM Y POSITION
MOVEI T3,3 ;PEN UP
PUSHJ P,PLOT ;POSITION PEN
PUSHJ P,SETTBF ;SET UP TEXT BUFFER
POP P,C ;RESTORE CHARACTER
CAIN C,200 ;DONE ALL CHARACTERS ?
PJRST OUTOUT ;PLOT TEXT AND RETURN
MOVEI P1,40 ;SET UP COUNTER
TEST.2: SKIPN S1,C ;GET CHARACTER
MOVEI S1," " ;STRING SUBROUTINE CAN'T HANDLE <NUL>
PUSHJ P,DEPBP ;PUT CARACTER
ADDI C,1 ;ADVANCE TO NEXT CHARACTER
SOJLE P1,TEST.1 ;DONE WITH THIS LINE ?
JRST TEST.2 ;NO
>
SUBTTL Plotter service -- Pen calibration
P$CPEN: MOVE T1,J$YMAX(J) ;GET THE MAXIMUM Y VALUE WE KNOW ABOUT
MOVEM T1,J$YPOS(J) ;FAKE OUT THE LOW LEVEL OUTPUT ROUTINE
PUSH P,J$YMIN(J) ;SAVE MINIMUM Y POSITION
SETZM J$YMIN(J) ;CLEAR SO WE CAN GO BELOW IT
MOVE T1,J$XPOS(J) ;DON'T TOUCH THE X POSITION
MOVEI T2,0 ;RAM THE PEN INTO THE AXIS
MOVEI T3,3 ;PEN UP
PUSHJ P,PLOT ;POSITION PEN
SETZM J$XMIN(J) ;ZERO X MINIMUM
SETZM J$YMIN(J) ;ZERO Y MINIMUM
SETZM J$XPOS(J) ;ZERO X POSITION
SETZM J$YPOS(J) ;ZERO Y POSITION
MOVE T1,J$XORG(J) ;GET ORIGINAL X MINIMUM
MOVE T2,(P) ;GET MINIMUM Y VALUE
MOVEI T3,3 ;PEN UP
PUSHJ P,PLOT ;PUT PEN THERE
MOVE T1,J$XORG(J) ;GET ORIGINAL X MINIMUM
MOVEM T1,J$XMIN(J) ;STORE IT
POP P,J$YMIN(J) ;RESTORE MINIMUM Y POSITION
POPJ P, ;RETURN
SUBTTL Plotter service -- Compute chracter size
P$CHKS: MOVE T1,J$YMAX(J) ;CALCULATE SIZE
SUB T1,J$YMIN(J) ; OF PLOTTING AREA
IDIVI T1,CHRPLN ;MAXIMUM NUMBER OF CHARACTERS PER LINE
MOVEM T1,J$CSIZ(J) ;STORE CHARACTER SIZE
POPJ P, ;RETURN
SUBTTL Plotter service -- Letters
P$LETR: $SAVE <T1,T2,T3,T4> ;PRESERVE TEMPORARIES
; MOVEI T1,0
; MOVEM T1,J$ROTA(J)
PUSH P,J$CSIZ(J) ;SAVE CHARACTER SIZE
PUSH P,J$XPOS(J) ;REMEMBER WHERE WE STARTED
MOVE T1,J$CSIZ(J) ;GET CHARACTER SPACING
IDIVI T1,CHRWID ;CALCULATE CHARACTER SIZE
JUMPN T1,SYM.1 ;SIZE OK -- PROCEED
ADDI T1,1 ;TOO SMALL -- CALCULATE FUDG
SUBI T2,CHRWID
SYM.1: MOVEM T1,J$CSIZ(J) ;SAVE CHARACTER SIZE
MOVEM T2,J$FUDG(J) ;AND FUDG (IF ANY)
IMULI T1,CHRBAS ;COMPUTE CHARACTER BASE
ADD T1,J$XPOS(J) ;GET CURRENT X POSITION
MOVEM T1,J$XBAS(J) ;SAVE AS CHARACTER X BASE
MOVE T2,J$YPOS(J) ;YPOSITION IS Y BASE
MOVEM T2,J$YBAS(J)
HLRZ T4,PLTTAB(S1) ;GET NUMBER OF STROKES
HRRZ T3,PLTTAB(S1) ;GET ADDR OF CHARACTER VECTORS
HRLI T3,(POINT 9) ;MAKE POINTER TO THEM
MOVEM T3,J$SPTR(J) ;AND SAVE IT
SYM.3: ILDB T2,J$SPTR(J) ;GET SEGMENT DISCRIPTOR
LDB T1,[POINT 4,T2,31] ;GET VERTICAL OFFSET
IMUL T1,J$CSIZ(J)
MOVNS T1 ;SUBTRACT FROM BASE
ADD T1,J$XBAS(J)
LDB T3,[POINT 1,T2,27] ;LOAD PEN STATUS
MOVE T3,[EXP 3,2](T3) ;CONVERT TO PLOT PEN CODE
ANDI T2,17 ;MASK ALL BUT HORIZONTAL OFFSET
IMUL T2,J$CSIZ(J) ;ADJUST PER CHARACTER SIZE
ADD T2,J$YBAS(J) ;ADD TO CHARACTER BASE
PUSHJ P,PLOT ;PLOT SEGMENT
SOJG T4,SYM.3 ;DO ALL SEGMENTS
SETZM J$ROTA(J) ;CLEAR CHARACTER ROTATION
POP P,T1 ;RESTORE X STARTING POSITION
POP P,J$CSIZ(J) ;RESTORE CHARACTER SIZE
MOVE T2,J$YBAS(J) ;GET STARTING Y POSITION
ADD T2,J$CSIZ(J) ;ADDJUST PER CHACTER SIZE
MOVEI T3,3 ;PEN UP BEFOR PLOTTING
PUSHJ P,PLOT ;POSITION PEN
POPJ P, ;RETURN
SUBTTL Plotter service -- Line segments
;Call T1/ X Coordinate to move to
; T2/ Y Coordinate to move to
; T3/ Pen code as follows
; 1 No Change in Pen
; 2 Pen Down before Plotting
; 3 Pen Up before moving
;
PLOT: $SAVE <T1,T2,T3,T4> ;PRESERVE TEMPORARIES
CAIG T3,1 ;CHANGE REQUESTED?
JRST PLT.1 ;NO..PROCEED
SUBI T3,3 ;YES..GET -1 OR 0
CAMN T3,J$PPOS(J) ;PEN IN POSITION?
JRST PLT.1 ;YES -- PROCEED
MOVEI C,PNUP ;GET PEN UP CODE
SKIPGE T3 ;WANT IT LOWERED?
MOVEI C,PNDN ;YES..GET THE CODE
$CALL PLTBYT ;MOVE THE PEN
PLT.1: SUB T1,J$XPOS(J) ;COMPUTE DELTA X
MOVEI T3,XYD ;ASSUME DOWN MOVEMENT
SKIPG T1 ;IS THAT CORRECT?
MOVEI T3,XYU ;NO..ASSUME UP
SUB T2,J$YPOS(J) ;COMPUTE DELTA Y
MOVEI T4,XYL ;ASSUME LEFTWARD MOVEMENT
SKIPG T2 ;IS THAT CORRECT?
MOVEI T4,XYR ;NO..THEN ASSUME RIGHT
MOVMS T1 ;MAKE DELTA X POSITIVE
MOVMS T2 ;MAKE DELTA Y POSITIVE
CAML T1,T2 ;IS SMALLEST DELTA IN T2?
JRST PLT.2 ;YES -- PROCEED
EXCH T1,T2 ;NO -- MAKE IT SO
EXCH T3,T4 ;EXCHANGE MOVEMENT CODES
PLT.2: JUMPE T1,PLT.8 ;DONE IF NO MOVEMENT REQUESTED
JUMPE T2,PLT.6 ;PLOT ONLY ONE DIRECTION
PLT.3: PUSH P,T3 ;SAVE MOVEMENT CODES
PUSH P,T4
MOVEI T4,0 ;CLEAR STEP COUNTER
PLT.4: TLNE T2,200000 ;NORMALIZE MOVEMENT COUNTER
JRST PLT.5
LSH T2,1 ;SHIFT LEFT
TRO T2,1 ;AND ROUND UP
AOJA T4,PLT.4 ;NORMALIZE TO BIT 1
PLT.5: SUBI T4,^D34 ;ADJUST STEP COUNT
MOVNS T4 ;GET REMAINING SHIFT COUNT
IDIV T2,T1 ;COMBINED(NORMALIZED)/TOTAL
LSH T2,(T4) ;COMPUTE FINAL STEP FUNCTION
POP P,T4 ;RESTORE MOVEMENT CODES
POP P,T3
PLT.6: MOVEM T2,J$STEP(J) ;SAVE STEP
MOVEI T2,0 ;CLEAR STEP COUNTER
PLT.7: ADD T2,J$STEP(J) ;BUMP STEP COUNTER
MOVE C,T3 ;ASSUME SINGULAR MOVEMENT
TLZE T2,200000 ;TIME FOR COMBINED MOVE?
IOR C,T4 ;YES..INCLUDE IT
$CALL PLTBYT
SOJG T1,PLT.7 ;LOOP ON TOTAL COUNT
PLT.8: POPJ P, ;RETURN
SUBTTL Plotter service -- Rotation and XY20 translation
;Plotter Translation Table Entry Description
; 0 17 20 23 24 27 28 31 32 35
; ================================================================
; ! XY20 CODE ! !ROT = 3!ROT = 2!ROT = 1!ROT = 0!
; ================================================================
;
ROTAB: EXP 0 ;NO MOVEMENT
BYTE (18) 106 (2) 0 (4) XYU ,XYL ,XYD ,XYR ;MOVE DOWN
BYTE (18) 102 (2) 0 (4) XYD ,XYR ,XYU ,XYL ;MOVE UP
BYTE (18) 114 (2) 0 (4) PEN3,PEN3,PEN3,PEN3 ;SELECT PEN3
BYTE (18) 104 (2) 0 (4) XYR ,XYU ,XYL ,XYD ;MOVE RIGHT
BYTE (18) 105 (2) 0 (4) XYDL,XYUL,XYUR,XYDR ;MOVE DOWN+RIGHT
BYTE (18) 103 (2) 0 (4) XYDR,XYDL,XYUL,XYUR ;MOVE UP+RIGHT
EXP -1 ;ILLEGAL
BYTE (18) 100 (2) 0 (4) XYL ,XYD ,XYR ,XYU ;MOVE LEFT
BYTE (18) 107 (2) 0 (4) XYUL,XYUR,XYDR,XYDL ;MOVE DOWN+LEFT
BYTE (18) 101 (2) 0 (4) XYUR,XYDR,XYDL,XYUL ;MOVE UP+LEFT
EXP -1 ;ILLEGAL
BYTE (18) 113 (2) 0 (4) PEN2,PEN2,PEN2,PEN2 ;SELECT PEN 2
EXP -1 ;ILLEGAL
EXP -1 ;ILLEGAL
BYTE (18) 112 (2) 0 (4) CNGP,CNGP,CNGP,CNGP ;CHANGE PENS
ROPTR: POINT 4,ROTAB(C),35 ;POINTER TO ZERO ROTATION
POINT 4,ROTAB(C),31 ; ROTATION = 1
POINT 4,ROTAB(C),27 ; ROTATION = 2
POINT 4,ROTAB(C),23 ; ROTATION = 3
SUBTTL Plotter service -- Pen movement generation
;Call C/ Character to plot
;
;Will adjust values in J$XPOS and J$YPOS based on pen movement
;Also checks range on J$XMIN-J$XMAX and J$YMIN-J$YMAX
;Saves highest pen movement in J$XLIM and J$YLIM
;
PLTBYT: TRZE C,PNUP ;TEST AND CLEAR PEN UP CODE
$CALL PENUP ;RAISE PEN
TRZE C,PNDN ;TEST AND CLEAR PEN DOWN CODE
$CALL PENDN ;LOWER PEN
PLTXYD: TRNN C,XYD ;GOING DOWN ?
JRST PLTXYU ;NO
AOS S1,J$XPOS(J) ;+1
CAMG S1,J$XMAX(J) ;BEYOND X MAXIMUM ?
CAMG S1,J$XMIN(J) ;WITHIN X BOUNDS ?
TRZ C,XYD!XYU ;STOP MOVING
PLTXYU: TRNN C,XYU ;GOING UP ?
JRST PLTXYL ;NO
SOS S1,J$XPOS(J) ;-1
CAMGE S1,J$XMAX(J) ;BEYOND X MAXIMUM ?
CAMGE S1,J$XMIN(J) ;WITHIN X BOUNDS ?
TRZ C,XYD!XYU ;STOP MOVING
PLTXYL: TRNN C,XYL ;GOING LEFT ?
JRST PLTXYR ;NO
AOS S2,J$YPOS(J) ;+1
CAMG S2,J$YMAX(J) ;BEYOND Y MAXIMUM ?
CAMG S2,J$YMIN(J) ;WITHIN Y BOUNDS ?
TRZ C,XYR!XYL ;STOP MOVING
PLTXYR: TRNN C,XYR ;GOING RIGHT ?
JRST PLTB.6 ;NO
SOS S2,J$YPOS(J) ;-1
CAMGE S2,J$YMAX(J) ;BEYOND Y MAXIMUM ?
CAMGE S2,J$YMIN(J) ;WITHIN Y BOUNDS ?
TRZ C,XYR!XYL ;STOP MOVING
PLTB.6: SKIPN J$PPOS(J) ;IS PEN DOWN?
PJRST PLTB.8 ;NO..DON'T RECORD MAX POSITIONS
CAMLE S1,J$XMAX(J) ;CLIPPED?
JRST PLTB.7 ;YES -- DON'T ADJUST LIMIT
CAMLE S1,J$XLIM(J) ;HIGHEST POINT SO FAR?
MOVEM S1,J$XLIM(J) ;YES -- SAVE IT
PLTB.7: CAMLE S2,J$YMAX(J) ;CLIPPED?
JRST PLTB.8 ;YES -- DON'T ADJUST LIMIT
CAMLE S2,J$YLIM(J) ;HIGHEST POINT SO FAR?
MOVEM S2,J$YLIM(J) ;YES -- SAVE IT
PLTB.8: JUMPE C,.RETT ;RETURN IF NOTHING TO PLOT
MOVEI S1,PLTMOV ;LOAD # TICS FOR MOVEMENT
ADDM S1,J$PTIC(J) ;ADD TO TOTAL SO FAR
; MOVE S1,[LDB C,ROPTR] ;GET ROTATE INSTRUCTION
; ADD S1,J$ROTA(J) ;OFFSET BY GRID ROTATION
; XCT S1 ;ROTATE
PJRST OUTBYT ;OUTPUT THE BYTE
PENUP: PUSH P,C ;SAVE CHARCTER AC
SETZM J$PPOS(J) ;MARK PEN RAISED
MOVEI C,PNUP ;LOAD CODE FOR PEN UP
PUSHJ P,OUTBYT ;PLOT CHARACTER
MOVEI C,PLTPEN ;LOAD # TICS FOR UP/DOWN COMMAND
ADDM C,J$PTIC(J) ;ADD TO TOTAL SO FAR
POP P,C ;RESTORE CHARACTER AC
POPJ P, ;RETURN
PENDN: PUSH P,C ;SAVE CHARACTER AC
SETOM J$PPOS(J) ;MARK PEN DOWN
MOVEI C,PNDN ;LOAD PENDOWN CODE
PUSHJ P,OUTBYT ;PLOT CHARACTER
MOVEI C,PLTPEN ;LOAD # TICS FOR UP/DOWN MOVEMENT
ADDM C,J$PTIC(J) ;ADD TO TOTAL SO FAR
POP P,C ;RESTORE CHARACTER AC
POPJ P, ;RETURN
SUBTTL Plotter service -- Character set
;DEFINE MACRO TO GENERATE CHARACTER TABLE ENTRY AS FOLLOWS
;PLTTAB
; ONE ENTRY FOR EACH CHARACTER VALUE 0 THRU 177
; LH OF EACH ENTRY
; NUMBER OF SEGMENTS TO PLOT FOR THIS CHARACTER
; RH OF EACH ENTRY
; ADDRESS OF 9 BIT BYTES DESCRIBING SEGMENTS AS FOLLOWS
; 0 1 4 5 8
; =============================================================
; ! PEN ! VERTICAL OFFSET ! HORIZONTAL OFFSET !
; =============================================================
; PEN 1 FOR PEN DOWN
; 0 FOR PEN UP
; VERTICAL OFFSET POINT IN CHARACTER GRID WHERE SEGMENT ENDS
; HORIZONT OFFSET POINT IN CHARACTER GRID WHERE SEGMENT ENDS
DEFINE XX (ARGS) <
ZZ=0
IRP ARGS,<ZZ=ZZ+1> ;;COUNT NUMBER OF SEGMENTS
XWD ZZ,[BYTE (9) ARGS] ;;BUILD TABLE ENTRY AND STRING
> ;END OF XX
CHRBAS==6
CHRWID==6
FIN==<CHRBAS>B31!<CHRWID>B35
PLTTAB:
C%000: Z ;NULL IS ILLEGAL
C%001: XX <200,542,702,142,604,FIN>
C%002: XX <144,563,603,622,621,600,560,541,542,563,603,624,FIN>
C%003: XX <561,701,702,663,642,241,643,624,603,601,FIN>
C%004: XX <602,544,FIN>
C%005: XX <220,624,564,FIN>
C%006: XX <243,641,620,560,541,543,200,602,FIN>
C%007: XX <141,641,240,644,243,543,FIN>
C%010: XX <602,240,544,FIN>
C%011: XX <240,661,604,564,543,562,602,644,FIN>
C%012: XX <242,641,620,560,541,543,564,624,643,642,702,704,FIN>
C%013: XX <160,541,562,662,703,664,FIN>
C%014: XX <240,644,302,562,160,564,FIN>
C%015: XX <200,560,541,543,564,624,643,641,620,600,604,242,542,FIN>
C%016: XX <202,561,600,620,641,622,602,563,604,624,643,622,FIN>
C%017: XX <204,623,621,600,560,541,543,564,644,702,701,FIN>
C%020: XX <244,641,620,560,541,544,FIN>
C%021: XX <240,643,624,564,543,540,FIN>
C%022: XX <160,640,661,663,644,564,FIN>
C%023: XX <260,600,561,563,604,664,FIN>
C%024: XX <300,600,542,604,704,240,644,FIN>
C%025: XX <544,704,700,221,624,206>
C%026: XX <100,640,600,561,562,603,643,603,564,FIN>
C%027: XX <143,564,603,164,560,221,640,661,240,644,FIN>
C%030: XX <541,561,600,620,641,643,624,604,563,543,544,FIN>
C%031: XX <220,624,262,624,562,FIN>
C%032: XX <160,601,543,564,FIN>
C%033: XX <602,642,704,244,640,200,604,FIN>
C%034: XX <160,563,303,620,623,FIN>
C%035: XX <300,623,620,160,563,FIN>
C%036: XX <160,564,224,620,260,664,FIN>
C%037: XX <200,542,604,FIN>
C%040: XX <FIN>
C%041: XX <142,562,222,702,FIN>
C%042: XX <241,701,303,643,FIN>
C%043: XX <141,701,303,543,204,600,240,644,FIN>
C%044: XX <160,563,604,623,621,640,661,664,302,542,FIN>
C%045: XX <160,664,261,701,700,660,661,163,543,544,564,563,FIN>
C%046: XX <144,640,660,701,662,642,600,560,541,542,604,FIN>
C%047: XX <243,703,702,662,663,FIN>
C%050: XX <142,600,640,702,FIN>
C%051: XX <142,604,644,702,FIN>
C%052: XX <160,664,262,562,164,660,220,624,FIN>
C%053: XX <162,662,220,624,FIN>
C%054: XX <123,603,602,562,563,FIN>
C%055: XX <220,624,FIN>
C%056: XX <142,543,563,562,542,FIN>
C%057: XX <160,664,FIN>
C%060: XX <160,660,701,703,664,564,543,541,560,664,FIN>
C%061: XX <142,702,661,FIN>
C%062: XX <260,701,703,664,644,623,621,600,540,544,FIN>
C%063: XX <260,701,703,664,644,623,622,623,604,564,543,541,FIN>
C%064: XX <300,620,624,623,663,543,FIN>
C%065: XX <141,543,564,624,643,641,620,700,704,FIN>
C%066: XX <220,623,604,564,543,541,560,660,701,703,FIN>
C%067: XX <560,664,704,700,FIN>
C%070: XX <221,623,644,664,703,701,660,640,621,600,560,541,543,564,604,623,FIN>
C%071: XX <141,543,564,664,703,701,660,640,621,624,FIN>
C%072: XX <161,562,602,601,561,241,642,662,661,641,FIN>
C%073: XX <122,602,601,561,562,242,662,661,641,642,FIN>
C%074: XX <143,620,703,FIN>
C%075: XX <200,604,244,640,FIN>
C%076: XX <141,624,701,FIN>
C%077: XX <142,622,623,644,664,703,701,660,FIN>
C%100: XX <143,541,560,660,701,703,664,604,602,642,644,FIN>
C%101: XX <640,702,644,604,600,604,544,FIN>
C%102: XX <700,703,664,644,623,620,623,604,564,543,540,FIN>
C%103: XX <264,703,701,660,560,541,543,564,FIN>
C%104: XX <700,702,644,604,542,540,FIN>
C%105: XX <144,540,620,623,620,700,704,FIN>
C%106: XX <620,623,620,700,704,FIN>
C%107: XX <264,703,701,660,560,541,543,564,624,622,FIN>
C%110: XX <700,620,624,704,544,FIN>
C%111: XX <141,543,542,702,701,703,FIN>
C%112: XX <160,541,543,564,704,FIN>
C%113: XX <700,600,704,621,544,FIN>
C%114: XX <300,540,544,FIN>
C%115: XX <700,642,704,544,FIN>
C%116: XX <700,660,564,544,704,FIN>
C%117: XX <160,660,701,703,664,564,543,541,560,FIN>
C%120: XX <700,703,664,644,623,620,FIN>
C%121: XX <160,660,701,703,664,564,543,541,560,202,544,FIN>
C%122: XX <700,703,664,644,623,620,621,544,FIN>
C%123: XX <543,564,604,623,621,640,660,701,704,FIN>
C%124: XX <142,702,700,704,FIN>
C%125: XX <300,540,544,704,FIN>
C%126: XX <300,660,542,664,704,FIN>
C%127: XX <300,540,602,544,704,FIN>
C%130: XX <560,664,704,664,622,660,700,660,564,544,FIN>
C%131: XX <300,642,704,642,542,FIN>
C%132: XX <300,704,664,622,620,624,622,560,540,544,FIN>
C%133: XX <142,540,700,702,FIN>
C%134: XX <260,564,FIN>
C%135: XX <142,544,704,702,FIN>
C%136: XX <240,702,644,302,542,FIN>
C%137: XX <162,620,662,220,624,FIN>
C%140: XX <341,703,FIN>
C%141: XX <163,542,541,560,620,641,643,563,544,FIN>
C%142: XX <300,540,543,564,624,643,640,FIN>
C%143: XX <224,643,641,620,560,541,543,564,FIN>
C%144: XX <304,544,541,560,620,641,644,FIN>
C%145: XX <143,541,560,620,641,643,624,604,600,FIN>
C%146: XX <141,661,702,703,664,220,622,FIN>
C%147: XX <144,541,560,620,641,643,624,524,503,501,FIN>
C%150: XX <700,220,641,643,624,544,FIN>
C%151: XX <141,543,542,642,641,262,702,662,FIN>
C%152: XX <121,502,503,524,644,643,FIN>
C%153: XX <700,243,601,600,602,544,FIN>
C%154: XX <141,543,542,702,701,FIN>
C%155: XX <640,620,641,622,542,622,643,624,544,FIN>
C%156: XX <640,200,642,643,624,544,FIN>
C%157: XX <160,620,641,643,624,564,543,541,560,FIN>
C%160: XX <100,640,643,624,564,543,540,FIN>
C%161: XX <144,541,560,620,641,644,504,FIN>
C%162: XX <640,200,642,643,624,FIN>
C%163: XX <543,564,603,601,620,641,644,FIN>
C%164: XX <301,561,542,543,564,240,642,FIN>
C%165: XX <240,560,541,542,604,644,544,FIN>
C%166: XX <240,600,542,604,644,FIN>
C%167: XX <240,560,541,562,642,562,543,564,644,FIN>
C%170: XX <644,240,544,FIN>
C%171: XX <240,560,541,544,244,524,503,501,FIN>
C%172: XX <240,644,540,544,201,603,FIN>
C%173: XX <144,543,562,602,621,620,621,642,662,703,704,FIN>
C%174: XX <102,702,FIN>
C%175: XX <142,600,642,604,542,FIN>
C%176: XX <541,562,602,623,624,623,642,662,701,700,FIN>
C%177: XX <260,564,FIN>
SUBTTL Paper tape punch service -- Dispatch table
T$DISP: JRST T$HEAD ;(0) FILE HEADER
JRST T$EOF ;(1) FILE TRAILER
SIXBIT /PTP/ ;(2) GENERIC DEVICE NAME
EXP PTPBSZ ;(3) OUTPUT BYTE SIZE
JRST T$PROC ;(4) PROCESS A FILE
JRST T$BANN ;(5) JOB BANNER
JRST T$TRAI ;(6) JOB TRAILER
JRST T$LETR ;(7) LETTER ProcessER
JRST .RETF ;(10) ERROR PROCCESSOR
JRST .RETT ;(11) ACCOUNTING
JRST T$CHKP ;(12) CHECKPOINT TEXT GENERATION
SUBTTL Paper tape punch service -- Checkpoint text generation
T$CHKP: $SAVE <P1,P2> ;SAVE SOME ACS
MOVE P1,J$TBCT(J) ;GET TOTAL BYTE COUNT
IDIVI P1,FRMPFT ;COMPUTE FEET OF TAPE USED
MOVE P2,J$RLIM(J) ;GET LIMIT
CAMN P2,[.INFIN] ;+INFINITY ?
JRST T$CHK1 ;YES
CAMG P1,J$RLIM(J) ;OPERATOR ALLOW LIMIT TO EXCEED ?
$TEXT (DEPBP,<punched ^D/P1/ of ^D/J$RLIM(J)/ feet^0>)
CAMLE P1,J$RLIM(J) ;OPERATOR ALLOW LIMIT TO EXCEED ?
T$CHK1: $TEXT (DEPBP,<punched ^D/P1/ feet (limit exceeded)^0>)
POPJ P, ;RETURN
SUBTTL Paper tape punch service -- File processing
T$PROC: LOAD S1,.FPINF(E),FP.FFF ;GET FILE FORMAT
CAIN S1,.FPF11 ;/FILE:ELEVEN?
JRST PTELF ;YES, DO IT
LOAD S1,.FPINF(E),FP.FPF ;GET PAPER FORMAT
CAILE S1,PTROUL ;WITHIN RANGE?
JRST BADMOD ;NO, LOSE
JUMPN S1,@T$ROUT-1(S1) ;YES, DISPATCH IF NON-ZERO
MOVEI S1,T$MTAB ;GET ADDRESS OF MODE TABLE
MOVEI S2,T$ROUT ;GET ADDRESS OF ROUTINE TABLE
PJRST DSPMOD ;AND DISPATCH BASED ON MODE
T$ROUT: EXP PTASC ;ASCII
EXP PTIMA ;IMAGE
EXP PTIBI ;IBIN
EXP PTBIN ;BINARY
PTROUL==.-T$ROUT ;LENGTH OF ROUTINE TABLE
;MODE TABLE
T$MTAB: BYTE (3) 1,1,0,0,0,0,0,0,2,0,0,3,4,4,4,4
; ! PAPER-TAPE MODE -- ELEVEN !
; ! !
; ! In ELEVEN format, each word read from disk !
; ! is treated as 4 8 bit bytes each of which is !
; ! punched as 1 frame of tape !
; ! - - - - - !
; ! !
; ! 0 1 2 2 !
; ! 2 0 0 8 !
; !=======================================================!
; ! ! Byte 2 ! Byte 1 ! ! Byte 4 ! Byte 3 !
; !=======================================================!
PTELF: $CALL INPBYT ;GET A CHARACTER
JUMPF .RETF ;RETURN WHEN DONE
MOVE T2,C ;PUT THE CHARACTER INTO T2
MOVEI T1,3 ;FOR SELECTION OF BYTE POINTER
PTEL.1: LDB C,ELFPTR(T1) ;SELECT A BYTE
PUSHJ P,PTPBYT ;OUTPUT BYTE
SOJGE T1,PTEL.1 ;COUNT DOWN
JRST PTELF ;LOOP
ELFPTR: POINT 8,T2,^D27 ;BYTE 4
POINT 8,T2,^D35 ;BYTE 3
POINT 8,T2,^D9 ;BYTE 2
POINT 8,T2,^D17 ;BYTE 1
; ! PAPER-TAPE MODE -- ASCII !
; ! !
; !In ASCII mode, each word read from disk is broken into !
; ! 5 seven bit bytes. Each byte gets an even parity bit !
; ! included and is punched as 1 frame of tape. !
; ! !
; !=======================================================!
; ! Byte 1 ! Byte 2 ! Byte 3 ! Byte 4 ! Byte 5 ! !
; !=======================================================!
; ! !
; ! If a vertical or horizontal TAB is punched, it is !
; ! followed by a RUBOUT character. If a formfeed !
; ! is punched, it is followed by 16 (decimal) NULLs. !
PTASC: MOVEI T1,7 ;USE 7 BIT BYTES FROM DISK
MOVEM T1,J$DBSZ(J) ;SAVE THE BYTE SIZE
PTAS.1: $CALL INPBYT ;GET A CHARACTER
JUMPF .RETF ;RETURN WHEN DONE
JUMPE C,PTAS.1 ;IGNORE NULLS
MOVEI T1,(C) ;COPY CHAR
LSH T1,-4 ;SHIFT OVER
XORI T1,(C) ;FIND DIFFERENT BITS
TRCE T1,14 ;LOOK AT 2 BITS
TRNN T1,14 ;ARE THEY THE SAME?
TRC C,200 ;YES--MAKE EVEN PARITY
TRCE T1,3 ;LOOK AT THE OTHER 2 BITS
TRNN T1,3 ;ARE THEY THE SAME?
TRC C,200 ;YES--MAKE EVEN PARITY
PTAS.2: PUSHJ P,PTPBYT ;OUTPUT BYTE
CAIE C,11 ;HORIZ. TAB?
CAIN C,213 ;VERT. TAB?
JRST PTAS.3 ;YES--ADD A RUBOUT
CAIE C,14 ;FORM FEED?
JRST PTAS.1 ;NO-- MARCH ON.
MOVEI S1,20 ;NEED 20 NULLS
SETZ C, ;NULL
PUSHJ P,PTPREP ;PUNCH THEM
JRST PTAS.1 ;GET NEXT CHAR
PTAS.3: MOVEI C,377 ;LOAD A RUBOUT
PUSHJ P,PTPBYT ;OUTPUT BYTE
JRST PTAS.1 ;AND LOOP
; ! PAPER-TAPE MODE -- BINARY !
; ! !
; ! In BINARY mode, the tape is broken up into logical !
; ! blocks consisting of 1 word of control information !
; ! and 40 (octal) words of data (the last block may be !
; ! smaller). Each word (both data and control words) !
; ! is split into 6 6-bit bytes, each of which gets 200 !
; ! (octal) added and is punched as one frame of tape. !
; ! !
; !=======================================================!
; ! Byte 1 ! Byte 2 ! Byte 3 ! Byte 4 ! Byte 5 ! Byte 6 !
; !=======================================================!
; ! !
; ! The control word consists of a folded checksum in the !
; ! left half and the data word count in the right half. !
; ! !
; !=======================================================!
; ! Folded checksum ! Number of data words !
; !=======================================================!
PTBIN: MOVEI S1,40 ;LOAD MAXIMUM BLOCKSIZE
$CALL CHKSUM ;GET A BLOCK CHECKSUMMED
JUMPF .RETT ;DONE!!
MOVN T4,S1 ;PUT NEGATIVE BLOCKSIZE IN T4
MOVE T1,S1 ;GET 0,,BLOCKSIZE
HRL T1,S2 ;GET CHECKSUM,,BLOCKSIZE
MOVEI C,0 ;LOAD A NULL
MOVEI S1,5 ;AND A COUNT
PUSHJ P,PTPREP ;PUNCH SOME BLANK TAPE
$CALL PTBI.2 ;PUNCH THE CONTROL WORD
HRLZ T4,T4 ;GET -VE COUNT,,0
HRRI T4,J$XCHB(J) ;MAKE AN AOBJN POINTER
PTBI.1: MOVE T1,0(T4) ;GET A WORD
$CALL PTBI.2 ;PUNCH IT
AOBJN T4,PTBI.1 ;LOOP FOR ALL DATA WORDS
JRST PTBIN ;AND GO START ANOTHER BLOCK
PTBI.2: MOVE T2,[POINT 6,T1] ;LOAD A BYTE POINTER
PTBI.3: ILDB C,T2 ;GET A BYTE
TRO C,200 ;ADD HIGH ORDER BIT
PUSHJ P,PTPBYT ;OUTPUT BYTE
TLNE T2,770000 ;ARE WE DONE?
JRST PTBI.3 ;NO, LOOP
POPJ P, ;YES, GET NEXT WORD
; ! PAPER-TAPE MODE -- IMAGE BINARY !
; ! !
; ! In Image Binary Mode, each word read from disk is !
; ! split into 6 6-bit bytes. Each byte gets 200 (octal) !
; ! added to it and is sent as 1 frame of tape. !
; ! !
; !=======================================================!
; ! Byte 1 ! Byte 2 ! Byte 3 ! Byte 4 ! Byte 5 ! Byte 6 !
; !=======================================================!
PTIBI: MOVEI T1,6 ;USE 6 BIT BYTES FROM DISK
MOVEM T1,J$DBSZ(J) ;SAVE BYTE SIZE
PTIB.1: $CALL INPBYT ;GET A CHRACTER
JUMPF .RETF ;AND RETURN WHEN DONE
TRO C,200 ;ADD A BIT
PUSHJ P,PTPBYT ;OUTPUT BYTE
JRST PTIB.1 ;LOOP FOR MORE
; ! PAPER-TAPE MODE -- IMAGE !
; ! !
; ! In IMAGE mode, the low-order 8 bits of each word !
; ! read from disk are punched as one frame of tape. !
; ! !
; !=======================================================!
; ! ! Byte 1 !
; !=======================================================!
PTIMA: $CALL INPBYT ;GET A CHARACTER (36 BITS)
JUMPF .RETF ;RETURN WHEN DONE
PUSHJ P,PTPBYT ;OUTPUT BYTE
JRST PTIMA ;AND LOOP
SUBTTL Paper tape punch service -- Banners
T$BANN: MOVEI T1,1 ;1 FOLD
SETZM J$TBCT(J) ;CLEAR TOTAL BYTE COUNT
SKIPN J$FBAN(J) ;BANNER ALLOWED?
PJRST BLKFLD ;NO -- PUNCH BLANK FOLD
$CALL SETTBF ;SETUP TEXT BUFFER
$TEXT(DEPBP,<Begin ^R/.EQJBB(J)/^A>)
GETLIM T1,.EQLIM(J),NOT1 ;GET /NOTE VALUE (WORD 1)
GETLIM T2,.EQLIM(J),NOT2 ;GET /NOTE VALUE (WORD 2)
SKIPN T1 ;CHECK WORD 1
SKIPE T2 ;CHECK WORD 2
$TEXT (DEPBP,<, Note: ^W6/T1/^W/T2/^A>) ;YES
MOVEI S1,.CHNUL ;GET A NUL
PUSHJ P,DEPBP ;STORE IT
$CALL STRING ;AND SEND TO THE PUNCH
MOVEI T1,1 ;1 FOLD
PJRST BLKFLD ;PUNCH BLANK FOLDS
SUBTTL Paper tape punch service -- File headers
T$HEAD: MOVEI T1,1 ;1 FOLD
SKIPN J$FHEA(J) ;HEADER ALLOWED?
JRST BLKFLD ;NO -- JUST PUNCH A BLANK FOLD
MOVEI T1,1 ;1 FOLD
LOAD S1,.FPINF(E),FP.NFH ;GET NO FILE HEADERS BIT
JUMPN S1,BLKFLD ;IF SET, JUST PUNCH A BLANK FOLD OF TAPE
$CALL SETTBF ;ELSE, SETUP TEXT BUFFER
MOVEI S1,[ITEXT <^F/@J$DFDA(J)/>] ;USE FILE NAME
SKIPE J$DSPN(J) ;UNLESS SPOOL NAME EXISTS
MOVEI S1,[ITEXT <^W/J$DSPN(J)/>] ;USE SPOOL NAME
$TEXT (DEPBP,<File: ^I/0(S1)/ started at ^H/[-1]/^0>)
$CALL STRING ;FORCE THE STRING OUT TO PUNCH
MOVEI T2,^D10 ;LOAD LOOP COUNT
THEA.1: MOVEI S1,^D10 ;GET A REPEAT COUNT
MOVEI C,0 ;AND A NULL CHARACTER
PUSHJ P,PTPREP ;PUNCH SOME BLANK TAPE
MOVEI S1,^D10 ;GET A REPEAT COUNT
MOVEI C,177 ;AND A CHARACTER
PUSHJ P,PTPREP ;PUNCH SOME LACED FRAMES
SOJG T2,THEA.1 ;AND LOOP
MOVEI T1,1 ;1 FOLD
PJRST BLKFLD ;AND SEND A BLANK FOLD OF TAPE
SUBTTL Paper tape punch service -- File trailers
T$EOF: MOVEI T1,1 ;LOAD A REPEAT COUNT
$CALL BLKFLD ;SEND A BLANK FOLD
MOVEI S1,5 ;GET A COUNT
MOVEI C,232 ;AND AN EOF CHARACTER
PUSHJ P,PTPREP ;PUNCH SOME EOFS
MOVEI T1,1 ;1 FOLD
LOAD S1,.FPINF(E),FP.NFH ;NO FILE HEADERS?
JUMPN S1,BLKFLD ;RIGHT -- PUNCH A BLANK FOLD
MOVEI S1,^D10 ;LOAD A COUNT
MOVEI C,0 ;AND A NULL
PUSHJ P,PTPREP ;PUNCH SOME BLANK TAPE
MOVEI S1,[ASCIZ /END/] ;PROBABLE TRAILER
TXNE S,ABORT!RQB ;IS FILE INCOMPLETE (ABORT OR REQUEUE)
MOVEI S1,[ASCIZ /ABORT/] ;YES!
MOVEI S2,[ITEXT <^F/@J$DFDA(J)/>] ;USE FILNAME
SKIPE J$DSPN(J) ;UNLESS SPOOL NAME EXISTS
MOVEI S2,[ITEXT <^W/J$DSPN(J)/>] ;USE SPOOL NAME
$CALL SETTBF ;SETUP TEXT BUFFER
$TEXT(DEPBP,<^T/0(S1)/ file ^I/0(S2)/--^0>)
$CALL STRING ;AND SEND IT
MOVEI T1,1 ;1 FOLD
PJRST BLKFLD ;SEND A BLANK FOLD OF TAPE
SUBTTL Paper tape punch service -- Trailers
T$TRAI: MOVEI T1,1 ;1 FOLD
SKIPN J$FTRA(J) ;GET TRAILER COUNT
PJRST BLKFLD ;PUNCH BLANK FOLDS
$CALL SETTBF ;SETUP THE TEXT BUFFER
MOVEI S1,[ASCIZ /END/] ;LOAD PROBABLE TRAILER
TXNE S,RQB ;REQUEUED?
MOVEI S1,[ASCIZ /REQUE/] ;YES!
$TEXT(DEPBP,<^T/(S1)/ JOB ^W/.EQJOB(J)/**^0>)
$CALL STRING ;SEND IT
MOVEI T1,1 ;1 FOLD
; PJRST BLKFLD ;SEND A BLANK FOLD OF TAPE
SUBTTL Paper tape punch service -- Blank folds
;Call T1/ Count of Blank folds to ppunch
;Returns after punching at least 10 blank frames and
;stopping tape at a fold
BLKFLD: MOVE S1,J$TBCT(J) ;GET TOTAL BYTE COUNT
IDIVI S1,CHPFLD ;EXTRACT REMAINDER
MOVEI S1,CHPFLD ;LOAD CHARACTERS PER FOLD
IMUL S1,T1 ;MULTIPLY BY REQUESTED FOLDS
ADD S1,S2 ;ADD REMAINDER FOR LAST FOLD
CAIG S1,^D10 ;PUNCH AT LEASE 10 FRAMES
ADDI S1,CHPFLD
SETZ C, ;PUNCH BLANK FRAMES
PJRST PTPREP ;PUNCH SOME BLANK TAPE AND RETURN
SUBTTL Paper tape punch service -- Letters
;SUBROUTINE TO PUNCH BLOCK CHARACTERS IN PAPER-TAPE
;CALL WITH ASCII CHARACTER TO PUNCH IN S1
;PUNCHES CHARACTER AS 5 7 BIT FRAMES FOLLOWED BY 2 BLANK FRAMES
T$LETR: CAIL S1,40 ;IN RANGE?
CAILE S1,177
POPJ P,0 ;NO -- RETURN
CAILE S1,"_" ;UPPER CASE?
SUBI S1,40 ;NO -- CONVERT TO UC
MOVEI S1,CHRTAB-40(S1) ;POINT TO BITS
HRLI S1,(POINT 7,0) ;MAKE BYTE POINTER
MOVSI S2,-5 ;MAKE AOBJN POINTER
TLET.1: ILDB C,S1 ;GT SEGMENT BITS
PUSHJ P,PTPBYT ;OUTPUT BYTE
AOBJN S2,TLET.1 ;REPEAT FOR ALL SEGMENTS
MOVEI S1,2 ;REPEAT COUNT
MOVEI C,0 ;CHARACTER
PJRST PTPREP ;PUNCH SOME BLANK TAPE AND RETURN
SUBTTL Paper tape punch service -- Byte output
; AC 'C' contains the byte to output
;
PTPBYT: PUSH P,S1 ;SAVE FROM
PUSH P,S2 ; DESTRUCTION
PUSHJ P,OUTBYT ;OUTPUT THE BYTE
AOS S1,J$TFRM(J) ;COUNT THE FRAME
IDIVI S1,FRMPFT ;COMPUTE FEET OF TAPE USED
MOVEM S1,J$APRT(J) ;STORE FOR ACCOUNTING PURPOSES
CAMLE S1,J$RLIM(J) ;EXCEEDED LIMIT ?
PUSHJ P,FRMLEX ;YES - ASK THE OPERATOR'S ADVICE
POP P,S2 ;RESTORE
POP P,S1 ; S1 & S2
POPJ P, ;RETURN
; Repeat the byte in AC 'C'
; Call: MOVE S1,repeat count
; MOVE C,byte to output
; PUSHJ P,PTPREP
;
PTPREP: PUSH P,P1 ;SAVE P1
MOVE P1,S1 ;GET COUNT
PUSHJ P,PTPBYT ;OUTPUT A BYTE
SOJG P1,.-1 ;AND LOOP
POP P,P1 ;RESTORE P1
POPJ P, ;RETURN
SUBTTL Character Bit Array for 5 X 7 Character Matrix
CHRTAB: BYTE (7) 000,000,000,000,000 ;SPACE
BYTE (7) 000,000,175,000,000 ;!
BYTE (7) 000,140,000,140,000 ;"
BYTE (7) 024,177,024,177,024 ;#
BYTE (7) 072,052,177,052,056 ;$
BYTE (7) 143,144,010,023,143 ;%
BYTE (7) 056,121,051,006,005 ;&
BYTE (7) 000,000,100,140,000 ;'
BYTE (7) 034,042,101,000,000 ;(
BYTE (7) 000,000,101,042,034 ;)
BYTE (7) 052,034,066,034,052 ;*
BYTE (7) 010,010,076,010,010 ;+
BYTE (7) 000,000,002,003,000 ;,
BYTE (7) 010,010,010,010,010 ;-
BYTE (7) 000,000,003,003,000 ;.
BYTE (7) 001,002,004,010,020 ;/
BYTE (7) 076,105,111,121,076 ;0
BYTE (7) 000,041,177,001,000 ;1
BYTE (7) 041,103,105,111,061 ;2
BYTE (7) 042,101,101,111,066 ;3
BYTE (7) 170,010,010,177,010 ;4
BYTE (7) 162,121,121,111,106 ;5
BYTE (7) 076,111,111,111,006 ;6
BYTE (7) 101,102,104,110,160 ;7
BYTE (7) 066,111,111,111,066 ;8
BYTE (7) 060,111,111,111,076 ;9
BYTE (7) 000,000,066,066,000 ;:
BYTE (7) 000,000,066,067,000 ;;
BYTE (7) 010,024,042,101,000 ;<
BYTE (7) 024,024,024,024,024 ;=
BYTE (7) 000,101,042,024,010 ;>
BYTE (7) 040,100,105,110,060 ;?
BYTE (7) 076,100,117,111,077 ;@
BYTE (7) 077,104,104,104,077 ;A
BYTE (7) 177,111,111,111,066 ;B
BYTE (7) 076,101,101,101,101 ;C
BYTE (7) 177,101,101,101,076 ;D
BYTE (7) 177,111,111,111,101 ;E
BYTE (7) 177,110,110,110,100 ;F
BYTE (7) 076,101,105,105,106 ;G
BYTE (7) 177,010,010,010,177 ;H
BYTE (7) 000,101,177,101,000 ;I
BYTE (7) 006,001,001,001,176 ;J
BYTE (7) 177,010,010,024,143 ;K
BYTE (7) 177,001,001,001,001 ;L
BYTE (7) 177,040,020,040,177 ;M
BYTE (7) 177,020,010,004,177 ;N
BYTE (7) 076,101,101,101,076 ;O
BYTE (7) 177,110,110,110,060 ;P
BYTE (7) 076,101,105,102,075 ;Q
BYTE (7) 177,110,114,112,061 ;R
BYTE (7) 061,111,111,111,106 ;S
BYTE (7) 100,100,177,100,100 ;T
BYTE (7) 177,001,001,001,177 ;U
BYTE (7) 174,002,001,002,174 ;V
BYTE (7) 177,002,004,002,177 ;W
BYTE (7) 143,024,010,024,143 ;X
BYTE (7) 140,020,017,020,140 ;Y
BYTE (7) 103,105,111,121,141 ;Z
BYTE (7) 000,177,101,000,000 ;[
BYTE (7) 020,010,004,002,001 ;\
BYTE (7) 000,000,101,177,000 ;]
BYTE (7) 010,020,076,020,010 ;^
BYTE (7) 010,034,052,010,010 ;
SUBTTL Common Utilities
;PUTERR Routine to Move error Messages into J$XERR Buffer
; Call: MOVE S1,address if ITEXT block
; PUSHJ P,PUTERR
;
PUTERR: $CALL SETEBF ;POINT $TEXT TO ERROR BUFFER
$TEXT (DEPBP,<? ^I/0(S1)/^0>) ;YES -- MOVE TO BUFFER
$RETT
;HERE TO PRINT THE STRING IN J$XTBF(J) ON THE DEVICE
STRING: $SAVE <P1,P2> ;SAVE P1 AND P2
MOVE P1,[POINT 7,J$XTBF(J)] ;LOAD A BYTE POINTER
MOVE P2,J$LSER(J) ;AND ADDRESS OF DISPATCH TABLE
STRI.1: ILDB S1,P1 ;GET A BYTE
JUMPE S1,.RETT ;END OF STRING
PUSHJ P,DLETR(P2) ;PRINT THE LETTER
JRST STRI.1 ;AND LOOP
;HERE TO SETUP A BYTE POINTER TO THE J$XTBF(J) BUFFER
SETTBF: MOVEI TF,J$XTBF(J) ;GET THE ADDRESS OF TEXT BUFFER
HRLI TF,(POINT 7,0) ;MAKE A POINTER
MOVEM TF,TEXTBP ;STORE THE BYTE POINTER
MOVEI TF,TXT$LN*5 ;GET BYTE COUNT
MOVEM TF,TEXTBC ;AND SAVE IT
SETZM J$XTBF(J) ;ZAP FIRST WORD
$RETT ;AND RETURN
SETEBF: MOVEI TF,J$XERR(J) ;GET THE ADDRESS OF ERROR BUFFER
HRLI TF,(POINT 7,0) ;MAKE A POINTER
MOVEM TF,TEXTBP ;STORE THE BYTE POINTER
MOVEI TF,ERR$LN*5 ;GET BYTE COUNT
MOVEM TF,TEXTBC ;AND SAVE IT
SETZM J$XERR(J) ;ZAP FIRST WORD
$RETT ;AND RETURN
;HERE TO DISPATCH TO A processing ROUTINE BASED ON FILE MODE.
; S1 CONTAINS THE MODE-TABLE ADDRESS AND S2 CONTAINS THE ROUTINE-
; TABLE ADDRESS.
DSPMOD: $SAVE <T1,T2,T3,T4> ;SAVE SOME ACS
MOVE T1,J$DMOD(J) ;GET THE MODE
IMULI T1,3 ;3 BITS/MODE
DMOVE T2,0(S1) ;GET THE MODE TABLE
LSHC T2,(T1) ;GET THE CORRECT BYTE ON TOP
LDB T2,[POINT 3,T2,2] ;AND PICK IT UP
JUMPE T2,BADMOD ;LOSE BIG
ADD S2,T2 ;ELSE ADD IT IN
JRST @-1(S2) ;AND DISPATCH
BADMOD: MOVEI S1,[ITEXT (<Illegal file mode ^O/T2/>)]
PJRST PUTERR ;AND FORCE IT OUT
;HERE TO COMPUTE A FOLDED 12 BIT CHECKSUM FOR CARDS AND PAPER-TAPE
;CALL: S1/ MAXIMUM BLOCKSIZE
;
;T RET: S1/ ACTUAL BLOCKSIZE
; S2/ CHECKSUM
; THE DATA READ (C[S1] WORDS) IS BUFFERED IN J$XCHB(J)
;
;F RET: EOF ON FIRST TRY
;
; * * * THIS ROUTINE DEPENDS ON AN INPUT BYTE-SIZE OF 36 BITS * * *
CHKSUM: $SAVE <P1,P2,P3,P4> ;SAVE SOME ACS
MOVE P1,S1 ;SAVE MAXIMUM BLOCKSIZE
MOVN P2,S1 ;GET NEGATIVE BLOCKSIZE
HRLS P2 ;PUT IT IN LEFT HALF
HRRI P2,J$XCHB(J) ;AND POINT TO THE INTERMEDIATE BUFFER
SETZ P3, ;AND ZERO THE CHECKSUM
CHKS.1: $CALL INPBYT ;GET A WORD
JUMPF CHKS.2 ;JUMP ON EOF
ADD P3,C ;ACCUMULATE A CHECKSUM
MOVEM C,0(P2) ;SAVE THE DATA WORD
AOBJN P2,CHKS.1 ;AND LOOP
JRST CHKS.3 ;GET A COMPLETE BLOCK!!
CHKS.2: HLRES P2 ;GET WHAT'S LEFT OF NEGATIVE COUNT
ADD P1,P2 ;AND GET ACTUAL BLOCKSIZE IN P1
JUMPE P1,.RETF ;IF NONE, RETURN FALSE
; / P3 / P4 /
; /--------------/--------------/
; / 1! 2! 3/ X! X! X/
CHKS.3: LSHC P3,-^D24 ; / 0! 0! 1/ 2! 3! X/
LSH P4,-^D12 ; / 0! 0! 1/ 0! 2! 3/
ADD P3,P4 ; / 0! 2+C! 1+3/ 0! 2! 3/
LSHC P3,-^D12 ; / 0! 0! 2+C/ 1+3! 0! 2/
LSH P4,-^D24 ; / 0! 0! 2+C/ 0! 0! 1+3/
ADD P3,P4 ; / 0!C+C1!123 / 0! 0! 1+3/
; /--------------/--------------/
TRZE P3,770000 ;TEST FOR CARRY (THIS IS A 1-COMP ADD)
ADDI P3,1 ;YES, END-AROUND
MOVE S1,P1 ;GET BLOCKSIZE IN S1
MOVE S2,P3 ;GET CHECKSUM IN S2
$RETT ;AND RETURN
SUBTTL Interrupt Module
; INTINI INITIALIZE INTERRUPT SYSTEM
; INTON ENABLE INTERRUPTS
; INTOFF DISABLE INTERRUPTS
; INTCNL CONNECT THE DEVICE
; INTDCL DISCONNECT THE DEVICE
; INTIPC INTERRUPT ROUTINE -- IPCF
; INTDEV INTERRUPT ROUTINE -- DEVICE OFF-LINE
;DOSTRMS MACRO TO REPEAT CODE FOR MULTIPLE STREAM
DEFINE DOSTRMS (CODE) <
LSTOF.
Z==0 ;CLEAR STREAM INDEX
ZZ==. ;SAVE TO COMPUTE TOTAL LENGTH
REPEAT NSTRMS,< ;REPEAT FOR EACH STREAM
CODE
Z==Z+1 ;INCREMENT STREAM INDEX
> ;END REPEAT NSTRMS
ZZ==.-ZZ ;COMPUTE TOTAL LENGTH
LSTON.
> ;END DEFINE DOSTRMS
;INTERRUPT SYSTEM DATABASE
TOPS20 <
.ICIPC==0 ;INTERUPT CHANNEL FOR IPCF
.ICODN==^D35 ;INTERUPT CHANNEL FOR OUTPUT DONE
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
CHNTAB: XWD 1,INTIPC ;IPCF CHANNEL 0
DOSTRMS < ;REPEAT FOR EACH STREAM
XWD 1,INTDEV+<DVHDSZ*Z> ;LEVEL 1, DEVICE HEADER CODE
> ;END DOSTRMS
BLOCK ^D35-NSTRMS ;CLEAR REST OF TABLE
> ;END TOPS20 CONDITIONAL
TOPS10 <
INTINI: MOVEI S1,INTIPC ;GET ADDRESS OF IPCF INT RTN
MOVEM S1,VECIPC+.PSVNP ;SAVE IN VECTOR
DOSTRMS < ;REPEAT FOR EACH STREAM
MOVEI S1,INTDEV+<DVHDSZ*Z> ;GET DEVICE HEADER ADDRESS
MOVEM S1,VECDEV+<4*Z>+.PSVNP ;STORE HEADER ADDRESS IN VECTOR
> ;END DOSTRMS
POPJ P, ;AND RETURN
> ;END TOPS10 CONDITIONAL
TOPS20 <
;BUILD ACTIVE CHANNEL MASK
INTMSK==<1B<.ICIPC>+MASK.(NSTRMS,NSTRMS)+1B<.ICODN>>
INTINI: MOVX S1,.FHSLF ;LOAD MY FORK HANDLE
MOVX S2,INTMSK ;CHANNEL MASK
AIC ;ACTIVATE THE CHANNELS
POPJ P, ;AND RETURN
> ;END TOPS20 CONDITIONAL
TOPS10 <
INTDCL: SKIPA S1,[PS.FRC+T1] ;REMOVE CONDITION USINGS ARGS IN T1
INTCNL: MOVX S1,PS.FAC+T1 ;ADD CONDITION USING ARGS IN T1
MOVE T1,J$LJFN(J) ;USE CHANNEL AS CONDTION
HRRZ T2,STREAM ;GET STREAM NUMBER
IMULI T2,4 ;GET BLOCK OFFSET
ADDI T2,VECDEV-VECTOR ;GET OFFSET FROM BEGINNING
HRLZS T2 ;GET OFFSET,,0
;**;[2541] Change 1 line at INTCNL+6L. /LWS
HRRI T2,PS.RDO+PS.ROD+PS.ROL+PS.RDH ;[2541] AND CONDITIONS
SETZ T3, ;ZERO T3
PISYS. S1, ;TO THE INTERRUPT SYSTEM
HALT
POPJ P, ;AND RETURN
> ;END TOPS10 CONDITIONAL
TOPS20 <
INTCNL: MOVE S1,J$LJFN(J) ;GET THE DEV JFN
MOVX S2,.MOPSI ;GET MTOPR FUNCTION
MOVEI T1,T2 ;AND ADDRESS OF ARGS
MOVEI T2,3 ;1ST ARG IS # ARGS
HRRZ T3,STREAM ;2ND ARG IS INT CHANNEL NUMBER
ADDI T3,1 ;INT CHANNEL IS STREAM PLUS 1
MOVX T4,MO%MSG ;DON'T TYPE THE MESSAGE
MTOPR ;DO IT
ERJMP .+1 ;IGNORE THE ERROR
POPJ P, ;AND RETURN
> ;END TOPS20 CONDITIONAL
SUBTTL IPCF and DEVICE Interrupt service for TOPS10
TOPS10 <
INTIPC: $BGINT 1, ;SETUP FOR INTERRUPT
$CALL C%INTR ;FLAG THE INTERRUPT
$DEBRK ;DISMISS INTERRUPT
;Here on device interrupts on the -10. This routine consists of multiple
; interrupt headers (one for each stream) which load S1 and S2 and
; call the main interrupt body, DVINTR. Note that on the -10, while
; it is assumed that 'output done' and 'on-line' interrupts can happen
; anytime and anywhere, it is also assumed that 'device off-line'
; interrupts ONLY HAPPEN IN THE STREAM CONTEXT.
INTDEV: ;ADDRESS OF HEADER FOR STREAM 0
DOSTRMS < ;REPEAT FOR EACH STREAM
$BGINT 1, ;SETUP FOR INTERRUPT
MOVEI S1,Z ;LOAD STREAM NUMBER IN S1
MOVEI S2,VECDEV+<4*Z> ;LOAD DEVICE VECTOR ADDRESS
JRST DVINTR ;ENTER COMMON CODE
> ;END DOSTRMS
DVHDSZ==ZZ/NSTRMS ;COMPUTE SIZE OF HEADER CODE
DVINTR: MOVE J,JOBPAG(S1) ;GET THE JOB PARAMETER PAGE
HRRZ T1,.PSVFL(S2) ;GET I/O REASON FLAGS
ANDCAM T1,.PSVFL(S2) ;AND CLEAR THEM
SKIPN JOBACT(S1) ;IS STREAM ACTIVE?
JRST INTDON ;NO -- IGNORE THE INTERRUPT
MOVX T2,PSF%OB ;GET OUTPUT BLOCKED FLAG
TXNE T1,PS.ROL ;IS IT ON-LINE?
TXO T2,PSF%DO ;YES, GET THE OFF-LINE FLAG
ANDCAM T2,JOBSTW(S1) ;CLEAR THE SCHEDULER FLAGS
MOVE T2,.PSVIS(S2) ;[QAR 10-4903] GET EXTRA STATUS
DMOVEM T1,J$LIOS(J) ;SAVE IT
;**;[2541] Add code at DVINTR+10L. /LWS
TXNE T1,PS.RDH ;[2541] HUNG DEVICE?
JRST DVIN.1 ;[2541] YEP
TXNN T1,PS.RDO ;IS IT DEVICE OFF-LINE?
JRST INTDON ;NO, RETURN
TXNE T1,PS.ROL ;IF BOTH OFFLINE AND ONLINE,
JRST INTDON ;ASSUME ITS ONLINE
MOVX T2,PSF%DO ;[2541] GET SCHED OFFLINE FLAG
IORM T2,JOBSTW(S1) ;[2541] SET IT
TXC T1,PS.RIE+PS.ROE+PS.RDO ;[2541] CHECK FOR CPU FAILURE
TXNN T1,PS.RIE+PS.ROE+PS.RDO ;[2541] DEAD CPU?
JRST DVIN.2 ;[2541] YES
MOVEI T1,OUTWON ;LOAD RESTART ADDRESS
EXCH T1,.PSVOP(S2) ;STORE FOR DEBRK AND GET OLD ADRESS
MOVEM T1,J$LIOA(J) ;STORE OLD-ADDRESS FOR DEVICE ON AGAIN
INTDON: $DEBRK ;DISMISS INTERRUPT
;**;[2541] Add code to handle CPU failures and hung devices
DVIN.1: SKIPA T2,[HNGDEV] ;[2541] ADDRESS FOR HUNG DEVICE PROCESSING
DVIN.2: MOVEI T2,CPUDIE ;[2541] ADDRESS FOR DEAD CPU PROCESSING
SETZM JOBSTW(S1) ;[2541] MAKE STREAM RUNNABLE
MOVE T1,J$RACS+P(J) ;[2541] GET STREAMS STACK
PUSH T1,T2 ;[2541] SAVE CONTINUATION ADDRESS
MOVEM T1,J$RACS+P(J) ;[2541] PUT STACK POINTER BACK
HRRZ T1,STREAM ;[2541] GET STREAM NUMBER
CAIN S1,(T1) ;[2541] IN STREAM CONTEXT?
MOVEM T2,.PSVOP(S2) ;[2541] YES, SET INTERRUPT RETURN ADDRESS
$DEBRK ;[2541] DISMISS THE INTERRUPT
;**;[2541] Add hung device and CPU failure processing routines
HNGDEV: TDZA P1,P1 ;[2541] INDICATE HUNG DEVICE
CPUDIE: MOVEI P1,1 ;[2541] OR DEAD CPU
MOVE P2,STREAM ;[2541] GET STREAM NUMBER
MOVE J,JOBPAG(P2) ;[2541] SETUP JOB DATA BASE POINTER
MOVE S,J$RACS+S(J) ;[2541] GET STREAM FLAGS
TXO S,GOODBY+RQB+ABORT ;[2541] LITE BYEBYE BITS
MOVEM S,J$RACS+S(J) ;[2541] STORE THEM
MOVE S1,[[ASCIZ\Hung device\]
[ASCIZ\CPU failure\]](P1) ;[2541] GET WTO TEXT FOR DEVICE
$WTO (<^T/(S1)/ - job requeued>,<^R/.EQJBB(J)/>,@JOBOBA(P2)) ;[2541]
MOVE S1,J$LSER(J) ;[2541] GET DEVICE DISPATCH ADDRESS
MOVE S1,DNAME(S1) ;[2541] GET DEVICE NAME
SKIPN P1 ;[2541] HUNG DEVICE?
CAME S1,[SIXBIT\PTP\] ;[2541] YES, PAPER TAPE PUNCH?
TRNA ;[2541] NO TO EITHER
$WTO (<Papertape feed may be empty>,<^R/.EQJBB(J)/>,@JOBOBA(P2)) ;[2541] HUNG PUNCH
SKIPE S1,J$DIFN(J) ;[2541] RELEASE FILE
PUSHJ P,F%REL ;[2541] YES
PUSHJ P,QREQUE ;[2541] REQUEUE THE JOB
PUSHJ P,INTDCL ;[2541] TURN OFF PSI
PJRST SHUTUP ;[2541] SHUT DOWN THE STREAM
> ;END TOPS10 CONDITIONAL
SUBTTL IPCF and DEVICE interrupt service for TOPS20
TOPS20 <
INTIPC: $BGINT 1, ;SET UP FOR INTERRUPT
$CALL C%INTR ;FLAG THE INTERRUPT
SKIPL T1,STREAM ;ARE WE IN STREAM CONTEXT?
JRST INTDON ;YES -- ENTER COMMON ENDING
$DEBRK ;NO -- JUST DISMISS INTERRUPT
;Here on device interrupts on the -20.
INTDEV: ;ADDRESS OF CODE FOR STREAM 0
DOSTRMS < ;REPEAT FOR EACH STREAM
$BGINT 1, ;SETUP FOR INTERRUPT
MOVEI T1,Z ;LOAD STREAM NUMBER
JRST DVINTR ;ENTER COMMON CODE
> ;END DOSTRMS
DVHDSZ==ZZ/NSTRMS ;COMPUTE SIZE OF HEADER CODE
DVINTR: SKIPN J,JOBPAG(T1) ;DOES STREAM HAVE A JOB PAGE?
JRST INTBRK ;NO -- JUST DISMISS INTERUPT
$CALL OUTSTS ;YES -- GET DEVICE STATUS
MOVX S2,PSF%DO ;GET SCHEDULER OFF LINE FLAG
ANDCAM S2,JOBSTW(T1) ;ASSUME WE'RE ON LINE
TXNE S1,MO%OL ;IS IT OFF-LINE?
IORM S2,JOBSTW(T1) ;YES -- SET FLAG
INTDON: SKIPN J,JOBPAG(T1) ;MUST HAVE A JOB PAGE
JRST INTBRK ;NO -- JUST DISMISS INTERRUPT
MOVEI S1,OUTINT ;SET UP TO BREAK OUT OF SOUT
SKIPE J$LIOA(J) ;ARE WE IN SOUT?
MOVEM S1,LEV1PC ;YES -- BREAK OUT ON $DEBRK
INTBRK: $DEBRK
> ;END TOPS20 CONDITIONAL
SPOEND::END SPROUT