Trailing-Edge
-
PDP-10 Archives
-
BB-D868C-BM
-
language-sources/sprout.mac
There are 33 other files named sprout.mac in the archive. Click here to see a list.
TITLE SPROUT -- Spooling PRocessor for OUTput - Version 4
SUBTTL D.A. Lewine - L.S. Samberg/PJT 28-Mar-79
;
;
;
; COPYRIGHT (c) 1975,1976,1977,1978,1979 BY
; DIGITAL EQUIPMENT CORPORATION, MAYNARD, MA.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; AND COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE
; AND WITH THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS
; SOFTWARE OR ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR
; OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON. NO TITLE TO
; AND OWNERSHIP OF THE SOFTWARE IS HEREBY TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE
; WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT
; BY DIGITAL EQUIPMENT CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
; OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY
; DIGITAL.
SEARCH GLXMAC ;SEARCH GLXLIB SYMBOLS
PROLOGUE(SPROUT) ;DO STANDARD PROLOG
SEARCH QSRMAC ;GET QUASAR SYMBOLS
SEARCH ORNMAC ;GET OPERATOR SYMBOLS
;VERSION INFORMATION
SPOVER==4 ;MAJOR VERSION NUMBER
SPOMIN==0 ;MINOR VERSION NUMBER
SPOEDT==2437 ;EDIT LEVEL
SPOWHO==0 ;WHO LAST PATCHED
%SPO==<BYTE (3)SPOWHO(9)SPOVER(6)SPOMIN(18)SPOEDT>
;STORE VERSION NUMBER IN JOBVER
LOC 137
.JBVER:: EXP %SPO ;SPROUT VERSION
RELOC 0
SUBTTL TABLE OF CONTENTS
; TABLE OF CONTENTS FOR SPROUT
;
;
; SECTION PAGE
; 1. TABLE OF CONTENTS......................................... 2
; 2. Revision History.......................................... 3
; 3. Constants (Conditional and Unconditional)................ 4
; 4. MACROS.................................................... 5
; 5. Special Forms Handling Parameters......................... 6
; 6. Flag Definitions.......................................... 8
; 7. Job Parameter Area........................................ 9
; 8. Random Impure Storage..................................... 12
; 9. Resident JOB DaTABase..................................... 13
; 10. Non-zero daTABase......................................... 14
; 11. $TEXT Utilities and common Messages....................... 15
; 12. Program Initialization.................................... 16
; 13. Idle Loop................................................. 17
; 14. Deschedule Process........................................ 18
; 15. Do the Job................................................ 19
; 16. Process a File............................................ 20
; 17. End of Job................................................ 21
; 18. FILDIS Routine to KEEP/DELETE requested files............ 21
; 19. CHKQUE Routine to process IPCF messages.................. 22
; 20. CHKOBJ Routine to validate QUASAR/ORION/OPR MSG Object block 23
; 21. FNDOBJ Routine to establish STREAM context............... 24
; 22. GETBLK Routine to return next argument from an OPR/ORION message 25
; 23. NEXTJOB Message from QUASAR............................... 26
; 24. User CANCEL Request....................................... 27
; 25. CHKSTS Routine to send status update and checkpoint to Quasar 28
; 26. Request for Checkpoint.................................... 29
; 27. SETUP/SHUTDOWN Message.................................... 30
; 28. Response to setup message................................. 31
; 29. Operator CANCEL command................................... 32
; 30. Operator STOP command..................................... 33
; 31. Operator CONTINUE command................................. 33
; 32. Operator RESPONSE command................................. 33
; 33. Operator REQUEUE command.................................. 34
; 34. CLRMSG and SNDQSR routines................................ 35
; 35. Accounting routines....................................... 36
; 36. FORMS -- Setup Forms for a job......................... 38
; 37. Forms switch Subroutines.................................. 42
; 38. Plotter only switches..................................... 43
; 39. I/O Subroutines for SPFORM.INI............................ 44
; 40. INPOPN -- Routine to open the input file................ 46
; 41. INPBUF -- Read a buffer from the input file............. 47
; 42. INPBYT -- Read a byte from the input file............... 47
; 43. INPERR -- Handle an input failure....................... 47
; 44. INPFEF -- Force end-of-file on next input............... 47
; 45. INPREW -- Rewind the input file......................... 47
; 46. OUTGET -- OPEN the output device........................ 48
; 47. OUTBYT -- Deposit a byte in the output buffer........... 51
; 48. OUTOUT -- Routine to output a buffer.................... 52
; 49. DEVERR -- Handle Output Device Errors................... 53
; 50. Buffer routines and discriptions for TOPS20............... 54
; 51. Routine to Setup Inferior Process to do OUTPUT to device.. 55
; 52. Fork IO Code for TOPS20................................... 56
; 53. TOPS20 Output Code to Drive Inferrior Fork................ 57
; 54. OUTREL -- Release output device......................... 58
; 55. OUTWON -- Wait for on-line.............................. 59
; 56. OUTFLS Routine to flush output buffers.................... 60
; 57. Card-punch Service Routines............................... 61
; 58. Card File Header and Trailer Routines..................... 67
; 59. Card Job Banner and Trailer Routines...................... 68
; 60. Card Block Word and Letter Routines....................... 69
; 61. Plotter Service Routines.................................. 71
; 62. PLOTTER BANNER HEADER AND TRAILER ROUTINES................ 73
; 63. Routine to Plot line Segment.............................. 76
; 64. Plotter Rotation and XY20 Translation table............... 78
; 65. PLTBYT Routine to plot a single character................ 79
; 66. Plotter Character Table and Segement Codes................ 82
; 67. Paper-tape punch Service Routines......................... 86
; 68. Tape Trailer and Blank Fold Routines...................... 92
; 69. Character Bit Array for 5 X 7 Character Matrix............ 94
; 70. Common Utilities.......................................... 96
; 71. Interrupt Module.......................................... 98
; 72. IPCF and DEVICE Interrupt service for TOPS10.............. 102
; 73. IPCF and DEVICE interrupt service for TOPS20.............. 103
SUBTTL Revision History
;2000 First GALAXY-10 Field-Test release, June, 1975.
;2100 Make this version 2, August, 1976.
;;First field-test release of GALAXY release 2, Jan 1977
;2400 MAKE THIS VERSION 4, APRIL 1977.
; (NOTE: RELEASE 3 OF GALAXY WAS TOPS20 ONLY AND DID NOT INCLUDE SPROUT)
; INSERT CHANGES FOR NEW FP/FD.
;2401 START CONVERTING TO USE GLXLIB INSTEAD OF CSP??? AND SBS???.
;2402 FIX UP AC CONVENTIONS TO BE COMPATIBLE WITH GLXLIB.
;2403 MAKE SPROUT INTO A SINGLE SEGMENT AND DO A CODE CLEANUP.
;2404 START MERGING IN GLXFIL USAGE FOR THE INPUT FILE.
;2405 MORE OF 2404 AND START REPLACING LUUOS WITH $TEXTS.
;2406 MAKE MORE USE OF $TEXT.
;2407 MANY MINOR BUG FIXES AND CHANGES.
;2410 SOME MAJOR CODE CLEANUP.
;2411 START MAJOR RE-WORK OF SPROUT TO MAKE MORE USE OF GLXLIB AND TO
; TALK WITH THE NEW OPERATOR INTERFACE.
;2412 CHANGE IMAGE MODE ON THE CDP TO IGNORE EACH 81ST BYTE READ
; FROM DISK SO THAT IT IS COMPATIBLE WITH SPRINT AND PIP.
;2413 DONT ENFORCE LIMITS ON PTP AND PLT SINCE THE LIMITS ARE DIRECTLY
; DERIVABLE FROM THE FILE-SIZE.
;2414 DO SOME CODE CLEANUP.
;2415 Code Cleanup and add plotter and card letter routines
;2416 Added Forms processing for SPFORM.INI File
;2417 Added MSGFLG and Changed interrupt and Scheduling code
; to set/check msgflg for IPCF messages
;2420 Added code to check length of message for DEP6BP and DEPBP
;2421 Removed msgflg (twas a bad idea)
;2422 Fixed OUTOUT and DEVERR for TOPS10
;2423 Fixed ACTION operator message processing
;2424 Fixed Offline device interrupt code
;2425 Updated to new library and message formats
;2426 Added preliminary accounting parameters
; Added two pass scheduling algorithm to allow mulitple
; devices to operate in parallel on TOPS20
;2427 Fixed bug in INPOPN regarding access checks
; Moved impure interrupt stuff to impure storage
; Added call to I%HOST to get local node name
;2430 Changed all message processing to use ac M
; Changed scheduling loop to WAIT instead of SLEEP
; when no jobs are scheduable
;2431 Added correct mulitple stream runtime accounting code
;2432 Put IB.PRG back into IB
;2433 add Mount Bypass
;2434 Add WTOR kill code (AWC)
;2435 Fix a $TEXT bug - IQN Stopcode (AWC)
;2436 Put in Null routines for TOPS10 accounting
;2437 Fix Plotter Banner Header and Trailer code
SUBTTL Constants (Conditional and Unconditional)
;2431 Moved FILDIS to QRELEAS
; Added Invalid account check to NXTJOB
;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
;RANDOM CONSTANTS
ND PDSIZE,100 ;SIZE OF PUSHDOWN LIST
ND CPC,^D80 ;CHARACTERS PER CARD
ND CHPFLD,^D90 ;CHARACTERS PER FOLD OF PTP
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,^D10 ;LENGTH OF JOB ERROR TEXT BUFFER
ND NBFRS,2 ;NUMBER OF BUFFERS TO CREATE
ND NJBPGS,3 ;NUMBER OF JOB PAGES TO CREATE
;*** FORK CODE CANNOT BE ON ***
ND FTFKIO,0 ;-1 TO INCLUDE INFERIOR IO FORK
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
CONT. (Constants) ;FORCE NEW LISTING PAGE
;PLOTTER MOTION CHARACTERS
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 XYL,10 ;-X MOVE LEFT
XP XYR,4 ;+X MOVE RIGHT
XP XYU,2 ;+Y MOVE UP
XP XYD,1 ;-Y MOVE DOWN
XP XYUL,12 ;-X+Y MOVE UP+LEFT
XP XYDL,11 ;-X-Y MOVE DOWN+LEFT
XP XYUR,06 ;+X+Y MOVE UP+RIGHT
XP XYDR,05 ;+X-Y MOVE DOWN+RIGHT
XP MARSTP,^D20 ;STEPS IN MARGIN
XP CHRSIZ,^D20 ;MAXIUM CHARACTER SIZE
SUBTTL MACROS
;MACRO TO GENERATE TBLUK TABLES
DEFINE TB (RESPONSE,CODE) <
[ASCIZ/RESPONSE/],,CODE>
DEFINE IOFORK <IFN FTFKIO,> ;END DEFINE IOFORK
DEFINE NOFORK <IFE FTFKIO,>
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
; ORIGIN:XX:YY POINT TO LOCATE PEN IN FORM
;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,2
FF TRAILER,2
FF HEADER,2
FF NOTE,0
FF SPU,1
FF SIZE,0
FF MINIMUM,0
FF MAXIMUM,0
FF ORIGIN,0
FF GUIDE,0
>
;GENERATE TABLE OF SWITCH NAMES
DEFINE FF(A,B),<
XLIST
<<SIXBIT /A/>&777777B17>+S$'A
LIST
SALL
>
FFNAMS: SWITCHES
;GENERATE TABLE OF DEFAULT PARAMETERS
DEFINE FF(X,Y),<
XLIST
D$'X: EXP Y
LIST
SALL
>
FFDEFS: SWITCHES
F$NSW==.-FFDEFS
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
TOPS20 <
IOFORK <
LP J$STRM,1 ;STREAM NUMBER
LP J$IFRK,1 ;FORK HANDLE
LP J$IHDR,2 ;CURRENT BUFFER HEADER
LP J$IBHB,<4*NBFRS> ;4 WORDS PER BUFFER HEADER
LP J$ICOD,200 ;FORK IO CODE LIVES HERE
> ;END IOFORK CONDITIONAL
> ;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$FMSP,1,Z ;FORMS WTO/WTOR PAGE ADDRESS
LP J$FPLT,1 ;FORMS TYPE FOR PLOTTER
;STORAGE FOR CURRENT FORMS SWITCHS
DEFINE FF(X,Y) <LP J$F'X,1>
LP J$FCUR,0 ;ORIGIN OF CURRENT SWITCH VALUES
SWITCHES ;ONE ENTRY PER SWITCH
;STORAGE FOR PREVIOUS FORMS SWITCHES
DEFINE FF(X,Y) <LP J$P'X,1>
LP J$FPRM,0 ;ORIGIN OF PREVIOUS SWITCHES
SWITCHES ;ONE LOCATION 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$XPOS,1 ;CURRENT PLOTTER X COORDINATE
LP J$XLIM,1 ;HIGHEST XSTEP SEEN THIS PLOT
LP J$XMIN,1 ;X MINIMUM POINT IN FORM
LP J$XORG,1 ;X ORIGIN IN FORM
LP J$XMAX,1 ;X MAXIMUM POINT IN FORM
LP J$XSIZ,1 ;NUMBER OF X STEPS 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$YORG,1 ;Y ORIGIN IN FORM
LP J$YMAX,1 ;MAXIMUM ALLOWABLE Y COORDINATE
LP J$YSIZ,1 ;NUMBER OF Y STEPS IN FORM
LP J$ORGF,1 ;-1 IF ORIGIN NEED TO BE RESET
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$GSIZ,1 ;GUIDE 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
;ACCOUNTING BLOCK
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$$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
Z==0
REPEAT <^D512+^D35>/^D36,<
XLIST
ZTAB(\Z)
Z==Z+1
LIST
> ;END REPEAT
SUBTTL Random Impure Storage
PDL: BLOCK PDSIZE ;PUSHDOWN LIST
LOWBEG: ;BEGINNING OF AREA TO CLEAR ON STARTUP
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
FOB: BLOCK FOB.SZ ;FILE OPEN BLOCK
JIFSEC: BLOCK 1 ;JIFFIES/SEC
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
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 ;-1 IF CHECKPOINT 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: EXP FFD$LN ;FILE DISCRIPTOR LENGTH
ASCIZ /SYS:SPFORM.INI/
FFD$LN==.-FRMFD ;COMPUTE FD LENGTH
> ;END TOPS20 CONDITIONAL
SUBTTL $TEXT Utilities and common Messages
JOBBAN: ITEXT <Start ^R/.EQJBB(J)/ ^H/[-1]/>
JOBTRA: ITEXT <^T/J$XERR(J)/End ^R/.EQJBB(J)/ ^C/[-1]/>
USRNAM: ITEXT <^T/.EQOWN(J)/>
;HERE ARE SOME TEXT-OUTPUT-ROUTINES
DEP6BP: SUBI S1,"A"-'A' ;CONVERT TO 6BIT
DEPBP: SOSL TEXTBC ;CHECK BYTE COUNT
IBP TEXTBP ;OK -- INCR POINTER
DPB S1,TEXTBP ;STORE BYTE
$RETT ;AND RETURN
SUBTTL Program Initialization
SPROUT: 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
> ;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
$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
SKIPE JOBCHK(P1) ;CHECKPOINT REQUESTED?
$CALL CHKSTS ;YES -- DO IT
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
MOVSI 17,J$RACS(J) ;SETUP STREAM CONTEXT
BLT 17,17 ;RESTORE STREAM 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: $CALL CHKPNT ;TAKE A CHECKPOINT
$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
TXNE S,ABORT!SKPFIL!RQB ;ABORTED OR SKIPPED OR REQUEUED?
JRST FILE.2 ;YES, CONTINUE ON
MOVE S1,J$LSER(J) ;GET ADDRESS OF DEVICE DISPATCH
PUSHJ P,DTAIL(S1) ;AND DO A FILE TRAILER
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
$RET ;AND RETURN
SUBTTL End of Job
ENDJOB: TXO S,GOODBY ;FLAG EOJ SEQUENCE
MOVE S1,J$LSER(J) ;GET DEVICE DISPATCH TABLE
PUSHJ P,DEOJ(S1) ;DO A TRAILER IF NECESSARY
HRRZ S1,STREAM ;POINT TO CURRENT STREAM
$WTOJ (End,^R/.EQJBB(J)/,@JOBOBA(S1))
$CALL QRELEASE ;RELEASE THE JOB
$CALL ACTEND ;DO FINAL ACCOUNTING
HRRZ S1,STREAM ;GET STREAM NUMBER
SETZM JOBACT(S1) ;NOT BUSY
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.
TXNE T2,FP.SPL+FP.DEL ;SPOOL FILE or /DELETE ???
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
$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 REQCHK,.QORCK ;REQUEST-FOR-CHECKPOINT
XWD NXTJOB,.QONEX ;NEXTJOB
XWD SETUP,.QOSUP ;SETUP
XWD OACCAN,.OMCAN ;CANCEL
XWD OACREQ,.OMREQ ;REQUEUE THE CURRENT JOB
XWD OACSTP,.OMPAU ;STOP FOR A WHILE
XWD OACCON,.OMCON ;CONTINUE FROM STOP
XWD OACRSP,.OMRSP ;RESPONSE TO WTOR
NMSGT==.-MSGTBL
SUBTTL CHKOBJ Routine to validate QUASAR/ORION/OPR MSG Object block
;CALL: S1/ MESSAGE TYPE
; M/ MESSAGE ADDRESS
;
;RET: STREAM/STREAM NUMBER
; J/DATA BASE ADDRESS
; S/STATUS BITS
CHKOBJ: $SAVE <T1,T2,T3,T4> ;SAVE THE TEMPORARIES
MOVSI T1,-NMSGO ;GET REPEAT COUNT
CHKO.1: HLRZ S2,MSGOBJ(T1) ;GET A MESSAGE TYPE
CAMN S1,S2 ;IS THIS IT?
JRST CHKO.3 ;YES..PROCESS IT
AOBJN T1,CHKO.1 ;NO..TRY THE NEXT
CAIGE S1,.OMOFF ;OPR/ORION MESSAGE?
$RETF ;NO..WE LOOSE
CHKO.2: PUSHJ P,GETBLK ;GET A MESSAGE BLOCK
JUMPF .RETF ;NO MORE,,THATS AN ERROR
CAIE T1,.OROBJ ;IS THIS THE OBJECT BLOCK ???
JRST CHKO.2 ;NO,,GET THE NEXT MSG BLOCK
MOVE S1,T3 ;GET THE BLOCK DATA ADDRESS IN S1.
JRST CHKO.4 ;GO FIND THE OBJECT BLOCK
CHKO.3: HRRZ S1,MSGOBJ(T1) ;GET THE MESSAGE OFFSET
JUMPE S1,.RETT ;RETURN IF NOT MAPPABLE
ADDI S1,0(M) ;ADD MESSAGE ADDRESS
JRST CHKO.4 ;MEET AT THE PASS.
CHKO.4: PUSHJ P,FNDOBJ ;GO FIND THE OBJECT BLOCK.
JUMPF .RETF ;NOT THERE,,THATS AN ERROR.
$RETT ;RETURN.
;TABLE FORMAT FOR NON STANDARD MESSAGES
; Message type,,Message offset to object block (or 0 if none)
MSGOBJ: .QOABO,,ABO.TY ;QUASAR ABORT MESSAGE
.QORCK,,RCK.TY ;QUASAR REQUEST CHECKPOINT
.QONEX,,.EQROB ;QUASAR NEXTJOB MESSAGE
.QOSUP,,0 ;QUASAR SETUP/SHUTDOWN MESSAGE
.OMRSP,,0 ;OPR/ORION RESPONSE?
NMSGO==.-MSGOBJ ;NUMBER OF TYPES
SUBTTL FNDOBJ Routine to establish STREAM context
;ACCEPTS S1/ Address of object block
;RETURNS TRUE J/ Address of context data
; S/ Context status bits
; STREAM/ Context stream
; FALSE Object not found
FNDOBJ: MOVE T1,.ROBTY(S1) ;GET OBJECT TYPE
MOVE T2,.ROBAT(S1) ;GET UNIT NUMBER
MOVE T3,.ROBND(S1) ;AND NODE NUMBER
SETZ T4, ;CLEAR AN INDEX REGISTER
FNDO.1: MOVE S2,T4 ;GET THE INDEX
IMULI S2,3 ;MULTIPLY BY OBJECT BLCK SIZE
CAMN T1,JOBOBJ+OBJ.TY(S2) ;COMPARE
CAME T2,JOBOBJ+OBJ.UN(S2) ;COMPARE
JRST FNDO.2 ;NOPE
CAMN T3,JOBOBJ+OBJ.ND(S2) ;COMPARE
JRST FNDO.3 ;WIN, SETUP THE CONTEXT
FNDO.2: ADDI T4,1 ;INCREMENT
CAIL T4,NSTRMS ;THE END OF THE LINE?
$RETF ;LOOSE
JRST FNDO.1 ;OK, LOOP
FNDO.3: HRROM T4,STREAM ;SAVE STREAM NUMBER
MOVE J,JOBPAG(T4) ;GET ADDRESS OF DATA
MOVE S,J$RACS+S(J) ;GET STREAMS 'S'
CAME J,ACTPAG ;SAME ACCOUNTING PAGE?
$CALL ACTRNT ;NO..DO RUNTIME ACCOUNTING
MOVEM J,ACTPAG ;SAVE ACCOUNTING PAGE
$RETT ;AND RETURN
SUBTTL GETBLK Routine to return next argument from an OPR/ORION message
;CALL: M/ MESSAGE ADDRESS
;
;RET: T1/ BLOCK TYPE
; T2/ BLOCK LENGTH
; T3/ BLOCK DATA ADDRESS
GETBLK: SOSGE .OARGC(M) ;SUBTRACT 1 FROM THE BLOCK COUNT
$RETF ;NO MORE,,RETURN
SKIPN S1,BLKADR ;GET THE PREVIOUS BLOCK ADDRESS
MOVEI S1,.OHDRS+ARG.HD(M) ;NONE THERE,,GET FIRST BLOCK ADDRESS
LOAD T1,ARG.HD(S1),AR.TYP ;GET THE BLOCK TYPE
LOAD T2,ARG.HD(S1),AR.LEN ;GET THE BLOCK LENGTH
MOVEI T3,ARG.DA(S1) ;GET THE BLOCK DATA ADDRESS
ADD S1,T2 ;POINT TO THE NEXT MESSAGE BLOCK
MOVEM S1,BLKADR ;SAVE IT FOR THE NEXT CALL
$RETT ;RETURN TO THE CALLER
SUBTTL NEXTJOB Message from QUASAR
NXTJOB: HRR S1,J ;GET 0,,DEST
HRR S2,M ;GET ADDRESS OF MESSAGE
HRL S1,S2 ;GET SOURCE,,DEST
LOAD S2,.MSTYP(S2),MS.CNT ;GET LENGTH OF MESSAGE
ADDI S2,-1(J) ;GET ADR OF END OF BLT
BLT S1,(S2) ;BLT THE DATA
HRRZ S1,STREAM ;GET STREAM NUMBER
SETOM JOBACT(S1) ;MAKE THE STREAM ACTIVE
SETZM JOBSTW(S1) ; AND NOT BLOCKED
MOVEI S1,J$RPDL-1(J) ;POINT TO CONTEXT PDL
HRLI S1,-PDSIZE ;AND THE LENGTH
PUSH S1,[EXP DOJOB] ;PUSH THE FIRST ADR ON THE STACK
MOVEM S1,J$RACS+P(J) ;AND STORE THE PDL
SETZB S,J$RACS+S(J) ;CLEAR FLAGS AC
MOVEI S1,J$$BEG(J) ;PREPARE TO ZERO SELECTED WORDS JOB AREA
MOVSI S2,-^D15 ;AOBJN POINTER TO BIT TABLE
NXTJ.2: MOVEI T1,^D36 ;BIT COUNTER FOR THIS WORD
MOVE T2,ZTABLE(S2) ;GET A WORD FROM BIT TABLE
NXTJ.3: JUMPE T2,NXTJ.4 ;DONE IF REST OF WORD IS ZERO
JFFO T2,.+1 ;FIND THE FIRST 1 BIT
ADD S1,T3 ;MOVE UP TO THE CORRESPONDING WORD
SETZM 0(S1) ;AND ZERO IT
SUB T1,T3 ;REDUCE BITS LEFT IN THIS WORD
LSH T2,0(T3) ;SHIFT OFFENDING BIT TO BIT 0
TLZ T2,(1B0) ;AND GET RID OF IT
JRST NXTJ.3 ;AND LOOP
NXTJ.4: ADD S1,T1 ;ACCOUNT FOR THE REST OF THE WORD
AOBJN S2,NXTJ.2 ;AND LOOP
LOAD S1,.EQSPC(J),EQ.NUM ;GET NUMBER OF FILES
MOVEM S1,J$RFLN(J) ;STORE IT
GETLIM T1,.EQLIM(J),OLIM ;GET PAGE LIMIT
MOVEM T1,J$RLIM(J) ;SAVE IT
$CALL I%NOW ;GET TIME OF DAY
MOVEM S1,J$RTIM(J) ;SAVE IT AWAY
HRRZ S1,STREAM ;POINT TO CURRENT STREAM
$WTOJ (Begin,^R/.EQJBB(J)/,@JOBOBA(S1))
LOAD S1,.EQSEQ(J),EQ.IAS ;GET INVALID ACCOUNT BIT
STORE S1,S,ABORT ;ABORT IF SET
$CALL ACTBEG ;START ACCOUNTING
$RETT ;AND RETURN
SUBTTL User CANCEL Request
KILL: TXOE S,GOODBY!ABORT ;SET SOME BITS
$RETT ;IF WE LEAVING, IGNORE IT ANYWAY
HRRZ S1,STREAM ;GET THE STREAM NUMBER
MOVX S2,PSF%OR ;GET OPERATOR RESPONSE BIT
TDNE S2,JOBSTW(S1) ;ARE WE WAITING FOR OPR RESPONSE ???
$KWTOR (JOBWAC(S1)) ;YES,,KILL IT !!!
ANDCAM S2,JOBSTW(S1) ;AND CLEAR THE WAIT BIT
$CALL INPFEF ;SET END OF FILE ALSO
HRRZ S1,STREAM ;POINT TO STREAM
$WTOJ (Canceled by user,<^R/.EQJBB(J)/>,@JOBOBA(S1))
MOVEI S1,[ASCIZ /CBU/] ;GET THE ERROR CODE
MOVEI S2,[ITEXT(^U/ABO.ID(M)/)] ;USER'S ID
$CALL PUTERR ;AND DO THE MESSAGE
$RETT ;AND RETURN
SUBTTL CHKSTS Routine to send status update and checkpoint to Quasar
;SENDS QUASAR STATUS UPDATE MESSAGE FOLLOWED BY A CHECKPOINT
CHKSTS: MOVX S1,STU.SZ ;GET STATUS UPDATE SIZE
MOVX S2,.QOSTU ; AND TYPE
$CALL CLRMSG ;INIT THE MESSAGE AND T1
HRRZ S1,STREAM ;GET THE STREAM NUMBER
MOVE S2,JOBSTW(S1) ;GET THE JOBS STATUS WORD
MOVX T2,%RESET ;DEFAULT TO RESET
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
PJRST CHKPNT ;ALSO SEND A CHECK POINT
SUBTTL Request for Checkpoint
REQCHK: TXNE S,GOODBY ;ARE WE ON THE WAY OUT?
$RETT ;YES, IGNORE THE MESSAGE
CHKPNT: MOVX S1,CHE.SZ ;GET SIZE OF CHECKPOINT MESSAGE
MOVX S2,.QOCHE ;AND CHECKPOINT TYPE
$CALL 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
HRRZ S1,STREAM ;GET THE STREAM NUMBER
SETZM JOBCHK(S1) ;CLEAR THE REQUEST
CHKP.1: $TEXT(DEPBP,<Started at ^C/J$RTIM(J)/^0>)
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 ;AND SEND IT
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> ;PRESERVE AN AC
$CALL INPFEF ;FORCE EOF
TXO S,ABORT ;LIGHT THE ABORT FLAG
MOVEI P1,[ASCIZ/No reason given/] ;ASSUME NO REASON
$CALL SETTBF ;POINT AT 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
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
;YES...
MOVE S1,0(T3) ;LOAD THE CANCEL TYPE.
CAIE S1,.CNPRG ;IS IT /PURGE ???
JRST OACC.1 ;NO,,PROCESS THE NEXT MSG BLK
HRRZ S1,STREAM ;YES..GET THE STREAM NUMBER
$ACK (Purged,<^R/.EQJBB(J)/>,@JOBOBA(S1),.MSCOD(M))
MOVEI P1,[ASCIZ/Purged by operator/]
$TEXT (DEPBP,^T/0(P1)/) ;STORE THE REASON
$CALL ACTEND ;DO FINAL ACCOUNTING
$CALL QRELEASE ;RELEASE THE STREAM
SETZM JOBACT(S1) ;INDICATE NOT ACTIVE
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.
PUSHJ P,OUTFLS ;FLUSH THE OUTPUT BUFFERS
CAIE S1,%RSUOK ;DO WE STILL HAVE THE DEVICE?
PJRST SHUTUP ;NO..KILL THE STREAM
$RETT ;RETURN
OACC.2: HRRZ S1,STREAM ;GET THE STREAM NUMBER
$ACK (Canceled,<^R/.EQJBB(J)/>,@JOBOBA(S1),.MSCOD(M)) ;TEl OPR
$TEXT (DEPBP,<^T/0(P1)/>) ;STORE THE REASON
$RETT
SUBTTL Operator STOP command
OACSTP: MOVX S2,PSF%ST ;LOAD THE STOP BIT
HRRZ S1,STREAM ;GET THE STREAM NUMBER
IORM S2,JOBSTW(S1) ;SET IT
$ACK (Stopped,,@JOBOBA(S1),.MSCOD(M)) ;TELL OPR
SETOM JOBCHK(S1) ;REQUEST CHECKPOINT
$RETT ;AND RETURN
SUBTTL Operator CONTINUE command
OACCON: MOVX S2,PSF%ST ;LOAD THE STOP FLAG
HRRZ S1,STREAM ;GET THE STREAM NUMBER
ANDCAM S2,JOBSTW(S1) ;CLEAR IT
$ACK (Continued,,@JOBOBA(S1),.MSCOD(M)) ;TELL OPR
SETOM JOBCHK(S1) ;REQUEST CHECKPOINT
$RETT ;AND RETURN
SUBTTL Operator RESPONSE command
OACRSP: MOVE S2,.MSCOD(M) ;GET WTOR ACK CODE.
MOVSI S1,-NSTRMS ;CREATE AOBJN AC.
RESP.1: CAME S2,JOBWAC(S1) ;COMPARE ACK CODES..
JRST [AOBJN S1,RESP.1 ;NOT EQUAL,,CHECK NEXT STREAM.
$RETT ] ;NOT THERE,,FLUSH THE MSG.
MOVX S2,PSF%OR ;GET "OPERATOR-RESPONSE" WAIT BIT
ANDCAM S2,JOBSTW(S1) ;AND CLEAR IT
MOVE J,JOBPAG(S1) ;GET THE STREAM DB ADDRESS.
$CALL SETTBF ;POINT TO TEXT BUFFER
MOVEI S1,.OHDRS+ARG.DA(M) ;POINT TO THE OPERATOR RESPONSE.
$TEXT (DEPBP,<^T/0(S1)/^0>) ;MOVE RESPONSE TO TEXT BUFFER
$RETT ;AND RETURN
SUBTTL Operator REQUEUE command
OACREQ: TXNE S,GOODBY ;IS IT TOO LATE FOR THIS ???
$RETT ;YES..JUST RETURN
PUSHJ P,INPFEF ;FORCE AN INPUT EOF
TXO S,RQB!ABORT ;SET ABORT AND REQUEUED
MOVE S1,STREAM ;GET THE STREAM NUMBER
$ACK (Requeued,<^R/.EQJBB(J)/>,@JOBOBA(S1),.MSCOD(M)) ;TELL OPR
$CALL SETTBF ;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
OACR.1: PUSHJ P,GETBLK ;GET A MESSAGE BLOCK
JUMPF .RETT ;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 ???
$TEXT(DEPBP,<Reason:^T/0(T3)/>)
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.3 ;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.3 ;AND CONTINUE ON
SETZM J$RNCP(J) ;CLEAR CURRENT COPY NUMBER
CAXN S1,.RQBFL ;FROM BEGINING OF FILE?
MOVEI S2,[ASCIZ /Job will retart at current file/]
JUMPN S2,OACR.3 ;AND CONTINUE ON
SETZM J$RNFP(J) ;CLEAR FILE COUNT
MOVEI S2,[ASCIZ /Job will restart at beginning/]
OACR.3: $TEXT(DEPBP,<^T/0(S2)/>) ;STORE REQUE
JRST OACR.1 ;GO PROCESS THE NEXT MSG BLOCK.
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)
SUBTTL Accounting routines
TOPS10 <
ACTBEG: $RETT ;JUST RETURN
ACTEND: $RETT ;HERE ALSO
ACTRNT: $RETT
> ;END TOPS10 CONDITIONAL
TOPS20 <
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
$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
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
$RETT ;ELSE RETURN
ACTE.1: MOVE S1,STREAM ;GET THIS STREAM NUMBER
$WTO (System Accounting Failure,<^R/.EQJBB(J)/>,@JOBOBA(S1))
$RETT ;RETURN
;ACCOUNT PARAMETER BLOCK DEFINED ON THE NEXT PAGE
ACTRNT: SKIPN ACTFLG ;DOING ACCOUNTING?
$RETT ;NO..JUST RETURN
MOVX S1,.FHSLF ;GET MY FORK
RUNTM ; RUNTIME
ADDM S1,ACTRNN ;STORE ACCUMULATED TIME
MOVNS S1 ;NEGATE ACTUAL RUNTIME
EXCH S1,ACTRNN ;INIT FOR NEXT PASS
SKIPE S2,ACTPAG ;GET LAST PROCESSES PAGE ADDRESS
ADDM S1,J$ARTM(S2) ;ACCUMULATE TOTAL
$RETT ;RETURN
SEARCH ACTSYM ;SEARCH THE ACCOUNTING UNV
ACTLST: USENT. (.UTOUT,1,1)
USJNO. (-1) ;JOB NUMBER
USTAD. (-1) ;CURRENT DATE/TIME
USTRM. (-1) ;TERMINAL DESIGNATOR
USLNO. (-1) ;TTY LINE NUMBER
USPNM. (<SIXBIT/SPROUT/>,US%IMM) ;PROGRAM NAME
USPVR. (%SPO,US%IMM) ;PROGRAM VERSION
USAMV. (-1) ;ACCOUNTING MODULE VERSION
USNOD. (-1) ;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$XTBF(J)>) ;EXTRA TEXT
USPRI. (J$APRI(J)) ;JOB PRIORITY
USNM2. (<POINT 7,.EQOWN(J)>) ;USER NAME
0 ;END OF LIST
> ;END TOPS20 CONDITIONAL
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,<SPROUT: Please load forms type '^W/J$FORM(J)/'>)
FORM.1: HRLI S1,J$FCUR(J) ;MOVE CURRENT SWITCH VALUES
HRRI S1,J$FPRM(J) ;TO PREVIOUS SWITCH VALUES
BLT S1,J$FPRM+F$NSW-1(J) ;DO ALL SWITCHES
HRLI S1,FFDEFS ;MOVE DEFAULT SWITCH VALUES
HRRI S1,J$FCUR(J) ;TO CURRENT SWITCH VALUES
BLT S1,J$FCUR+F$NSW-1(J) ;DO ALL SWITCHES
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,<Respond 'CONTINUE' when ready.^0>)
HRRZ S1,STREAM ;GET STREAM NUMBER
$WTOR (,<^T/J$XTBF(J)/>,@JOBOBA(S1),JOBWAC(S1)) ;SEND THE WTOR.
$DSCHD (PSF%OR) ;WAIT FOR OPERATOR RESPONSE.
$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.1 ;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.
$WTOJ (SPFORM.INI Error,<bad format>,@JOBOBA(S1)) ;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.
$WTOJ (SPFORM.INI Error,<Unrecognized SWITCH ^W/T1/ found.>,@JOBOBA(S1))
JRST FRMSWI ;AND LOOP
FRMS.4: HRRZ T3,FFNAMS(T2) ;GET DISPATCH ADDRESS
PUSHJ P,0(T3) ;GO!!
JUMPF FRMERR ;REPORT FAILURE AND GIVE UP
JRST FRMSWI ;AND LOOP
FRMS.5: SKIPN J$FPLT(J) ;SPECIAL PLOTTER SWITCHES
JRST FRMIEX ;NO -- FINISH UP
MOVE T1,J$FSPU(J) ;GET MULTIPLYING FACTOR
IMULM T1,J$FBANN(J) ;MULTIPLY ALL BY FACTOR
IMULM T1,J$FHEAD(J)
IMULM T1,J$FTRAI(J)
IMULM T1,J$FSIZE(J)
IMULM T1,J$FMINI(J)
IMULM T1,J$FMAXI(J)
IMULM T1,J$FORIG(J)
IMULM T1,J$FGUID(J)
MOVE T1,J$FMINI(J) ;GET MINIMUM X Y POINTS
HLRZ T2,J$XMIN(J) ;SAVE MINUMUM X POINT
HRRZ T3,J$YMIN(J) ;SAVE MINIMUM Y POINT
ADD T2,J$FBANN(J) ;XMIN IS RELATIVE TO BANNER
ADD T2,J$FHEAD(J) ; AND HEADER
MOVEM T2,J$XMIN(J) ;SAVE MINIMUM X POINT
MOVEM T3,J$YMIN(J) ;SAVE MAXIMUM Y POINT
MOVE T1,J$FMAXI(J) ;GET MAXIMUM X Y POINTS
HLRZM T1,J$XMAX(J)
ADDM T2,J$XMAX(J) ;XMAX IS RELATIVE TO XMIN
HRRZM T1,J$YMAX(J)
ADDM T3,J$YMAX(J) ;YMAX IS RELATIVE TO YMIN
ADDM T3,J$YMAX(J)
MOVE T1,J$FORIG(J)
HLRZM T1,J$XORG(J)
ADDM T2,J$XORG(J) ;XORG IS RELATIVE TO XMIN
HRRZM T1,J$YORG(J)
ADDM T3,J$YORG(J) ;YORG IS RELATIVE TO YMIN
MOVE T1,J$FSIZE(J) ;GET ABSOLUTE FORMS SIZE
HLRZM T1,J$XSIZ(J) ;SAVE MAXIMUM X SIZE
HRRZM T1,J$YSIZ(J) ;SAVE MAXIMUM Y SIZE
JRST FRMIEX ;FINISH UP
SUBTTL Forms switch Subroutines
S$BANN: $CALL FH$DEC ;GET DECIMAL ARGUMENT
MOVEM T1,J$FBAN(J) ;STORE IT
POPJ P, ;AND RETURN
S$TRAI: $CALL FH$DEC ;GET DECIMAL ARGUMENT
MOVEM T1,J$FTRA(J) ;STORE IT
POPJ P, ;AND RETURN
S$HEAD: $CALL FH$DEC ;GET A DECIMAL ARGUMENT
MOVEM T1,J$FHEA(J) ;STORE IT
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,<>) ;ADD A CRLF
$RETT ;RETURN.
SUBTTL Plotter only switches
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$SIZE: SKIPN J$FPLT(J) ;IS DEVICE A PLOTTER?
$RETF ;NO -- INVALID SWITCH
$CALL FH$DEC ;GET DECIMAL INTEGER
HRLZM T1,J$FSIZE(J) ;STORE X SIZE
CAIE C,":" ;IS Y ARGUMENT SPECIFIED?
$RETT ;NO -- RETURN
$CALL FH$DEC ;GET DECIMAL INTEGER
HRRM T1,J$FSIZE(J) ;STORE Y SIZE
$RETT ;AND RETURN
S$MINI: SKIPN J$FPLT(J) ;IS DEVICE A PLOTTER?
$RETF ;NO -- INVALID SWITCH
$CALL FH$DEC ;GET DECIMAL INTEGER
HRLZM T1,J$FMINI(J) ;STORE X MINI
CAIE C,":" ;IS Y ARGUMENT SPECIFIED?
$RETT ;NO -- RETURN
$CALL FH$DEC ;GET DECIMAL INTEGER
HRRM T1,J$FMINI(J) ;STORE Y MINI
$RETT ;AND RETURN
S$MAXI: SKIPN J$FPLT(J) ;IS DEVICE A PLOTTER?
$RETF ;NO -- INVALID SWITCH
$CALL FH$DEC ;GET DECIMAL INTEGER
HRLZM T1,J$FMAXI(J) ;STORE X MAXI
CAIE C,":" ;IS Y ARGUMENT SPECIFIED?
$RETT ;NO -- RETURN
$CALL FH$DEC ;GET DECIMAL INTEGER
HRRM T1,J$FMAXI(J) ;STORE Y MAXI
$RETT ;AND RETURN
S$ORIG: SKIPN J$FPLT(J) ;IS DEVICE A PLOTTER?
$RETF ;NO -- INVALID SWITCH
$CALL FH$DEC ;GET DECIMAL INTEGER
HRLZM T1,J$FORIG(J) ;STORE X ORIG
CAIE C,":" ;IS Y ARGUMENT SPECIFIED?
$RETT ;NO -- RETURN
$CALL FH$DEC ;GET DECIMAL INTEGER
HRRM T1,J$FORIG(J) ;STORE Y ORIG
$RETT ;AND RETURN
S$GUID: SKIPN J$FPLT(J) ;IS DEVICE A PLOTTER?
$RETF ;NO..INVALID SWITCH
SETZM J$GSIZ(J) ;CLEAR GUIDE SIZE
$CALL FH$DEC ;GET DECIMAL INTERGER
HRLZM T1,J$FGUID(J) ;SAVE X OFFSET
CAIE C,":" ;IS Y ARGUMENT SPECIFIED?
$RETT ;NO -- RETURN
$CALL FH$DEC ;GET DECIMAL NUMBER
HRRM T1,J$FGUID(J) ;SAVE THE Y OFFSET
CAIE C,":" ;GUIDE SIZE SPECIFIED
$RETT
$CALL FH$DEC ;YES..GET A NUMBER
MOVEM T1,J$GSIZ(J) ;SAVE SIZE OF THE "+"
$RETT
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: CLEAR 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: CLEAR 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 ; ...
HRROI S1,.EQOWN(J) ;GET THE OWNERS NAME
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.2 ;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
$RETT ;AND RETURN
INPO.2: MOVEI S1,[ASCIZ /CAF/] ;CANT ACCESS FILE
MOVEI S2,[ITEXT(^E/[-1]/)] ;EXPAND LAST ERROR
$CALL PUTERR ;AND TYPE ERROR MESSAGE
$RETF
SUBTTL INPBUF -- Read a buffer from the input file
INPBUF: MOVE S1,J$DIFN(J) ;GET THE IFN
$CALL F%IBUF ;GET A BUFFERFUL
JUMPF INPERR ;LOSE
MOVEM S1,J$DBCT(J) ;SAVE THE BYTE COUNT
MOVEM S2,J$DBPT(J) ;AND THE BYTE POINTER
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,[ASCIZ /ERI/] ;ERROR READING INPUT
MOVEI S2,[ITEXT(^E/[-1]/)] ;EXPAND LAST ERROR
$CALL PUTERR ;AND PUT AN ERROR OUT
TXO S,SKPFIL ;SKIP THE REST OF THE FILE
$RETF ;AND RETURN
SUBTTL INPFEF -- Force end-of-file on next input
INPFEF: MOVE S1,J$DIFN(J) ;GET THE IFN
SETOB S2,J$DBCT(J) ;CLEAR BYTE COUNT AND SET EOF POS
TXNE S,DSKOPN ;IS THE SPOOL FILE OPEN ???
$CALL F%POS ;YES,,POSITION IT
$RETT ;AND RETURN
SUBTTL INPREW -- Rewind the input file
INPREW: MOVE S1,J$DIFN(J) ;GET THE IFN
TXNE S,DSKOPN ;IS THE SPOOL FILE OPEN ???
$CALL F%REW ;YES,,REWIND IT
SETOM J$DBCT(J) ;AND SET THE BYTE COUNT
$RETT ;AND RETURN
SUBTTL OUTGET -- OPEN the output device
;THIS ROUTINE OPENS THE SPECIFIED OUTPUT DEVICE, AND SETS UP A BUFFER RING
TOPS10 <
OUTGET: HRRZ S1,STREAM ;GET THE STREAM NUMBER
MOVE S1,JOBOBA(S1) ;GET OBJECT BLOCK ADDRESS
MOVE S1,OBJ.TY(S1) ;GET OBJECT TYPE
SETZ S2, ;AND CLEAR AN AC
CAXN S1,.OTPTP ;IS IT A PAPERTAPE PUNCH?
MOVEI S2,T$DISP ;YES!!
CAXN S1,.OTCDP ;NO, HOW ABOUT A CARD PUNCH?
MOVEI S2,C$DISP ;WIN!!
CAXN S1,.OTPLT ;TRY FOR A PLOTTER
MOVEI S2,P$DISP ;AND GET THE PLOTTER DISPATCH
JUMPE S2,OUTDDE ;DONT KNOW ABOUT IT
MOVEM S2,J$LSER(J) ;SAVE IT
MOVEI S1,J$LDEV(J) ;ADDRESS OF WHERE TO PUT DEVNAM
HRLI S1,(POINT 6,0) ;MAKE IT A BYTE POINTER
MOVEM S1,TEXTBP ;SAVE IT
MOVEI S1,6 ;MAXIMUM CHARACTER COUNT
MOVEM S1,TEXTBC
HRRZ S1,STREAM ;GET THE STREAM NUMBER
MOVE S1,JOBOBA(S1) ;GET OBJECT BLOCK ADDRESS
$TEXT(DEP6BP,<^W3/DNAME(S2)/^O2R0/OBJ.ND(S1)/^O1/OBJ.UN(S1)/^A>)
MOVE T1,J$LDEV(J) ;GET THE DEVICE NAME
DEVNAM T1, ;GET ITS PHYSICAL NAME
JRST OUTDDE ;LOSE?
MOVEM T1,J$LDEV(J) ;AND SAVE IT
MOVX T1,.IOIMG+UU.PHS+UU.AIO
;IMAGE+PHONLY+NBIO
MOVE T2,J$LDEV(J) ;OUTPUT DEVICE NAME
MOVSI T3,J$LBRH(J) ;BUFFER HEADER
MOVE S1,STREAM ;GET OUR STREAM NUMBER
MOVEM S1,J$LJFN(J) ;SAVE AS THE STREAM NUMBER
LSH S1,^D23 ;PUT IN THE RIGHT PLACE
IOR S1,[OPEN T1] ;MAKE IT AN INSTRUCTION
XCT S1 ;AND EXECUTE IT
JRST OUTDNA ;LOSE GIVE ERROR
CONT. (OUTGET) ;FORCE NEW LISTING PAGE
MOVE S1,J$LSER(J) ;GET DEVICE DISPATCH ADDRESS
MOVE S1,DBYTE(S1) ;GET OUTPUT BYTE SIZE
STORE S1,J$LBRH+1(J),BP.SIZ ;STORE IT
MOVX S1,PSF%OB!PSF%DO ;GET OUTPUT-BLOCKED AND DEVICE OFFLINE
HRRZ S2,STREAM ;AND STREAM NUMBER
ANDCAM S1,JOBSTW(S2) ;AND CLEAR THE CONDITIONS
MOVE T1,J$LJFN(J) ;LOAD CHANNEL NUMBER
WHERE T1, ;GET OUR STATION NUMBER
SETZ T1,
TLZ T1,-1 ;CLEAR STATION FLAGS
CAME T1,CNTSTA ;IS THIS CENTRAL STATION?
SETOM J$LREM(J) ;NO -- SET REMOTE
MOVEI S1,T1 ;LOAD ADDRESS OF ARGBLOCK FOR DEVSIZ
MOVX T1,.IOIMG ;GET IMAGE MODE
MOVE T2,J$LJFN(J) ;GET THE CHANNEL
DEVSIZ S1, ;DO THE DEVSIZ
JRST OUTDNA ;LOSE
MOVEI T1,PAGSIZ ;LOAD PAGE SIZE
IDIVI T1,(S1) ;GET NUMBER OF BUFFER TO CREATE
MOVE S1,J$LBUF(J) ;GET ADDRESS OF BUFFER PAGE
EXCH S1,.JBFF ;SWAP WITH JOBFF
MOVE S2,J$LJFN(J) ;GET CHANEL NUMBER
LSH S2,^D23 ;POSITION IT
IOR S2,[OUTBUF 0(T1)] ;BUILD THE OUTBUF
XCT S2 ;AND DO IT
MOVEM S1,.JBFF ;RESTORE JOBFF
$CALL INTCNL ;CONNECT TO INTERRUPTS
MOVX S1,%RSUOK ;LOAD OK CODE
$RETT ;AND RETURN
> ;END TOPS10 CONDITIONAL
TOPS20 <
OUTGET: $SAVE <P1,P2> ;PRESERVE P1 AND P2
HRRZ S1,STREAM ;GET OUR STREAM
MOVE P1,JOBOBA(S1) ;P1 POINTS TO OUR OBJECT BLOCK
MOVE S1,OBJ.TY(P1) ;GET OBJECT TYPE
SETZ P2, ;P2 POINTS TO DISPATCH ADDRESS
CAXN S1,.OTCDP ;CARD PUNCH?
MOVEI P2,C$DISP ;YES -- LOAD DISPATCH ADDRESS
CAXN S1,.OTPLT ;PLOTTER ?
MOVEI P2,P$DISP ;YES -- LOAD DISPATCH ADDRESS
CAXN S1,.OTPTP ;PAPER TAPE PUNCH?
MOVEI P2,T$DISP ;YES -- LOAD DISPATCH ADDRESS
JUMPE P2,OUTDDE ;UNKNOWN OBJECT TYPE
MOVEM P2,J$LSER(J) ;SAVE DISPATCH ADDRESS
MOVE S1,[POINT 7,J$LDEV(J)] ;POINT TEXT TO DEVICE STRING
MOVEM S1,TEXTBP
MOVEI S1,^D10 ;GET A STRING LENGTH
MOVEM S1,TEXTBC ;AND SAVE IT
$TEXT (DEPBP,<P^W3/DNAME(P2)/^O1/OBJ.UN(P1)/:^0>) ;FORM STRING
MOVX S1,GJ%FOU!GJ%SHT ;LOAD GTJFN FLAGS
HRROI S2,J$LDEV(J) ;POINT TO THE DEVICE STRING
GTJFN ;AND GET A JFN
ERJMP OUTDDE ;DEVICE DOESNT EXIST!!
MOVEM S1,J$LJFN(J) ;WIN, SAVE THE JFN
MOVX S2,OF%WR+OF%OFL ;GET OPENF BITS
MOVE T1,DBYTE(P2) ;GET DEVICE BYTE SIZE
STORE T1,S2,OF%BSZ ;AND STORE FOR OPENF
OPENF ;OPEN IT
ERJMP OUTDNA ;NOT AVAILBLE NOW
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
IOFORK <
$CALL GETFRK ;GET IO FORK
JUMPF OUTDNA ;FORK NOT AVAILABLE
> ;END IOFORK CONDITINAL
$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
> ;END TOPS20 CONDITIONAL
OUTSOK: $CALL INTCNL ;CONNECT UP THE DEV
MOVX S1,%RSUOK ;LOAD THE CODE
$RETT ;AND RETURN
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: 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
$RETT ;WIN!!
OUTERR: PUSHJ P,OUTSTS ;READ DEVICE STATUS
JUMPT [$DSCHD (PSF%OB) ;ASSUME OUTPUT BLOCKED
JRST OUTOUT] ;RETRY OUTPUT
$CALL DEVERR ;PROCESS DEVICE ERROR
JUMPT OUTOUT ;RETRY OUTPUT IF CORRECTED
JRST MAIN ;STREAM IS SHUTDOWN
> ;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
$DSCHD (PSF%NP) ;PICK UP AGAIN AFTER SCHEDULE
$RETT ;AND FINALLY RETURN
OUTERR: SETOM J$LIOE(J) ;SET ERROR FLAG
OUTINT: SETZM J$LIOA(J) ;CLEAR IO ACTIVE
MOVEM S2,J$LBPT(J) ;SAVE THE CURRENT POINTER
MOVEM T1,J$LBCT(J) ;SAVE NUMBER OF CHARACTERS LEFT
SKIPE JOBSTW(J) ;DEVICE OFF-LINE?
$CALL OUTWON ;POSSIBLY. GO CHECK
SKIPE J$LIOE(J) ;ERROR?
$CALL OUTSTS ;READ DEVICE STATUS
SKIPT ;ERROR?
$CALL DEVERR ;YES -- PROCESS IT
JUMPF MAIN ;STREAM HAS BEEN SHUTDOWN
MOVE S1,J$LJFN(J) ;RESTORE DEVICE JFN
MOVE S2,J$LBPT(J) ;RESTORE POINTER
MOVE T1,J$LBCT(J) ;RESTORE COUNT
JRST OUTO.1 ;RESTART SOUT
> ;END TOPS20 CONDITIONAL
SUBTTL DEVERR -- Handle Output Device Errors
DEVERR: MOVE S1,J$LIOS(J) ;GET IO STATUS
MOVE S2,J$LSER(J) ;GET ADDRESS OF SERVICE ROUTINES
PUSHJ P,DERR(S2) ;DO ERROR ROUTINE
JUMPT .POPJ ;ERROR CORRECTED -- RETURN
HRRZ S1,STREAM ;POINT TO CURRENT STREAM
$WTO (Device I/O Error,^R/.EQJBB(J)/,@JOBOBA(S1))
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 Buffer routines and discriptions for TOPS20
TOPS20 <
IOFORK <
;DEFINE BUFFER CONTROL BLOCK (FOR INFERIOR IO FORK)
MSKSTR CURBFR,J$IHDR(J),RHMASK ;POINTS TO CURRENT BUFFER
MSKSTR INICNT,J$LIBC(J),FWMASK ;INITIAL BYTE COUNT
;DEFINE BUFFER HEADER BLOCK (CURRENT HEADER ADDRESS MUST BE IN P1)
MSKSTR USEFLG,0(P1),.MIFIN ;BUFFER USE FLAG
MSKSTR NXTBFR,0(P1),RHMASK ;NEXT BUFFER HEADER
MSKSTR CURPTR,1(P1),FWMASK ;CURRENT BUFFER BYTE POINTER
MSKSTR CURCNT,2(P1),FWMASK ;CURRENT BUFFER BYTE COUNT
MSKSTR INIPTR,3(P1),FWMASK ;INITIAL BUFFER BYTE POINTER
> ;END IOFORK CONDITIONAL
> ;END TOPS20 CONDITIONAL
SUBTTL Routine to Setup Inferior Process to do OUTPUT to device
TOPS20 <
IOFORK <
GETFRK: $SAVE <P1,P2> ;PRESERVE P2
HRRZ P2,STREAM ;LOAD OUR STREAM NUMBER
;MOVE OUTFRK CODE
HRLI S1,FKCODE ;GET OUR ADDRESS OF OUTFRK
HRRI S1,OUTFRK(J) ;GET DESTINATION IN JOBPAG
BLT S1,COD$LN(J) ;AND MOVE IT
MOVX S1,CR%ACS ;LOAD FORKS ACS
SETZ S2, ;FROM OUR ACS
CFORK ;BUILD THE FORK
ERJMP .RETF ;OOPS
MOVEM S1,J$IFRK(J) ;REMEMBER FORK HANDLE
MOVEI S1,(J) ;GET JOBPAG ADDRESS
ADR2PG S1, ;CONVERT TO PAGE NUMBER
MOVE S2,S1 ;SETUP FOR PMAP
HRLI S1,.FHSLF ;FROM THIS FORK
HRL S2,J$IFRK(J) ;TO INFERIOR
MOVX T1,PM%RD+PM%WR+PM%EX+PM%CNT+<NJBPGS>B35
PMAP
HRRI S1,<JOBSTW/1000> ;ALSO MAP JOB STATUS PAGE
HRRI S2,<JOBSTW/1000> ;THE SAME
MOVX T1,PM%RD+PM%WR ;WITH READ AND WRITE
PMAP
MOVE S1,J$IFRK(J) ;GET FORK HANDLE
RPCAP ;GET CURRENT CAPABILITIES
TXO T1,SC%SUP ;ALLOW INTERRUPTS
EPCAP
$RETT
KILFRK: MOVE S1,J$IFRK(J) ;GET FORK HANDLE
KFORK
ERJMP .RETF ;OOPS
$RETT
> ;END IOFORK CONDTIONAL
> ;END TOPS20 CONDITIONAL
SUBTTL Fork IO Code for TOPS20
TOPS20 <
IOFORK <
;NOTE: This code will be moved into inferior Job Pages
; All Instruction Addresses Must be indexed by (J)
FKCODE==. ;TOP LEVEL ADDRESS OF CODE
PHASE J$ICOD ;TO BE MOVED TO THIS LOCATION
OUTFRK: LOAD P1,CURBFR ;POINT TO CURRENT BUFFER
MOVE P2,J$STRM(J) ;AND MY STREAM
OUTF.1: LOAD S1,USEFLG ;GET USE BIT
JUMPE S1,OUTF.5(J) ;TERMINATE IF BUFFER UNUSED
OUTF.2: MOVE S1,J$LJFN(J) ;GET DEVICE JFN
LOAD S2,CURPTR ;GET BUFFER POINTER
LOAD T1,CURCNT ;GET NEGITIVE BYTE COUNT
JUMPE T1,OUTF.3(J) ;NOTHING TO DO -- RESET BUFFER
SOUT ;DUMP THE BUFFER
ERJMP OUTF.4(J) ;FLAG ERROR AND TERMINATE
OUTF.3: LOAD S1,INIPTR ;GET INITIAL POINTER
STORE S1,CURPTR ;RESET BUFFER POINTER
LOAD S1,INICNT ;GET INITIAL BYTE COUNT
STORE S1,CURCNT ;RESET BUFFER COUNT
SETZ S1, ;LOAD A ZERO
STORE S1,USEFLG ;CLEAR USEFLG (SAYS OK TO FILL)
MOVX S1,PSF%OB ;GET SCHED OUTPUT BLOCKED BIT
ANDCAM S1,JOBSTW(P2) ;AND CLEAR IT FOR OUR STREAM
LOAD P1,NXTBFR ;ADVANCE TO OUR NEXT BUFFER
STORE P1,CURBFR ;AND MAKE IT CURRENT
SKIPGE STREAM ;IS SUPERIOR IDLE?
JRST OUTF.1(J) ;NO -- DON'T BOTHER HIM
LOAD S1,USEFLG ;IS THIS BUFFER USED?
JUMPE S1,OUTF.5(J) ;NO -- TERMINATE.
MOVX S1,.FHSUP ;WAKE SUPERIOR WITH INTERRUPT
MOVX S2,1B<.ICODN> ;ON OUTPUT DONE CHANNEL
IIC
ERJMP OUTF.5(J) ;TERMINATE ON ERROR
JRST OUTF.2(J) ;THEN DO NEXT BUFFER
OUTF.4: SETOM J$LIOE(J) ;FLAG ERROR
STORE S2,CURPTR ;SAVE FINAL POINTER
STORE T1,CURCNT ;SAVE FINAL COUNT
MOVX S1,PSF%OB ;GET SCHED OUTPUT BLOCKED BIT
ANDCAM JOBSTW(P2) ;AND CLEAR IT FOR OUR STREAM
OUTF.5: SETZM J$LIOA(J) ;CLEAR IO ACTIVE
HALTF ;DIE AND WAKE SUPERIOR
JRST OUTFRK(J) ;NEXT BUFFER IF CONTINUED
DEPHASE
COD$LN==.-FKCODE ;COMPUTE LENGTH FOR BLT
> ;END IOFORK CONDITIONAL
> ;END TOPS20 CONDITIONAL
SUBTTL TOPS20 Output Code to Drive Inferrior Fork
TOPS20 <
IOFORK <
OUTPUT: SKIPE J$LIOE(J) ;ERROR FLAG LIT?
$RETF ;YES -- GIVE BAD RETURN
$SAVE <P1> ;PRESERVE AN AC
LOAD P1,J$LBRH(J) ;GET OUR BUFFER HEADER
SKIPGE S1,J$LBCT(J) ;GET COUNT OF REMAINING BYTES
SETZ S1, ;MUST BE .GE. 0
SUB S1,J$LIBC(J) ;SUBTRACT INITIAL COUNT
STORE S1,CURCNT ;SAVE NEGITIVE BYTE COUNT
SETZ S1, ;CLEAR S1
STORE S1,USEFLG ;AND CLEAR USEFLG (OK TO EMPTY)
SKIPL J$LIOA(J) ;IS IO FORK ACTIVE?
$CALL IOGO ;NO -- GO START IT
LOAD P1,NXTBFR ;GET NEXT BUFFER ADDRESS
STORE P1,J$LBRH(J) ;MAKE IT OUR OWN
OUTP.1: LOAD S1,USEFLG ;GET USE FLAG
JUMPE S1,OUTP.2 ;HURRAY! IT'S UNUSED
$DSCHD (PSF%OB) ;WAIT FOR OUTPUT DONE
SKIPE J$LIOE(J) ;ANY ERRORS?
$RETF ;YES -- GIVE FALSE RETURN
JRST OUTP.1 ;RECHECK USE FLAG
OUTP.2: LOAD S1,CURPTR ;GET BUFFER POINTER
STORE S1,J$LBPT(J) ;MAKE IT OUR OWN
LOAD S1,CURCNT ;GET CURRENT COUNT
STORE S1,J$LBCT(J) ;MAKE IT OUR OWN
$RETT ;AND FINALLY, RETURN
IOGO: MOVE S1,J$IFRK(J) ;GET FORK HANDLE
MOVEI S2,TF ;SCRATCH AC
MOVEI TF,OUTFRK(J) ;LOAD START ADDRESS
SFORK ;AND GET IT SPINNING
ERJMP $RETF
SETOM J$LIOA(J) ;SET IO ACTIVE
$RETT ;AND RETURN
> ;END IOFORK CONDITIONAL
> ;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
IOFORK <
$CALL KILFRK ;DESTROY OUR FORK
> ;END IOFORK CONDITIONAL
SKIPT
$RETF
$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))
SETOM JOBCHK(S1) ;REQUEST CHECKPOINT
$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
SETOM JOBCHK(S1) ;REQUEST CHECKPOINT
$WTO (Device went off-line,,@JOBOBA(S1))
$DSCHD(0) ;BLOCK FOR DEVICE ONLINE
POPJ P, ;NO, RETURN
> ;END TOPS20 CONDITIONAL
SUBTTL OUTFLS Routine to flush output buffers
;OUTFLS IS CALLED TO FLUSH OUTPUT TO THE DEVICE WHICH HAS ALREADY BEEN
; BUFFERED (AND POSSIBLE SENT TO THE DEVICE).
TOPS10 <
OUTFLS: PUSHJ P,INTDCL ;DISCONNECT DEVICE INTERRUPTS
MOVE S1,J$LJFN(J) ;LOAD THE CHANNEL NUMBER
RESDV. S1, ;RESET THE CHANNEL
JFCL ;??
PJRST OUTGET ;AND REINIT THE LPT
> ;END TOPS10 CONDITIONAL
TOPS20 <
OUTFLS: $SAVE <T1> ;PRESERVE AN AC
MOVE S1,J$LJFN(J) ;GET OUTPUT JFN
MOVX S2,.MOFLO ;LOAD FLUSH FUNCTION
MOVEI T1,0 ;AND ZERO ARGUMENTS
MTOPR ;FLUSH THE BUFFERS
ERCAL OUTF.1 ;ON AN ERROR,,SHUT IT DOWN AND RESET IT
MOVE S1,J$LIBC(J) ;INITIAL WORDS IN BUFFER
MOVEM S1,J$LBCT(J) ;RESET BUFFER COUNT
MOVE S1,J$LIBP(J) ;GET INITIAL POINTER
MOVEM S1,J$LBPT(J) ;AND SAVE IT
MOVEI S1,%RSUOK ;LOAD GOOD RETURN CODE
$RETT ;RETURN
OUTF.1: MOVX S1,CZ%ABT ;GET THE ABORT BITS.
ADD S1,J$LJFN(J) ;ADD THE JFN
CLOSF ;CLOSE THE DEVICE
ERJMP .+1 ;IGNORE AN ERROR
PJRST OUTGET ;SET THE DEVICE UP AGAIN
> ;END TOPS20 CONDITIONAL
SUBTTL Card-punch Service Routines
;DISPATCH TABLE FOR CARD-PUNCH
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
;HERE TO PROCESS A FILE
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
$CALL OUTBYT ;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
$CALL OUTBYT ;AND PUNCH COLUMN 1
MOVE C,T2 ;GET THE CHECKSUM
$CALL OUTBYT ;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
$CALL OUTBYT ;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
$CALL OUTBYT ;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
$CALL OUTBYT ;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 File Header and Trailer Routines
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
> ;END TOPS10 CONDITIONAL
MOVEI S1,[ITEXT<^W6/S2/>] ;POINT TO NAME
PJRST C$WORD ;PUNCH CARD AND RETURN
C$EOF: MOVEI S1,^D80 ;PUNCH EOF CARD
MOVEI C,7417 ;TOP FOUR AND BOTTOM FOUR ROWS
$CALL REPBYT
PJRST OUTOUT ;FORCE OUTPUT
SUBTTL Card Job Banner and Trailer Routines
C$BANN: SKIPN T1,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 T1,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
SOJE T1,.RETT ;RETURN IF FINISHED
MOVEI S1,[ITEXT<^W6/.EQJOB(J)/>]
$CALL C$WORD
SOJE T1,.RETT ;RETURN IF FINISHED
MOVEI S1,[ITEXT<#^D5R0/.EQSEQ(J),EQ.SEQ/>] ;SEQUENCE NUMBER
$CALL C$WORD
SOJE T1,.RETT ;RETURN IF FINISHED
MOVEI S1,[ITEXT<USER: >]
$CALL C$WORD
SOJE T1,.RETT ;RETURN IF FINISHED
$CALL SETTBF ;POINT TO TEXT BUFFER
$TEXT (DEPBP,<^I/USRNAM/>) ;GET USER NAME
MOVEI S1,[ITEXT <^T6/J$XTBF(J)/>] ;SIX CHARACTER USER NAME
PJRST C$WORD ;PUNCH LAST CARD AND RETURN
SUBTTL Card Block Word and Letter Routines
;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
$CALL OUTBYT
MOVEI C,7777 ;SECOND COLUMN FULLY LACED
$CALL OUTBYT
MOVEI S1,3 ;NEXT 3 COLUMNS WITH SPECIAL MASK
MOVE C,J$CMSK(J)
$CALL REPBYT
$CALL STRING ;COLUMNS 6-77 FOR CHARACTERS
MOVE C,J$CMSK(J) ;COLUMN 78 SPECIAL MASK
$CALL OUTBYT
MOVEI C,7777 ;COLUMN 79 FULLY LACED
$CALL OUTBYT
MOVEI C,3776 ;COLUMN 80 ROUNDED CORNERS
$CALL OUTBYT
PJRST OUTOUT ;PUNCH CARD AND RETURN
;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
$CALL OUTBYT ;PUNCH FIRST FRAME
$CALL OUTBYT
AOBJN S2,CLET.1 ;REPEAT 10 FRAMES
MOVEI S1,2
MOVE C,J$CMSK(J) ;PUNCH SPECIAL ROWS
PJRST REPBYT ;PUNCH 2 BLANK FRAMES
OUTCDP: $CALL OUTOUT ;FORCE CARD OUT
AOS S1,J$APRT(J) ;COUNT ANOTHER ONE
CAMG S1,J$RLIM(J) ;OVER LIMIT?
$RETT ;NO, CONTINUE ON
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
$WTOR (Output limit exceeded,<^I/OLEMSG/>,@JOBOBA(S1),JOBWAC(S1))
SETOM JOBCHK(S1) ;REQUEST A CHECKPOINT
$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,[ASCIZ /OLE/] ;OUTPUT LIMIT EXCEEDED
SETZ S2,
$CALL PUTERR ;Process IT
$CALL INPFEF ;FORCE EOF ON NEXT INPUT
TXO S,ABORT ;LIGHT ABORT
HRRZ S1,STREAM
$WTO (Canceled,<^R/.EQJBB(J)/>,@JOBOBA(S1)) ;NOTIFY
$RETT ;AND RETURN
OUTIGN: MOVX S1,.INFIN ;GET MAXIMUM LIMIT
MOVEM S1,J$RLIM(J) ;SAVE IT
$RETT ;AND TRY SOME MORE
OLEANS: OLESIZ,,OLESIZ ;BUILD RESPONSE TABLE
TB (CANCEL,OUTCAN) ;CANCEL
TB (IGNORE,OUTIGN) ;IGNORE
OLESIZ==.-OLEANS-1 ;GET NUMBER OF ENTRIES
OLEMSG: ITEXT <^R/.EQJBB(J)/^T/@OLETXT/>
OLETXT: [ASCIZ/
Type 'Respond <Number> CANCEL' to Cancel the Job
Type 'Respond <Number> IGNORE' to Ignore the Error/]
SUBTTL Plotter Service Routines
;PLOTTER 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 .RETF ;(10) ERROR PROCESSOR
JRST .RETT ;(11) ACCOUNTING
;HERE TO PROCESS A FILE
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 ;STANDARD 6BIT INPUT
EXP PLTSVN ;SEVEN-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 .RETT ;RETURN WHEN DONE
$CALL PLTBYT ;WRITE THE CHARACTER OUT
JRST PLTLUP ;AND LOOP
SUBTTL PLOTTER BANNER HEADER AND TRAILER ROUTINES
P$BANN: SKIPN T1,J$FGUID(J) ;GUIDE POSITIONING WANTED?
JRST P$BAN1 ;NO..GO RESET THE ORIGIN
SETZM J$XPOS(J) ;YES..RESET TEMPORARILY
SETZM J$YPOS(J)
$CALL P$GUID ;DO THE POSITIONING
P$BAN1: $CALL P$ORG ;RESET OUR ORIGIN
SKIPN T1,J$FBANN(J) ;BANNER WANTED?
$RETT ;NO..JUST RETURN
$CALL P$CHKS ;CHECK CHARACTER SIZE
IMULI T1,2 ;GET STARTING POSITION
MOVEI T2,MARSTP ;GET STEPS IN MARGIN
MOVEI T3,3 ;PEN UP
$CALL PLOT ;POSITION TO PRINT BANNER
$CALL SETTBF
$TEXT (DEPBP,^I/JOBBAN/^0) ;Display job banner
$CALL STRING ;CALL P$LETR TO PLOT IT
$RETT
P$ORG: SETZM J$XPOS(J) ;RESET THE ORIGIN
SETZM J$YPOS(J)
SETZM J$XLIM(J) ;RESET REMEMBERED LIMITS
SETZM J$YLIM(J)
SETZM J$ORGF(J) ;RESET ORIGIN NEEDED FLAG
SKIPN S1,J$GSIZ(J) ;GUIDE WANTED?
PJRST OUTOUT ;NO..DUMP BUFFERS AND RETURN
$CALL PENDN ;LOWER THE PEN
MOVE T1,J$GSIZ(J)
MOVEI C,XYD ;PRINT A +
$CALL REPBYT ;PRINT A +
MOVE T1,J$GSIZ(J)
IMULI S1,2
MOVEI C,XYU
$CALL REPBYT
MOVE S1,J$GSIZ(J)
MOVEI C,XYD
$CALL REPBYT
MOVE S1,J$GSIZ(J)
MOVEI C,XYL
$CALL REPBYT
MOVE S1,J$GSIZ(J)
IMULI S1,2
MOVEI C,XYR
$CALL REPBYT
MOVE S1,J$GSIZ(J)
MOVEI C,XYL
$CALL REPBYT
$CALL PENUP
PJRST OUTOUT ;DUMP WHAT WE HAVE
P$HEAD: SKIPE J$ORGF(J) ;ORIGIN NEEDED?
$CALL P$ORG ;YES..DO IT
SKIPN T1,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
$CALL P$CHKS ;CHECK CHARCTER SIZE
IMULI T1,2 ;GET OFFSET TO START AT
ADD T1,J$FBANN(J) ;RELATIVE TO BANNER
MOVEI T2,MARSTP ;GET STEPS IN MARGIN
MOVEI T3,3 ;PEN GOES UP
$CALL PLOT ;POSITION TO PRINT STRING
$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
$TEXT (DEPBP,<File ^F/@J$DFDA(J)/ created:^H/S1/^0>)
$CALL STRING
P$HEA1: MOVE T1,J$XORG(J) ;POSITION TO ORIGIN
MOVE T2,J$YORG(J)
MOVEI T3,3 ;PEN GOES UP
$CALL PLOT
$RETT
P$CHKS: IDIVI T1,3 ;Get size of characters
CAILE T1,CHRSIZ ;Exceed maximum size?
MOVEI T1,CHRSIZ ;No..don't let it be
MOVEM T1,J$CSIZ(J) ;Save size for P$LETR
$RETT
P$EOF: SKIPN T1,J$XSIZ(J) ;X FORM SIZE GIVEN?
JRST [MOVE T1,J$XLIM(J) ;NO..USE OUR HIGHEST X STEP
ADD T1,J$FTRA(J) ;PLUS TRAILER SIZE
IDIV T1,J$FSPU(J) ;ROUND TO NEAREST UNIT
IMUL T1,J$FSPU(J)
SKIPE T2
ADD T1,J$FSPU(J)
JRST .+1]
MOVEI T2,0 ;GO BACK TO THE MARGIN
MOVEI T3,3 ;WITH PEN UP
$CALL PLOT
SETOM J$ORGF(J) ;SET ORIGIN NEEDED
PJRST OUTOUT ;DUMP WHAT WE HAVE
P$TRAI: SKIPN T1,J$FTRA(J) ;TRAILER ALLOWED?
PJRST P$TRA1 ;NO..RESET THE ORIGIN
PUSH P,J$XPOS(J) ;YES..REMEMBER WHERE WE START
$CALL P$CHKS ;CHECK CHARACTER SIZE
MOVNS T1 ;SUBTRACT FROM CURRENT POSITION
ADD T1,J$XPOS(J)
MOVEI T2,MARSTP ;GET THE MARGIN TO START AT
MOVEI T3,3 ;PEN GOES UP
$CALL PLOT
$CALL SETTBF ;Point to text buffer
$TEXT (DEPBP,^I/JOBTRA/^0) ;Display job trailer
$CALL STRING
POP P,T1 ;GET STARTING POSITION
MOVEI T2,0
MOVEI T3,3 ;PEN GOES UP
$CALL PLOT
P$TRA1: $CALL P$ORG ;RESET THE ORIGIN
SKIPN T1,J$FGUID(J) ;GUIDE POSITIONING WANTED?
$RETT
MOVNS T1 ;YES..DO REVERSE POSITIONING
P$GUID: HRRE T2,T1 ;GET Y GUID POSITION
HLRE T1,T1 ;GET Y GUIDE POSITION
MOVEI T3,3 ;PEN GOES UP
$CALL PLOT
PJRST OUTOUT ;DUMP WHAT WE HAVE
P$LETR: $SAVE <T1,T2,T3,T4> ;PRESERVE TEMPORARIES
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
$CALL PLOT ;PLOT SEGMENT
SOJG T4,SYM.3 ;DO ALL SEGMENTS
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
$CALL PLOT
$RETT
SUBTTL Routine to Plot line Segment
;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,XYR ;ASSUME RIGHT MOVEMENT
SKIPG T1 ;IS THAT CORRECT?
MOVEI T3,XYL ;NO..ASSUME LEFT
SUB T2,J$YPOS(J) ;COMPUTE DELTA Y
MOVEI T4,XYU ;ASSUME UPWARD MOVEMENT
SKIPG T2 ;IS THAT CORRECT?
MOVEI T4,XYD ;NO..THEN ASSUME DOWN
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: $RETT ;RETURN
SUBTTL Plotter Rotation and XY20 Translation table
;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) XYL ,XYU ,XYR ,XYD ;MOVE DOWN
BYTE (18) 102 (2) 0 (4) XYR ,XYD ,XYL ,XYU ;MOVE UP
BYTE (18) 114 (2) 0 (4) PEN3,PEN3,PEN3,PEN3 ;SELECT PEN3
BYTE (18) 104 (2) 0 (4) XYD ,XYL ,XYU ,XYR ;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) XYU ,XYR ,XYD ,XYL ;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 PLTBYT Routine to plot a single character
;Call C/ Character to plot
;Will ROTA Plot per variable J$ROTA(J) and Adjust Values in J$XPOS(J) and J$YPOS(J)
;per movement code.
;Also makes range check on XMIN-J$XMAX(J) and J$YMIN(J)-J$YMAX(J)
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
MOVE S1,J$XPOS(J)
TRNE C,XYR ;ADD 1 FOR RIGHT MOVE
AOS S1,J$XPOS(J) ;ADD 1 FOR RIGHT MOVE
TRNE C,XYL
SOS S1,J$XPOS(J) ;SUB 1 FOR LEFT MOVE
CAMLE S1,J$XLIM(J) ;HIGHEST POINT SO FAR?
MOVEM S1,J$XLIM(J) ;YES -- SAVE IT
MOVE S2,J$YPOS(J) ;GET CURRENT Y POSITION
TRNE C,XYU ;ADJUST PER MOVEMENT
AOS S2,J$YPOS(J) ;ADD 1 FOR UPWARD MOVE
TRNE C,XYD
SOS S2,J$YPOS(J) ;SUB 1 FOR DOWN MOVE
CAMLE S2,J$YLIM(J) ;HIGHEST POINT SO FAR?
MOVEM S2,J$YLIM(J) ;YES -- SAVE IT
PJRST OUTBYT ;PUT CHARACTER IN BUFFER AND RETURN
PENUP: PUSH P,C ;SAVE CHARCTER AC
SETZM J$PPOS(J) ;MARK PEN RAISED
MOVEI C,PNUP ;LOAD CODE FOR PEN UP
$CALL OUTBYT ;PLOT CHARACTER
POP P,C ;RESTORE CHARACTER AC
$RETT
PENDN: PUSH P,C ;SAVE CHARACTER AC
SETOM J$PPOS(J) ;MARK PEN DOWN
MOVEI C,PNDN ;LOAD PENDOWN CODE
$CALL OUTBYT
POP P,C ;RESTORE CHARACTER AC
$RETT
;DEC 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
SUBTTL Plotter Character Table and Segement Codes
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 Routines
;PAPER TAPE DISPATCH TABLE
T$DISP: JRST T$HEAD ;(0) FILE HEADER
JRST T$EOF ;(1) FILE TRAILER
SIXBIT /PTP/ ;(2) GENERIC DEVICE NAME
EXP ^D36 ;(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
;HERE TO PROCESS A FILE
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
EXP PTIMA ;IMAGE
EXP PTELF ;ELEVEN
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
$CALL OUTBYT ;PUT IT IN THE TAPE
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: $CALL OUTBYT ;PUNCH THE CHAR
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
$CALL REPBYT ;PUNCH THEM
JRST PTAS.1 ;GET NEXT CHAR
PTAS.3: MOVEI C,377 ;LOAD A RUBOUT
$CALL OUTBYT ;PUNCH IT
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
$CALL REPBYT ;OUTPUT 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
$CALL OUTBYT ;PUNCH IT
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
$CALL OUTBYT ;PUNCH
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
$CALL OUTBYT ;PUNCH IT
JRST PTIMA ;AND LOOP
;PAPER-TAPE HEADERS, TRAILERS, ETC.
T$BANN: SETZM J$TBCT(J) ;CLEAR TOTAL BYTE COUNT
SKIPN T1,J$FBAN(J) ;BANNER ALLOWED?
PJRST BLKFLD ;NO -- PUNCH BLANK FOLD
$CALL SETTBF ;SETUP TEXT BUFFER
$TEXT(DEPBP,<Begin ^R/.EQJBB(J)/>)
$CALL STRING ;AND SEND TO THE PUNCH
PJRST BLKFLD ;PUNCH BLANK FOLDS
T$HEAD: SKIPN T1,J$FHEA(J) ;HEADER ALLOWED?
JRST BLKFLD ;NO -- JUST PUNCH A BLANK 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,<Start ^I/0(S1)/ 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
$CALL REPBYT ;SEND SOME BLANK FRAMES
MOVEI S1,^D10 ;GET A REPEAT COUNT
MOVEI C,177 ;AND A CHARACTER
$CALL REPBYT ;SEND SOME LACED FRAMES
SOJG T2,THEA.1 ;AND LOOP
PJRST BLKFLD ;AND SEND A BLANK FOLD OF TAPE
CONT. (HEADERS) ;FORCE NEW LIST PAGE
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
$CALL REPBYT ;SEND SOME EOFS
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
$CALL REPBYT ;LEAVE SOME SPACE
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
PJRST BLKFLD ;SEND A BLANK FOLD OF TAPE
SUBTTL Tape Trailer and Blank Fold Routines
T$TRAI: SKIPN T1,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
;Routine to Punch a number of 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 REPBYT
;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
$CALL OUTBYT ;PUNC IT
AOBJN S2,TLET.1 ;REPEAT FOR ALL SEGMENTS
MOVEI S1,2 ;REPEAT COUNT
MOVEI C,0 ;CHARACTER
PJRST REPBYT ;PUNCH 2 BLANKS AND 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 S1/ Address of Asciz "short error" message or 0 if none
; S2/ Address of ITEXT for "Extended Error" Message or 0 if none
PUTERR: $CALL SETEBF ;POINT $TEXT TO ERROR BUFFER
SKIPE S1
$TEXT (DEPBP,^T/(S1)/--^A) ;YES -- MOVE TO BUFFER
SKIPE S2 ;LONG MESSAGE?
$TEXT(DEPBP,^I/0(S2)/^A) ;YES -- MOVE TO BUFFER
$TEXT (DEPBP,^0) ;STORE NULL
$RETT
;HERE TO REPEAT THE BYTE IN ACCUMULATOR C ACCORDING TO THE COUNT IN AC S1.
REPBYT: $SAVE <P1> ;SAVE P1
MOVE P1,S1 ;PUT COUNT IN P1
REPB.1: $CALL OUTBYT ;PUT OUT A BYTE
SOJG P1,REPB.1 ;AND LOOP
$RETT ;RETURN WHEN DONE
;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,[ASCIZ /UPM/] ;LOAD AN ERROR
SETZ S2, ;NO ADDITIONAL MESSAGE
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 ;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
> ;END TOPS20 CONDITIONAL
SPOEND::END SPROUT