Trailing-Edge
-
PDP-10 Archives
-
CFS_TSU04_19910205_1of1
-
update/galsrc/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
SUBTTL Preliminaries
; COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1975, 1988.
; ALL RIGHTS RESERVED.
;
; 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 THAT IS NOT SUPPLIED BY DIGITAL.
SEARCH GLXMAC ;SEARCH GLXLIB SYMBOLS
PROLOGUE(SPROUT) ;DO STANDARD PROLOG
SEARCH QSRMAC ;GET QUASAR SYMBOLS
SEARCH ORNMAC ;GET OPERATOR SYMBOLS
;**;[6002]At SEARCH ORNMAC:+1L add 1 line JCR 1/11/90
SEARCH NEBMAC ;[6002]Get NEBULA's symbols
SUBTTL Edit vector and Version numbers
SPOVEC: BLDVEC (GLXMAC,GMC,L)
BLDVEC (ORNMAC,OMC,L)
BLDVEC (QSRMAC,QMC,L)
BLDVEC (SPROUT,SPO,L)
SPOMAN==:6002 ;Maintenance edit number
SPODEV==:6001 ;Development edit number
VERSIN (SPO) ;Generate edit number
SPOWHO==0
SPOVER==6
SPOMIN==0
SPOVRS==<VRSN.(SPO)>+GMCEDT+OMCEDT+QMCEDT
LOC 137
EXP SPOVRS
RELOC
Subttl Table of Contents
; Table of Contents for SPROUT
;
; Section Page
;
;
; 1. Edit vector and Version numbers . . . . . . . . . . . 2
; 2. Revision history . . . . . . . . . . . . . . . . . . . 5
; 3. Constants (Conditional and Unconditional) . . . . . . 6
; 4. MACROS . . . . . . . . . . . . . . . . . . . . . . . . 7
; 5. Special Forms Handling Parameters . . . . . . . . . . 8
; 6. Flag Definitions . . . . . . . . . . . . . . . . . . . 10
; 7. Job Parameter Area . . . . . . . . . . . . . . . . . . 11
; 8. Random Impure Storage . . . . . . . . . . . . . . . . 14
; 9. Resident JOB DaTABase . . . . . . . . . . . . . . . . 15
; 10. Non-zero daTABase . . . . . . . . . . . . . . . . . . 16
; 11. $TEXT Utilities . . . . . . . . . . . . . . . . . . . 17
; 12. Program Initialization . . . . . . . . . . . . . . . . 18
; 13. Idle Loop . . . . . . . . . . . . . . . . . . . . . . 19
; 14. Deschedule Process . . . . . . . . . . . . . . . . . . 20
; 15. Do the Job . . . . . . . . . . . . . . . . . . . . . . 21
; 16. Process a File . . . . . . . . . . . . . . . . . . . . 22
; 17. End of Job . . . . . . . . . . . . . . . . . . . . . . 23
; 18. CHKQUE Routine to process IPCF messages . . . . . . . 24
; 19. CHKOBJ Routine to validate QUASAR/ORION/OPR MSG Object 25
; 20. FNDOBJ Routine to establish STREAM context . . . . . . 26
; 21. GETBLK Routine to return next argument from an OPR/ORI 27
; 22. NEXTJOB Message from QUASAR . . . . . . . . . . . . . 28
; 23. User CANCEL Request . . . . . . . . . . . . . . . . . 29
; 24. UPDATE Routine to send status update . . . . . . . . . 30
; 25. CHKPNT Routine to send checkpoint message . . . . . . 31
; 26. SETUP/SHUTDOWN Message . . . . . . . . . . . . . . . . 32
; 27. Response to setup message . . . . . . . . . . . . . . 33
; 28. Operator CANCEL command . . . . . . . . . . . . . . . 34
; 29. Operator STOP command . . . . . . . . . . . . . . . . 35
; 30. Operator REQUEUE command . . . . . . . . . . . . . . . 36
; 31. CLRMSG and SNDQSR routines . . . . . . . . . . . . . . 37
; 32. Accounting routines . . . . . . . . . . . . . . . . . 39
; 33. FORMS - Setup Forms for a job . . . . . . . . . . . . 42
; 34. Forms switch Subroutines . . . . . . . . . . . . . . . 46
; 35. Plotter only switches . . . . . . . . . . . . . . . . 47
; 36. I/O Subroutines for SPFORM.INI . . . . . . . . . . . . 48
; 37. INPOPN - Routine to open the input file . . . . . . . 50
; 38. INPBUF - Read a buffer from the input file . . . . . . 51
; 39. OUTGET - OPEN the output device . . . . . . . . . . . 52
; 40. OUTBYT - Deposit a byte in the output buffer . . . . . 55
; 41. OUTOUT - Routine to output a buffer . . . . . . . . . 56
; 42. DEVERR - Handle Output Device Errors . . . . . . . . . 57
; 43. OUTREL - Release output device . . . . . . . . . . . . 58
; 44. OUTWON - Wait for on-line . . . . . . . . . . . . . . 59
; 45. OUTFLS Routine to flush output buffers . . . . . . . . 60
Subttl Table of Contents (page 2)
; Table of Contents for SPROUT
;
; Section Page
;
;
; 46. Card punch service
; 46.1 Dispatch table . . . . . . . . . . . . . . . . 61
; 46.2 Checkpoint text generation . . . . . . . . . . 62
; 46.3 File processing . . . . . . . . . . . . . . . 63
; 46.4 File headers . . . . . . . . . . . . . . . . . 69
; 46.5 File trailers . . . . . . . . . . . . . . . . 70
; 46.6 Banners . . . . . . . . . . . . . . . . . . . 71
; 46.7 Word punching . . . . . . . . . . . . . . . . 72
; 46.8 Letters . . . . . . . . . . . . . . . . . . . 73
; 46.9 Byte output . . . . . . . . . . . . . . . . . 74
; 47. Plotter service
; 47.1 Dispatch table . . . . . . . . . . . . . . . . 75
; 47.2 Checkpoint text generation . . . . . . . . . . 76
; 47.3 File processing . . . . . . . . . . . . . . . 77
; 47.4 Devout output errors . . . . . . . . . . . . . 79
; 47.5 Banners . . . . . . . . . . . . . . . . . . . 80
; 47.6 File headers . . . . . . . . . . . . . . . . . 81
; 47.7 File trailers . . . . . . . . . . . . . . . . 82
; 47.8 Job trailers . . . . . . . . . . . . . . . . . 83
; 47.9 Solid lines . . . . . . . . . . . . . . . . . 84
; 47.10 Dashed lines . . . . . . . . . . . . . . . . . 85
; 47.11 Job information plotting . . . . . . . . . . . 86
; 47.12 Alignment and testing . . . . . . . . . . . . 87
; 47.13 Pen calibration . . . . . . . . . . . . . . . 88
; 47.14 Compute chracter size . . . . . . . . . . . . 89
; 47.15 Letters . . . . . . . . . . . . . . . . . . . 90
; 47.16 Line segments . . . . . . . . . . . . . . . . 91
; 47.17 Rotation and XY20 translation . . . . . . . . 93
; 47.18 Pen movement generation . . . . . . . . . . . 94
; 47.19 Character set . . . . . . . . . . . . . . . . 96
; 48. Paper tape punch service
; 48.1 Dispatch table . . . . . . . . . . . . . . . . 101
; 48.2 Checkpoint text generation . . . . . . . . . . 102
; 48.3 File processing . . . . . . . . . . . . . . . 103
; 48.4 Banners . . . . . . . . . . . . . . . . . . . 108
; 48.5 File headers . . . . . . . . . . . . . . . . . 109
; 48.6 File trailers . . . . . . . . . . . . . . . . 110
; 48.7 Trailers . . . . . . . . . . . . . . . . . . . 111
; 48.8 Blank folds . . . . . . . . . . . . . . . . . 112
; 48.9 Letters . . . . . . . . . . . . . . . . . . . 113
; 48.10 Byte output . . . . . . . . . . . . . . . . . 114
; 49. Character Bit Array for 5 X 7 Character Matrix . . . . 115
; 50. Common Utilities . . . . . . . . . . . . . . . . . . . 117
; 51. Interrupt Module . . . . . . . . . . . . . . . . . . . 119
; 52. IPCF and DEVICE Interrupt service for TOPS10 . . . . . 123
; 53. IPCF and DEVICE interrupt service for TOPS20 . . . . . 124
SUBTTL Revision history
COMMENT \
2533 4.2.1528 9-Nov-82
Fix copyright.
***** Release 4.2 -- begin maintenance edits *****
2535 4.2.1566 12-Jan-84
Move 2 lines from ENDJOB+8 to ENDJOB+10.
2536 4.2.1567 16-Jan-84
Send error messages to OPR on file input error and
file inaccessibility.
***** Release 5.0 -- begin development edits *****
2550 5.1003 30-Dec-82
Move to new development area. Add version vector. Clean up
edit organization. Update TOC.
2551 5.1046 21-Oct-83
Change version number from 4 to 5.
2552 5.1202 13-Feb-85
Fix bug in FILD.1. The /DELETE switch was improperly processed,
when the job was cancelled, the file was deleted.
***** Release 5.0 -- begin maintenance edits *****
2560 Increment maintenance edit level for version 5 of GALAXY.
***** Release 6.0 -- begin development edits *****
6000 6.1037 26-Oct-87
Move sources from G5: to G6:
6001 6.1225 8-Mar-88
Update copyright notice.
***** Release 6.0 -- begin maintenance edits *****
6002 6.1299 11-Jan-90
Add support for remote IPCF processing.
\ ;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
; 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:NN NUMBER OF JOB HEADERS
; TRAILER:NN NUMBER OF JOB TRAILERS
; HEADER:NN NUMBER OF FILE HEADERS (PICTURE PAGES)
; NOTE:AA TYPE NOTE TO THE OPERATOR
;FOR PLOTTER ONLY
; SPU:NN STEPS PER UNIT (FACTOR OF ALL XX AND YY)
; SIZE:XX:YY NUMBER OF STEPS IN X AND Y AXIS
; MAXIMUM:XX:YY STEP FOR FORMS LIMIT IN X AND Y AXIS
; MINIMUM:XX:YY STEP FOR FROMS LIMIT IN X AND Y AXIS
;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 STEP NUMBER IN X AXIS
; YY INTEGER STEP NUMBER IN Y AXIS
;LOCATION SPECIFIERS
; ALL ALL DEVICES
; CENTRAL ALL DEVICES AT THE CENTRAL SITE
; REMOTE 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
;TYPICAL SPFORM.INI FORMS SPECIFICATION
; CDP NORMAL/BANNER:6/HEADER:1/TRAILER:6-
; /NOTE:Load NORMAL Cards in Card Punch
;
; PLT NORMAL/BANNER:200/HEADER:200/TRAILER:200-
; /MINIMUM:0:0/MAXIMUM:0:5900-
; /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)
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
;**;[6002]At LP J$DSPX,1 add 6 lines JCR 1/11/90
;[6002]Remote IPCF message
LP J$RPID,1,Z ;[6002]Remote operator PID
LP J$RNOD,1,Z ;[6002]Remote operator node name
LP J$NULA,1,Z ;[6002]Need to reply to NEBULA
LP J$NEBF,1,Z ;[6002]Response msg originated remotely
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
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
;**;[6002]At FILNAM:+2L add 4 lines JCR 1/11/90
G$NEBF: BLOCK 1 ;[6002]Remote message flag
G$REMN: BLOCK 1 ;[6002]Remote node where msg originated
G$NULA: BLOCK 1 ;[6002]Null ACK indicator
JOBARG: BLOCK 1 ;[6002]IPCF message argument number
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
;HERE ARE SOME TEXT-OUTPUT-ROUTINES
DEP6BP: SUBI S1," " ;CONVERT TO ASCII
DEPBP: SOSL TEXTBC ;CHECK BYTE COUNT
IBP TEXTBP ;OK -- INCR POINTER
DPB S1,TEXTBP ;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
TOPS10 <MOVEM T2,CNTSTA> ;SAVE NUMBER AS CENTRAL STATION
TOPS20 <MOVEM T1,CNTSTA> ;SAVE NAME 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
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
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
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
;**;[6002]At ENDJOB:+11L replace 1 line with 3 lines JCR 1/11/90
$CALL SETREM ;[6002]Set up remote origin parameters
HRRZ S1,STREAM ;[6002]Point to the current stream
$QWTOJ (End,^R/.EQJBB(J)/,@JOBOBA(S1),<$WTACK(J$RPID(J)),$WTFLG(WT.SUP)>);[6002]
$CALL QRELEASE ;RELEASE THE JOB
$CALL ACTEND ;DO FINAL ACCOUNTING
TOPS20 <
PUSHJ P,OUTOUT ;FORCE OUTPUT
> ;;END TOPS20
HRRZ S1,STREAM ;GET STREAM NUMBER
SETZM JOBACT(S1) ;NOT BUSY
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.
;**;[2552]Replace 1 line with 3 lines at FILD.1:+7L JCR 2/14/85
TXNN T2,ABORT ;[2552]Abort set?
TXNN T2,FP.DEL ;[2552]No, /DELETE?
TXNE T2,FP.SPL ;[2552]SPOOL file?
PUSHJ P,F%DEL ;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
;**;[6002]At CHKQ.4:+1L add 4 lines JCR 1/11/90
LOAD S2,.MSFLG(M),MF.NEB ;[6002]Pick up the remote origin bit
MOVEM S2,G$NEBF ;[6002]Save for any $Qxxx macro
MOVE S2,.OARGC(M) ;[6002]Pick up the argument count
MOVEM S2,JOBARG ;[6002]Save for routine FNDBLK
$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.
;**;[6002]At CHKO.4:+1L replace 2 lines with 24 lines JCR 1/11/90
JUMPF CHKO.6 ;[6002]Not there, that's an error
SKIPN G$NEBF ;[6002]Message originate remotely?
$RET ;[6002]No, so finished
LOAD S1,.MSTYP(M),MS.TYP ;[6002]Pick up the message type
CAIE S1,.QOABO ;[6002]An ABORT message?
JRST CHKO.5 ;[6002]No, go set up G$REMN
MOVE S1,ABO.ND(M) ;[6002]Pick up the remote node name
MOVEM S1,G$REMN ;[6002]Save where expected by $Qxxx
$RET ;[6002]Return to the caller
CHKO.5: $CALL FNDREM ;[6002]Set up G$REMN
$RETIT ;[6002]Return to the caller
JRST REMERR ;[6002]Shouldn't happen but tell ORION
CHKO.6: SKIPN G$NEBF ;[6002]Message originate remotely?
$RET ;[6002]No, so return now
LOAD S1,.MSTYP(M),MS.TYP ;[6002]Pick up the message type
CAIE S1,.QOABO ;[6002]An ABORT message?
JRST CHKO.7 ;[6002]No, go set up G$REMN
MOVE S1,ABO.ND(M) ;[6002]Pick up the remote node name
MOVEM S1,G$REMN ;[6002]Place where expected by $NUL
JRST CHKO.8 ;[6002]Go send the Null ACK
CHKO.7: $CALL FNDREM ;[6002]Set up G$REMN
JUMPF REMERR ;[6002]Shouldn't happen but tell ORION
CHKO.8: $NUL (.MSCOD(M)) ;[6002]Send a Null ACK to NEBULA
$RETF ;[6002]Indicate error occurred to caller
;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
;**;[6002]At KILL:+1L change 1 line JCR 1/11/90
JRST KILL.1 ;[6002]If leaving, check if remote
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 ???
;**;[6002]At KILL:+5L change 1 line JCR 1/11/90
$QKWTO (JOBWAC(S1)) ;[6002]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
;**;[6002]At KILL:+9L change 1 line JCR 1/11/90
$QWTOJ (<Cancel request queued by user ^U/ABO.ID(M)/>,<^R/.EQJBB(J)/>,@JOBOBA(S1),<$WTACK(.MSCOD(M))>);[6002]
PUSHJ P,SETEBF ;SET UP ERROR BUFFER
$TEXT (DEPBP,<? Canceled by user ^U/ABO.ID(M)/^0>)
$RETT ;AND RETURN
;**;[6002]At KILL:+12L add 3 lines JCR 1/11/90
KILL.1: SKIPE G$NEBF ;[6002]Request originated remotely?
$NUL (.MSCOD(M)) ;[6002]Yes, send a Null ACK to NEBULA
$RETT ;[6002]Return to the caller
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
$CALL SHUTDN ;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
MOVE S2,J ;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 ???
;**;[6002]At OACCAN:+7L change 3 lines JCR 1/11/90
$QKWTO (JOBWAC(S1)) ;[6002]Yes, kill it
ANDCAM S2,JOBSTW(S1) ;[6002]And clear the wait bit
$QACK (<Abort request queued>,<^R/.EQJBB(J)/>,@JOBOBA(S1),.MSCOD(M));[6002]
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
;**;[6002]At OACC.2:+4L add 2 lines JCR 1/11/90
SKIPE G$NEBF ;[6002]Request originate remotely?
$CALL TRSREM ;[6002]Yes, set up the remote parameters
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
PUSHJ P,OUTFLS ;FLUSH THE OUTPUT BUFFERS
CAIE S1,%RSUOK ;DO WE STILL HAVE THE DEVICE?
PJRST SHUTUP ;NO..KILL THE STREAM
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
;**;[6002]At OACSTP:+3L change 1 line JCR 1/11/90
$QACK (<Stopped>,,@JOBOBA(S1),.MSCOD(M)) ;[6002]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
;**;[6002]At OACCON:+3L change 1 line JCR 1/11/90
$QACK (<Continued>,,@JOBOBA(S1),.MSCOD(M)) ;[6002]]Tell OPR
PUSHJ P,UPDATE ;UPDATE STATUS TO QUASAR
$RETT ;AND RETURN
SUBTTL Operator RESPONSE command
;**;[6002]At OACRSP:+0L replace 6 lines with 9 lines JCR 1/11/90
OACRSP: $SAVE <P1> ;[6002]Save this AC
MOVE S2,.MSCOD(M) ;[6002]Get WTOR ACK code
MOVSI S1,-NSTRMS ;[6002]Create AOBJN AC
RESP.1: CAMN S2,JOBWAC(S1) ;[6002]ACK codes the same?
JRST RESP.2 ;[6002]Yes, this is the stream
AOBJN S1,RESP.1 ;[6002]Check the next stream
JRST RESP.3 ;[6002]Not there, check if remote
RESP.2: MOVE P1,S1 ;[6002]Save the stream number
MOVX S2,PSF%OR ;[6002]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
;**;[6002]At RESP.2:+7L replace 1 line with 26 lines JCR 1/11/90
SKIPN S1,G$NEBF ;[6002]Message originate remotely?
$RETT ;[6002]No, return now
MOVEM S1,J$NEBF(J) ;[6002]Save in the job data stream
MOVEI S1,.ACKID ;[6002]Want to find the ACK block
$CALL FNDBLK ;[6002]Search for the ACK block
JUMPF REMERR ;[6002]Shouldn't happen, but tell ORION
MOVE S2,ARG.HD(S1) ;[6002]Pick up the PID of the operator
MOVEM S2,J$RPID(J) ;[6002]Save for any $Qxxx
MOVE S2,ARG.DA(S1) ;[6002]Pick up the node name
MOVEM S2,J$RNOD(J) ;[6002]Save for any $Qxxx
SETOM J$NULA(J) ;[6002]Indicate NEBULA needs a response
MOVE S1,JOBSTW(P1) ;[6002]Pick up the stream status
TXNE S1,PSF%ST ;[6002]Is the stream stopped?
$CALL SNDNUL ;[6002]Yes, send a Null ACK to NEBULA
$RETT ;[6002]Now return
RESP.3: SKIPN G$NEBF ;[6002]Message originate remotely?
$RET ;[6002]No, so return now
MOVEI S1,.ACKID ;[6002]Want to find the ACK block
$CALL FNDBLK ;[6002]Search for the ACK block
JUMPF REMERR ;[6002]Shouldn't happen but tell ORION
MOVE S2,ARG.DA(S1) ;[6002]Pick up the node name
MOVEM S2,G$REMN ;[6002]Place where $NUL expects it
MOVE S2,ARG.HD(S1) ;[6002]Pick up the PID of the operator
$NUL (S2) ;[6002]Send a Null ACK to NEBULA
$RET ;[6002]Return to the caller
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
;**;[6002]At OACREQ:+5L change 1 line JCR 1/11/90
$QACK (<Requeue request queued>,<^R/.EQJBB(J)/>,@JOBOBA(S1),.MSCOD(M));[6002]
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
;**;[6002]At OACR.3:+7L add 2 lines JCR 1/11/90
SKIPE G$NEBF ;[6002]Message originate remotely?
$CALL TRSREM ;[6002]Yes, set up the remote parameters
$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
;**;[6002]At OUTASK:+7L change 1 line JCR 1/11/90
$QWTOR (Output limit exceeded,<^I/OLEMSG/>,@JOBOBA(S1),JOBWAC(S1),<$WTPID(J$RPID(J))>);[6002]
$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
;**;[6002]At OUTCAN:+5L replace 4 lines with 5 lines JCR 1/11/90
$QWTO (Canceled,<^R/.EQJBB(J)/>,@JOBOBA(S1),<$WTACK(J$RPID(J)),$WTFLG(WT.SUP)>) ;[6002]
$RETT ;[6002]And return
OUTIGN: $CALL SNDNUL ;[6002]Send a Null ACK if necessary
MOVX S1,.INFIN ;[6002]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
TOPS10< 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
;**;[6002]At ACTE.1:+1L change 1 line JCR 1/11/90
$QWTO (System Accounting Failure,<^R/.EQJBB(J)/>,@JOBOBA(S1),<$WTACK(J$RPID(J)),$WTFLG(WT.SUP)>);[6002]
$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
$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. (SPOVRS,US%IMM) ;PROGRAM VERSION
USAMV. (-1) ;ACCOUNTING MODULE VERSION
USNOD. (.EQROB+.ROBND(J)) ;NODE NAME
USACT. (<POINT 7,.EQACT(J)>) ;ACCOUTN STRING POINTER
USSRT. (J$ARTM(J)) ;RUN TIME
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
MOVE S2,[POINT 7,J$XTBF(J)] ;GET POINTER TO WTOR BUFFER.
MOVEM S2,TEXTBP ;AND SAVE IT FOR DEPBP.
MOVEI S2,TXT$LN*5 ;GET MAXIMUM BYTE COUNT
MOVEM S2,TEXTBC
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
SKIPE S1 ;NO NEED TO CHANGE FORMS.
$TEXT (DEPBP,<Please load forms type '^W/J$FORM(J)/'>)
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.
MOVE S1,TEXTBP ;GET THE WTOR BYTE POINTER.
CAMN S1,[POINT 7,J$XTBF(J)] ;IS THERE A MESSAGE FOR THE OPERATOR ??
$RETT ;NO,,RETURN.
$TEXT (DEPBP,<Type 'RESPOND ^7/[.CHLAB]/number^7/[.CHRAB]/ PROCEED' when ready^0>)
HRRZ S1,STREAM ;GET STREAM NUMBER
;**;[6002]At FORM.2:+6L replace 2 lines with 3 lines JCR 1/11/90
$QWTOR (,<^T/J$XTBF(J)/>,@JOBOBA(S1),JOBWAC(S1),<$WTPID(J$RPID(J))>) ;[6002]
$DSCHD (PSF%OR) ;[6002]Wait for operator response
$CALL SNDNUL ;[6002]Send a Null ACK to NEBULA
$RETT ;RETURN...
FRMINI: $SAVE <T1,T2,T3,T4> ;PRESERVE TEMPORARIES
MOVE S1,J$LSER(J) ;GET DEVICE DISPATCH ADDRESS
MOVE T3,DNAME(S1) ;GET DEVICE NAME
CAMN T3,[SIXBIT/PLT/] ;IS DEVICE A PLOTTER?
SETOM J$FPLT(J) ;YES -- SET SWITCH FLAG
DMOVE S1,[EXP FOB.SZ,FRMFOB] ;POINT TO FILE OPEN BLOCK
$CALL F%IOPN ;AND OPEN FORM INI FILE
JUMPF .RETF ;RETURN IF FILE NOT FOUND
MOVEM S1,J$FIFN(J) ;SAVE IFN OF FORM INI FILE
FRMI.1: $CALL FH$SIX ;READ FIRST WORD OF LINE
JUMPF FRMIEX ;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
JUMPF FRMIEX ;EXIT ON EOF
JRST FRMI.1 ;DO NEXT LINE
FRMI.3: $CALL FH$SIX ;GET THE FORMS NAME
JUMPF FRMIEX ;EOF!!
GETLIM T2,.EQLIM(J),FORM ;GET FORMS
CAMN T1,T2 ;MATCH??
JRST FRMI.4 ;YES!!
JRST FRMI.2 ;NO -- END LINE
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
JUMPF FRMIEX ;EOF
JRST FRMI.4 ;AND LOOP
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.
;**;[6002]At FRMERR:+1L change 1 line JCR 1/11/90
$QWTOJ (SPFORM.INI Error,<bad format>,@JOBOBA(S1),<$WTACK(J$RPID(J)),$WTFLG(WT.SUP)>) ;[6002]Tell OPR
FRMIEX: MOVE S1,J$FIFN(J) ;CLOSE FILE
$CALL F%REL
$RETT
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!
CAIN T2,'REM' ;DOES IT SAY "REMOTE"?
SKIPL J$LREM(J) ;YES, ARE WE REMOTE
SKIPA ;NO!!!
JRST FRMSWI ;YES!!
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 FRMIEX ;EOF, RETURN
JUMPE T1,FRMERR ;BAD FORMAT
JRST FRMI.7 ;AND LOOP AROUND
;GET HERE IF THIS LINE IS FOR US
FRMSWI: CAIN C,.CHLFD ;WAS THE LAST CHARACTER A LINEFEED?
JRST FRMS.5 ;YES -- CHECK PLOTTER processing
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.
;**;[6002]At FRMS.3:+6L change 1 line JCR 1/11/90
$QWTOJ (SPFORM.INI Error,<Unrecognized SWITCH ^W/T1/ found.>,@JOBOBA(S1),<$WTACK(J$RPID(J)),$WTFLG(WT.SUP)>);[6002]
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
FRMS.5: SKIPN J$FPLT(J) ;SPECIAL PLOTTER SWITCHES
JRST FRMIEX ;NO - CLOSE FILE AND RETURN
SKIPN T1,J$FSPU(J) ;GET /SPU MULTIPLIER
MOVEI T1,1 ;SOMEONE FORGOT TO PUT IT IN SPFORM.INI
IMULM T1,J$XORG(J) ;ADJUST X MINIMUM
IMULM T1,J$XMAX(J) ;ADJUST X MAXIMUM
IMULM T1,J$YMIN(J) ;ADJUST Y MINIMUM
IMULM T1,J$YMAX(J) ;ADJUST Y MAXIMUM
MOVE T1,J$FSPS(J) ;GET STEPS PER SECOND
IMULI T1,^D60 ;COMPUTE STEPS PER MINUTE
MOVEM T1,J$PTPM(J) ;STORE IT
PUSHJ P,P$CHKS ;COMPUTE CHARACTER SIZE
IMULI T1,^D8 ;ALLOW 8 LINES FOR TRAILER
MOVNS T1 ;NEGATE IT
ADDM T1,J$XMAX(J) ;LEAVE ROOM FOR TRAILER
JRST FRMIEX ;CLOSE FILE AND RETURN
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
SETZM J$XORG(J) ;DEFAULT TO ZERO
SETZM J$YMIN(J) ;DITTO
$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
MOVX T1,.INFIN ;GET A LARGE NUMBER
MOVEM T1,J$XMAX(J) ;DEFAULT
MOVEM T1,J$YMAX(J) ;DITTO
$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
HRRZ S1,STREAM ;Get stream number
;**;[6002]At INPO.3:+3L change 1 line JCR 1/11/90
$QWTO (Cannot access file,<^R/.EQJBB(J)/>,@JOBOBA(S1),<$WTACK(J$RPID(J)),$WTFLG(WT.SUP)>) ;[6002]Notify operator
$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
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 FUTURE COPIES OF THIS FILE
HRRZ S1,STREAM ;Get stream number
;**;[6002]At INPERR:+6L change 1 line JCR 1/11/90
$QWTO (File input error - file skipped,<^R/.EQJBB(J)/>,@JOBOBA(S1),<$WTACK(J$RPID(J)),$WTFLG(WT.SUP)>) ;[6002]Notify operator
$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
;**;[6002]At DEVERR:+6L change 1 line JCR 1/11/90
$QWTO (Device I/O Error,^R/.EQJBB(J)/,@JOBOBA(S1),<$WTACK(J$RPID(J)),$WTFLG(WT.SUP)>);[6002]
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
;**;[6002]At OUTWON:+5L change 1 line JCR 1/11/90
$QWTO (Device went off-line,,@JOBOBA(S1),<$WTACK(J$RPID(J)),$WTFLG(WT.SUP)>) ;[6002]
$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
;**;[6002]At P$DERR:+1L change 1 line JCR 1/11/90
$QWTO (<I/O error ^O6R0/J$LIOS(J),RHMASK/>,,@JOBOBA(S1),<$WTACK(J$RPID(J)),$WTFLG(WT.SUP)>);[6002]
$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
HRRI T2,PS.RDO+PS.ROD+PS.ROL ;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
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 T1,PSF%DO ;GET SCHED OFFLINE FLAG
IORM T1,JOBSTW(S1) ;SET IT
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
> ;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
;**;[6002]At INTBRK:+1L add routines FNDBLK, SNDNUL, SETREM, FNDREM, TRSREM
SUBTTL FNDBLK - ROUTINE TO FIND ANY BLOCK IN AN IPCF MESSAGE
;[6002]FNDBLK is called to find a specified block in an IPCF message.
;[6002]Call is: M/The message address
;[6002] S1/The block type of the block to be found
;[6002] JOBARG/The number of arguments in the IPCF message
;[6002]Returns true: S1/The block's data field address
;[6002]Returns false: The block is not in the message
FNDBLK: $SAVE <P1,P2> ;[6002]Save some scratch ACs
MOVE P1,JOBARG ;[6002]Get the message argument count
MOVE P2,S1 ;[6002]Save the block type
MOVEI S1,.OHDRS(M) ;[6002]Point to the first block
LOAD TF,.MSTYP(M),MS.CNT ;[6002]Get the message length
ADD TF,M ;[6002]Point to the end of the message
FNDB.1: LOAD S2,ARG.HD(S1),AR.TYP ;[6002]Get this block type
CAMN S2,P2 ;[6002]Is this the block?
JRST FNDB.2 ;[6002]Yes, return with block address
LOAD S2,ARG.HD(S1),AR.LEN ;[6002]No, get this block's length
ADD S1,S2 ;[6002]Address of the next block
CAIG TF,0(S1) ;[6002]Still within the message?
$RETF ;[6002]No, return block not found
SOJG P1,FNDB.1 ;[6002]Check the next block
$RETF ;[6002]Block not found
FNDB.2: MOVEI S1,ARG.DA(S1) ;[6002]Point to the data field
$RETT ;[6002]And return
SUBTTL SNDNUL - Routine to send a Null ACK to NEBULA
;[6002]SNDNUL determines if a Null ACK message must be sent to NEBULA as the
;[6002]result of a remote operator answering a response (.OMRSP) message. If
;[6002]such is the case, then a Null ACK message is sent.
;[6002]Call is: J/Stream data base
;[6002]Returns true: A Null ACK (.OMNAK) message has been sent to NEBULA
;[6002]Returns false: A Null ACK message does not need to be sent to NEBULA
;[6002]Side effects: J$NULA(J) is zeroed
SNDNUL: SKIPN J$NULA(J) ;[6002]Need to send a Null ACK?
$RETF ;[6002]No, indicate so
SETOM G$NEBF ;[6002]Indicate remote origin to $NUL
MOVE S1,J$RNOD(J) ;[6002]Pick up node where message originated
MOVEM S1,G$REMN ;[6002]Place where it is expected by $NUL
$NUL (J$RPID(J)) ;[6002]Send a Null ACK to NEBULA
SETZM J$NULA(J) ;[6002]Don't send any more Null ACKs
$RETT ;[6002]Indicate a Null ACK has been sent
SUBTTL SETREM - Set Up the Remote Origin Indicators From Stream
;[6002]SETREM determines if a remote operator has been involved in the
;[6002]processing of the current batch stream by means of answering a
;[6002]WTOR. If such is the case, then G$REMN and G$NEBF are set up
;[6002]appropriatly. This routine is called before sending a WTO so that
;[6002]ORION may forward the WTO to the node of the remote operator.
;[6002]
;[6002]Call is: J/Stream data base
;[6002]Returns true: A remote operator has been involved with this stream
;[6002]Returns false: A remote operator has not been involved with this stream
SETREM: MOVE S1,J$NEBF(J) ;[6002]Pick up the remote origin bit
MOVEM S1,G$NEBF ;[6002]Place where $Qxxxx expects it
SKIPN S1 ;[6002]Remote operator been involved?
$RETF ;[6002]No, indicate so
MOVE S1,J$RNOD(J) ;[6002]Pick up remote node name
MOVEM S1,G$REMN ;[6002]Place where $Qxxx expects it
$RETT ;[6002]Return
SUBTTL FNDREM - Set Up the Remote Origin Indicators From IPCF
;[6002]FNDREM is called during the processing of an IPCF message after it
;[6002]has been determined that the message originated from a remote
;[6002]operator. FNDREM determines the node of the remote operator and
;[6002]saves the node name in G$REMN.
;[6002]
;[6002]Call is: M/IPCF message address
;[6002]Returns true: S1/Remote node name
;[6002] G$REMN/Remote node name
;[6002]Returns false: Remote node name block not found
FNDREM: MOVEI S1,.NDENM ;[6002]Remote node name block
$CALL FNDBLK ;[6002]Check for remote node name block
$RETIF ;[6002]Remote node name block not found
MOVE S1,0(S1) ;[6002]Pick up the node name
MOVEM S1,G$REMN ;[6002]Save for later
$RETT ;[6002]Indicate success
SUBTTL TRSREM - Transfer Remote Data From IPCF to Stream Data Base
;[6002]TRSREM is called by those operator action commands (ABORT, CANCEL
;[6002]and REQUEUE) that, in addition to an ACK, will result in a WTO
;[6002]being sent to ORION at a later time. TRSREM preserves the remote
;[6002]origin information so that the WTO may be forwarded to the remote
;[6002]operator.
;[6002]
;[6002]Call is: J/Stream data base address
;[6002] M/The IPCF message address
;[6002]Returns: The data stream's remote origin indicators have been updated
;[6002]
;[6002]Note: it is assumed that G$REMN contains the remote node name.
TRSREM: SETOM J$NEBF(J) ;[6002]Indicate remote request
MOVE S1,G$REMN ;[6002]Pick up the remote node name
MOVEM S1,J$RNOD(J) ;[6002]Place in the stream data base
MOVE S1,.MSCOD(M) ;[6002]Pick up the remote PID
MOVEM S1,J$RPID(J) ;[6002]Place in the stream data base
SETZM J$NULA(J) ;[6002]Don't need to send a Null ACK
$RET ;[6002]Return
REMERR: $WTOJ (<Illegally formatted message from NEBULA detected>,<SPROUT detected an illegally formatted mesage>,,<$WTFLG(WT.SJI)>);[6002]
$RET ;[6002]Return
> ;END TOPS20 CONDITIONAL
SPOEND::END SPROUT