$CONTROL USLINIT,CODE,MAP                                     <<EPC.AZ>>00005000
$CONTROL MAIN = SPOOLING    << MPE MODULE 79 -- SPOOLING >>    <<04397>>00010000
<< HP32002C MPE SOURCE C.00.00 >>                                       00015000
$COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00020000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00025000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00030000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00035000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00040000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00045000
$THIRTY                                                                 00050000
$CONTROL SEGMENT=SPOOLING                                               00055000
$CONTROL PRIVILEGED                                                     00060000
<< MPE 3000/30 SPOOLING FACILITY >>                                     00065000
BEGIN                                                                   00070000
$PAGE "****     FIX  INFORMATION    ****"                      <<04398>>00075000
<<**********************************************************>> <<04398>>00080000
<<                                                          >> <<04398>>00085000
<<                FIX     INFORMATION                       >> <<04398>>00090000
<<                                                          >> <<04398>>00095000
<<   For each fix submitted, please describe the fix and    >> <<04398>>00100000
<<   date below.                                            >> <<04398>>00105000
<<**********************************************************>> <<04398>>00110000
                                                               <<04398>>00115000
<<**********************************************************>> <<04398>>00120000
<< Modified the SLOG procedure to log subtype, number of    >> <<04398>>00125000
<< logical procedures and number of pages printed (for epoc >> <<04398>>00130000
<< only).  February 9, 1982.                                >> <<04398>>00135000
<<**********************************************************>> <<04398>>00140000
                                                               <<04398>>00145000
$INCLUDE INCLGLBL                                              <<04400>>00150000
$INCLUDE INCLLDT5                                              <<06334>>00155000
$INCLUDE INCLLPDT                                              <<06334>>00160000
$INCLUDE INCLDCT                                               <<06527>>00165000
$INCLUDE INCLXDD5                                              <<06912>>00170000
$PAGE "OTHER GENERAL GLOBAL DEFINITIONS"                       <<04400>>00175000
                                                               <<04400>>00180000
define                                                         <<04400>>00185000
                                                               <<04400>>00190000
       a               = absolute # << addressing >>           <<04400>>00195000
                                                               <<04400>>00200000
<< Note:  This define and 'arrdb11' depends on PXGLOB format >><<06527>>00205000
      ,setjit          = push(dl);                             <<04400>>00210000
                         tos := arrdb11(tos-ps0(-1))#          <<06527>>00215000
                                                               <<04400>>00220000
      ,xreg            = x #                                   <<04400>>00225000
                                                               <<04400>>00230000
;                                                              <<04400>>00235000
                                                               <<04400>>00240000
logical                                                        <<04400>>00245000
        ls0            = S-0                                   <<04400>>00250000
;                                                              <<04400>>00255000
                                                               <<04400>>00260000
integer pointer                                                <<04400>>00265000
                pdb1            = DB+1                         <<04400>>00270000
               ,ps0             = S-0                          <<04400>>00275000
;                                                              <<04400>>00280000
                                                               <<04400>>00285000
integer array                                                  <<04400>>00290000
              arrdb11(*)      = DB+11                          <<06527>>00295000
             ,arrq0(*)        = Q-0                            <<04400>>00300000
;                                                              <<04400>>00305000
                                                               <<04400>>00310000
byte pointer                                                   <<04400>>00315000
             bps0            = S-0                             <<04400>>00320000
;                                                              <<04400>>00325000
$PAGE "MPE TABLE ACCESS:  Job Master Table (JMAT)"             <<S8949>>00330000
$INCLUDE INCLJMAT                                              <<S8949>>00335000
$PAGE "***   SPOOLING CONSTANTS   ***"                                  00340000
EQUATE                                                                  00345000
<< TABLE SIZE CONSTANTS >>                                              00350000
           BSIZE             = 512   ,                                  00355000
           BRECX             = 4     ,                                  00360000
           RSIZE             = 128   ,                                  00365000
           MAXRSIZE          = 255   ,                                  00370000
<< LOW MAIN MEMORY >>                                                   00375000
           CSTB              = 0     ,                                  00380000
           XCSTB             = 1     ,                                  00385000
           DSTB              = 2     ,                                  00390000
<< MESSAGE CATALOG NUMBERS FOR SPOOLERS' MESSAGES >>                    00395000
           NORMALSTOP        = 237   ,                                  00400000
           NONEXISTENTDEV    = 222   ,                                  00405000
           SPOOLEEIOERR      = 223   ,                                  00410000
           NOTACCEPTING      = 224   ,                                  00415000
           SPOOFLEIOERR      = 225   ,                                  00420000
           NOSUCHSTACK       = 226   ,                                  00425000
           SUSPENDED         = 268   ,                         <<02580>>00430000
           RESUMED           = 269   ,                         <<02580>>00435000
           SIO'FAILURE       = 281,                            <<00909>>00440000
           POWER'UP          = 302   ,                         <<00909>>00445000
           VFC'RESET         = 303   ,                         <<00909>>00450000
           GENERAL'IOERR     = 304   ,                         <<00909>>00455000
           REQUEST'ABORTED'EXTERNAL = 305,                     <<00909>>00460000
           POWER'FAIL'ABORT  = 306,                            <<00909>>00465000
           INVALID'FUNCTION  = 307,                            <<00909>>00470000
           TIMEOUT           = 308,                            <<00909>>00475000
           TRANSFER'ERROR    = 309,                            <<00909>>00480000
           BAD'BLOCK         = 239,                            <<02634>>00485000
                                                               <<01549>>00490000
           UNIT'NOT'ONLINE   =  361  ,<<UNIT OFFLINE>>         <<01549>>00495000
           BUFFER'FULL      =  362  ,<<DATA BUFFER>>           <<01549>>00500000
           CHAR'MEM'FULL    = 363  ,<<CHARACTER SETS>>         <<01549>>00505000
           FORM'MEM'FULL    = 364 ,<<FORMS BUFFER>>            <<01549>>00510000
           SELECT'CHAR     = 365 ,<<CHAR NONEXISTANT>>         <<01549>>00515000
           SELECT'FORM    = 366 ,<<FORM NONEXISTANT>>          <<01549>>00520000
           SELECT'VFC    = 367 ,<<VFC NONEXISTANT>>            <<01549>>00525000
           SELECT'LPT     = 368, <<LOGICAL PAGE TABLE>>        <<01549>>00530000
           MOVE'PEN       = 369, <<MOVE PEN ERROR>>            <<01549>>00535000
           CHAR'PROC'SATURATED = 370,<<PROCESSOR SATUR>>       <<01549>>00540000
           MAX'COPIES'EXCEEDED  = 371,<<MAX COPIES>>           <<01549>>00545000
           HARD'MALFUNCTION    = 372,<<HARDWARE>>              <<01549>>00550000
           BAD'SPOOL'BLOCK    = 373,<<LENGTH BAD>>             <<01549>>00555000
           CATASTROPHIC      = 374,<<CALL CE>>                 <<01549>>00560000
           CONTROLLER'DEAD   = 375, <<CALL CE>>                <<01549>>00565000
           SIO'ERROR        = 376, <<SIO ERROR>>               <<01549>>00570000
           HPIB'PHI'LOCKUP  = 377,<<HPIB LOCKUP>>              <<01549>>00575000
           CONTROLLER'MEM  = 378,<<CONTROLLER PARITY>>         <<01549>>00580000
           JOB'OPEN'FAILURE = 379, <<JOB OPEN FAILED>>         <<02504>>00585000
           RESTART'FAILED    = 381  , <<2680 AUTO RESTART>>    <<01549>>00590000
           RESTART'IN'PROGRESS=382  , <<NOTIFY OPERATOR CONS>> <<01549>>00595000
           DATA'CTL'INFO'ERR =  386  ,                         <<C7517>>00600000
           COMMANDS'IGNRD    = 1404  ,                         <<01549>>00605000
           EXPECTJOB'IGNRD   = 1405  ,                         <<01549>>00610000
           MISSINGJOBCOM     = 1406  ,                         <<01549>>00615000
           LAST'COM'IGNRD    = 1407  ,                         <<01549>>00620000
           STRMSPLEEIOERR    = 1593  ,<<ERR READING STRM FILE>><<01549>>00625000
           STRMSPOOFLEIOERR  = 1594  ,<<ERR WRITING SPOOLFILE>><<01549>>00630000
           STRMSPFLEOPENERR  = 1595  ,<<ERR OPENING SPOOLFILE>><<01549>>00635000
           STRMFILEOPENERR   = 1596  ,<<ERR OPENING STRM FILE>><<01549>>00640000
           COMMANDTOOLONG    = 1597  ,<<COMMAND GTR 255 CHARS>><<01549>>00645000
           NOCOLON           = 1598  ,<<NO ":" ON CONT. LINE >><<01549>>00650000
           STRMSPFLECLOSEERR = 1599  ,<<Err closing spoolfile>><<FSCLS>>00655000
           CANNOTSINIT       = SPOOFLEIOERR ;                           00660000
$PAGE "***   SYSTEM GLOBAL TABLE - SYSDB   ***"                         00665000
<< SYSTEM GLOBAL TABLE - SYSDB >>                                       00670000
EQUATE                                                                  00675000
           EXTSSECT          = %104  ;                         <<06334>>00680000
DEFINE                                                                  00685000
           ABSYS             = %1000              #,                    00690000
           ABSYS'EXTSSECT    = A(ABSYS+EXTSSECT)  #;           <<06334>>00695000
$PAGE "***   PROCESS CONTROL BLOCK - PCB   ***"                         00700000
$INCLUDE INCLPCB5                                              <<06425>>00705000
$PAGE "***   PROCESS CONTROL BLOCK - PCB   ***"                <<06527>>00710000
<< PROCESS CONTROL BLOCK:  PCB WAIT FLAGS >>                   <<06425>>00715000
EQUATE                                                                  00720000
             IODADWAIT       = %101      ,                              00725000
             FILEDADWAIT     = 3         ,                              00730000
             DADWAIT         = 1         ,                              00735000
             SONWAIT         = 2         ;                              00740000
$PAGE "***   LOGICAL - PHYSICAL DEVICE TABLE - LPDT   ***"              00745000
<< LOGICAL - PHYSICAL DEVICE TABLE - LPDT >>                            00750000
DEFINE                                                                  00755000
                                                               <<04397>>00760000
           SUBTYPE'2608A    = 4                 #,             <<04425>>00765000
           SUBTYPE'2680A    = 8                 #,             <<04397>>00770000
           SUBTYPE'EPOC     = 8                 #,             <<04397>>00775000
           SUBTYPE'2608B'FEATURE = 9            #,             <<04397>>00780000
           SUBTYPE'2608B'TRANSPARENT = 13       #,             <<B9094>>00785000
           SUBTYPE'2631B'HARDWIRED   = 14       #,             <<B9094>>00790000
           SUBTYPE'2631B'MODEM       = 15       #;             <<B9094>>00795000
$PAGE "***   LOGICAL DEVICE TABLE - LDT   ***"                 <<06527>>00800000
<< LDT related defines for GETDEVINFO returns >>               <<06527>>00805000
                                                               <<06527>>00810000
EQUATE                                                         <<06527>>00815000
   SIZE'OF'GETDEVINFO       = 13;  << size of returned array >><<06527>>00820000
DEFINE                                                         <<06527>>00825000
   G'DEV'TYPE               = DEVINFO(1)#,                     <<06527>>00830000
   G'DEV'RECORD'WIDTH       = DEVINFO(8).(0:8)#;               <<06527>>00835000
                                                               <<06527>>00840000
$PAGE "***   SPOOLER STACK   ***"                                       00845000
COMMENT  <<P>> MEANS PROGEN INITIALIZES VARIABLE;                       00850000
                                                                        00855000
<< PROGEN -> SPOOLER COMMUNICATION >>                                   00860000
   LOGICAL DADSCALL          = DB+0              , <<P>>                00865000
           DIRECTIVE         = DADSCALL          ;                      00870000
   DEFINE  DADCALLING        = DADSCALL.(0:1)    #,                     00875000
           DADSALTER'DEV    = DADSCALL.(1:1)    #,             <<02582>>00880000
           DADSSPOOLREQ      = DADSCALL.(8:4)    #,                     00885000
           DADSFILEREQ       = DADSCALL.(12:4)   #;                     00890000
   EQUATE  PRIORDIRECTIVE    = 0                 ,                      00895000
           QUITSPOOLING      = 1                 ,                      00900000
           WAITSPOOLING      = 2                 ,                      00905000
           RESUMESPOOLING    = 3                 ,                      00910000
           KEEPSPOOLING      = RESUMESPOOLING    ,                      00915000
           FINISHFILE        = 0                 ,                      00920000
           DELETEFILE        = 1                 ,                      00925000
           DEFERFILE         = 2                 ,                      00930000
           RELINKFILE        = 3                 ;                      00935000
   LOGICAL SPOOLREQUEST      = DB+1              ,                      00940000
           FILEREQUEST       = DB+2              ;                      00945000
                                                                        00950000
<< SPOOLER CONTROL >>                                                   00955000
   INTEGER SPOOLEE           = DB+3              ,<<P>>                 00960000
           DEVICE            = SPOOLEE           ,                      00965000
           STOPSPOOLING      = DB+4              ;                      00970000
   LOGICAL IMAGETYPE         = DB+5              ;                      00975000
   DEFINE                                                      <<01549>>00980000
           RECOVER'POWER'FAIL= IMAGETYPE.(9:1)   #,            <<01549>>00985000
           DONEIMAGE         = IMAGETYPE.(10:1)  #,            <<01549>>00990000
           FREEIMAGE         = IMAGETYPE.(11:1)  #,                     00995000
           PUTIMAGE          = IMAGETYPE.(12:1)  #;                     01000000
   EQUATE  MAIL              = 4                 ,                      01005000
           FORMS             = 6                 ,                      01010000
           NORMAL            = %30               ,                      01015000
           PHYSEOF           = %60               ,                      01020000
           LOGEOF            = %63               ,                      01025000
           IOERR             = %64               ,                      01030000
           IMAGE'DATA'CTL'ERR= %65               ,             <<C7517>>01035000
           EOD               = %31               ,                      01040000
           DADMAD            = %40               ,                      01045000
           DATA              = %61               ,                      01050000
           JOB               = %62               ,                      01055000
           IOSPOOFLERR       = %44               ,                      01060000
           VAL'COMMAND       = 0                 ,             <<00291>>01065000
           INVALID'COM       = 1                 ,             <<00291>>01070000
           BLANKLINE         = 2                 ,             <<00291>>01075000
           EOJ               = %72               ;                      01080000
   INTEGER DEVICEFILE        = DB+7              ,                      01085000
           SPOOLFILE         = DB+8              ;                      01090000
   LOGICAL SPOOLER           = DB+9              ;                      01095000
   INTEGER DEVICETYPE        = DB+10             ;                      01100000
<< DEVICE RECOGNITION >>                                                01105000
   LOGICAL DEVRECFLAGS       = DB+12             ,                      01110000
           OUTFLAGS          = DEVRECFLAGS       ;                      01115000
   logical outflags2         = DB + 76;                        <<04407>>01120000
   define                                                      <<04407>>01125000
           resumed'spoolfle    = outflags2.(0:1)   #           <<04407>>01130000
          ,is'suspended        = outflags2.(1:1)   #           <<04407>>01135000
          ,alter'dev           = outflags2.(2:1)   #           <<04407>>01140000
          ,end'of'check'points = outflags2.(3:1)   #           <<04407>>01145000
          ,printer'2608        = outflags2.(4:1)   #           <<04407>>01150000
          ,sent'a'header       = outflags2.(5:1)   #           <<04407>>01155000
          ,sent'a'trailer      = outflags2.(6:1)   #           <<04407>>01160000
          ,dev'in'silent'run   = outflags2.(7:1)   #           <<04407>>01165000
          ,silent'run'at'eoj   = outflags2.(8:1)   #           <<04407>>01170000
          ,printer'2680A       = outflags2.(9:1)   #           <<04407>>01175000
          ,got'new'block       = outflags2.(10:1)  #           <<04407>>01180000
          ,new'silent'run      = outflags2.(11:1)  #           <<04407>>01185000
          ,printer'2631B       = outflags2.(12:1)  #           <<B9094>>01190000
          ;                                                    <<04407>>01195000
   DEFINE  PROMPTING         = DEVRECFLAGS.(0:1) #,                     01200000
           RECOVERING        = OUTFLAGS.(0:1)    #,                     01205000
           CONTINUING        = DEVRECFLAGS.(1:1) #,                     01210000
           CHOOSEDEV         = OUTFLAGS.(1:1)    #,                     01215000
           IMAGEHUNGOVER     = DEVRECFLAGS.(2:1) #,                     01220000
           STARTED           = OUTFLAGS.(2:1)    #,                     01225000
           FOD               = OUTFLAGS.(3:1)    #,                     01230000
           INCOMPLETE        = OUTFLAGS.(4:1)    #,                     01235000
           NOSPACE           = OUTFLAGS.(5:1)    #,                     01240000
           SQEEZE            = OUTFLAGS.(6:1)    #,                     01245000
           RSQEEZE           = OUTFLAGS.(7:1)    #,                     01250000
           PENDACTIVE        = DEVRECFLAGS.(8:8) #;                     01255000
   EQUATE BLOCKS=8; <<NUMBER OF 512 WORD SPOOLFILE BLOCKS >>   <<01549>>01260000
                    << IN BUFFER                          >>   <<01549>>01265000
   EQUATE EPOC'SUBTYPE = 8; <<EPOC SUB TYPE>>                  <<01549>>01270000
   INTEGER COMLENGTH         = DB+13             ;                      01275000
   INTEGER POINTER COMIMAGE  = DB+14             ;                      01280000
                                                                        01285000
<< BUFFER/RECORD CONTROL >>                                             01290000
   BYTE PSEUDOCOLON          = DB+15             ;                      01295000
   INTEGER READCODE          = DB+16             ,                      01300000
           EOFCODE           = DB+17             ;                      01305000
   LOGICAL WRITEEND          = READCODE          ,                      01310000
           WRITEWAIT         = EOFCODE           ;                      01315000
   EQUATE  INBUFS            = 2                 ,                      01320000
           OUTBUFS           = 16                ,                      01325000
           MAXLINESPERPAGE   = 66                ,             <<01549>>01330000
           ZEROREAD          = 0                 ,                      01335000
           HDWRREAD          = 1                 ,                      01340000
           DATAREAD          = 2                 ,                      01345000
           SESSREAD          = 3                 ,                      01350000
           JOBREAD           = 4                 ;                      01355000
   INTEGER DEVICERECL        = DB+18             ,                      01360000
           RECL              = DB+19             ;                      01365000
   INTEGER POINTER DEVICERECP= DB+20             ,                      01370000
                   RECP      = DB+21             ;                      01375000
   DOUBLE POINTER RECPD      = RECP              ;                      01380000
   BYTE POINTER RECPB        = DB+22             ;                      01385000
   INTEGER SRFUNC            = DB+23             ,                      01390000
           SRP1              = DB+24             ,                      01395000
           SRP2              = DB+25             ;                      01400000
   EQUATE  SREAD             = 0                 ,                      01405000
           SWRITE            = 1                 ,                      01410000
           SCONTROL          = 2                 ,                      01415000
           SOPEN             = 3                 ,                      01420000
           SCLOSE            = 4                 ,                      01425000
           SFINI             = 5                 ;                      01430000
   INTEGER POINTER SBASE     = DB+26             ;                      01435000
   INTEGER SCOUNT            = DB+27             ;                      01440000
                                                                        01445000
<< REAL WORLD >>                                                        01450000
   INTEGER CIERRNUM          = DB+28             ,             <<00534>>01455000
           CIPARMNUM         = DB+29             ;             <<00534>>01460000
   INTEGER POINTER JMATP     = DB+30             ,                      01465000
                   OUTCLASSES= JMATP             ,                      01470000
                   XDDEP     = DB+31             ,                      01475000
                   IDDEP     = XDDEP             ,                      01480000
                   ODDEP     = XDDEP             ,                      01485000
                   ODDXP     = DB+32             ,                      01490000
                   LDTP      = DB+33             ,                      01495000
                   DEVHP     = DB+34             ,                      01500000
                   CLASSHP   = DB+35             ;                      01505000
   INTEGER DEVFILEID         = DB+36             ,                      01510000
           JOBNUMBER         = DB+37             ,                      01515000
           STREAMDEV         = DB+38             ,                      01520000
           LISTTYPE          = DB+39             ,                      01525000
           LISTSIZE          = DB+40             ,                      01530000
           STACKDST          = DB+41             ,                      01535000
           JLISTED           = DB+42             ,                      01540000
           ORIGDEST          = DB+43             ;                      01545000
                                                                        01550000
   DOUBLE   LINES'PRINTED     = DB+44              ;           <<B0.SZ>>01555000
   INTEGER  LINES'PRINTED0    = LINES'PRINTED      ;           <<B0.SZ>>01560000
   INTEGER  LINES'PRINTED1    = LINES'PRINTED + 1  ; <<DB+45>> <<B0.SZ>>01565000
<<  RESTART CONTROL  >>                                        <<01549>>01570000
   LOGICAL  BACK              = DB+46               ;<<P>>     <<01549>>01575000
   INTEGER  PAGES             = DB+47               ,<<P>>     <<01549>>01580000
            FILES             = DB+48               ;<<P>>     <<01549>>01585000
   LOGICAL  BACKWARDS         = DB+49               ;          <<01549>>01590000
   INTEGER  PAGECNT           = DB+50               ,          <<01549>>01595000
            FILECNT           = DB+51               ;          <<01549>>01600000
   DOUBLE   BLKNUM            = DB+52 <<AND 53>>    ;          <<01549>>01605000
   INTEGER BLKNUM0             = BLKNUM      ,                 <<01549>>01610000
           BLKNUM1             = BLKNUM + 1  ;                 <<01549>>01615000
   DOUBLE  CURR'PAGE           = DB+54;   <<AND 55>>           <<01549>>01620000
   DOUBLE  REC'LAST'PAGE       = DB+56;    <<AND 57>>          <<01549>>01625000
   DOUBLE REC'COUNT = DB + 58;  <<AND 59>>                     <<01549>>01630000
                                                               <<M8207>>01635000
<< The following variables are used by  the  input  spooler >> <<M8207>>01640000
<< when scheduling a job for logon some time in the future. >> <<S8949>>01645000
<< They share the locations with REC'COUNT (a  double)  and >> <<S8949>>01650000
<< CHANNELSKIP, which are not used by the input spooler.    >> <<S8949>>01655000
                                                               <<M8207>>01660000
   LOGICAL ARRAY FUTURE'TIME(*) = REC'COUNT;                   <<S8949>>01665000
   DEFINE  PAGE'BOUNDARY   = (RECI.(0:8) = "1" LAND SRP1 = 1)  <<01549>>01670000
                            OR   SRP1 = "1" OR SRP1 = %300 OR  <<01549>>01675000
                 (RECI.(0:8) = %300 LAND SRP1 = 1) #;          <<01549>>01680000
   INTEGER  CHANNELSKIP        = DB + 60; <<TOP OF FORM>>      <<01549>>01685000
   INTEGER  FUTURE'DATE        = CHANNELSKIP;                  <<S8949>>01690000
$PAGE "SPOOL FILE USER LABEL DECLARATIONS"                     <<04407>>01695000
   <<CIRCULAR QUEUE ON STACK CONTAINS 1 SECTOR OF 8 WORD>>     <<01549>>01700000
   <<  ENTRIES>>                                               <<01549>>01705000
                                                               <<01549>>01710000
   INTEGER POINTER BLOCKTABLE = DB+61;<<CIRCULAR Q IN-CORE>>   <<01549>>01715000
   INTEGER POINTER BLOCKCP = DB+62; <<CURRENT,FIRST POINTER>>  <<01549>>01720000
   INTEGER POINTER BLOCKFP = DB+63;                            <<01549>>01725000
   DOUBLE POINTER DBLOCKFP = BLOCKFP;                          <<01549>>01730000
   DOUBLE POINTER DBLOCKCP = BLOCKCP;                          <<01549>>01735000
   INTEGER POINTER FLAB  = DB+64; << TEMPORARY ULAB READS>>    <<01549>>01740000
   DOUBLE POINTER FLABDBL = FLAB;                              <<01549>>01745000
                                                               <<01549>>01750000
                                                               <<01549>>01755000
   <<SPOOLFILE USER LABEL 0>>                                  <<01549>>01760000
                                                               <<01549>>01765000
   DEFINE                                                      <<01549>>01770000
           SPULAB'LDEV = FLAB       #,   <<LDEV OF ACTIVE DEVICE >>     01775000
           SPULAB'CURREXT = FLAB(1) #,   <<CURRENT EXTENT PRINTING>>    01780000
           SPULAB'LASTBLOCK = FLAB(2)#,<<LASTBLOCK ACTIVELY PRINTING>>  01785000
           SPULAB'LASTREC = FLAB(4)#,    <<LAST RECORD PRINTING>>       01790000
           SPULAB'LASTULAB = FLAB(6).(0:8) #,  <<LAST USED CIRCULAR Q>> 01795000
           SPULAB'ULABENTRY = FLAB(6).(8:8)#,  <<LAST CIRC Q ENTRY>>    01800000
           SPULAB'CHNSKIP = FLAB(7).(0:8)#, <<PAGE EJECT CHANNEL>>      01805000
           SPULAB'LINESPERPAGE = FLAB(7).(8:8)#, <<# LINES/PAGE>>       01810000
           SPULAB'LASTFOPEN = FLAB(8).(0:8)#, <<LAST FOPEN ULAB>>       01815000
           SPULAB'FOPENENTRY = FLAB(8).(8:8)#, <<LAST FOPEN ENTRY>>     01820000
           SPULAB'TOTULAB = FLAB(9)#,    <<TOTAL USERLABELS ALLOC>>     01825000
           SPULAB'LASTPAGE = FLAB(10)#, <<LAST PAGE PRINTING>> <<01885>>01830000
           SPULAB'LAST'ENV = FLAB(11)#, <<LAST USED ENV FILE>> <<01885>>01835000
           SPULAB'DAYFILE  = FLAB(50)#; <<ERR FILE DFID>>      <<01885>>01840000
   DEFINE                                                      <<01549>>01845000
         SPULAB'LASTBLKD = FLABDBL(1)#,            <<SP.12>>   <<01549>>01850000
         SPULAB'LASTRECD   = FLABDBL(2)#,            <<SP.12>> <<01549>>01855000
         SPULAB'LASTPAGD = FLABDBL(5)#;                        <<01549>>01860000
                                                               <<01549>>01865000
   EQUATE                                                      <<01549>>01870000
           FOPENULABSIZE = 4,   <<FOPEN ENTRY SIZE IN ULAB>>   <<01549>>01875000
           MAXUSERLABELS = 27,  <<MAXIMUM USER LABELS ASSIGNED>>        01880000
           MAXFOPENULAB = 10, <<USER LABELS USED FOR FOPENS>>  <<01549>>01885000
           MAXFOPENENTRY = 31; <<NUMBER OF 4 WORD ENTRIES IN A ULAB>>   01890000
                                                               <<01549>>01895000
                                                               <<01549>>01900000
<<SPOOLFILE USER LABELS 1-10>>                                 <<01549>>01905000
<<CONTAIN FOPEN/FCLOSE ENTRIES>>                               <<01549>>01910000
<<A DOUBLEWORD ENTRY INDICATES BLKCOUNT>>                      <<01549>>01915000
                                                               <<01549>>01920000
<<SPOOLFILE USER LABELS 11-26>>                                <<01549>>01925000
<<CIRCULAR QUEUE ENTRIES>>                                     <<01549>>01930000
DEFINE                                                         <<01549>>01935000
         SPULAB'CQBLKD  = PFLABDBL#,                           <<01549>>01940000
         SPULAB'CQRECD  = PFLABDBL(1)#,                        <<01549>>01945000
         SPULAB'CQPAGE  = PFLABDBL(2)#,                        <<01549>>01950000
         SPULAB'CQRESVD = PFLABDBL(3)#;                        <<01549>>01955000
                                                               <<01549>>01960000
EQUATE                                                         <<01549>>01965000
     NORMAL'CQENTRIES = 16, <<NUMBER OF 8 WORD ENTRIES>>       <<01549>>01970000
                            <<IN A ULAB>>                      <<01549>>01975000
     NORMAL'CQENTRYSIZE  = 8;  <<SIZE OF CIRCULAR QUEUE>>      <<01549>>01980000
                            <<ENTRIES IN WORDS>>              <<01549>>01985000
                                                               <<01549>>01990000
DEFINE                                                         <<01549>>01995000
     MAXCQENTRIES = ( IF BLOCKMODE OR CIPER                    <<04397>>02000000
                        THEN NORMAL'CQENTRIES/2                <<04397>>02005000
                        ELSE NORMAL'CQENTRIES   )#,            <<04397>>02010000
     CQENTRYSIZE  = ( IF BLOCKMODE OR CIPER                    <<04397>>02015000
                        THEN NORMAL'CQENTRYSIZE*2              <<04397>>02020000
                        ELSE NORMAL'CQENTRYSIZE  )#;           <<04397>>02025000
$PAGE                                                          <<04397>>02030000
  equate                                                       <<04397>>02035000
                                                               <<04397>>02040000
     fulab'open           = 0                                  <<04397>>02045000
    ,fulab'close          = 1 + fulab'open                     <<04397>>02050000
    ,fulab'read'cq        = 1 + fulab'close                    <<04397>>02055000
    ,fulab'write'cq       = 1 + fulab'read'cq                  <<04397>>02060000
    ,fulab'enable'func    = 1 + fulab'write'cq                 <<04397>>02065000
    ,fulab'disable'func   = 1 + fulab'enable'func              <<04397>>02070000
    ,fulab'min            = fulab'open                         <<04397>>02075000
    ,fulab'max            = fulab'disable'func                 <<04397>>02080000
    ;                                                          <<04397>>02085000
                                                               <<04397>>02090000
  define                                                       <<04397>>02095000
                                                               <<04397>>02100000
     ulab0'device         = 0 #                                <<04397>>02105000
    ,ulab0'curr'ext       = 1 #                                <<04397>>02110000
    ,ulab0'd'last'block   = 1 #                                <<04397>>02115000
    ,ulab0'd'last'rec     = 2 #                                <<04397>>02120000
    ,ulab0'chan'skip      = 7).(0:8 #                          <<04397>>02125000
    ,ulab0'lines'per'page = 7).(8:8 #                          <<04397>>02130000
    ,ulab0'last'fopen     = 8).(0:8 #                          <<04397>>02135000
    ,ulab0'fopen'entry    = 8).(8:8 #                          <<04397>>02140000
    ,ulab0'num'ulabs      = 9 #                                <<04397>>02145000
    ,ulab0'last'page      = 10 #                               <<04397>>02150000
    ,ulab0'last'env       = 11 # << 18 words >>                <<04397>>02155000
    ,ulab0'b'last'env     = 22 #                               <<04397>>02160000
                                                               <<04397>>02165000
    ,ulab0'cq'first'ulab  = 29).(0:8 #                         <<04397>>02170000
    ,ulab0'cq'last'ulab   = 29).(8:8 #                         <<04397>>02175000
                                                               <<04397>>02180000
    ,ulab0'cq'head'ptr    = 30 #                               <<04397>>02185000
    ,ulab0'cq'head'ulab   = 30).(0:8 #                         <<04397>>02190000
    ,ulab0'cq'head'entry  = 30).(8:8 #                         <<04397>>02195000
                                                               <<04397>>02200000
    ,ulab0'cq'tail'ptr    = 31 #                               <<04397>>02205000
    ,ulab0'cq'tail'ulab   = 31).(0:8 #                         <<04397>>02210000
    ,ulab0'cq'tail'entry  = 31).(8:8 #                         <<04397>>02215000
                                                               <<04397>>02220000
    ,ulab0'cq'max'entry'size  = 32).(0:8 #                     <<04397>>02225000
    ,ulab0'cq'per'ulab    = 32).(8:8 #                         <<04397>>02230000
                                                               <<04397>>02235000
    ,ulab0'max'cq'entries = 33 #                               <<04397>>02240000
                                                               <<04397>>02245000
    ,ulab0'cq'empty       = 34).(0:1 #                         <<04397>>02250000
    ,ulab0'cq'record'freq = 34).(8:8 #                         <<04397>>02255000
                                                               <<04397>>02260000
    ,ulab0'device'type    = 35 #                               <<04397>>02265000
    ,ulab0'device'subtype = 36 #                               <<04397>>02270000
                                                               <<04397>>02275000
    ,ulab0'sp'mit'version = 37 #                               <<04397>>02280000
    ,ulab0'sp'mit'update  = 38 #                               <<04397>>02285000
    ,ulab0'sp'mit'fix     = 39 #                               <<04397>>02290000
                                                               <<04397>>02295000
    ,ulab0'fs'mit'version = 40 #                               <<04397>>02300000
    ,ulab0'fs'mit'update  = 41 #                               <<04397>>02305000
    ,ulab0'fs'mit'fix     = 42 #                               <<04397>>02310000
                                                               <<04397>>02315000
    ,ulab0'spoolfle'block'size = 43 #                          <<04397>>02320000
                                                               <<04397>>02325000
    ,ulab0'd'last'checkpoint = 22 # << words 44 & 45 >>        <<04397>>02330000
                                                               <<04397>>02335000
    ,ulab0'errfile'dfid   = 51 #                               <<04397>>02340000
    ;                                                          <<04397>>02345000
                                                               <<04397>>02350000
$PAGE "MAXIMUM BUFFER SIZES"                                   <<04397>>02355000
  equate                                                       <<04397>>02360000
                                                               <<04397>>02365000
     size'of'avail'returns     =  16 << words;   32 bytes >>   <<04397>>02370000
    ,size'of'check'point       =  16 << words;   32 bytes >>   <<04397>>02375000
    ,size'of'device'status     =   3 << words;    6 bytes >>   <<04397>>02380000
    ,size'of'env'status'block  =  16 << words;   32 bytes >>   <<04397>>02385000
    ,size'of'job'report'status =   3 << words;    6 bytes >>   <<04397>>02390000
    ,size'of'silent'run        =  16 << words;   32 bytes >>   <<04397>>02395000
    ,size'of'spoolfle'block    = 512 << words; 1024 bytes >>   <<04397>>02400000
    ,size'of'ulab              = 128 << words;  256 bytes >>   <<04397>>02405000
    ;                                                          <<04397>>02410000
                                                               <<04397>>02415000
$PAGE "CIPER STATUSES & SILENT RUN RECORD DECLARATIONS"        <<04397>>02420000
  define                                                       <<04397>>02425000
                                                               <<04397>>02430000
                                                               <<04397>>02435000
    << Device Status Report expansion >>                       <<04397>>02440000
                                                               <<04397>>02445000
       << peripheral status >>                                 <<04397>>02450000
     dev'st'peripheral'status            = 0 #                 <<04397>>02455000
    ,dev'st'on'line                      = 0).(0:1 #           <<04397>>02460000
    ,dev'st'paper'out                    = 0).(1:1 #           <<04397>>02465000
    ,dev'st'paper'jam                    = 0).(2:1 #           <<04397>>02470000
    ,dev'st'platen'open                  = 0).(3:1 #           <<04397>>02475000
    ,dev'st'ribbon'error                 = 0).(4:1 #           <<04397>>02480000
    ,dev'st'self'test'failed             = 0).(6:1 #           <<04397>>02485000
                                                               <<04397>>02490000
       << peripheral errors >>                                 <<04397>>02495000
    ,dev'st'possible'data'loss           = 0).(14:1 #          <<04397>>02500000
    ,dev'st'power'fail                   = 0).(15:1 #          <<04397>>02505000
                                                               <<04397>>02510000
       << self test failuse code >>                            <<04397>>02515000
    ,dev'st'failure'code                 = 1 #                 <<04397>>02520000
                                                               <<04397>>02525000
       << CIPER protocol errors >>                             <<04397>>02530000
    ,dev'st'protocol'errors              = 2 #                 <<04397>>02535000
    ,dev'st'header'length'illegal        = 2).(0:1 #           <<04397>>02540000
    ,dev'st'recv'record'numbering'error  = 2).(1:1 #           <<04397>>02545000
    ,dev'st'creator'bit'illegal          = 2).(2:1 #           <<04397>>02550000
    ,dev'st'undefined'record'opcode      = 2).(3:1 #           <<04397>>02555000
    ,dev'st'bad'data'type                = 2).(4:1 #           <<04397>>02560000
    ,dev'st'bad'esb'format'number        = 2).(5:1 #           <<04397>>02565000
    ,dev'st'block'label'len'illegal      = 2).(7:1 #           <<04397>>02570000
    ,dev'st'transport'error              = 2).(8:1 #           <<04397>>02575000
    ,dev'st'data'overrun                 = 2).(9:1 #           <<04397>>02580000
                                                               <<04397>>02585000
                                                               <<04397>>02590000
    << Job Status Report expansion >>                          <<04397>>02595000
                                                               <<04397>>02600000
    ,job'st'in'silent'run                = 0).(7:1 #           <<04397>>02605000
    ,job'st'msw'sheet'cnt                = 1 #                 <<04397>>02610000
    ,job'st'lsw'sheet'cnt                = 2 #                 <<04397>>02615000
                                                               <<04397>>02620000
                                                               <<04397>>02625000
    << Environmental Status Block expansion >>                 <<04397>>02630000
                                                               <<04397>>02635000
    ,env'st'd'block'number               = 0 #                 <<04397>>02640000
    ,env'st'd'byte'offset                = 1 #                 <<04397>>02645000
    ,env'st'd'checkpoint'number          = 2 #                 <<04397>>02650000
    ,env'st'd'last'non'recoverable       = 3 #                 <<04397>>02655000
    ,env'st'device'format'number         = 8 #                 <<04397>>02660000
                                                               <<04397>>02665000
                                                               <<04397>>02670000
    << Silent Run Record expansion >>                          <<04397>>02675000
                                                               <<04397>>02680000
    ,silent'run'd'block'number           = 0 #                 <<04397>>02685000
    ,silent'run'd'byte'offset            = 1 #                 <<04397>>02690000
    ,silent'run'd'checkpoint'number      = 2 #                 <<04397>>02695000
    ,silent'run'd'start'print'checkpoint = 3 #                 <<04397>>02700000
    ,silent'run'device'format'number     = 8 #                 <<04397>>02705000
                                                               <<04397>>02710000
    ,silent'run'min'rec'size             = 8 #                 <<04397>>02715000
    ,silent'run'max'rec'size             = size'of'silent'run# <<04397>>02720000
  ;                                                            <<04397>>02725000
                                                               <<04397>>02730000
                                                               <<01549>>02735000
$PAGE "2680A LASER PRINTING SYSTEM DECLARATIONS"               <<04400>>02740000
   INTEGER DEVICE'SUBTYPE = DB+65;                             <<01549>>02745000
   LOGICAL BLOCKMODE =      DB+66;                             <<01549>>02750000
   DEFINE PAGEPRINTER = DEVICETYPE = PRINTER                   <<01549>>02755000
                 AND DEVICE'SUBTYPE = EPOC'SUBTYPE #;          <<01549>>02760000
   LOGICAL FLAGWORD = DB + 67;                                 <<01549>>02765000
   INTEGER CURRULABNO = DB + 68;                               <<01549>>02770000
    DOUBLE PAGE'ST'BLKNUM = DB + 69; <<DB+69,70>>              <<01549>>02775000
   DEFINE UPDATE'CKPT'FLAG = FLAGWORD.(15:1)#;                 <<01549>>02780000
   DEFINE UPDATE'ULABNUM'FLAG = FLAGWORD.(14:1)#;              <<01549>>02785000
DEFINE                                                         <<01549>>02790000
   SINGLE'BLOCK'MODE = FLAGWORD.(12:1)#,                       <<01549>>02795000
   POWER'UP'OCCURRED    = FLAGWORD.(11:1)#,                    <<01885>>02800000
   END'OF'JOB           = FLAGWORD.(10:1)#,                    <<02504>>02805000
   JOB'OPEN'FAILED      = FLAGWORD.(9:1)#,                     <<02512>>02810000
   JOB'HAS'ERRORS       = FLAGWORD.(8:1)#,                     <<02527>>02815000
   DAYFILE'LOST         = FLAGWORD.(7:1)#;                     <<02527>>02820000
       <<2680 EQUATES AND CONSTANTS >>                         <<01549>>02825000
   EQUATE                                                      <<01549>>02830000
                                                               <<01549>>02835000
           JOB'ABORT            = 1,                           <<01885>>02840000
           JOB'CLOSE            = 0,                           <<01885>>02845000
           DEVICE'CLOSE         = 4,                           <<01885>>02850000
           FLUSH                = 141,                         <<01885>>02855000
           JOB'OPEN             = 142,                         <<01885>>02860000
           LOAD'DEFAULT         = 143,                         <<01885>>02865000
           READ'IO'STATUS       = 71,                          <<01885>>02870000
           CLEAR = 189,  <<2680 CLEAR FUNCTION>>               <<02504>>02875000
           WRITE'PAGE'STATUS'RECOVERY = 190,                   <<01885>>02880000
           READ'LAST'PHYS'PAGE  = 71,                          <<01885>>02885000
           READ'PAGE'STATUS     = 191,                         <<01885>>02890000
           READ'ENVIR'STATUS    = 191,                         <<01885>>02895000
           INTER'JOB'CLEAR      = %40,                         <<01885>>02900000
           IMMEDIATE'CLEAR     = 189,                         <<EPC0U >>02905000
            ERR'UPPER'LIMIT   = 100,                           <<02504>>02910000
           REWIND               = 5;  <<FCONTROL REWIND>>      <<01885>>02915000
                                                               <<01549>>02920000
       << NOTE DOUBLEWORD QUANTITIES ARE  <<D>>                <<01549>>02925000
DEFINE                                                         <<01549>>02930000
       PG'STAT'BLK               = 0      #, <<D>>             <<01549>>02935000
       PG'STAT'BYTE'OFFSET       = 2      #,                   <<01549>>02940000
       PG'STAT'SEC'CHAR          = 3).(0:8#,                   <<01549>>02945000
       PG'STAT'PRI'CHAR          = 3).(8:8#,                   <<01549>>02950000
       PG'STAT'PAGENUM           = 2      #, <<D>>             <<01549>>02955000
       PG'STAT'NON'RECOVER'PG    = 3      #, <<D>>             <<01549>>02960000
       PG'STAT'ACTIVE'LOGICAL'MAP= 4      #, <<D>>             <<01549>>02965000
       PG'STAT'NUMCOPIES         =10      #,                   <<01549>>02970000
       PG'STAT'PS                =11).(0:1#,                   <<01549>>02975000
       PG'STAT'SM                =11).(1:1#,                   <<01549>>02980000
       PG'STAT'AE                =11).(2:1#,                   <<01549>>02985000
       PG'STAT'RP                =11).(3:1#,                   <<01549>>02990000
       PG'STAT'NG                =11).(4:1#,                   <<01549>>02995000
       PG'STAT'MC                =11).(5:1#,                   <<01549>>03000000
       PG'STAT'UNUSED            =11).(6:8#,                   <<01549>>03005000
       PG'STAT'SP                =11).(14:2#,                  <<01549>>03010000
       PG'RECOVER'PAGENUM=PG'STAT'NON'RECOVER'PG#; <<D>>       <<01549>>03015000
                                                               <<01885>>03020000
DEFINE ENV'STAT'PAGENUM = 7#;  <<D>>                           <<01885>>03025000
DEFINE   SET'DISPOSITION =                                     <<02504>>03030000
             FILEREQUEST := DEFERFILE;                         <<02504>>03035000
             IMAGETYPE := PHYSEOF;                             <<02504>>03040000
             INCOMPLETE := 1; #;                               <<02504>>03045000
   INTEGER DAYFILE = DB + 71;                                  <<01885>>03050000
                                                               <<01885>>03055000
   INTEGER ERR'COUNT = DB + 72;                                <<01885>>03060000
   INTEGER DAY'DFID = DB + 73;                                 <<01885>>03065000
   DOUBLE NEXT'FOPEN'REC = DB+74; <<AND DB + 75>>              <<01885>>03070000
   <<SEE OUTFLAGS2 FOR DB+76 DECLARATION>>                     <<02580>>03075000
                                                               <<04397>>03080000
   LOGICAL CIPER = DB + 77;   << TRUE FOR CIPER DEVICES >>     <<04397>>03085000
                                                               <<01885>>03090000
   EQUATE                                                      <<01549>>03095000
         RESTART = 0,                                          <<01549>>03100000
         RECOVER = 1,                                          <<01549>>03105000
         SKIP'PHYS'PAGES = 2,                                  <<01549>>03110000
         SKIP'FILES = 3;                                       <<01549>>03115000
$PAGE "MPE IO SYSTEM: STATUS QUALIFIERS & RETURNS"             <<04400>>03120000
  define                                                       <<04400>>03125000
                                                               <<04400>>03130000
  << * * IO System status qualifiers * * >>                    <<04400>>03135000
     general'status    = (13:3) #                              <<04400>>03140000
    ,qual'gen'status   = (8:8) #                               <<04400>>03145000
    ,qualifying'status = (8:5) #                               <<04400>>03150000
  ;                                                            <<04400>>03155000
                                                               <<04397>>03160000
  equate                                                       <<04397>>03165000
                                                               <<04397>>03170000
  << * * IO System status returns * * >>                       <<04397>>03175000
    << * General Status * >>                                   <<04397>>03180000
     gen'st'pending         =   %0                             <<04397>>03185000
    ,gen'st'ok              =   %1                             <<04397>>03190000
    ,gen'st'eof             =   %2                             <<04397>>03195000
    ,gen'st'unusual         =   %3                             <<04397>>03200000
    ,gen'st'irrecoverable   =   %4                             <<04397>>03205000
    ,GEN'ST'DATA'CTL'INFO   =    5                             <<C7517>>03210000
                                                               <<04397>>03215000
    << * Qualified General Status * >>                         <<04397>>03220000
      << Pending >>                                            <<04397>>03225000
    ,st'pending             =   %0                             <<04397>>03230000
                                                               <<04397>>03235000
      << Successful >>                                         <<04397>>03240000
    ,st'ok                  =   %1                             <<04397>>03245000
    ,st'ok'plus'status      =  %41                             <<04397>>03250000
                                                               <<04397>>03255000
      << Unusual >>                                            <<04397>>03260000
    ,st'io'status'available =  %13                             <<04397>>03265000
    ,st'io'st'and're'xmit   =  %23                             <<04397>>03270000
    ,st'req'abort'external  =  %33                             <<04397>>03275000
    ,st'device'not'on'line  =  %53                             <<04397>>03280000
    ,st'power'fail'abort    =  %63                             <<04397>>03285000
    ,st'device'power'up     = %213                             <<04397>>03290000
    ,st'not'ok'plus'status  = %243                             <<04397>>03295000
    ,st'vfc'reset           = %273                             <<04397>>03300000
                                                               <<04397>>03305000
      << Irrecoverable >>                                      <<04397>>03310000
    ,st'invalid'request     =   %4                             <<04397>>03315000
    ,st'transfer'error      =  %14                             <<04397>>03320000
    ,st'timeout             =  %24                             <<04397>>03325000
    ,st'sio'failure         =  %44                             <<04397>>03330000
    ,st'hard'malfunction    =  %54                             <<04397>>03335000
    ,st'catastrophic        = %124                             <<04397>>03340000
    ,st'controller'dead     = %144                             <<04397>>03345000
    ,st'sio'error           = %154                             <<04397>>03350000
    ,st'hpib'phi'lockup     = %214                             <<04397>>03355000
    ,st'dev'protocol'err    = %304                             <<04397>>03360000
    ,st'ldriver'protocol'err= %314                             <<04397>>03365000
    ,st'irrecoverable       = %374                             <<04397>>03370000
    ,st'job'open'failure    = %444                             <<04397>>03375000
                                                               <<C7517>>03380000
      << Error in data control information.                 >> <<C7517>>03385000
    ,ST'INVALID'ITEMNO      =    5,                            <<C7517>>03390000
     ST'INVALID'ACCESS      =  %15,                            <<C7517>>03395000
     ST'DATA'CTL'FSERR      =  %25,                            <<C7517>>03400000
     ST'PARITY'CHNG'8BIT    =  %35,                            <<C7517>>03405000
     ST'INVALID'FORMAT      =  %45,                            <<C7517>>03410000
     ST'INFO'CKSUM'ERR      =  %55,                            <<C7517>>03415000
     ST'VAL'TOO'SMALL       =  %65,                            <<C7517>>03420000
     ST'VAL'TOO'BIG         =  %75,                            <<C7517>>03425000
     ST'VAL'ILLEGAL         = %105,                            <<C7517>>03430000
     ST'COUNT'TOO'SMALL     = %115,                            <<C7517>>03435000
     ST'COUNT'TOO'BIG       = %125,                            <<C7517>>03440000
     ST'OUT'OF'ORDER        = %135,                            <<C7517>>03445000
     ST'OTHER'FUNCTION      = %145                             <<C7517>>03450000
  ;                                                            <<04397>>03455000
$PAGE "MPE IO SYSTEM: ATTACHIO FUNCTION CODES"                 <<04397>>03460000
  equate                                                       <<04397>>03465000
                                                               <<04397>>03470000
  << * * function codes for Attachio's func parameter * * >>   <<04397>>03475000
     func'read'data              = %  0  << = #  0;     data >><<04397>>03480000
    ,func'write'data             = %  1  << = #  1;     data >><<04397>>03485000
    ,func'file'open              = %  2  << = #  2; file     >><<04397>>03490000
    ,func'file'close             = %  3  << = #  3; file     >><<04397>>03495000
    ,func'dev'close              = %  4  << = #  4; dev      >><<04397>>03500000
                                                               <<04397>>03505000
    ,func'dev'stat'immediate     = % 17  << = # 15; dev'stat >><<04397>>03510000
    ,func'load'vfc               = %100  << = # 64; load     >><<04397>>03515000
    ,func'set'left'margin        = %101  << = # 65;          >><<04397>>03520000
    ,func'dev'stat'buffered      = %107  << = # 71; dev'stat >><<04397>>03525000
    ,func'self'test              = %111  << = # 73;          >><<04397>>03530000
    ,func'select'char'sets       = %200  << = #128; select   >><<04397>>03535000
    ,func'select'log'page        = %201  << = #129; select   >><<04397>>03540000
    ,func'move'pen'relative      = %202  << = #130; move'pen >><<04397>>03545000
    ,func'move'pen'absolute      = %203  << = #131; move'pen >><<04397>>03550000
    ,func'def'job'characteristics= %204  << = #132; def      >><<04397>>03555000
    ,func'load'phy'page'def      = %205  << = #133; load     >><<04397>>03560000
    ,func'load'del'char'set      = %206  << = #134; load'del >><<04397>>03565000
    ,func'load'del'forms         = %207  << = #135; load'del >><<04397>>03570000
    ,func'load'log'page'table    = %210  << = #136; load     >><<04397>>03575000
    ,func'load'multicopy'table   = %211  << = #137; load     >><<04397>>03580000
    ,func'load'del'vfc           = %212  << = #138; load'del >><<04397>>03585000
    ,func'load'del'picture       = %213  << = #139; load'del >><<04397>>03590000
    ,func'page'control           = %214  << = #140;          >><<04397>>03595000
    ,func'env'clear              = %215  << = #141; env      >><<04397>>03600000
    ,func'job'start              = %216  << = #142; job      >><<04397>>03605000
    ,func'env'default            = %217  << = #143; env      >><<04397>>03610000
    ,func'print'picture          = %220  << = #144;          >><<04397>>03615000
    ,func'job'end                = %221  << = #145; job      >><<04397>>03620000
    ,func'extended'cap'mode      = %222  << = #146;          >><<04397>>03625000
    ,func'block'start            = %223  << = #147; block    >><<04397>>03630000
    ,func'block'end              = %224  << = #148; block    >><<04397>>03635000
    ,func'job'rprt'buffered      = %263  << = #179; job'rprt >><<04397>>03640000
    ,func'env'stat'immediate     = %264  << = #180; env'stat >><<04397>>03645000
    ,func'dev'stat'composite     = %265  << = #181; dev'stat >><<04397>>03650000
    ,func'send'pending'records   = %266  << = #182;      rec >><<04397>>03655000
    ,func'erase'pending'records  = %267  << = #183;      rec >><<04397>>03660000
    ,func'send'control'mask      = %271  << = #185;          >><<04397>>03665000
    ,func'job'rprt'immediate     = %272  << = #186; job'rprt >><<04397>>03670000
    ,func'read'avail'stat'types  = %273  << = #187;          >><<04397>>03675000
    ,func'set'avail'stat'returns = %274  << = #188;          >><<04397>>03680000
    ,func'dev'clear              = %275  << = #189; dev      >><<04397>>03685000
    ,func'start'silent'recovery  = %276  << = #190;          >><<04397>>03690000
    ,func'env'stat'buffered      = %277, << = #191; env'stat >><<04990>>03695000
     MAX'FUNC                    = %377; << = #255          >> <<04990>>03700000
$PAGE "CIPER DECLARATIONS"                                     <<04397>>03705000
                                                               <<04397>>03710000
                                                               <<04398>>03715000
<<**********************************************************>> <<04398>>03720000
<<                                                          >> <<04398>>03725000
<<                ADDED GLOBAL VARIABLES                    >> <<04398>>03730000
<<                                                          >> <<04398>>03735000
<<  Because of the way global variables have been declared, >> <<04398>>03740000
<< eg. DB+XX, please add all global variables below so that >> <<04398>>03745000
<< they can be kept track of easily and no conflicts result.>> <<04398>>03750000
<<**********************************************************>> <<04398>>03755000
                                                               <<04398>>03760000
DOUBLE                                                         <<04398>>03765000
  PHYSICAL'PAGES    =   DB+78; <<# of physical logical pages>> <<04398>>03770000
                               <<printed (epoc only).       >> <<04398>>03775000
INTEGER                                                        <<04398>>03780000
  LOGICAL'PAGES     =   PHYSICAL'PAGES + 2; <<#of logical   >> <<04398>>03785000
                               <<pages/phys. (epoc only)    >> <<04398>>03790000
                                                               <<04398>>03795000
  logical                                                      <<04407>>03800000
                                                               <<04407>>03805000
     fulab'func'mask       = DB + 81                           <<04407>>03810000
    ,mit'update            = DB + 82                           <<04407>>03815000
    ,mit'fix               = DB + 83                           <<04407>>03820000
    ,mit'version           = DB + 84                           <<04407>>03825000
    ;                                                          <<04407>>03830000
                                                               <<04407>>03835000
  double                                                       <<04407>>03840000
                                                               <<04407>>03845000
     next'page'to'print = DB + 85  << and DB + 86 >>           <<04407>>03850000
    ;                                                          <<04407>>03855000
BYTE POINTER                                                   <<04990>>03860000
   VALID'FUNC'TABLE = DB + 87;                                 <<04990>>03865000
  integer                                                      <<04407>>03870000
                                                               <<04407>>03875000
     device'type     = devicetype                              <<04407>>03880000
    ;                                                          <<04407>>03885000
                                                               <<04407>>03890000
  logical pointer                                              <<04407>>03895000
                                                               <<04407>>03900000
     ulab0           = flab                                    <<04407>>03905000
    ;                                                          <<04407>>03910000
                                                               <<04407>>03915000
  double pointer                                               <<04407>>03920000
                                                               <<04407>>03925000
     ulab0'd         = flab                                    <<04407>>03930000
    ;                                                          <<04407>>03935000
                                                               <<04407>>03940000
$PAGE "***  OPTION EXTERNAL PROCEDURES  ***"                   <<02580>>03945000
PROCEDURE SCHEDULEJOB(JMATPTR);                                         03950000
   VALUE JMATPTR;                                                       03955000
   INTEGER POINTER JMATPTR;                                             03960000
   OPTION UNCALLABLE,PRIVILEGED,EXTERNAL;                               03965000
                                                                        03970000
PROCEDURE SCHEDULESCHED(JMATPTR);                              <<S8949>>03975000
   VALUE JMATPTR;                                              <<S8949>>03980000
   INTEGER POINTER JMATPTR;                                    <<S8949>>03985000
   OPTION UNCALLABLE,PRIVILEGED,EXTERNAL;                      <<S8949>>03990000
                                                               <<S8949>>03995000
PROCEDURE DEALLOCATE'JMAT (ENTRYP);                            <<07058>>04000000
   VALUE ENTRYP;                                               <<07058>>04005000
   INTEGER POINTER ENTRYP;                                     <<07058>>04010000
   OPTION EXTERNAL;                                            <<07058>>04015000
                                                                        04020000
PROCEDURE SRELINKODD (ODDEP, DEV);                                      04025000
   VALUE   DEV,ODDEP;                                                   04030000
   INTEGER DEV;                                                         04035000
   INTEGER POINTER ODDEP;                                               04040000
   OPTION EXTERNAL;                                                     04045000
                                                                        04050000
PROCEDURE WRITEDSEG (D);                                                04055000
   VALUE   D;                                                           04060000
   INTEGER D;                                                           04065000
   OPTION EXTERNAL;                                                     04070000
                                                                        04075000
PROCEDURE CIERR(ERRNUM, ERRADR, PARMMASK, PARM);               <<U.RAO>>04080000
   VALUE ERRNUM, PARMMASK, PARM;                               <<U.RAO>>04085000
   INTEGER ERRNUM, PARMMASK, PARM;                             <<U.RAO>>04090000
   BYTE ARRAY ERRADR;                                          <<U.RAO>>04095000
   OPTION PRIVILEGED, UNCALLABLE, VARIABLE, EXTERNAL;          <<U.RAO>>04100000
   << THIS PROCEDURE REPORTS COMMAND INTERPRETER ERRORS>>      <<U.RAO>>04105000
                                                               <<U.RAO>>04110000
PROCEDURE STARTDEVICE(COMMAND,PARMARR,DEVICE,LINENUM,JMATP,    <<00534>>04115000
                      IDDSUBP,JOBNUM,CIERRNUM,CIPARMNUM);      <<00534>>04120000
   VALUE COMMAND, DEVICE, LINENUM;                             <<1.RAO>>04125000
   INTEGER DEVICE,COMMAND,JOBNUM,CIERRNUM,CIPARMNUM;           <<00534>>04130000
   LOGICAL LINENUM;                                            <<08.EB>>04135000
   BYTE ARRAY PARMARR;                                                  04140000
   INTEGER POINTER JMATP, IDDSUBP;                                      04145000
   OPTION VARIABLE, PRIVILEGED, UNCALLABLE, EXTERNAL;                   04150000
                                                                        04155000
PROCEDURE SROOSTER(D);                                                  04160000
   VALUE D;                                                             04165000
   INTEGER D;                                                           04170000
   OPTION EXTERNAL;                                                     04175000
                                                                        04180000
LOGICAL PROCEDURE REQUESTSERVICE;                                       04185000
   OPTION EXTERNAL;                                                     04190000
                                                                        04195000
PROCEDURE STREAMJNUM;                                                   04200000
   OPTION EXTERNAL;                                                     04205000
                                                                        04210000
$PAGE                                                          <<04399>>04215000
LOGICAL PROCEDURE ASKOP(REQDEV,FNAME,OLDFLAG,ALLOCDEV,                  04220000
                 TYPE,JMPIN,SPOOLERNUM,JOBNUM,LABELED,         <<SD.00>>04225000
                 PTYPE,STRIN,RESPONSE);                        <<SD.00>>04230000
   VALUE REQDEV,OLDFLAG,SPOOLERNUM,JOBNUM,JMPIN,LABELED,       <<SD.00>>04235000
         PTYPE;                                                <<SD.00>>04240000
   INTEGER REQDEV,ALLOCDEV,TYPE,SPOOLERNUM,JOBNUM,JMPIN,       <<SD.00>>04245000
   LABELED,PTYPE;                                              <<SD.00>>04250000
   LOGICAL OLDFLAG;                                                     04255000
   INTEGER ARRAY FNAME;                                                 04260000
   BYTE ARRAY STRIN,RESPONSE;                                  <<SD.00>>04265000
   OPTION VARIABLE,EXTERNAL;                                            04270000
                                                                        04275000
PROCEDURE CLEAN'MESSAGE(MSG,LEN);                                       04280000
   VALUE LEN;                                                           04285000
   INTEGER LEN;                                                         04290000
   BYTE ARRAY MSG;                                                      04295000
   OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                               04300000
                                                                        04305000
                                                                        04310000
LOGICAL PROCEDURE EXCHANGEDB(DSTX);                                     04315000
   VALUE DSTX;                                                          04320000
   LOGICAL DSTX;                                                        04325000
   OPTION EXTERNAL;                                                     04330000
                                                                        04335000
PROCEDURE FORMSALIGN(DEVNO);                                            04340000
   VALUE DEVNO;                                                         04345000
   INTEGER DEVNO;                                                       04350000
   OPTION EXTERNAL;                                                     04355000
                                                                        04360000
INTEGER PROCEDURE GETDEVINFO(DEVICE,DEVINFO);                           04365000
   BYTE ARRAY DEVICE;                                                   04370000
   INTEGER ARRAY DEVINFO;                                               04375000
   OPTION EXTERNAL;                                                     04380000
                                                                        04385000
LOGICAL PROCEDURE GETSIR(SIRNUM);                                       04390000
   VALUE SIRNUM;                                                        04395000
   INTEGER SIRNUM;                                                      04400000
   OPTION EXTERNAL;                                                     04405000
                                                                        04410000
INTEGER PROCEDURE GENMSG(SETNO,MSGNO,MASK,B,C,D,E,F,           <<0U.EB>>04415000
      DEST,REPLY,BUFF,DST,IOTYPE);                             <<0U.EB>>04420000
   VALUE SETNO,MSGNO,MASK,B,C,D,E,F,DEST,REPLY,BUFF,           <<0U.EB>>04425000
      DST,IOTYPE;                                              <<0U.EB>>04430000
   LOGICAL SETNO,MSGNO,MASK,B,C,D,E,F,DEST,REPLY,BUFF,         <<0U.EB>>04435000
      DST,IOTYPE;                                              <<0U.EB>>04440000
   OPTION VARIABLE,EXTERNAL;                                   <<0U.EB>>04445000
                                                                        04450000
PROCEDURE RELSIR(SIRNUM,ALREADY);                                       04455000
   VALUE SIRNUM,ALREADY;                                                04460000
   INTEGER SIRNUM;                                                      04465000
   LOGICAL ALREADY;                                                     04470000
   OPTION EXTERNAL;                                                     04475000
                                                               <<01549>>04480000
PROCEDURE WAIT(WF,JPCNTX);                                              04485000
   VALUE WF,JPCNTX;                                                     04490000
   INTEGER WF,JPCNTX;                                                   04495000
   OPTION EXTERNAL;                                                     04500000
$PAGE                                                          <<04399>>04505000
PROCEDURE LOG;                                                          04510000
   OPTION EXTERNAL;                                                     04515000
                                                                        04520000
PROCEDURE ABORTIO (LDEV);                                               04525000
   VALUE   LDEV;                                                        04530000
   INTEGER LDEV;                                                        04535000
   OPTION  EXTERNAL;                                                    04540000
                                                                        04545000
PROCEDURE FREEDEVICE(LDEV,WAIT,NOREW);                         <<TAPEL>>04550000
   VALUE   LDEV,WAIT;                                                   04555000
   INTEGER LDEV;                                                        04560000
   LOGICAL WAIT,NOREW;                                         <<TAPEL>>04565000
   OPTION EXTERNAL,VARIABLE;                                   <<TAPEL>>04570000
                                                                        04575000
PROCEDURE SETWAKE (IOQX);                                               04580000
   VALUE   IOQX;                                                        04585000
   INTEGER IOQX;                                                        04590000
   OPTION EXTERNAL;                                                     04595000
                                                                        04600000
                                                                        04605000
DOUBLE PROCEDURE IOSTATUS (IOQX);                                       04610000
   VALUE   IOQX;                                                        04615000
   INTEGER IOQX;                                                        04620000
   OPTION EXTERNAL;                                                     04625000
                                                                        04630000
DOUBLE PROCEDURE ATTACHIO (LDEV,Q,D,B,F,C,P1,P2,FL);                    04635000
   VALUE   LDEV,Q,D,B,F,C,P1,P2,FL;                                     04640000
   INTEGER LDEV,Q,D,B,F,C,P1,P2,FL;                                     04645000
   OPTION EXTERNAL;                                                     04650000
                                                               <<02608>>04655000
INTEGER PROCEDURE LDEVTOTYPE(LDEV);                            <<02608>>04660000
   VALUE LDEV;                                                 <<02608>>04665000
   INTEGER LDEV;                                               <<02608>>04670000
   OPTION EXTERNAL;                                            <<02608>>04675000
                                                               <<02608>>04680000
INTEGER PROCEDURE LDEVTOSUBTYPE(LDEV);                         <<02608>>04685000
   VALUE LDEV;                                                 <<02608>>04690000
   INTEGER LDEV;                                               <<02608>>04695000
   OPTION EXTERNAL;                                            <<02608>>04700000
                                                                        04705000
INTEGER PROCEDURE FSOPEN (FDESG,FOPT,AOPT,XDDX,DEV,FMSG,                04710000
      ULAB,BF,NB,FS,NE,IA,FC);                                          04715000
   VALUE   FOPT,AOPT,XDDX,ULAB,BF,NB,FS,NE,IA,FC;                       04720000
   INTEGER XDDX,ULAB,BF,NB,NE,IA,FC;                                    04725000
   LOGICAL FOPT,AOPT;                                                   04730000
   DOUBLE  FS;                                                          04735000
   BYTE ARRAY FDESG;                                                    04740000
   BYTE ARRAY DEV,FMSG;                                                 04745000
   OPTION EXTERNAL,VARIABLE; <<FOPEN SEC ENTRY POINT>>                  04750000
                                                                        04755000
PROCEDURE FSCLOSE (FN,DISP,SEC);                                        04760000
   VALUE   FN,DISP,SEC;                                                 04765000
   INTEGER FN,DISP,SEC;                                                 04770000
   OPTION EXTERNAL;          <<FCLOSE SEC ENTRY POINT>>                 04775000
                                                                        04780000
$PAGE                                                          <<04399>>04785000
LOGICAL PROCEDURE VALIDDEVTYPE(LDEV, FUNCTION, USAGE);         <<04413>>04790000
  VALUE                        LDEV, FUNCTION        ;         <<04413>>04795000
  INTEGER                      LDEV, FUNCTION        ;         <<04413>>04800000
  LOGICAL                                      USAGE ;         <<04413>>04805000
  OPTION EXTERNAL;                                             <<04413>>04810000
LOGICAL PROCEDURE SFINDODD(DFID,XDDEP);                        <<01549>>04815000
   VALUE DFID;                                                 <<01549>>04820000
   INTEGER XDDEP;                                              <<01549>>04825000
   INTEGER DFID;                                               <<01549>>04830000
   OPTION EXTERNAL;                                            <<01549>>04835000
                                                               <<01549>>04840000
$PAGE "***  OPTION FORWARD PROCEDURES  ***"                    <<02580>>04845000
LOGICAL PROCEDURE SGETBLOCK;                                   <<02580>>04850000
OPTION FORWARD;                                                <<02580>>04855000
                                                               <<02580>>04860000
LOGICAL PROCEDURE SDWRITE(SRFUNC, BLOCKMODE, WRITEEND,         <<04397>>04865000
                                 WRITEWAIT, IMAGETYPE);        <<04397>>04870000
  INTEGER                 SRFUNC                               <<04397>>04875000
                                                      ;        <<04397>>04880000
  LOGICAL                        BLOCKMODE, WRITEEND,          <<04397>>04885000
                                 WRITEWAIT, IMAGETYPE ;        <<04397>>04890000
   OPTION FORWARD;                                             <<01549>>04895000
                                                               <<02580>>04900000
LOGICAL PROCEDURE POWER'FAIL'RESTART;                          <<01549>>04905000
OPTION FORWARD;                                                <<01549>>04910000
                                                               <<04397>>04915000
LOGICAL PROCEDURE CIPER'POWER'FAIL;                            <<04397>>04920000
  OPTION FORWARD;                                              <<04397>>04925000
                                                               <<01549>>04930000
logical procedure ciper'restart'page(offset, dev'power'fail);  <<04407>>04935000
  value                              offset, dev'power'fail ;  <<04407>>04940000
  double                             offset                 ;  <<04407>>04945000
  logical                                    dev'power'fail ;  <<04407>>04950000
  option forward, privileged, uncallable;                      <<04407>>04955000
                                                               <<04407>>04960000
logical procedure fulab(fulab'func, target'addr, target'len);  <<04407>>04965000
  value                 fulab'func, target'addr, target'len ;  <<04407>>04970000
  integer               fulab'func, target'addr, target'len ;  <<04407>>04975000
  option forward, privileged, uncallable, variable;            <<04407>>04980000
                                                               <<04407>>04985000
logical procedure ciper'resumespool(pagecnt, backwards);       <<04407>>04990000
  value                             pagecnt, backwards ;       <<04407>>04995000
  integer                           pagecnt            ;       <<04407>>05000000
  logical                                    backwards ;       <<04407>>05005000
  option forward, privileged, uncallable;                      <<04407>>05010000
                                                               <<04407>>05015000
LOGICAL PROCEDURE VALID'FUNC(FUNC, USAGE);                     <<04397>>05020000
  VALUE                      FUNC        ;                     <<04397>>05025000
  INTEGER                    FUNC, USAGE ;                     <<04397>>05030000
  OPTION FORWARD;                                              <<04397>>05035000
                                                               <<04397>>05040000
PROCEDURE RESTORE'ENVIR(TARGETBLK,STATUS);                     <<01549>>05045000
    VALUE TARGETBLK;                                           <<01549>>05050000
    INTEGER STATUS;                                            <<01549>>05055000
    DOUBLE TARGETBLK;                                          <<01549>>05060000
    OPTION FORWARD;                                            <<01549>>05065000
                                                               <<01549>>05070000
LOGICAL PROCEDURE CHECKPOINT'PAGE;                             <<04397>>05075000
  OPTION FORWARD;                                              <<04397>>05080000
                                                               <<04397>>05085000
PROCEDURE SILENT'RUN(FROM'BLOCK,RECOVER'STATUS'BLOCK,          <<01549>>05090000
   TO'BLOCK, MODE, RESULT);                                    <<01549>>05095000
   VALUE FROM'BLOCK,TO'BLOCK,MODE;                             <<01549>>05100000
   DOUBLE FROM'BLOCK,TO'BLOCK;                                 <<01549>>05105000
   INTEGER MODE,RESULT;                                        <<01549>>05110000
   LOGICAL ARRAY RECOVER'STATUS'BLOCK;                         <<01549>>05115000
   OPTION FORWARD;                                             <<01549>>05120000
                                                               <<01549>>05125000
PROCEDURE RESTART'PAGE'2680(PAGECNT, BACKWARDS,                <<01549>>05130000
    PAGE'BLOCK);                                               <<01549>>05135000
    VALUE PAGECNT,BACKWARDS;                                   <<01549>>05140000
    LOGICAL ARRAY PAGE'BLOCK;                                  <<01549>>05145000
    LOGICAL PAGECNT,BACKWARDS;                                 <<01549>>05150000
    OPTION FORWARD;                                            <<01549>>05155000
                                                               <<01549>>05160000
LOGICAL PROCEDURE CIPER'CHECKPOINT'PAGE;                       <<04397>>05165000
  OPTION FORWARD;                                              <<04397>>05170000
                                                               <<04397>>05175000
PROCEDURE SPOOLOUTLOOP;                                        <<01885>>05180000
   OPTION FORWARD;                                             <<01885>>05185000
                                                               <<04397>>05190000
PROCEDURE FINISHUP;                                            <<04397>>05195000
  OPTION FORWARD;                                              <<04397>>05200000
                                                               <<01885>>05205000
   PROCEDURE REPORT'ENV(ENV'STATUS);                           <<01885>>05210000
      LOGICAL ARRAY ENV'STATUS;                                <<01885>>05215000
      OPTION FORWARD;                                          <<01885>>05220000
                                                               <<04397>>05225000
LOGICAL PROCEDURE SPUTREC(SRFUNC);                             <<04397>>05230000
  INTEGER                 SRFUNC ;                             <<04397>>05235000
  OPTION FORWARD;                                              <<04397>>05240000
                                                               <<04397>>05245000
                                                               <<02504>>05250000
LOGICAL PROCEDURE FOPEN'FORMS;                                 <<04413>>05255000
   OPTION FORWARD;                                             <<02504>>05260000
                                                               <<02504>>05265000
PROCEDURE SABORTWRITE;                                         <<02504>>05270000
   OPTION FORWARD;                                             <<02504>>05275000
                                                               <<02504>>05280000
PROCEDURE SPECIAL'CASES(IO'STATUS'BLOCK);                      <<02504>>05285000
   LOGICAL ARRAY IO'STATUS'BLOCK;                              <<02504>>05290000
   OPTION FORWARD;                                             <<02504>>05295000
                                                               <<02504>>05300000
$PAGE "***  INTRINSIC DECLARATIONS  ***"                       <<02580>>05305000
INTRINSIC DBINARY,FREAD,FWRITE,ASCII,DASCII,PRINT,PAUSE;       <<01549>>05310000
INTRINSIC FREADLABEL, FWRITELABEL,FCONTROL,FREADDIR;           <<01549>>05315000
INTRINSIC DEBUG,FGETINFO,FFILEINFO;                            <<01549>>05320000
INTRINSIC FOPEN,FCLOSE;                                        <<01885>>05325000
INTRINSIC FCHECK;                                              <<02527>>05330000
INTRINSIC DATE'LINE; <<FOR HEADER/TRAILER>>                    <<02596>>05335000
$PAGE "(INPUT) PROCEDURE: STREAMERROR"                         <<02601>>05340000
PROCEDURE STREAMERROR(ERRNUM,ECHO);                            <<00751>>05345000
   VALUE ERRNUM,ECHO;                                          <<00751>>05350000
   INTEGER ERRNUM;  << CIERR ERR #. NEGATIVE FOR WARNINGS. >>  <<00751>>05355000
   LOGICAL ECHO;    << IF TRUE THEN ECHO JOB/DATA CARD.    >>  <<00751>>05360000
   OPTION UNCALLABLE,PRIVILEGED;                               <<00751>>05365000
COMMENT:                                                       <<00751>>05370000
   This routine is called to handle errors occuring while      <<00751>>05375000
   STREAMing. It calls CIERR to print the appropriate error    <<00751>>05380000
   message and set JCW CIERROR. It always calls CIERR with a   <<00751>>05385000
   negative error number so that CIERR won't call TERMINATE    <<00751>>05390000
   if this is a JOB and there was not a previous :CONTINUE.    <<00751>>05395000
   This is necessary since: a) we want to attempt to process   <<00751>>05400000
   any additional jobs in the STREAM file, and b) we are       <<00751>>05405000
   'critical' until we return to CXSTREAM. The global CIERRNUM <<00751>>05410000
   is used to save the last error to occur for the COMMAND     <<00751>>05415000
   intrinsic, and as a flag to CXSTREAM to indicate if any     <<00751>>05420000
   errors occurred while STREAMing. Since only one error       <<00751>>05425000
   can be returned by the COMMAND intrinsic we save the        <<00751>>05430000
   last error and will not report additional warnings.         <<00751>>05435000
   ;                                                           <<00751>>05440000
BEGIN                                                          <<00751>>05445000
INTEGER                                                        <<00751>>05450000
   LEN;  << Length of JOB/DATA card to be printed >>           <<00751>>05455000
ARRAY                                                          <<00751>>05460000
   LINE(0:2) = Q;                                              <<00751>>05465000
LOGICAL POINTER                                                <<06425>>05470000
   PCB = SYSPCBINDEX;                                          <<06425>>05475000
LOGICAL                                                        <<06425>>05480000
   PCBPT;                                                      <<06425>>05485000
                                                               <<00751>>05490000
PCBPT := CURPRC;                                               <<06425>>05495000
IF ECHO AND (integer(SPCBPTYPE) >= 2) THEN <<not programmatic>><<06425>>05500000
   BEGIN                                                       <<00751>>05505000
   IF PENDACTIVE = JOB THEN  MOVE LINE := ":JOB  "             <<00751>>05510000
                       ELSE  MOVE LINE := ":DATA ";            <<00751>>05515000
   LEN := IF COMLENGTH > (LISTSIZE-3) THEN  (LISTSIZE-3)       <<00751>>05520000
                                      ELSE  COMLENGTH;         <<00751>>05525000
   PRINT(LINE,0,0);  << CR,LF >>                               <<00751>>05530000
   PRINT(LINE,3,%320);                                         <<00751>>05535000
   PRINT(COMIMAGE,LEN,0);                                      <<00751>>05540000
   JLISTED := 0;  << Length of jobs listed on current line. >> <<00751>>05545000
   END;                                                        <<00751>>05550000
                                                               <<00751>>05555000
IF ERRNUM > 0 THEN                                             <<00751>>05560000
   BEGIN                                                       <<00751>>05565000
   CIERR(-ERRNUM); << Negative so JOB isn't terminated >>      <<00751>>05570000
   CIERRNUM := ERRNUM;  << Save err # for COMMAND intrinsic >> <<00751>>05575000
   END                                                         <<00751>>05580000
ELSE                                                           <<00751>>05585000
   BEGIN                                                       <<00751>>05590000
   CIERR(ERRNUM);                                              <<00751>>05595000
   << Save warning # only if no previous error. >>             <<00751>>05600000
   IF CIERRNUM <= 0 THEN CIERRNUM := ERRNUM;                   <<00751>>05605000
   END;                                                        <<00751>>05610000
                                                               <<00751>>05615000
END;  << STREAMERROR >>                                        <<00751>>05620000
$PAGE "(OUTPUT) PROCEDURE: SDOFORMS"                           <<02580>>05625000
LOGICAL PROCEDURE SDOFORMS(FORMSL,FORMSA);                              05630000
VALUE FORMSL,FORMSA;                                                    05635000
INTEGER FORMSL,FORMSA;                                                  05640000
OPTION UNCALLABLE,PRIVILEGED;                                           05645000
   BEGIN <<SDOFORMS>>                                                   05650000
   LOGICAL FORMSON := FALSE,                                            05655000
           ASK := FALSE,                                                05660000
           OPLOVESIT := TRUE;                                           05665000
   LOGICAL ARRAY XDD'SUBENTRY(0:SIZE'OF'XDD'SUBENTRY-1),       <<S8677>>05670000
                 LDT(0:SIZE'OF'LDT'ENTRY-1);                   <<S8677>>05675000
   INTEGER REQDEV,                                                      05680000
           REPLYDEV,                                                    05685000
           REPLYTYPE,                                                   05690000
           LDT'INDEX := 0,                                     <<S7789>>05695000
           SAVE'LDT'SIR,                                       <<S8677>>05700000
           SAVE'ODD'SIR,                                       <<S8677>>05705000
           PIN;                                                <<S8677>>05710000
   BYTE NEXTBYTE;                                                       05715000
   BYTE POINTER FORMSMSG;                                               05720000
   LOGICAL ARRAY FNAME(0:4);                                   <<S8677>>05725000
   DEFINE NEW = FALSE#;                                                 05730000
                                                               <<S8677>>05735000
   DECLARE'MOVE'FROM'DATA'SEGMENT;                             <<S8677>>05740000
   DECLARE'MOVE'TO'DATA'SEGMENT;                               <<S8677>>05745000
   << >>                                                                05750000
   PIN := CURPRC/PCBSIZE;     << current pin >>                <<06425>>05755000
                                                               <<S8677>>05760000
<< Don't need to acquire SIRs just to read  table  entries. >> <<S8677>>05765000
<< The  entries don't move, and the fields we look at don't >> <<S8677>>05770000
<< change.                                                  >> <<S8677>>05775000
                                                               <<S8677>>05780000
   MFDS (XDD'SUBENTRY, ODD'DST, @ODDEP, SIZE'OF'XDD'SUBENTRY); <<S8677>>05785000
   MFDS (LDT,          LDT'DST, @LDTP,  SIZE'OF'LDT'ENTRY   ); <<S8677>>05790000
   IF FORMSL <> 0 THEN                                                  05795000
      BEGIN <<USER FORMS MESSAGE>>                                      05800000
      ASK := FORMSON := TRUE;                                           05805000
      @FORMSMSG := FORMSA&LSL(1);                              <<SP.02>>05810000
      NEXTBYTE := FORMSMSG(FORMSL);;                                    05815000
      FORMSMSG(FORMSL) := 0;   <<PUTMSG EOM>>                           05820000
      CLEAN'MESSAGE(FORMSMSG,FORMSL);   <<REMOVE ESCAPE SEQ. >>         05825000
      << 213 Forms on ldev#\: ! >>                             <<06334>>05830000
      GENMSG(1,213,%10000,DEVICE,@FORMSMSG,,,,0);              <<00578>>05835000
      FORMSMSG(FORMSL) := NEXTBYTE;                                     05840000
      END <<USER FORMS MESSAGE>>                                        05845000
   ELSE                                                                 05850000
      BEGIN <<NO FORMS FROM USER>>                                      05855000
      IF RECOVERING THEN                                                05860000
         BEGIN <<RECOVER PREVIOUS FORMS?>>                              05865000
         IF FOD THEN                                                    05870000
            BEGIN <<RECOVER THEM>>                                      05875000
            ASK := FORMSON := TRUE;                                     05880000
             << 231 SP#\/#0! Previous forms assumed >>         <<06334>>05885000
            GENMSG(1,231,%11000,DEVICE,DEVFILEID,,,,0);        <<0U.EB>>05890000
            END <<RECOVER THEM>>;                                       05895000
         END <<RECOVER PREVIOUS FORMS?>>;                               05900000
      IF NOT FORMSON THEN                                               05905000
         IF LDT'SPECIAL'FORMS THEN                             <<S8677>>05910000
            BEGIN <<USER WANTS STANDARD,BUT FORMS ARE MOUNTED>>         05915000
            ASK := TRUE;                                                05920000
            << 214 Standard forms on ldev#\ >>                 <<06334>>05925000
            GENMSG(1,214,%10000,DEVICE,,,,,0);                 <<00578>>05930000
            END <<USER WANTS STANDARD, BUT FORMS ARE MOUNTED>>;         05935000
      END <<NO FORMS FROM USER>>;                                       05940000
   IF ASK THEN                                                          05945000
      BEGIN <<ASK OPERATOR>>;                                           05950000
      REQDEV := XDDS'DEVICE;                                   <<06912>>05955000
      IF XDDS'CLASS THEN REQDEV := -REQDEV;                    <<06912>>05960000
      MOVE FNAME := XDDS'FILE'NAME, (4);                       <<06912>>05965000
      FNAME(4) := "  ";                                                 05970000
      IF NOT (OPLOVESIT :=  ASKOP(REQDEV,FNAME,NEW,REPLYDEV,            05975000
            REPLYTYPE,PIN,DEVICE,JOBNUMBER,0)) THEN            <<TAPEL>>05980000
         BEGIN <<DAD MAD>>                                              05985000
         FILEREQUEST := DEFERFILE;                                      05990000
         << 234 SP#\/#O! deferred >>                           <<06334>>05995000
         GENMSG(1,234,%11000,DEVICE,DEVFILEID);                <<0U.EB>>06000000
         END <<DAD MAD>>                                                06005000
      ELSE                                                              06010000
         IF REPLYDEV <> DEVICE THEN                                     06015000
            BEGIN <<MOVE FILE TO A DEVICE CHAIN>>                       06020000
            SRELINKODD(ODDEP,REPLYDEV);                                 06025000
            FILEREQUEST := RELINKFILE;                                  06030000
            OPLOVESIT := FALSE;                                         06035000
            END <<MOVE FILE TO A DEVICE CHAIN>>;                        06040000
      END <<ASK OPERATOR>>;                                             06045000
   IF OPLOVESIT THEN                                                    06050000
      BEGIN                                                             06055000
                                                               <<S8715>>06060000
<< Although we didn't need SIRs earlier,  we  MUST  acquire >> <<S8715>>06065000
<< them  here  and then refresh our local copies of the LDT >> <<S8715>>06070000
<< and ODD entries.   Because we didn't lock them  earlier, >> <<S8715>>06075000
<< other  code may have modified parts of our entries since >> <<S8715>>06080000
<< we copied them.  We must have up-to-date  copies  before >> <<S8715>>06085000
<< writing them back.                                       >> <<S8715>>06090000
                                                               <<S8715>>06095000
      SAVE'LDT'SIR := GETSIR (LDT'SIR);                        <<S8677>>06100000
      SAVE'ODD'SIR := GETSIR (ODD'SIR);                        <<S8677>>06105000
      MFDS (LDT, LDT'DST, @LDTP, SIZE'OF'LDT'ENTRY);           <<S8715>>06110000
      MFDS (XDD'SUBENTRY, ODD'DST, @ODDEP,                     <<S8715>>06115000
            SIZE'OF'XDD'SUBENTRY);                             <<S8715>>06120000
      ODDS'FORMS'ON'DEVICE := FORMSON;                         <<S8715>>06125000
      LDT'SPECIAL'FORMS    := FORMSON;                         <<S8715>>06130000
      MTDS (ODD'DST, @ODDEP, XDD'SUBENTRY,                     <<S8677>>06135000
            SIZE'OF'XDD'SUBENTRY);                             <<S8677>>06140000
      MTDS (LDT'DST, @LDTP, LDT, SIZE'OF'LDT'ENTRY);           <<S8677>>06145000
      RELSIR (ODD'SIR, SAVE'ODD'SIR);                          <<S8677>>06150000
      RELSIR (LDT'SIR, SAVE'LDT'SIR);                          <<S8677>>06155000
      FOD := FORMSON;                                                   06160000
      SDOFORMS := TRUE;                                                 06165000
      END;                                                              06170000
   END <<SDOFORMS>>;                                                    06175000
$PAGE "(OUTPUT) PROCEDURE: OPEN'ERRFILE"                       <<04399>>06180000
PROCEDURE OPEN'ERRFILE(DEVICE);                                <<02595>>06185000
   VALUE DEVICE;                                               <<01885>>06190000
   INTEGER DEVICE;                                             <<01885>>06195000
   OPTION UNCALLABLE, PRIVILEGED;                              <<01885>>06200000
      BEGIN  <<OPEN DAYFILE FOR ERROR MESSAGES>>               <<01885>>06205000
      BYTE ARRAY DEVICE'STRING(0:27);                          <<01885>>06210000
      BYTE ARRAY ERROR'LOG(0:8);                               <<01885>>06215000
      INTEGER NUMCHAR,DUMMY;                                   <<01885>>06220000
      INTEGER ERRN;                                            <<02527>>06225000
      INTEGER LDT'INDEX;                                       <<06334>>06230000
      LOGICAL SAVE'LDT'SIR,                                    <<02728>>06235000
              OLD'SQ'BIT;     << SPOOL QUEUE BIT FROM LDT >>   <<02728>>06240000
      LOGICAL POINTER LDT;    << FOR ACCESSING LDT ENTRY  >>   <<06334>>06245000
      EQUATE                                                   <<01885>>06250000
            DAYFILE'MSG'SET = 25,                              <<01885>>06255000
             DAY'TITLE      = 1,                               <<01885>>06260000
             DAY'MAX'EXCEEDED = 2,                             <<01885>>06265000
             DAYFILE'OPEN'FAIL = 100,                          <<02527>>06270000
             FIRST'REAL'MSG  = 3;                              <<01885>>06275000
         DUMMY := FOPEN(,%60); <<$NULL>>                       <<01885>>06280000
         MOVE ERROR'LOG := "ERR      ";                        <<02581>>06285000
         ASCII(DEVFILEID, 10, ERROR'LOG(3));                   <<02581>>06290000
         NUMCHAR := ASCII(DEVICE,10,DEVICE'STRING);            <<01885>>06295000
         DEVICE'STRING(NUMCHAR) := " ";                        <<01885>>06300000
         EXCHANGEDB(LDT'DST);             << FORCE Q OPEN  >>  <<06334>>06305000
         SAVE'LDT'SIR := GETSIR(LDT'SIR); << SO THAT ERROR >>  <<06334>>06310000
         @LDT := 0;                                            <<06334>>06315000
         LDT'INDEX := DEVICE * SIZE'OF'LDT'ENTRY;              <<06334>>06320000
         OLD'SQ'BIT := LDT'SPOOL'QUEUES;  << CAN BE CREATED>>  <<06334>>06325000
         LDT'SPOOL'QUEUES := TRUE;                             <<06334>>06330000
         RELSIR(LDT'SIR, SAVE'LDT'SIR);                        <<06334>>06335000
         EXCHANGEDB(0);                                        <<02728>>06340000
         DAYFILE := FOPEN( ERROR'LOG, 4, 1,, DEVICE'STRING     <<01885>>06345000
            ,,,,%10000);                                       <<01885>>06350000
         IF <> THEN                                            <<02527>>06355000
            DAY'DFID := 0                                      <<02527>>06360000
         ELSE                                                  <<02527>>06365000
         FFILEINFO ( DAYFILE, 38, DAY'DFID);                   <<02527>>06370000
         EXCHANGEDB(LDT'DST);           << RESTORE SQ BIT >>   <<06334>>06375000
         SAVE'LDT'SIR := GETSIR(LDT'SIR);                      <<06334>>06380000
         LDT'SPOOL'QUEUES := OLD'SQ'BIT;                       <<06334>>06385000
         RELSIR(LDT'SIR, SAVE'LDT'SIR);                        <<06334>>06390000
         EXCHANGEDB(0);                                        <<02728>>06395000
         IF DAY'DFID = 0 THEN                                  <<02527>>06400000
         BEGIN  <<TROUBLE OPENING A SPOOLFILE>>                <<02527>>06405000
            FCHECK(0,ERRN);                                    <<02527>>06410000
            IF DUMMY = 2 THEN                                  <<02527>>06415000
            BEGIN  <<OPEN A $NULL FILE FOR DAYFILE <> 2>>      <<02527>>06420000
               DUMMY := FOPEN(,%60); <<$NULL>>                 <<02527>>06425000
               FCLOSE(2,0,0);  <<CLOSE PREVIOUS $NULL>>        <<02527>>06430000
               FCLOSE(DAYFILE,4,0); <<CLOSE PREV. DAYFILE>>    <<02527>>06435000
            END;                                               <<02527>>06440000
            DAYFILE := DUMMY;                                  <<02527>>06445000
            DAYFILE'LOST := TRUE;                              <<02527>>06450000
<< 100 Ldev\errfile open failed for dfid #O! Check if Shutq. >><<06334>>06455000
            GENMSG(DAYFILE'MSG'SET, DAYFILE'OPEN'FAIL,         <<02527>>06460000
                 %11000, DEVICE, DEVFILEID,,,,0);              <<02527>>06465000
            GENMSG(8,ERRN);                                    <<02527>>06470000
         END                                                   <<02527>>06475000
         ELSE                                                  <<02527>>06480000
         BEGIN <<CONTINUE INITIALIZING DAYFILE>>               <<02527>>06485000
         IF DUMMY > 2 THEN                                     <<01885>>06490000
         FCLOSE(DUMMY,0,0);                                    <<01885>>06495000
         <<INITIALIZE USER LABEL FOR DFID OF DAYFILE>>         <<01885>>06500000
         FREADLABEL(SPOOLFILE, FLAB);                          <<01885>>06505000
         SPULAB'DAYFILE := DAY'DFID;                           <<01885>>06510000
         FWRITELABEL(SPOOLFILE, FLAB);                         <<01885>>06515000
                                                               <<01885>>06520000
         << PRINT TITLE "ERROR LOG FOR LDEV ">>                <<01885>>06525000
                                                               <<01885>>06530000
         GENMSG( DAYFILE'MSG'SET, DAY'TITLE, %11000, DEVICE,   <<01885>>06535000
                DEVFILEID,,,,-DAYFILE);                        <<01885>>06540000
         ERR'COUNT := 0; <<INIT>>                              <<01885>>06545000
         END;                                                  <<02527>>06550000
END; << of procedure open'errfile >>                           <<04399>>06555000
$PAGE "(GENERAL) PROCEDURE: NOTIFY'OPERATOR"                   <<02580>>06560000
   PROCEDURE NOTIFY'OPERATOR(DEVICE,STATUS'RETURN);            <<00909>>06565000
      VALUE DEVICE, STATUS'RETURN;                             <<00909>>06570000
      INTEGER DEVICE, STATUS'RETURN;                           <<00909>>06575000
      OPTION UNCALLABLE,PRIVILEGED;                            <<00909>>06580000
<<>>                                                           <<00909>>06585000
                                                               <<00909>>06590000
   BEGIN                                                       <<00909>>06595000
                                                               <<00909>>06600000
      INTEGER RESULT'LENGTH,ERRNUM;                            <<00909>>06605000
      INTEGER I;                                               <<01549>>06610000
      BYTE ARRAY RESULT(0:6);                                  <<00909>>06615000
                                                               <<01549>>06620000
      INTEGER ARRAY STATUS'TABLE(*) = PB :=                    <<01549>>06625000
         <<ARRAY CONTAINS STATUS'RETURN, ERRNUM FOR>>          <<01549>>06630000
         <<GENMSG. END OF TABLE IS A ZERO PAIR>>               <<01549>>06635000
                                                               <<01549>>06640000
        ST'REQ'ABORT'EXTERNAL,   REQUEST'ABORTED'EXTERNAL,     <<04397>>06645000
        ST'DEVICE'NOT'ON'LINE,   UNIT'NOT'ONLINE,              <<04397>>06650000
        ST'POWER'FAIL'ABORT,     POWER'FAIL'ABORT,             <<04397>>06655000
        ST'DEVICE'POWER'UP,      POWER'UP,                     <<04397>>06660000
        ST'VFC'RESET,            VFC'RESET,                    <<04397>>06665000
                                                               <<04397>>06670000
                                                               <<04397>>06675000
        ST'INVALID'REQUEST,      INVALID'FUNCTION,             <<04397>>06680000
        ST'TRANSFER'ERROR,       TRANSFER'ERROR,               <<04397>>06685000
        ST'TIMEOUT,              TIMEOUT,                      <<04397>>06690000
        ST'SIO'FAILURE,          SIO'FAILURE,                  <<04397>>06695000
        ST'HARD'MALFUNCTION,     HARD'MALFUNCTION,             <<04397>>06700000
        ST'CATASTROPHIC,         CATASTROPHIC,                 <<04397>>06705000
        ST'CONTROLLER'DEAD,      CONTROLLER'DEAD,              <<04397>>06710000
        ST'SIO'ERROR,            SIO'ERROR,                    <<04397>>06715000
        ST'HPIB'PHI'LOCKUP,      HPIB'PHI'LOCKUP,              <<04397>>06720000
        ST'JOB'OPEN'FAILURE,     JOB'OPEN'FAILURE,             <<04397>>06725000
                                                               <<01549>>06730000
        ST'INVALID'ITEMNO,       DATA'CTL'INFO'ERR,            <<C7517>>06735000
        ST'INVALID'ACCESS,       DATA'CTL'INFO'ERR,            <<C7517>>06740000
        ST'DATA'CTL'FSERR,       DATA'CTL'INFO'ERR,            <<C7517>>06745000
        ST'PARITY'CHNG'8BIT,     DATA'CTL'INFO'ERR,            <<C7517>>06750000
        ST'INVALID'FORMAT,       DATA'CTL'INFO'ERR,            <<C7517>>06755000
        ST'INFO'CKSUM'ERR,       DATA'CTL'INFO'ERR,            <<C7517>>06760000
        ST'VAL'TOO'SMALL,        DATA'CTL'INFO'ERR,            <<C7517>>06765000
        ST'VAL'TOO'BIG,          DATA'CTL'INFO'ERR,            <<C7517>>06770000
        ST'VAL'ILLEGAL,          DATA'CTL'INFO'ERR,            <<C7517>>06775000
        ST'COUNT'TOO'SMALL,      DATA'CTL'INFO'ERR,            <<C7517>>06780000
        ST'COUNT'TOO'BIG,        DATA'CTL'INFO'ERR,            <<C7517>>06785000
        ST'OUT'OF'ORDER,         DATA'CTL'INFO'ERR,            <<C7517>>06790000
        ST'OTHER'FUNCTION,       DATA'CTL'INFO'ERR,            <<C7517>>06795000
                                                               <<01549>>06800000
        0,0; <<END OF STATUS'TABLE>>                           <<01549>>06805000
<<>>                                                           <<01549>>06810000
               RESULT(6) := 0; << FOR GENMSG>>                 <<01549>>06815000
               RESULT'LENGTH := ASCII(STATUS'RETURN,8,RESULT); <<01549>>06820000
               MOVE RESULT := RESULT(6 - RESULT'LENGTH),       <<01549>>06825000
                   (RESULT'LENGTH + 1); <<LEFT-JUSTIFY>>       <<01549>>06830000
               ERRNUM := 0;                                    <<01549>>06835000
               I := 0;                                         <<01549>>06840000
               DO                                              <<01549>>06845000
               BEGIN                                           <<01549>>06850000
                  IF STATUS'RETURN = STATUS'TABLE(I)           <<01549>>06855000
                  THEN ERRNUM := STATUS'TABLE(I+1);            <<01549>>06860000
               END                                             <<01549>>06865000
               UNTIL (STATUS'TABLE(I:= I+2) = 0 OR             <<01549>>06870000
                      ERRNUM <> 0);                            <<01549>>06875000
               IF ERRNUM = 0 THEN ERRNUM := GENERAL'IOERR;     <<01549>>06880000
       GENMSG(1,ERRNUM,%10000,DEVICE,@RESULT,,,,0);            <<00909>>06885000
                                                               <<00909>>06890000
      END; <<NOTIFY'OPERATOR>>                                 <<00909>>06895000
$PAGE "(OUTPUT) PROCEDURE: NOTIFY'USER"                        <<02580>>06900000
                                                               <<01885>>06905000
PROCEDURE NOTIFY'USER(DEVICE);                                 <<01885>>06910000
   VALUE DEVICE;                                               <<01885>>06915000
   INTEGER DEVICE;                                             <<01885>>06920000
   OPTION UNCALLABLE, PRIVILEGED;                              <<01885>>06925000
                                                               <<01885>>06930000
   BEGIN                                                       <<01885>>06935000
      ARRAY IO'STATUS'BLOCK(0:16);                             <<01885>>06940000
      DEFINE STATUS = IO'STATUS'BLOCK#;                        <<01885>>06945000
      DOUBLE ARRAY DIO'STATUS(*) = IO'STATUS'BLOCK;            <<01885>>06950000
      DEFINE DIO'RECNUM = DIO'STATUS(6)#,                      <<01885>>06955000
             DIO'PAGENUM = DIO'STATUS(7)#;                     <<01885>>06960000
      BYTE ARRAY DEVICE'STRING(0:27);                          <<01885>>06965000
      BYTE ARRAY ERROR'LOG(0:8);                               <<01885>>06970000
      INTEGER NUMCHAR,ERRN,IO'STATUS'RETURN,I;                 <<02581>>06975000
      EQUATE                                                   <<01885>>06980000
            DAYFILE'MSG'SET = 25,                              <<01885>>06985000
                                                               <<02504>>06990000
            MAX'ERRNUM      = 18;                              <<01885>>06995000
         << MESSAGE SET 25 ERROR MESSAGES>>                    <<01885>>07000000
      EQUATE                                                   <<01885>>07005000
             DAY'TITLE      = 1,                               <<01885>>07010000
             DAY'MAX'EXCEEDED = 2,                             <<01885>>07015000
             FIRST'REAL'MSG  = 3;                              <<01885>>07020000
$PAGE &                                                        <<02580>>07025000
$"(OUTPUT) PROCEDURE: NOTIFY'USER;  SUBROUTINE: EXAMINE'STATUS"<<02580>>07030000
LOGICAL SUBROUTINE EXAMINE'STATUS(FLAG);                       <<02581>>07035000
      VALUE FLAG; LOGICAL FLAG;                                <<02504>>07040000
      BEGIN                                                    <<02581>>07045000
      I:=0; <<START CHECKING AT THE BEGIN OF FLAG>>            <<02581>>07050000
      DO BEGIN << SHIFT STATUS WORD GENERATING A MSG IF <> 0>> <<02504>>07055000
         IF FLAG.(0:1) AND NOT END'OF'JOB THEN                 <<02581>>07060000
           BEGIN                                               <<01885>>07065000
             ERR'COUNT := ERR'COUNT + 1;                       <<01885>>07070000
             IF ERR'COUNT > ERR'UPPER'LIMIT THEN RETURN;       <<02581>>07075000
             GENMSG(DAYFILE'MSG'SET, ERRN  , %22000,           <<01885>>07080000
           @DIO'RECNUM, @DIO'PAGENUM,,,, -DAYFILE);            <<01885>>07085000
           END;                                                <<01885>>07090000
         ERRN := ERRN + 1;                                     <<01885>>07095000
         FLAG:= FLAG&LSL(1);                                   <<02581>>07100000
     END                                                       <<01885>>07105000
     UNTIL ( I := I + 1) > 15 ;                                <<02581>>07110000
     EXAMINE'STATUS:=TRUE;                                     <<02581>>07115000
     END; <<SUBROUTINE EXAMINE'STATUS>>                        <<01885>>07120000
$PAGE "(OUTPUT) PROCEDURE: NOTIFY'USER"                        <<02580>>07125000
READ'STATUS:      <<READ IO STATUS>>                           <<02581>>07130000
      IO'STATUS'BLOCK := 0;                                    <<01885>>07135000
      MOVE IO'STATUS'BLOCK(1) := IO'STATUS'BLOCK , (15);       <<01885>>07140000
      TOS := ATTACHIO(DEVICE, 0, 0, @IO'STATUS'BLOCK,          <<01885>>07145000
          READ'IO'STATUS, 16, 0, 0, 1);                        <<01885>>07150000
      DEL;                                                     <<01885>>07155000
      IO'STATUS'RETURN := TOS.QUAL'GEN'STATUS;                 <<04397>>07160000
      IF IO'STATUS'RETURN.GENERAL'STATUS<>GEN'ST'OK THEN       <<04397>>07165000
      BEGIN                                                    <<01885>>07170000
   IF IO'STATUS'RETURN <> ST'IO'STATUS'AVAILABLE   AND         <<04397>>07175000
      IO'STATUS'RETURN <> ST'IO'ST'AND'RE'XMIT    THEN         <<04397>>07180000
         BEGIN                                                 <<01885>>07185000
            NOTIFY'OPERATOR(DEVICE, IO'STATUS'RETURN);         <<01885>>07190000
            GO TO LX;                                          <<01885>>07195000
         END;                                                  <<01885>>07200000
      END;                                                     <<01885>>07205000
      IF IO'STATUS'BLOCK(4) = 0 AND IO'STATUS'BLOCK(5) = 0     <<04140>>07210000
         AND IO'STATUS'BLOCK(6) = 0 THEN GO TO LX;             <<04140>>07215000
      IF END'OF'JOB THEN GOTO LX;  <<IGNORE IT>>               <<02581>>07220000
      SPECIAL'CASES(IO'STATUS'BLOCK);                          <<02504>>07225000
      << PARSE IO'STATUS BLOCK>>                               <<01885>>07230000
      IF DAYFILE = 0 THEN                                      <<02581>>07235000
        BEGIN                                                  <<02581>>07240000
        OPEN'ERRFILE(DEVICE);                                  <<02595>>07245000
        JOB'HAS'ERRORS:=TRUE;                                  <<02581>>07250000
        ERR'COUNT:=0;                                          <<02581>>07255000
        END;                                                   <<02581>>07260000
      IF ERR'COUNT > ERR'UPPER'LIMIT THEN GOTO LX;             <<02581>>07265000
      ERRN := FIRST'REAL'MSG;  <<INITIALIZE ERROR NUMBER>>     <<01885>>07270000
      IF NOT EXAMINE'STATUS(STATUS(4))                         <<02581>>07275000
      OR NOT EXAMINE'STATUS(STATUS(5))                         <<04140>>07280000
      OR NOT EXAMINE'STATUS(STATUS(6)) THEN                    <<04140>>07285000
        BEGIN                                                  <<02581>>07290000
        SET'DISPOSITION; <<DEFER, INCOMPLETE>>                 <<02581>>07295000
   << 2 Exceeded 100 errors for this job, spoolfile deferred >><<06334>>07300000
        GENMSG(DAYFILE'MSG'SET, DAY'MAX'EXCEEDED,,,,,,,        <<02581>>07305000
            -DAYFILE);                                         <<02581>>07310000
        GOTO LX;                                               <<02581>>07315000
        END;                                                   <<02581>>07320000
     IF IO'STATUS'RETURN = ST'IO'STATUS'AVAILABLE  OR          <<04397>>07325000
        IO'STATUS'RETURN = ST'IO'ST'AND'RE'XMIT         THEN   <<04397>>07330000
     GO TO READ'STATUS;                                        <<01885>>07335000
LX:      WRITEEND := FALSE; WRITEWAIT := TRUE;                 <<02504>>07340000
END;  <<NOTIFY'USER>>                                          <<01885>>07345000
$PAGE "(OUTPUT) PROCEDURE: SPECIAL'CASES"                      <<02580>>07350000
PROCEDURE SPECIAL'CASES(IO'STATUS'BLOCK);                      <<02504>>07355000
   LOGICAL ARRAY IO'STATUS'BLOCK;                              <<02504>>07360000
OPTION PRIVILEGED, UNCALLABLE;                                 <<02580>>07365000
   BEGIN                                                       <<02504>>07370000
                                                               <<02504>>07375000
      DEFINE                                                   <<02504>>07380000
             FORMAT'ERROR        =          4).(9:1#,          <<02634>>07385000
             EXPECT'JOB'OPEN     =          4).(12:1#,         <<02504>>07390000
             OUT'OF'MEMORY       =          4).(13:1#;         <<02504>>07395000
      LOGICAL POINTER XDD'SUBENTRY := @ODDEP;                  <<06912>>07400000
      INTEGER DEVFILEID;                                       <<02634>>07405000
                                                               <<06912>>07410000
      IF IO'STATUS'BLOCK(EXPECT'JOB'OPEN) THEN                 <<02504>>07415000
      BEGIN                                                    <<02504>>07420000
         SRFUNC := IMMEDIATE'CLEAR;                            <<02504>>07425000
         WRITEEND := FALSE; WRITEWAIT := TRUE;                 <<02504>>07430000
         SDWRITE(SRFUNC, BLOCKMODE, WRITEEND, WRITEWAIT,       <<04397>>07435000
                 IMAGETYPE);                                   <<04397>>07440000
         JOB'OPEN'FAILED := TRUE;                              <<02504>>07445000
      END;                                                     <<02504>>07450000
      IF IO'STATUS'BLOCK(OUT'OF'MEMORY) THEN                   <<02504>>07455000
      BEGIN   <<CATASTROPHIC ERROR>>                           <<02504>>07460000
         SET'DISPOSITION; <<DEFER, INCOMPLETE>>                <<02504>>07465000
         SRFUNC := IMMEDIATE'CLEAR;                            <<02504>>07470000
         WRITEEND := FALSE;                                    <<02504>>07475000
         WRITEWAIT := TRUE;                                    <<02504>>07480000
         SDWRITE(SRFUNC, BLOCKMODE, WRITEEND, WRITEWAIT,       <<04397>>07485000
                 IMAGETYPE);                                   <<04397>>07490000
      END;                                                     <<02504>>07495000
      IF IO'STATUS'BLOCK(FORMAT'ERROR) THEN                    <<02634>>07500000
      BEGIN                                                    <<02634>>07505000
         SET'DISPOSITION; << DEFER, INCOMPLETE >>              <<02634>>07510000
         SRFUNC:=IMMEDIATE'CLEAR;                              <<02634>>07515000
         WRITEEND:=FALSE;                                      <<02634>>07520000
         WRITEWAIT:=TRUE;                                      <<02634>>07525000
         SDWRITE(SRFUNC, BLOCKMODE, WRITEEND, WRITEWAIT,       <<04397>>07530000
                 IMAGETYPE);                                   <<04397>>07535000
         EXCHANGEDB(ODD'DST);                                  <<06912>>07540000
         DEVFILEID:=XDDS'DFID'NUMBER;                          <<06912>>07545000
         EXCHANGEDB(0);                                        <<02634>>07550000
<< 239 SP#\/#0! deferred, spooler block contains format error>><<06334>>07555000
         GENMSG(1, BAD'BLOCK, %11000, DEVICE, DEVFILEID,,,,0); <<02634>>07560000
      END;                                                     <<02634>>07565000
   END;  <<SPECIAL'CASES>>                                     <<02504>>07570000
$PAGE "(OUTPUT) PROCEDURE: PRINT'ERRFILE"                      <<04399>>07575000
LOGICAL PROCEDURE PRINT'ERRFILE(PURGE'ONLY);                   <<02594>>07580000
VALUE                           PURGE'ONLY ;                   <<02594>>07585000
LOGICAL                         PURGE'ONLY ;                   <<02594>>07590000
OPTION UNCALLABLE, PRIVILEGED;                                 <<02594>>07595000
                                                               <<01885>>07600000
BEGIN                                                          <<01885>>07605000
   INTEGER DAY'XDDEPI;                                         <<01885>>07610000
   INTEGER POINTER DAY'XDDEP;                                  <<01885>>07615000
   INTEGER SAVE'SPOOL'DFID;                                    <<01885>>07620000
   INTEGER SPOOLREQUEST', FILEREQUEST';                        <<02504>>07625000
                                                               <<01885>>07630000
<<>>                                                           <<01885>>07635000
   IF DAYFILE <> 0 THEN                                        <<02605>>07640000
     BEGIN                                                     <<02605>>07645000
     FCLOSE(DAYFILE, 0, 0);                                    <<02605>>07650000
     DAYFILE:=0;                                               <<02605>>07655000
     END;                                                      <<02605>>07660000
   IF DAY'DFID = 0 THEN RETURN; <<DAYFILE WAS $NULL>>          <<02605>>07665000
                                                               <<02527>>07670000
   SFINDODD(LOGICAL(DAY'DFID) LOR %100000, DAY'XDDEPI);        <<01885>>07675000
   @DAY'XDDEP := DAY'XDDEPI;                                   <<01885>>07680000
   DAYFILE := FSOPEN(, %305, %520,                             <<01885>>07685000
         LOGICAL(@DAY'XDDEP) LOR %100000);                     <<01885>>07690000
 IF NOT PURGE'ONLY THEN                                        <<02594>>07695000
   BEGIN <<REALLY TRY TO PRINT THE ERRFILE>>                   <<02594>>07700000
   SAVE'SPOOL'DFID := SPOOLFILE;                               <<01885>>07705000
   SPOOLFILE := DAYFILE;                                       <<01885>>07710000
   DONEIMAGE := FALSE;                                         <<01885>>07715000
   SPOOLREQUEST' := SPOOLREQUEST;                              <<02504>>07720000
   FILEREQUEST' := FILEREQUEST;  <<SAVE ORIGINAL FILE VALUES>> <<02504>>07725000
   SPOOLREQUEST := KEEPSPOOLING;                               <<02504>>07730000
   FILEREQUEST := FINISHFILE;                                  <<02504>>07735000
   DAYFILE := 0;                                               <<01885>>07740000
   END'OF'JOB := TRUE;                                         <<01885>>07745000
   SPOOLOUTLOOP;  <<PRINT DAYFILE>>                            <<01885>>07750000
   FINISHUP;                                                   <<04397>>07755000
   PRINT'ERRFILE := TRUE;                                      <<02594>>07760000
   DAYFILE := SPOOLFILE;                                       <<01885>>07765000
   SPOOLFILE := SAVE'SPOOL'DFID;                               <<01885>>07770000
   FILEREQUEST := FILEREQUEST';                                <<02594>>07775000
   SPOOLREQUEST := SPOOLREQUEST';                              <<02504>>07780000
   END;                                                        <<02594>>07785000
 IF (FILEREQUEST = FINISHFILE) AND                             <<02594>>07790000
     (ERR'COUNT > ERR'UPPER'LIMIT) THEN                        <<02594>>07795000
   FILEREQUEST := DEFERFILE;                                   <<02594>>07800000
   FSCLOSE(DAYFILE,4,0);  <<PURGE DAYFILE>>                    <<02512>>07805000
   DAYFILE := 0;                                               <<01885>>07810000
   DAY'DFID:=0;                                                <<02594>>07815000
END; << of procedure print'errfile >>                          <<04399>>07820000
$PAGE "(OUTPUT) PROCEDURE: CIPER'PERIPHERAL'ERROR"             <<04404>>07825000
logical procedure ciper'peripheral'error;                      <<04404>>07830000
                                                               <<04404>>07835000
  option privileged, uncallable;                               <<04404>>07840000
                                                               <<04404>>07845000
begin                                                          <<04404>>07850000
                                                               <<04404>>07855000
  << tell operator what's happening >>                         <<04404>>07860000
                                                               <<04404>>07865000
  << 382  LDEV \ RESTART IN PROGRESS >>                        <<06334>>07870000
  genmsg(1, restart'in'progress, %10000, device,,,,,0);        <<04404>>07875000
                                                               <<04404>>07880000
  ciper'peripheral'error := ciper'restart'page( 0D, false );   <<04404>>07885000
                                                               <<04404>>07890000
end; << of procedure ciper'peripheral'error >>                 <<04404>>07895000
                                                               <<04441>>07900000
$PAGE "(OUTPUT) PROCEDURE: HANDLE'DEVICE'STATUS"               <<04441>>07905000
logical procedure handle'device'status;                        <<04441>>07910000
                                                               <<04441>>07915000
  option privileged, uncallable;                               <<04441>>07920000
                                                               <<04441>>07925000
begin                                                          <<04441>>07930000
                                                               <<04441>>07935000
                                                               <<04441>>07940000
  equate                                                       <<04441>>07945000
                                                               <<04441>>07950000
     retry'limit     = 20                                      <<04441>>07955000
  ;                                                            <<04441>>07960000
                                                               <<04441>>07965000
  integer                                                      <<04441>>07970000
                                                               <<04441>>07975000
     retry'cnt                                                 <<04441>>07980000
    ,status'return                                             <<04441>>07985000
  ;                                                            <<04441>>07990000
                                                               <<04441>>07995000
  logical array                                                <<04441>>08000000
                                                               <<04441>>08005000
     device'status( 0 : size'of'device'status - 1 )            <<04441>>08010000
  ;                                                            <<04441>>08015000
                                                               <<04441>>08020000
$PAGE                                                          <<04441>>08025000
                                                               <<04441>>08030000
                                                               <<04441>>08035000
<< * * *                 Procedure body                * * * >><<04441>>08040000
                                                               <<04441>>08045000
  handle'device'status := true; << assume success >>           <<04447>>08050000
                                                               <<04447>>08055000
  retry'cnt := -1;  << initialize >>                           <<04447>>08060000
                                                               <<04441>>08065000
try'again:                                                     <<04441>>08070000
                                                               <<04441>>08075000
  retry'cnt := retry'cnt + 1;                                  <<04441>>08080000
                                                               <<04441>>08085000
  if retry'cnt > retry'limit then                              <<04441>>08090000
    handle'device'status := false                              <<04441>>08095000
                                                               <<04441>>08100000
  else                                                         <<04441>>08105000
    begin                                                      <<04441>>08110000
                                                               <<04441>>08115000
    tos := attachio(device, 0 << QMISC := NA >>,               <<04441>>08120000
         0 << DSTX := stack >>, @device'status,                <<04441>>08125000
    func'dev'stat'composite, size'of'device'status,            <<04441>>08130000
    0 << P1 := NA >>, 0 << P2 := NA >>,                        <<04441>>08135000
    1 << FLAGS := no premption; not special request;         >><<04441>>08140000
    << not diagnostic; not system buffer; blocked;           >><<04441>>08145000
    << wake on completion; impede if no IOQ element          >><<04441>>08150000
    << is available.  >> );                                    <<04441>>08155000
                                                               <<04441>>08160000
      << analyze io status return >>                           <<04441>>08165000
    del;                                                       <<04441>>08170000
    status'return := tos.qual'gen'status;                      <<04441>>08175000
                                                               <<04441>>08180000
    if status'return.general'status <> gen'st'ok then          <<04441>>08185000
      go exit'device'ioerr                                     <<04441>>08190000
                                                               <<04441>>08195000
    else                                                       <<04441>>08200000
      if device'status(dev'st'self'test'failed) then           <<04441>>08205000
        begin                                                  <<04441>>08210000
          << self test failed; stop spooling >>                <<04441>>08215000
        imagetype := ioerr;                                    <<04441>>08220000
        stopspooling := spooleeioerr;                          <<04441>>08225000
        filerequest := relinkfile;                             <<04441>>08230000
        handle'device'status := false;                         <<04441>>08235000
        end                                                    <<04441>>08240000
                                                               <<04441>>08245000
      else                                                     <<04441>>08250000
        if device'status(dev'st'power'fail) then               <<04441>>08255000
            << device power failed, recover >>                 <<04441>>08260000
          handle'device'status := ciper'power'fail             <<04441>>08265000
                                                               <<04441>>08270000
        else                                                   <<04441>>08275000
          if device'status(dev'st'protocol'error) <> 0 then    <<04441>>08280000
            handle'device'status := ciper'peripheral'error     <<04441>>08285000
                                                               <<04441>>08290000
          else                                                 <<04441>>08295000
            if device'status(dev'st'possible'data'loss) then   <<04441>>08300000
              begin                                            <<04441>>08305000
                                                               <<04441>>08310000
              tos := attachio(device, 0 << QMISC := NA >>,     <<04441>>08315000
                   0 << DSTX := NA >>, 0 << ADDR := NA >>,     <<04441>>08320000
              func'dev'clear, 0 << CNT := NA >>,               <<04441>>08325000
              1 << P1 := purge device buffers >>,              <<04441>>08330000
              0 << P2 := NA >>,                                <<04441>>08335000
              1 << FLAGS := no premption;                    >><<04441>>08340000
              << not special request; not diagnostic;        >><<04441>>08345000
              << not system buffer; blocked;                 >><<04441>>08350000
              << wake on completion;                         >><<04441>>08355000
              << impede if no IOQ element is available.  >> ); <<04441>>08360000
                                                               <<04441>>08365000
                << analyze io status return >>                 <<04441>>08370000
              del;                                             <<04441>>08375000
              status'return := tos.qual'gen'status;            <<04441>>08380000
                                                               <<04441>>08385000
              if status'return.general'status = gen'st'ok then <<04441>>08390000
                handle'device'status := ciper'peripheral'error <<04441>>08395000
                                                               <<04441>>08400000
              else                                             <<04441>>08405000
                if status'return = st'device'power'up then     <<04441>>08410000
                    << device power failed, recover >>         <<04441>>08415000
                  handle'device'status := ciper'power'fail     <<04441>>08420000
                                                               <<04441>>08425000
                else                                           <<04441>>08430000
                  if status'return = st'not'ok'plus'status then<<04441>>08435000
                    go try'again                               <<04441>>08440000
                                                               <<04441>>08445000
                  else                                         <<04441>>08450000
                    go exit'device'ioerr;                      <<04441>>08455000
              end;                                             <<04441>>08460000
    end;                                                       <<04441>>08465000
                                                               <<04441>>08470000
  return;                                                      <<04441>>08475000
                                                               <<04441>>08480000
                                                               <<04441>>08485000
exit'device'ioerr:                                             <<04441>>08490000
                                                               <<04441>>08495000
  notify'operator( device, status'return );                    <<04441>>08500000
  imagetype := ioerr;                                          <<04441>>08505000
  stopspooling := spooleeioerr;                                <<04441>>08510000
  filerequest := relinkfile;                                   <<04441>>08515000
  handle'device'status := false;                               <<04441>>08520000
                                                               <<04441>>08525000
end; << of procedure handle'device'status >>                   <<04441>>08530000
                                                               <<04441>>08535000
$PAGE "(OUTPUT) PROCEDURE: PROCESS'STATUS"                     <<04404>>08540000
logical procedure process'status(type'index);                  <<04404>>08545000
                                                               <<04404>>08550000
  value                          type'index ;                  <<04404>>08555000
                                                               <<04404>>08560000
  integer                        type'index ;                  <<04404>>08565000
                         << The kind of status available >>    <<04404>>08570000
                                                               <<04404>>08575000
  option privileged, uncallable;                               <<04404>>08580000
                                                               <<04404>>08585000
begin                                                          <<04404>>08590000
                                                               <<04404>>08595000
                                                               <<04404>>08600000
  COMMENT                                                      <<04404>>08605000
                                                               <<04404>>08610000
    This procedure contains routines to process each of the    <<04404>>08615000
    various kinds of status information available from CIPER   <<04404>>08620000
    devices, the 2608B in particular.                          <<04404>>08625000
  ;                                                            <<04404>>08630000
                                                               <<04404>>08635000
  equate                                                       <<04404>>08640000
                                                               <<04404>>08645000
     type'index'min  = 0  << Minimum value for TYPE'INDEX >>   <<04404>>08650000
    ,type'index'max  = 15 << Maximum value for TYPE'INDEX >>   <<04404>>08655000
  ;                                                            <<04404>>08660000
                                                               <<04404>>08665000
$PAGE                                                          <<04440>>08670000
                                                               <<04404>>08675000
                                                               <<04404>>08680000
<< * * *                 Procedure body                * * * >><<04404>>08685000
                                                               <<04404>>08690000
  if not (type'index'min <= type'index <= type'index'max) then <<04404>>08695000
    return;                                                    <<04404>>08700000
                                                               <<04404>>08705000
  process'status := true; << assume success >>                 <<04404>>08710000
                                                               <<04404>>08715000
  case type'index of                                           <<04404>>08720000
                                                               <<04404>>08725000
    case'begin                                                 <<04404>>08730000
                                                               <<04404>>08735000
                                                               <<04404>>08740000
    ;       << TYPE 0 is reserved >>                           <<04404>>08745000
                                                               <<04404>>08750000
                                                               <<04404>>08755000
    ;       << TYPE 1 is reserved >>                           <<04404>>08760000
                                                               <<04404>>08765000
                                                               <<04404>>08770000
    ;       << TYPE 2 is reserved >>                           <<04404>>08775000
                                                               <<04404>>08780000
                                                               <<04404>>08785000
    ;       << TYPE 3 is reserved >>                           <<04404>>08790000
                                                               <<04404>>08795000
                                                               <<04404>>08800000
    ;       << TYPE 4 is reserved >>                           <<04404>>08805000
                                                               <<04404>>08810000
                                                               <<04404>>08815000
    ;       << TYPE 5 is reserved >>                           <<04404>>08820000
                                                               <<04404>>08825000
                                                               <<04404>>08830000
    ;       << TYPE 6 is reserved >>                           <<04404>>08835000
                                                               <<04404>>08840000
                                                               <<04404>>08845000
    ;       << TYPE 7 is reserved >>                           <<04404>>08850000
                                                               <<04404>>08855000
                                                               <<04404>>08860000
    ;       << TYPE 8 is reserved >>                           <<04404>>08865000
                                                               <<04404>>08870000
                                                               <<04404>>08875000
    ;       << TYPE 9 is reserved >>                           <<04404>>08880000
                                                               <<04404>>08885000
                                                               <<04404>>08890000
    ;       << TYPE 10 is reserved >>                          <<04404>>08895000
                                                               <<04404>>08900000
                                                               <<04404>>08905000
    ;       << TYPE 11 is reserved >>                          <<04404>>08910000
                                                               <<04404>>08915000
                                                               <<04404>>08920000
    ;       << TYPE 12 is reserved >>                          <<04404>>08925000
                                                               <<04404>>08930000
                                                               <<04404>>08935000
    begin   << TYPE 13 = Job Status >>                         <<04404>>08940000
                                                               <<04404>>08945000
         << Not yet implemented. >>                            <<04404>>08950000
                                                               <<04404>>08955000
    end;    << TYPE 13 >>                                      <<04404>>08960000
                                                               <<04404>>08965000
                                                               <<04404>>08970000
    begin   << TYPE 14 = Device Status >>                      <<04404>>08975000
                                                               <<04404>>08980000
    process'status := handle'device'status;                    <<04440>>08985000
                                                               <<04404>>08990000
    end;    << TYPE 14 >>                                      <<04404>>08995000
                                                               <<04404>>09000000
                                                               <<04404>>09005000
    begin   << TYPE 15 = ENVIRONMENTAL STATUS >>               <<04404>>09010000
                                                               <<04404>>09015000
    process'status := ciper'checkpoint'page;   << save it >>   <<04404>>09020000
                                                               <<04404>>09025000
    end;    << TYPE 15 >>                                      <<04404>>09030000
                                                               <<04404>>09035000
                                                               <<04404>>09040000
  case'end;  << CASE of type'index >>                          <<04404>>09045000
                                                               <<04404>>09050000
exit'true:                                                     <<04404>>09055000
                                                               <<04404>>09060000
  return;                                                      <<04404>>09065000
                                                               <<04404>>09070000
                                                               <<04404>>09075000
exit'false:                                                    <<04404>>09080000
                                                               <<04404>>09085000
  process'status := false; << failure >>                       <<04404>>09090000
                                                               <<04404>>09095000
end;  << of procedure process'status >>                        <<04404>>09100000
                                                               <<04404>>09105000
$PAGE "(OUTPUT) PROCEDURE: CIPER'STATUS"                       <<04404>>09110000
integer procedure ciper'status(status'return);                 <<04404>>09115000
                                                               <<04404>>09120000
  value                        status'return ;                 <<04404>>09125000
                                                               <<04404>>09130000
  integer                      status'return ;                 <<04404>>09135000
                                                               <<04404>>09140000
  option privileged, uncallable;                               <<04404>>09145000
                                                               <<04404>>09150000
begin                                                          <<04404>>09155000
                                                               <<04404>>09160000
                                                               <<04404>>09165000
  comment                                                      <<04404>>09170000
                                                               <<04404>>09175000
    This procedure does special processing on the              <<04404>>09180000
    status returns from ATTACHIO for CIPER devices             <<04404>>09185000
    such as the 2608B line printer.                            <<04404>>09190000
  ;                                                            <<04404>>09195000
                                                               <<04404>>09200000
  logical                                                      <<04404>>09205000
                                                               <<04404>>09210000
     local'status                                              <<04404>>09215000
    ,status'types                                              <<04404>>09220000
  ;                                                            <<04404>>09225000
                                                               <<04404>>09230000
  integer                                                      <<04404>>09235000
                                                               <<04404>>09240000
     type'index                                                <<04404>>09245000
  ;                                                            <<04404>>09250000
                                                               <<04404>>09255000
                                                               <<04404>>09260000
<< * * *                 Procedure body                * * * >><<04404>>09265000
                                                               <<04404>>09270000
  if not ciper then                                            <<04404>>09275000
    begin                                                      <<04404>>09280000
    ciper'status := status'return;                             <<04404>>09285000
    return;                                                    <<04404>>09290000
    end;                                                       <<04404>>09295000
                                                               <<04404>>09300000
  if status'return <> st'ok'plus'status and                    <<04404>>09305000
       status'return <> st'not'ok'plus'status and              <<04404>>09310000
  status'return <> st'device'power'up then                     <<04404>>09315000
    begin                                                      <<04404>>09320000
    ciper'status := status'return;                             <<04404>>09325000
    return;                                                    <<04404>>09330000
    end;                                                       <<04404>>09335000
                                                               <<04404>>09340000
  if status'return = st'device'power'up then                   <<04404>>09345000
    ciper'status := if ciper'power'fail then st'ok             <<04404>>09350000
                                        else st'irrecoverable  <<04404>>09355000
                                                               <<04404>>09360000
  else                                                         <<04404>>09365000
      << There is special status available. >>                 <<04404>>09370000
    begin                                                      <<04404>>09375000
    do                                                         <<04404>>09380000
                                                               <<04404>>09385000
      begin                                                    <<04404>>09390000
                                                               <<04404>>09395000
      tos := attachio( device, 0 << QMISC := NA >>,            <<04404>>09400000
           0 << DSTX := stack >>, @status'types << ADDR >>,    <<04404>>09405000
      func'read'avail'stat'types, 1 << CNT >>, 0 << P1 >>,     <<04404>>09410000
      0 << P2 >>,                                              <<04404>>09415000
      1 << FLAGS := no premption; not special request;         <<04404>>09420000
      << not diagnostic; not system buffer; blocked,           <<04404>>09425000
      << wake on completion, impede if no IOQ element          <<04404>>09430000
      << is avaiable. >> );                                    <<04404>>09435000
                                                               <<04404>>09440000
      del;                                                     <<04404>>09445000
      local'status := tos.qual'gen'status;                     <<04404>>09450000
                                                               <<04404>>09455000
      if local'status.general'status <> gen'st'ok then         <<04404>>09460000
        begin  << Real trouble >>                              <<04404>>09465000
        ciper'status := local'status;                          <<04404>>09470000
        return;                                                <<04404>>09475000
        end;                                                   <<04404>>09480000
                                                               <<04404>>09485000
      type'index := 15;   << loop through status types >>      <<04404>>09490000
      while status'types <> 0 do                               <<04404>>09495000
        begin                                                  <<04404>>09500000
        if status'types << checking last bit of word >> then   <<04404>>09505000
          if not process'status( type'index ) then             <<04404>>09510000
            begin << More real trouble >>                      <<04404>>09515000
            ciper'status := st'irrecoverable;                  <<04404>>09520000
            return;                                            <<04404>>09525000
            end;                                               <<04404>>09530000
                                                               <<04404>>09535000
        status'types := status'types & lsr(1);                 <<04404>>09540000
        type'index := type'index - 1;                          <<04404>>09545000
        end;                                                   <<04404>>09550000
                                                               <<04404>>09555000
      end << of DO loop >>                                     <<04404>>09560000
                                                               <<04404>>09565000
    until local'status = st'ok;                                <<04404>>09570000
                                                               <<04404>>09575000
    ciper'status := st'ok                                      <<04404>>09580000
                                                               <<04404>>09585000
    end; << special status available >>                        <<04404>>09590000
                                                               <<04404>>09595000
end; << of procedure ciper'status >>                           <<04404>>09600000
$PAGE "(OUTPUT) PROCEDURE: HEADER/TRAILER"                     <<04401>>09605000
logical procedure header(odd'sub'ptr, device, dev'type,        <<04401>>09610000
                                     dev'configured'rec'width);<<04401>>09615000
                                                               <<04401>>09620000
  value                  odd'sub'ptr, device, dev'type,        <<04401>>09625000
                                     dev'configured'rec'width ;<<04401>>09630000
                                                               <<04401>>09635000
  integer pointer        odd'sub'ptr                           <<04401>>09640000
                                                              ;<<04401>>09645000
                                                               <<04401>>09650000
  integer                             device, dev'type,        <<04401>>09655000
                                     dev'configured'rec'width ;<<04401>>09660000
                                                               <<04401>>09665000
  option privileged, uncallable;                               <<04401>>09670000
                                                               <<04401>>09675000
begin                                                          <<04401>>09680000
                                                               <<04401>>09685000
                                                               <<04401>>09690000
  define                                                       <<04401>>09695000
                                                               <<04401>>09700000
     epoc'page'width = 8).(8:8 #                               <<04401>>09705000
    ,inc'line'bp     = @line'bp := @line'bp + #                <<04401>>09710000
  ;                                                            <<04401>>09715000
                                                               <<04401>>09720000
                                                               <<04401>>09725000
  entry                                                        <<04401>>09730000
                                                               <<04401>>09735000
    trailer                                                    <<04401>>09740000
  ;                                                            <<04401>>09745000
                                                               <<04401>>09750000
                                                               <<04401>>09755000
  equate                                                       <<04401>>09760000
                                                               <<04401>>09765000
       << maximum device record width Header/Trailer will use ><<04401>>09770000
     line'max'size   = 66                                      <<04401>>09775000
    ,line'b'max'size = line'max'size * 2                       <<04401>>09780000
                                                               <<04401>>09785000
       << values for mode >>                                   <<04401>>09790000
    ,mode'form'feed  = %61                                     <<04401>>09795000
          << Page eject, selects VFC Channel 1               >><<04401>>09800000
                                                               <<04401>>09805000
    ,mode'space'1'line = %201                                  <<04401>>09810000
          << Space 1 line (no automatic page eject)          >><<04401>>09815000
                                                               <<04401>>09820000
    ,mode'space'21'lines = %221                                <<04401>>09825000
          << Space 21 lines (no automatic page eject)        >><<04401>>09830000
                                                               <<04401>>09835000
    ,mode'no'space'no'return = %320                            <<04401>>09840000
          << No space, no return                             >><<04401>>09845000
          << (next printing physically follows this)         >><<04401>>09850000
                                                               <<04401>>09855000
       << CIPER protocol error retry limit >>                  <<04401>>09860000
    ,retry'limit     = 20                                      <<04401>>09865000
  ;                                                            <<04401>>09870000
                                                               <<04401>>09875000
                                                               <<04401>>09880000
  integer                                                      <<04401>>09885000
                                                               <<04401>>09890000
    LPDT'INDEX,                                                <<06334>>09895000
    LDT'INDEX,                                                 <<06334>>09900000
    LDTX'INDEX,                                                <<06334>>09905000
     curlen                                                    <<04401>>09910000
    ,curpos                                                    <<04401>>09915000
    ,delta                                                     <<04401>>09920000
    ,delta'3                                                   <<04401>>09925000
    ,dev'subtype                                               <<04401>>09930000
    ,dev'rec'width                                             <<04401>>09935000
    ,group'num                                                 <<04401>>09940000
    ,ldt'sir'save                                              <<04401>>09945000
    ,line'b'len                                                <<04401>>09950000
    ,line'len                                                  <<04401>>09955000
    ,line'len'max                                              <<04401>>09960000
    ,line'num'of'group                                         <<04401>>09965000
    ,mode                                                      <<04401>>09970000
    ,retry'count                                               <<04401>>09975000
    ,status'return                                             <<04401>>09980000
  ;                                                            <<04401>>09985000
                                                               <<04401>>09990000
                                                               <<04401>>09995000
  logical                                                      <<04401>>10000000
                                                               <<04401>>10005000
     card'device                                               <<04401>>10010000
    ,ciper'protocol                                            <<04401>>10015000
    ,dev'spooled                                               <<04401>>10020000
    ,doing'header                                              <<04401>>10025000
    ,doing'trailer                                             <<04401>>10030000
    ,form'aligned'ok                                           <<04401>>10035000
    ,header'off                                                <<04401>>10040000
    ,last'group                                                <<04401>>10045000
    ,last'line'of'group                                        <<04401>>10050000
    ,last'line'of'page                                         <<04401>>10055000
    ,paper'device                                              <<04401>>10060000
    ,epoc'2680A                                                <<04401>>10065000
    ,printing'device                                           <<04401>>10070000
    ,sent'fopen                                                <<04401>>10075000
    ,started'printing                                          <<04401>>10080000
    ,trailer'off                                               <<04401>>10085000
                                                               <<04401>>10090000
       << trailer messages sent by spooler >>                  <<04401>>10095000
    ,trlr'msg'spaced'out                                       <<04401>>10100000
    ,trlr'msg'resumed                                          <<04401>>10105000
    ,trlr'msg'incomplete                                       <<04401>>10110000
  ;                                                            <<04401>>10115000
                                                               <<04401>>10120000
                                                               <<04401>>10125000
  integer pointer                                              <<04401>>10130000
                                                               <<04401>>10135000
     block'p;       <<word pointer to block>>                  <<06334>>10140000
  LOGICAL POINTER                                              <<06334>>10145000
     LDT,                                                      <<06334>>10150000
     LDTX                                                      <<06334>>10155000
  ;                                                            <<04401>>10160000
                                                               <<04401>>10165000
                                                               <<04401>>10170000
  logical array                                                <<04401>>10175000
                                                               <<04401>>10180000
     avail'returns( 0 : size'of'avail'returns - 1 )            <<04401>>10185000
    ,block( 0 : size'of'spoolfle'block - 1 )                   <<04401>>10190000
    ,env'status( 0 : size'of'env'status'block - 1 )            <<04401>>10195000
    ,device'status( 0 : size'of'device'status - 1 )            <<04401>>10200000
    ,job'report'status( 0 :                                    <<04401>>10205000
          size'of'job'report'status - 1 )                      <<04401>>10210000
    ,line( 0 : line'max'size )                                 <<04401>>10215000
    ,XDD'SUBENTRY(0 : SIZE'OF'XDD'SUBENTRY-1)                  <<06912>>10220000
    ,physical'pages'(*) = physical'pages                       <<04401>>10225000
    ,silent'run( 0 : size'of'silent'run - 1 )                  <<04401>>10230000
  ;                                                            <<04401>>10235000
                                                               <<04401>>10240000
                                                               <<04401>>10245000
  logical pointer                                              <<04401>>10250000
                                                               <<04401>>10255000
     write'block'addr                                          <<04401>>10260000
  ;                                                            <<04401>>10265000
                                                               <<04401>>10270000
                                                               <<04401>>10275000
  byte                                                         <<04401>>10280000
                                                               <<04401>>10285000
     add'bp'name'b'temp                                        <<04401>>10290000
  ;                                                            <<04401>>10295000
                                                               <<04401>>10300000
                                                               <<04401>>10305000
  byte array                                                   <<04401>>10310000
                                                               <<04401>>10315000
     XDD'BSUBENTRY(*)= XDD'SUBENTRY                            <<06912>>10320000
    ,line'b(*)       = line                                    <<04401>>10325000
  ;                                                            <<04401>>10330000
                                                               <<04401>>10335000
                                                               <<04401>>10340000
  byte pointer                                                 <<04401>>10345000
                                                               <<04401>>10350000
     js'number'digit                                           <<04401>>10355000
    ,line'bp                                                   <<04401>>10360000
    ,add'bp'name'bp'temp                                       <<04401>>10365000
  ;                                                            <<04401>>10370000
                                                               <<04401>>10375000
                                                               <<04401>>10380000
  double pointer                                               <<04401>>10385000
                                                               <<04401>>10390000
     d'env'status    = env'status                              <<04401>>10395000
    ,d'silent'run    = silent'run                              <<04401>>10400000
  ;                                                            <<04401>>10405000
                                                               <<04401>>10410000
                                                               <<04401>>10415000
declare'move'from'data'segment;                                <<04401>>10420000
                                                               <<04401>>10425000
                                                               <<04401>>10430000
$PAGE "(OUTPUT) ",&                                            <<04401>>10435000
$"PROCEDURE: HEADER/TRAILER;  SUBROUTINE: GET'DEVICE'INFO"     <<04401>>10440000
subroutine get'device'info;                                    <<04401>>10445000
                                                               <<04401>>10450000
begin                                                          <<04401>>10455000
                                                               <<04401>>10460000
                                                               <<04401>>10465000
  LPDT'INDEX := DEVICE * SIZE'OF'LPDT'ENTRY;                   <<06334>>10470000
  dev'subtype := LPDT'SUBTYPE;                                 <<06334>>10475000
                                                               <<04401>>10480000
  epoc'2680A := ( dev'type = LDT'printer )  land               <<06334>>10485000
       ( dev'subtype = subtype'2680A );                        <<04401>>10490000
                                                               <<04401>>10495000
<< * * Extract ldt/ldtx information * * >>                     <<04401>>10500000
  @LDT := 0;                                                   <<06334>>10505000
  LDT'INDEX := device * size'of'ldt'entry;                     <<06334>>10510000
  ldt'sir'save := getsir(ldt'sir);                             <<04401>>10515000
  exchangedb(ldt'dst);                                         <<04401>>10520000
                                                               <<04401>>10525000
  header'off := ldt'header'off;                                <<06334>>10530000
  trailer'off := ldt'trailer'off;                              <<06334>>10535000
  ldt'trailer'off := ldt'header'off;                           <<06334>>10540000
                                                               <<04401>>10545000
  dev'spooled := ( ldt'spool'state = LDT'OUTPUT'SPOOLED );     <<06334>>10550000
                                                               <<04401>>10555000
  @ldtX := LDTX'BASE;                                          <<06334>>10560000
  LDTX'INDEX := DEVICE * SIZE'OF'LDTX'ENTRY;                   <<06334>>10565000
  ciper'protocol :=  ldtx'ciper'protocol;                      <<06334>>10570000
                                                               <<04401>>10575000
  exchangedb(0);                                               <<04401>>10580000
  relsir(ldt'sir, ldt'sir'save);                               <<04401>>10585000
                                                               <<04401>>10590000
end; << of subroutine get'device'info >>                       <<04401>>10595000
                                                               <<04401>>10600000
$PAGE "(OUTPUT) ",&                                            <<04401>>10605000
$"PROCEDURE: HEADER/TRAILER;  SUBROUTINE: DO'ATTACHIO"         <<04401>>10610000
subroutine do'attachio(addr, func, cnt, p1, p2);               <<04401>>10615000
                                                               <<04401>>10620000
  value                addr, func, cnt, p1, p2 ;               <<04401>>10625000
                                                               <<04401>>10630000
  integer              addr, func, cnt, p1, p2 ;               <<04401>>10635000
                                                               <<04401>>10640000
begin                                                          <<04401>>10645000
                                                               <<04401>>10650000
                                                               <<04401>>10655000
  tos := attachio(device, 0 << QMISC := NA >>,                 <<04401>>10660000
       0 << DSTX := stack >>,                                  <<04401>>10665000
  addr, func, cnt, p1, p2,                                     <<04401>>10670000
  1 << FLAGS := no premption; not special request;           >><<04401>>10675000
  << not diagnostic; not system buffer; blocked;             >><<04401>>10680000
  << wake on completion; impede if no IOQ element            >><<04401>>10685000
  << is available.  >> );                                      <<04401>>10690000
                                                               <<04401>>10695000
  del;  << get rid of transmission log/control returns       >><<04401>>10700000
  status'return := tos.qual'gen'status; << save io status's  >><<04401>>10705000
                                                               <<04401>>10710000
    << intercept status'return 's which are ok, >>             <<04401>>10715000
    << but indicate other statuses are available >>            <<04401>>10720000
  if status'return = st'ok'plus'status then                    <<04401>>10725000
    status'return := st'ok;                                    <<04401>>10730000
                                                               <<04401>>10735000
  if status'return.general'status = gen'st'irrecoverable then  <<04401>>10740000
    begin                                                      <<04401>>10745000
    notify'operator( device, status'return );                  <<04401>>10750000
    go exit'false;                                             <<04401>>10755000
    end;                                                       <<04401>>10760000
                                                               <<04401>>10765000
end; << of subroutine do'attachio >>                           <<04401>>10770000
                                                               <<04401>>10775000
$PAGE "(OUTPUT) ",&                                            <<04401>>10780000
$"PROCEDURE: HEADER/TRAILER;  SUBROUTINE: WRITE'BLOCK"         <<04401>>10785000
logical subroutine write'block(addr, cnt, p1, flush);          <<04401>>10790000
                                                               <<04401>>10795000
  value                        addr, cnt, p1, flush ;          <<04401>>10800000
                                                               <<04401>>10805000
  integer                      addr, cnt, p1        ;          <<04401>>10810000
                                                               <<04401>>10815000
  logical                                     flush ;          <<04401>>10820000
                                                               <<04401>>10825000
begin                                                          <<04401>>10830000
                                                               <<04401>>10835000
                                                               <<04401>>10840000
  write'block := false; << assume failure >>                   <<04401>>10845000
                                                               <<04401>>10850000
    << make cnt in to a positive byte count >>                 <<04401>>10855000
  cnt := if cnt > 0 then cnt to'byte                           <<04401>>10860000
                    else - cnt;                                <<04401>>10865000
                                                               <<04401>>10870000
<< 2 words for block record number (words #511/512)          >><<04401>>10875000
<< + 1 word for the end of block indicator (a -1)            >><<04401>>10880000
<< + 5 words for the header of the next record if included   >><<04401>>10885000
<< + the number of data words in the next record if included >><<04401>>10890000
<< + the number of words currently in the block              >><<04401>>10895000
<< must be less than or equal to the 512 words/Epoc block    >><<04401>>10900000
<< to add the next record, otherwise the block must be       >><<04401>>10905000
<< written out before adding it.                             >><<04401>>10910000
<<                                                           >><<04401>>10915000
<< 2 + 1 + 5 + # of data words in next record                >><<04401>>10920000
<< + # of words currently in block <= 512                    >><<04401>>10925000
<<                                                           >><<04401>>10930000
<< # of data words in next record + # of words currently in  >><<04401>>10935000
<< block > 504                                               >><<04401>>10940000
<<                                                           >><<04401>>10945000
  if ( @block'p - @block + (cnt + 1) to'word > 504 ) or        <<04401>>10950000
       flush then <<write out block , it is too full>>         <<04401>>10955000
    begin                                                      <<04401>>10960000
                                                               <<04401>>10965000
    block'p := -1; <<write end of block record>>               <<04401>>10970000
    recp(1) := @block;                                         <<04401>>10975000
    srp1 := srp2 := 0;                                         <<04401>>10980000
    recl := 1024;                                              <<04401>>10985000
    srfunc := 1;                                               <<04401>>10990000
    writewait := true;                                         <<04401>>10995000
                                                               <<04401>>11000000
    if not sdwrite(srfunc, blockmode, writeend,                <<04401>>11005000
         writewait, imagetype) then go exit'false;             <<04401>>11010000
                                                               <<04401>>11015000
    @block'p := @block; <<reset block'p pointer>>              <<04401>>11020000
    end;                                                       <<04401>>11025000
                                                               <<04401>>11030000
    << put record in block >>                                  <<04401>>11035000
  if not flush then                                            <<04401>>11040000
    begin                                                      <<04401>>11045000
                                                               <<04401>>11050000
    block'p    := cnt + 8;                                     <<04401>>11055000
    block'p(1) := cnt;                                         <<04401>>11060000
    block'p(2) := func'write'data;                             <<04401>>11065000
    block'p(3) := p1;                                          <<04401>>11070000
    block'p(4) := 0;                                           <<04401>>11075000
                                                               <<04401>>11080000
    @write'block'addr := addr;                                 <<04401>>11085000
    move block'p(5) := write'block'addr, ( (cnt+1) to'word );  <<04401>>11090000
                                                               <<04401>>11095000
    @block'p := @block'p + ( block'p + 1 ) to'word + 1;        <<04401>>11100000
                                                               <<04401>>11105000
    end;                                                       <<04401>>11110000
                                                               <<04401>>11115000
  write'block := true; << we succeeded >>                      <<04401>>11120000
                                                               <<04401>>11125000
end; << of subroutine write'block >>                           <<04401>>11130000
                                                               <<04401>>11135000
$PAGE "(OUTPUT) ",&                                            <<04401>>11140000
$"PROCEDURE: HEADER/TRAILER;  SUBROUTINE: REALIGN'TOP'OF'FORM" <<04401>>11145000
subroutine realign'top'of'form;                                <<04401>>11150000
                                                               <<04401>>11155000
begin                                                          <<04401>>11160000
                                                               <<04401>>11165000
                                                               <<04401>>11170000
  notify'operator( device, status'return );                    <<04401>>11175000
                                                               <<04401>>11180000
  form'aligned'ok := false;                                    <<04401>>11185000
                                                               <<04401>>11190000
  if status'return = st'device'power'up                        <<04401>>11195000
       or status'return = st'vfc'reset then                    <<04401>>11200000
                                                               <<04401>>11205000
    << ask operator to realign top of form >>                  <<04401>>11210000
    << vfc may have been reset during header/trailer >>        <<04401>>11215000
    << 1-291: "LDEV#\ IS PAPER AT TOP OF FORM (Y/N)?" >>       <<04401>>11220000
    genmsg(1, 219, %10000, device,,,,, 0, 1, @form'aligned'ok);<<04401>>11225000
                                                               <<04401>>11230000
  if form'aligned'ok land started'printing then                <<04401>>11235000
    go start'printing                                          <<04401>>11240000
       << Nothing more to do, but exit from header/trailer.  >><<04401>>11245000
  else                                                         <<04401>>11250000
    go exit'false;                                             <<04401>>11255000
                                                               <<04401>>11260000
end; << of subroutine realign'top'of'form >>                   <<04401>>11265000
                                                               <<04401>>11270000
$PAGE "(OUTPUT) ",&                                            <<04401>>11275000
$"PROCEDURE: HEADER/TRAILER;  SUBROUTINE: ANALYZE'STATUS"      <<04401>>11280000
subroutine analyze'status;                                     <<04401>>11285000
                                                               <<04401>>11290000
begin                                                          <<04401>>11295000
                                                               <<04401>>11300000
                                                               <<04401>>11305000
  if status'return.general'status = gen'st'ok then return;     <<04401>>11310000
                                                               <<04401>>11315000
  if ( status'return = st'io'status'available ) and            <<04401>>11320000
       epoc'2680a then return;                                 <<04401>>11325000
                                                               <<04401>>11330000
  if not ciper'protocol then realign'top'of'form;              <<04401>>11335000
                                                               <<04401>>11340000
<< Must be ciper protocol at this point >>                     <<04401>>11345000
                                                               <<04401>>11350000
  if status'return = st'device'power'up then                   <<04401>>11355000
    go restart'from'pfail;                                     <<04401>>11360000
                                                               <<04401>>11365000
  if status'return = st'not'ok'plus'status then                <<04401>>11370000
    begin                                                      <<04401>>11375000
    << Figure out what went wrong; take corrective action >>   <<04401>>11380000
                                                               <<04401>>11385000
    do'attachio( @device'status, func'dev'stat'composite,      <<04401>>11390000
         size'of'device'status, 0, 0);                         <<04401>>11395000
                                                               <<04401>>11400000
    if device'status(dev'st'self'test'failed) then             <<04401>>11405000
         << self test failed; stop spooling >>                 <<04401>>11410000
      go exit'false                                            <<04401>>11415000
    else                                                       <<04401>>11420000
      begin                                                    <<04401>>11425000
                                                               <<04401>>11430000
      if device'status(dev'st'power'fail) then                 <<04401>>11435000
        go restart'from'pfail;                                 <<04401>>11440000
                                                               <<04401>>11445000
      if device'status(dev'st'protocol'errors) <> 0 then       <<04401>>11450000
        begin                                                  <<04401>>11455000
                                                               <<04401>>11460000
        retry'count := retry'count + 1;                        <<04401>>11465000
        if retry'count > retry'limit then                      <<04401>>11470000
          go exit'false                                        <<04401>>11475000
                                                               <<04401>>11480000
        else                                                   <<04401>>11485000
          go restart'from'pfail;                               <<04401>>11490000
                                                               <<04401>>11495000
        end;                                                   <<04401>>11500000
                                                               <<04401>>11505000
                                                               <<04401>>11510000
        << clear on-line bit >>                                <<04401>>11515000
      device'status(dev'st'on'line) := false;                  <<04401>>11520000
                                                               <<04401>>11525000
      if device'status(dev'st'peripheral'status) <> 0 then     <<04401>>11530000
                                                               <<04401>>11535000
        if started'printing then                               <<04401>>11540000
          go start'printing                                    <<04401>>11545000
                                                               <<04401>>11550000
        else                                                   <<04401>>11555000
          go restart'from'pfail;                               <<04401>>11560000
                                                               <<04401>>11565000
      end;                                                     <<04401>>11570000
                                                               <<04401>>11575000
    end                                                        <<04401>>11580000
                                                               <<04401>>11585000
  else                                                         <<04401>>11590000
                                                               <<04401>>11595000
    if status'return.general'status = gen'st'unusual then      <<04401>>11600000
      go exit'false;                                           <<04401>>11605000
                                                               <<04401>>11610000
end; << of subroutine analyze'status >>                        <<04401>>11615000
                                                               <<04401>>11620000
$PAGE "(OUTPUT) ",&                                            <<04401>>11625000
$"PROCEDURE: HEADER/TRAILER;  SUBROUTINE: ADD'BP'NAME"         <<04401>>11630000
subroutine add'bp'name(destination'bp, source'bp);             <<04401>>11635000
                                                               <<04401>>11640000
  value                                source'bp ;             <<04401>>11645000
                                                               <<04401>>11650000
  byte pointer         destination'bp, source'bp ;             <<04401>>11655000
                                                               <<04401>>11660000
begin                                                          <<04401>>11665000
                                                               <<04401>>11670000
                                                               <<04401>>11675000
    << set a delimiter for the move >>                         <<04401>>11680000
  @add'bp'name'bp'temp := @source'bp(8);                       <<04401>>11685000
  add'bp'name'b'temp := add'bp'name'bp'temp;                   <<04401>>11690000
  add'bp'name'bp'temp := blank;                                <<04401>>11695000
                                                               <<04401>>11700000
  if source'bp = "$" then                                      <<04401>>11705000
    move destination'bp := source'bp, (8), 2                   <<04401>>11710000
  else                                                         <<04401>>11715000
    move destination'bp := source'bp while an, 1;              <<04401>>11720000
                                                               <<04401>>11725000
  x := tos;                                                    <<04401>>11730000
  @destination'bp := x;                                        <<04401>>11735000
                                                               <<04401>>11740000
  add'bp'name'bp'temp := add'bp'name'b'temp                    <<04401>>11745000
                                                               <<04401>>11750000
end; << of subroutine add'bp'name >>                           <<04401>>11755000
                                                               <<04401>>11760000
$PAGE "(OUTPUT)",&                                             <<04401>>11765000
$"PROCEDURE: HEADER/TRAILER;  SUBROUTINE: ADD'BP'CHAR"         <<04401>>11770000
subroutine add'bp'char(destination'bp, character);             <<04401>>11775000
                                                               <<04401>>11780000
  value                                character ;             <<04401>>11785000
                                                               <<04401>>11790000
  byte pointer         destination'bp            ;             <<04401>>11795000
                                                               <<04401>>11800000
  logical                              character ;             <<04401>>11805000
                                                               <<04401>>11810000
begin                                                          <<04401>>11815000
                                                               <<04401>>11820000
                                                               <<04401>>11825000
  destination'bp := character;                                 <<04401>>11830000
  @destination'bp := @destination'bp + 1;;                     <<04401>>11835000
                                                               <<04401>>11840000
end; << of subroutine add'bp'char >>                           <<04401>>11845000
                                                               <<04401>>11850000
$PAGE "(OUTPUT) ",&                                            <<04401>>11855000
$"PROCEDURE: HEADER/TRAILER;  SUBROUTINE: BUILD'LINE"          <<04401>>11860000
subroutine build'line;                                         <<04401>>11865000
                                                               <<04401>>11870000
begin                                                          <<04401>>11875000
                                                               <<04401>>11880000
                                                               <<04401>>11885000
    << start at the begining of line >>                        <<04401>>11890000
  @line'bp := @line'b;                                         <<04401>>11895000
                                                               <<04401>>11900000
    << fill line with blanks >>                                <<04401>>11905000
  line := blanks;                                              <<04401>>11910000
  move line(1) := line, (line'max'size - 1);                   <<04401>>11915000
                                                               <<04401>>11920000
    << cause a 2608A to go to the primary character set      >><<04401>>11925000
  if dev'type = LDT'printer and dev'subtype = subtype'2608A    <<06334>>11930000
    THEN add'bp'char(line'bp, si); << shift in >>              <<06334>>11935000
                                                               <<04401>>11940000
<< build a line of the following format:                     >><<04401>>11945000
<< for a card device:                                        >><<04401>>11950000
<<                                                           >><<04401>>11955000
<< [#J'12345; #O67890: $STDLIST  11111111 22222222 33333333] >><<04401>>11960000
<< [ 44444444 55555555 ....................................] >><<04401>>11965000
<<                                                           >><<04401>>11970000
<< for a line/page printer device:                           >><<04401>>11975000
<<                                                           >><<04401>>11980000
<< [#J'12345; #O12345  *  JOB'NAME, USERNAME.ACCTNAME; $STD] >><<04401>>11985000
<< [LIST  *  WED, MAR 31, 1982,  5:05 PM                   ] >><<04401>>11990000
<<                                                           >><<04401>>11995000
                                                               <<04401>>12000000
  add'bp'char(line'bp, "#");                                   <<04401>>12005000
                                                               <<04401>>12010000
  add'bp'char(line'bp,  if XDDS'JOB'TYPE                       <<06912>>12015000
       >= XDDS'JOB then "J" else "S");                         <<06912>>12020000
                                                               <<04401>>12025000
  if not (XDDS'SESSION <= integer(XDDS'JOB'TYPE)               <<06912>>12030000
                       <= XDDS'JOB) THEN                       <<06912>>12035000
    add'bp'char(line'bp, "'");                                 <<04401>>12040000
                                                               <<04401>>12045000
  @js'number'digit := @line'bp; << remember the start of the >><<04401>>12050000
       << job / session number                               >><<04401>>12055000
                                                               <<04401>>12060000
  inc'line'bp( ascii( XDDS'JOB'NUMBER,                         <<06912>>12065000
       10, line'bp));                                          <<04401>>12070000
                                                               <<04401>>12075000
  move line'bp := "; #O";                                      <<04401>>12080000
  inc'line'bp(4);                                              <<04401>>12085000
                                                               <<04401>>12090000
  inc'line'bp( ascii( XDDS'DFID'NUMBER,                        <<06912>>12095000
       10, line'bp));                                          <<04401>>12100000
                                                               <<04401>>12105000
  if paper'device then                                         <<04401>>12110000
    begin                                                      <<04401>>12115000
                                                               <<04401>>12120000
    move line'bp := "  *  ";                                   <<04401>>12125000
    inc'line'bp(5);                                            <<04401>>12130000
                                                               <<04401>>12135000
    if XDDS'JOB'NAME <> blanks then                            <<06912>>12140000
      begin                                                    <<04401>>12145000
                                                               <<04401>>12150000
      add'bp'name(line'bp,  XDDSB'JOB'NAME );                  <<06912>>12155000
                                                               <<04401>>12160000
      move line'bp := ", ";                                    <<04401>>12165000
      inc'line'bp(2);                                          <<04401>>12170000
                                                               <<04401>>12175000
      end;                                                     <<04401>>12180000
                                                               <<04401>>12185000
    add'bp'name(line'bp,  XDDSB'USER'NAME );                   <<06912>>12190000
                                                               <<04401>>12195000
    add'bp'char(line'bp, ".");                                 <<04401>>12200000
                                                               <<04401>>12205000
    add'bp'name(line'bp,  XDDSB'ACCOUNT'NAME );                <<06912>>12210000
                                                               <<04401>>12215000
    end;                                                       <<04401>>12220000
                                                               <<04401>>12225000
                                                               <<04401>>12230000
  if XDDS'FILE'NAME <> blanks then                             <<06912>>12235000
    begin                                                      <<04401>>12240000
                                                               <<04401>>12245000
    add'bp'char(line'bp,  if paper'device then ";" else ":" ); <<04401>>12250000
    add'bp'char(line'bp, " ");                                 <<04401>>12255000
                                                               <<04401>>12260000
    add'bp'name(line'bp,  XDDS'FILE'NAME );                    <<06912>>12265000
                                                               <<04401>>12270000
    end;                                                       <<04401>>12275000
                                                               <<04401>>12280000
                                                               <<04401>>12285000
  if card'device then                                          <<04401>>12290000
    begin                                                      <<04401>>12295000
                                                               <<04401>>12300000
    move line'bp := "  ";                                      <<04401>>12305000
    inc'line'bp(2);                                            <<04401>>12310000
                                                               <<04401>>12315000
    do                                                         <<04401>>12320000
      begin                                                    <<04401>>12325000
                                                               <<04401>>12330000
      line'bp := js'number'digit;                              <<04401>>12335000
      move line'bp(1) := line'bp, (7);                         <<04401>>12340000
      inc'line'bp(8);                                          <<04401>>12345000
                                                               <<04401>>12350000
      add'bp'char(line'bp, " ");                               <<04401>>12355000
                                                               <<04401>>12360000
      @js'number'digit := @js'number'digit + 1;                <<04401>>12365000
                                                               <<04401>>12370000
      end                                                      <<04401>>12375000
    until js'number'digit = ";"                                <<04401>>12380000
                                                               <<04401>>12385000
    end;                                                       <<04401>>12390000
                                                               <<04401>>12395000
  if paper'device then                                         <<04401>>12400000
    begin                                                      <<04401>>12405000
                                                               <<04401>>12410000
    move line'bp := "  *  ";                                   <<04401>>12415000
    inc'line'bp(5);                                            <<04401>>12420000
                                                               <<04401>>12425000
    date'line(line'bp);                                        <<04401>>12430000
    inc'line'bp(27);                                           <<04401>>12435000
                                                               <<04401>>12440000
    add'bp'char(line'bp, " ");                                 <<04495>>12445000
                                                               <<04495>>12450000
    end;                                                       <<04401>>12455000
                                                               <<04401>>12460000
                                                               <<04401>>12465000
  if trlr'msg'incomplete or trlr'msg'spaced'out                <<04401>>12470000
       or trlr'msg'resumed then                                <<04401>>12475000
    begin                                                      <<04401>>12480000
                                                               <<04401>>12485000
    if trlr'msg'incomplete then                                <<04401>>12490000
      move line'bp := "(INCOMPLETE)"                           <<04401>>12495000
                                                               <<04401>>12500000
    else                                                       <<04401>>12505000
      if trlr'msg'spaced'out then                              <<04401>>12510000
        move line'bp := "(SPACED OUT)"                         <<04401>>12515000
                                                               <<04401>>12520000
      else << trlr'msg'resumed >>                              <<04401>>12525000
        move line'bp := "(RESUMED)   ";                        <<04401>>12530000
                                                               <<04401>>12535000
    inc'line'bp(12);                                           <<04401>>12540000
                                                               <<04401>>12545000
    end                                                        <<04401>>12550000
                                                               <<04401>>12555000
  else << not any of the above messages >>                     <<04401>>12560000
    if dev'spooled and job'has'errors and                      <<04401>>12565000
        dayfile'lost then                                      <<04401>>12570000
      begin                                                    <<04401>>12575000
      move line'bp := "(NO ERRFILE)";                          <<04401>>12580000
      inc'line'bp(12);                                         <<04401>>12585000
      end;                                                     <<04401>>12590000
                                                               <<04401>>12595000
  if card'device then << fill in periods >>                    <<04401>>12600000
    begin                                                      <<04401>>12605000
    add'bp'char(line'bp, ".");                                 <<04401>>12610000
    move line'bp := line'bp(-1),                               <<04401>>12615000
         ( line'b'max'size - ( @line'bp - @line'b ) );         <<04401>>12620000
    @line'bp := @line'b(line'b'max'size);                      <<04401>>12625000
    end;                                                       <<04401>>12630000
                                                               <<04401>>12635000
  line'b'len := @line'bp - @line'b;                            <<04401>>12640000
                                                               <<04401>>12645000
end; << of subroutine build'line >>                            <<04401>>12650000
                                                               <<04401>>12655000
$PAGE "(OUTPUT)",&                                             <<04401>>12660000
$"PROCEDURE: HEADER/TRAILER;  SUBROUTINE: COMPUTE'REC'WIDTH"   <<04401>>12665000
subroutine compute'rec'width;                                  <<04401>>12670000
                                                               <<04401>>12675000
begin                                                          <<04401>>12680000
                                                               <<04401>>12685000
                                                               <<04401>>12690000
  << * * Compute the device's record width in words * * >>     <<04401>>12695000
    dev'rec'width := dev'configured'rec'width;                 <<04401>>12700000
                                                               <<04401>>12705000
  if epoc'2680A then << EPOC >>                                <<04401>>12710000
    begin                                                      <<04401>>12715000
                                                               <<04401>>12720000
    << read 2680 environmental status for record width >>      <<04401>>12725000
    do'attachio( @env'status, func'env'stat'buffered,          <<04401>>12730000
         16, 0, 0);                                            <<04401>>12735000
    analyze'status;                                            <<04401>>12740000
                                                               <<04401>>12745000
    comment                                                    <<04401>>12750000
         We've read the environmental status successfully.     <<04401>>12755000
    Epoc'page'width is env'status(8).(8:8).  It is a number    <<04401>>12760000
    in .1 inch increments up to 11.5 inchs.  So, we calculate  <<04401>>12765000
    the record width by multiplying the size of the default    <<04401>>12770000
    character set (1.2 characters per .1 inch).  Then we       <<04401>>12775000
    divide by 2 to get the record length in words.  Note the   <<04401>>12780000
    trick below in that we multiply the page width by 0.6      <<04401>>12785000
    ( = 1.2/2.0) which avoids the divide by 2.                 <<04401>>12790000
    ;                                                          <<04401>>12795000
                                                               <<04401>>12800000
    dev'rec'width := integer( fixt( real(                      <<04401>>12805000
         env'status( epoc'page'width ) ) * 0.6 ) );            <<04401>>12810000
                                                               <<04401>>12815000
    end;                                                       <<04401>>12820000
                                                               <<04401>>12825000
    << compute the line'len in words >>                        <<04401>>12830000
  line'len := ( line'b'len + 1 ) to'word;                      <<04401>>12835000
                                                               <<04401>>12840000
    << set upper limit on the size of H/T's output line >>     <<04401>>12845000
  if dev'rec'width > line'max'size then                        <<04401>>12850000
    dev'rec'width := line'max'size;                            <<04401>>12855000
                                                               <<04401>>12860000
    << clip the output line if it is too long >>               <<04401>>12865000
  if dev'rec'width < line'len then                             <<04401>>12870000
    line'len := dev'rec'width;                                 <<04401>>12875000
                                                               <<04401>>12880000
end; << of subroutine compute'rec'width >>                     <<04401>>12885000
                                                               <<04401>>12890000
$PAGE "(OUTPUT)",&                                             <<04401>>12895000
$"PROCEDURE: HEADER/TRAILER;  SUBROUTINE: PRINT'LINES"         <<04401>>12900000
subroutine print'lines;                                        <<04401>>12905000
                                                               <<04401>>12910000
begin                                                          <<04401>>12915000
                                                               <<04401>>12920000
                                                               <<04401>>12925000
  if paper'device then                                         <<04401>>12930000
    begin                                                      <<04401>>12935000
                                                               <<04401>>12940000
    delta := (dev'rec'width - line'len) / 3;                   <<04401>>12945000
                                                               <<04401>>12950000
    delta'3 := delta * 3;                                      <<04401>>12955000
    line'len'max := delta'3 + line'len;                        <<04401>>12960000
                                                               <<04401>>12965000
    move line( line'len'max - 1 ) := line( line'len - 1 ),     <<04401>>12970000
         ( -line'len );                                        <<04401>>12975000
                                                               <<04401>>12980000
    line := blanks;                                            <<04401>>12985000
    move line(1) := line, ( delta'3 - 1 );                     <<04401>>12990000
                                                               <<04401>>12995000
    if doing'header then                                       <<04401>>13000000
      begin << left to right >>                                <<04401>>13005000
      delta := -delta; << reverse the angle of print >>        <<04401>>13010000
                                                               <<04401>>13015000
      curpos := delta'3;                                       <<04401>>13020000
      curlen := line'len;                                      <<04401>>13025000
      end                                                      <<04401>>13030000
                                                               <<04401>>13035000
    else                                                       <<04401>>13040000
      begin << right to left >>                                <<04401>>13045000
      curpos := 0;                                             <<04401>>13050000
      curlen := line'len'max;                                  <<04401>>13055000
      end;                                                     <<04401>>13060000
                                                               <<04401>>13065000
    @block'p := @block;                                        <<04401>>13070000
                                                               <<04401>>13075000
    if not epoc'2680A and ( dev'spooled or ciper'protocol ) and<<04421>>13080000
         not sent'fopen then                                   <<04421>>13085000
      begin  <<fopen device>>                                  <<04401>>13090000
      do'attachio(0, func'file'open, 0, 0, 0);                 <<04401>>13095000
      analyze'status;                                          <<04401>>13100000
      sent'fopen := true;                                      <<04401>>13105000
      end;                                                     <<04401>>13110000
                                                               <<04401>>13115000
    if ciper'protocol and doing'trailer then                   <<04435>>13120000
      begin                                                    <<04421>>13125000
        << send command to set device to default             >><<04421>>13130000
        << enviornment so the trailer will print correctly   >><<04421>>13135000
      do'attachio(0, func'env'default, 0, 0, 0);               <<04421>>13140000
                                                               <<04421>>13145000
      analyze'status;                                          <<04421>>13150000
      end;                                                     <<04421>>13155000
                                                               <<04421>>13160000
    group'num := 0;                                            <<04401>>13165000
    do                                                         <<04401>>13170000
      begin                                                    <<04401>>13175000
      group'num := group'num + 1;                              <<04401>>13180000
      last'group := ( group'num = 4 );                         <<04401>>13185000
                                                               <<04401>>13190000
      line'num'of'group := 0;                                  <<04401>>13195000
      do                                                       <<04401>>13200000
        begin                                                  <<04401>>13205000
        line'num'of'group := line'num'of'group + 1;            <<04401>>13210000
        last'line'of'group := ( line'num'of'group = 3 );       <<04401>>13215000
        last'line'of'page := last'line'of'group land           <<04401>>13220000
             last'group;                                       <<04401>>13225000
                                                               <<04401>>13230000
                                                               <<04401>>13235000
          << set mode (i.e. carriage control) >>               <<04401>>13240000
        mode := mode'space'1'line;                             <<04401>>13245000
        if last'line'of'page then                              <<04401>>13250000
          begin                                                <<04401>>13255000
            << a form feed is done when Epoc gets the      >>  <<04401>>13260000
            << fopen from the spool file.                  >>  <<04401>>13265000
          if not epoc'2680A then mode := mode'form'feed;       <<04401>>13270000
          end                                                  <<04401>>13275000
        else                                                   <<04401>>13280000
          if last'line'of'group then                           <<04401>>13285000
            mode := mode'space'21'lines;                       <<04401>>13290000
                                                               <<04401>>13295000
        if epoc'2680A then                                     <<04401>>13300000
          begin                                                <<04401>>13305000
          if not write'block(@line(curpos), curlen, mode,      <<04401>>13310000
               false) then go exit'false;                      <<04401>>13315000
          end                                                  <<04401>>13320000
        else                                                   <<04401>>13325000
          begin << non-Epoc >>                                 <<04401>>13330000
          do'attachio( @line(curpos), func'write'data,         <<04401>>13335000
               curlen, mode, 0);                               <<04401>>13340000
          analyze'status;                                      <<04401>>13345000
          end; <<ordinary lp>>                                 <<04401>>13350000
                                                               <<04401>>13355000
                                                               <<04401>>13360000
        end                                                    <<04401>>13365000
      until last'line'of'group;                                <<04401>>13370000
                                                               <<04401>>13375000
      curpos := curpos + delta;                                <<04401>>13380000
      curlen := curlen - delta;                                <<04401>>13385000
                                                               <<04401>>13390000
      end                                                      <<04401>>13395000
    until last'group;                                          <<04401>>13400000
                                                               <<04401>>13405000
    if epoc'2680a then << flush block >>                       <<04401>>13410000
      begin                                                    <<04401>>13415000
      if not write'block(0, 0, 0, true) then                   <<04401>>13420000
        go exit'false;                                         <<04401>>13425000
      end;                                                     <<04401>>13430000
                                                               <<04401>>13435000
    end << paper printing device >>                            <<04401>>13440000
                                                               <<04401>>13445000
  else << card device >>                                       <<04401>>13450000
    begin << card punching device >>                           <<04401>>13455000
                                                               <<04401>>13460000
    line'len := ( line'b'len + 1 ) to'word;                    <<04401>>13465000
                                                               <<04401>>13470000
    do'attachio(@line, func'write'data, line'len, 0, %40);     <<04401>>13475000
                                                               <<04401>>13480000
    analyze'status;                                            <<04401>>13485000
                                                               <<04401>>13490000
    end; << card punching device >>                            <<04401>>13495000
                                                               <<04401>>13500000
end; << of subroutine print'lines >>                           <<04401>>13505000
                                                               <<04401>>13510000
$PAGE "(OUTPUT) PROCEDURE: HEADER/TRAILER"                     <<04401>>13515000
                                                               <<04401>>13520000
                                                               <<04401>>13525000
<< * * *                 Procedure body                * * * >><<04401>>13530000
                                                               <<04401>>13535000
  doing'header := true;                                        <<04401>>13540000
                                                               <<04401>>13545000
  if not doing'header then                                     <<04401>>13550000
trailer:                                                       <<04401>>13555000
    doing'header := false;                                     <<04401>>13560000
                                                               <<04401>>13565000
  doing'trailer := not doing'header;                           <<04401>>13570000
                                                               <<04401>>13575000
  header := false; << assume failure >>                        <<04401>>13580000
                                                               <<04401>>13585000
    << copy spooler trailer qualifiers from dev'type >>        <<04401>>13590000
  trlr'msg'resumed := dev'type.(2:1);                          <<04401>>13595000
  trlr'msg'spaced'out := dev'type.(1:1);                       <<04401>>13600000
  trlr'msg'incomplete := dev'type.(0:1);                       <<04401>>13605000
    << now clear the trailer qualifiers from dev'type >>       <<04401>>13610000
  dev'type.(0:3) := 0;                                         <<04401>>13615000
                                                               <<04401>>13620000
                                                               <<04401>>13625000
  get'device'info;                                             <<04401>>13630000
                                                               <<04401>>13635000
                                                               <<04401>>13640000
  retry'count := 0;                                            <<04401>>13645000
                                                               <<04401>>13650000
                                                               <<04401>>13655000
restart'from'pfail: << power fail >>                           <<04401>>13660000
                                                               <<04401>>13665000
  started'printing := false;                                   <<04401>>13670000
                                                               <<04401>>13675000
                                                               <<04401>>13680000
<< * * Handle Ciper Protocol;  Part 1 * * >>                   <<04401>>13685000
                                                               <<04401>>13690000
ciper'part'1:                                                  <<04401>>13695000
                                                               <<04401>>13700000
  if ciper'protocol and dev'spooled then                       <<04401>>13705000
    begin                                                      <<04401>>13710000
    if doing'header then                                       <<04401>>13715000
      begin << send job'start >>                               <<04401>>13720000
      do'attachio(0, func'job'start, 0,                        <<04401>>13725000
           1 << reset programable features >>, 0);             <<04401>>13730000
                                                               <<04401>>13735000
      analyze'status;                                          <<04401>>13740000
                                                               <<04401>>13745000
        << Set available status returns >>                     <<04401>>13750000
      avail'returns := 0;                                      <<04401>>13755000
      move avail'returns(1) := avail'returns,                  <<04401>>13760000
            (size'of'avail'returns - 1);                       <<04401>>13765000
                                                               <<04401>>13770000
      avail'returns(15) := 1;                                  <<04401>>13775000
                                                               <<04401>>13780000
      do'attachio( @avail'returns, func'set'avail'stat'returns,<<04401>>13785000
           size'of'avail'returns,                              <<04401>>13790000
      %1 << enviornmental status only >>, 0);                  <<04401>>13795000
                                                               <<04401>>13800000
      analyze'status;                                          <<04401>>13805000
                                                               <<04401>>13810000
      end                                                      <<04401>>13815000
                                                               <<04401>>13820000
    else << doing trailer >>                                   <<04401>>13825000
      begin                                                    <<04401>>13830000
        << force all data to print >>                          <<04401>>13835000
      do'attachio( @job'report'status, func'job'rprt'immediate,<<04401>>13840000
           size'of'job'report'status, 1                        <<04401>>13845000
      << send pending data, get new job report status >>, 0);  <<04401>>13850000
                                                               <<04401>>13855000
      analyze'status;                                          <<04401>>13860000
                                                               <<04401>>13865000
      silent'run'at'eoj :=                                     <<04401>>13870000
           job'report'status(job'st'in'silent'run);            <<04401>>13875000
                                                               <<04401>>13880000
        << get last page printed from printer >>               <<04401>>13885000
      do'attachio(@env'status, func'env'stat'immediate,        <<04401>>13890000
           size'of'env'status'block, 0, 0);                    <<04401>>13895000
                                                               <<04401>>13900000
      analyze'status;                                          <<04401>>13905000
                                                               <<04401>>13910000
      if double(sent'a'header) <>                              <<04401>>13915000
           d'env'status(env'st'd'checkpoint'number) then       <<04401>>13920000
      ulab0'd(ulab0'd'last'checkpoint) :=                      <<04401>>13925000
           d'env'status(env'st'd'checkpoint'number);           <<04401>>13930000
                                                               <<04401>>13935000
      if silent'run'at'eoj then                                <<04401>>13940000
           << exit silent run with a new silent run >>         <<04401>>13945000
        begin                                                  <<04401>>13950000
                                                               <<04401>>13955000
        d'silent'run(silent'run'd'block'number) := 0D;         <<04401>>13960000
        d'silent'run(silent'run'd'byte'offset) := 0D;          <<04401>>13965000
        d'silent'run(silent'run'd'checkpoint'number) :=        <<04401>>13970000
             d'env'status(env'st'd'checkpoint'number);         <<04401>>13975000
        d'silent'run(silent'run'd'start'print'checkpoint) :=   <<04401>>13980000
             d'env'status(env'st'd'checkpoint'number);         <<04401>>13985000
                                                               <<04401>>13990000
        do'attachio(@silent'run, func'start'silent'recovery,   <<04401>>13995000
             silent'run'min'rec'size, 0, 0);                   <<04401>>14000000
                                                               <<04401>>14005000
        analyze'status;                                        <<04401>>14010000
                                                               <<04401>>14015000
        end;                                                   <<04401>>14020000
                                                               <<04401>>14025000
                                                               <<04401>>14030000
        << send start of block (block 0D) >>                   <<04401>>14035000
      do'attachio(0, func'block'start, 0, 0, 0);               <<04401>>14040000
                                                               <<04401>>14045000
      analyze'status;                                          <<04401>>14050000
                                                               <<04401>>14055000
      << In the future Ciper error & report trailers should  >><<04401>>14060000
      << be done here.  i.e.:                                >><<04401>>14065000
      <<   job'report'trailer(not trailer'off);              >><<04401>>14070000
      end;                                                     <<04401>>14075000
    end; << of ciper part 1 >>                                 <<04401>>14080000
                                                               <<04401>>14085000
                                                               <<04401>>14090000
    << legal device for printed headers & trailers? >>         <<04401>>14095000
  printing'device := ( dev'type = LDT'printer  lor             <<06334>>14100000
                     dev'type = LDT'terminal  lor              <<06334>>14105000
                     dev'type = LDT'card'punch  lor            <<06334>>14110000
                     dev'type = LDT'reader'punch );            <<06334>>14115000
                                                               <<04401>>14120000
start'printing:                                                <<04401>>14125000
                                                               <<04401>>14130000
  started'printing := true;                                    <<04401>>14135000
                                                               <<04401>>14140000
  if printing'device then                                      <<04401>>14145000
    begin                                                      <<04401>>14150000
                                                               <<04401>>14155000
    if printer'2631B and doing'header then                     <<B9094>>14160000
      begin   << Always do FOPEN to 2631B.                  >> <<B9094>>14165000
      do'attachio (0, func'file'open, 0, 0, 0);                <<B9094>>14170000
      analyze'status;                                          <<B9094>>14175000
      sent'fopen := true;                                      <<B9094>>14180000
      end                                                      <<B9094>>14185000
    else                                                       <<B9094>>14190000
      sent'fopen := false;                                     <<B9094>>14195000
    if not ( (doing'header land header'off) lor                <<04401>>14200000
         (doing'trailer land trailer'off) lor                  <<04401>>14205000
      (dev'type = LDT'terminal land not dev'spooled) ) then    <<06334>>14210000
      << print header/trailer >>                               <<04401>>14215000
      begin                                                    <<04401>>14220000
                                                               <<04401>>14225000
                                                               <<04401>>14230000
        << get a local copy of this odd subentry >>            <<04401>>14235000
      mfds(XDD'SUBENTRY,odd'dst,@odd'sub'ptr,                  <<06912>>14240000
           SIZE'OF'XDD'SUBENTRY);                              <<06912>>14245000
                                                               <<04401>>14250000
                                                               <<04401>>14255000
      card'device := ( dev'type = LDT'card'punch ) lor         <<06334>>14260000
           ( dev'type = LDT'reader'punch );                    <<06334>>14265000
                                                               <<04401>>14270000
      paper'device := not card'device;                         <<04401>>14275000
                                                               <<04401>>14280000
                                                               <<04401>>14285000
      build'line;                                              <<04401>>14290000
                                                               <<04401>>14295000
                                                               <<04401>>14300000
      compute'rec'width;                                       <<04401>>14305000
                                                               <<04401>>14310000
                                                               <<04401>>14315000
      print'lines;                                             <<04401>>14320000
                                                               <<04401>>14325000
                                                               <<04401>>14330000
      if ciper'protocol then                                   <<04401>>14335000
        begin << fclose device >>                              <<04401>>14340000
        do'attachio( 0, func'file'close, 0, 0, 0);             <<04401>>14345000
        analyze'status;                                        <<04401>>14350000
        end;                                                   <<04401>>14355000
                                                               <<04401>>14360000
      end; << print header/trailer >>                          <<04401>>14365000
                                                               <<04401>>14370000
    if dev'spooled then                                        <<04401>>14375000
         << record if a header or trailer was printed >>       <<04401>>14380000
      if doing'header then                                     <<04401>>14385000
        sent'a'header := not header'off                        <<04401>>14390000
      else << doing'trailer >>                                 <<04401>>14395000
        sent'a'trailer := not trailer'off;                     <<04401>>14400000
                                                               <<04401>>14405000
    end; <<printing'device>>                                   <<04401>>14410000
                                                               <<04401>>14415000
                                                               <<04401>>14420000
<< * * Handle Ciper Protocol;  Part 2 * * >>                   <<04401>>14425000
                                                               <<04401>>14430000
ciper'part'2:                                                  <<04401>>14435000
                                                               <<04401>>14440000
  if ciper'protocol and dev'spooled then                       <<04401>>14445000
    if doing'header then                                       <<04401>>14450000
      begin                                                    <<04401>>14455000
        << force all data to print >>                          <<04401>>14460000
      do'attachio( @job'report'status, func'job'rprt'immediate,<<04401>>14465000
           size'of'job'report'status, 1                        <<04401>>14470000
      << sent pending data, get new job report status >>,      <<04401>>14475000
      0);                                                      <<04401>>14480000
                                                               <<04401>>14485000
      analyze'status;                                          <<04401>>14490000
      end                                                      <<04401>>14495000
    else << doing'trailer >>                                   <<04401>>14500000
      begin                                                    <<04401>>14505000
        << Job End >>                                          <<04401>>14510000
      do'attachio( @job'report'status, func'job'end,           <<04401>>14515000
           size'of'job'report'status, 0, 0);                   <<04401>>14520000
                                                               <<04401>>14525000
      analyze'status;                                          <<04401>>14530000
                                                               <<04401>>14535000
        << Job Logging >>                                      <<04401>>14540000
      move physical'pages':= job'report'status(1), (2);        <<04401>>14545000
      logical'pages := 1; << number of logical/physical pages ><<04401>>14550000
      end; << of ciper part 2 >>                               <<04401>>14555000
                                                               <<04401>>14560000
  if ciper'protocol and not dev'spooled then                   <<04436>>14565000
    if doing'header then                                       <<04436>>14570000
      begin                                                    <<04436>>14575000
        << force all data to print >>                          <<04436>>14580000
      do'attachio( @job'report'status, func'job'rprt'immediate,<<04436>>14585000
           size'of'job'report'status, 1                        <<04436>>14590000
      << sent pending data, get new job report status >>,      <<04436>>14595000
      0);                                                      <<04436>>14600000
                                                               <<04436>>14605000
      analyze'status;                                          <<04436>>14610000
      end;                                                     <<04436>>14615000
                                                               <<04436>>14620000
                                                               <<04436>>14625000
exit'true:                                                     <<04401>>14630000
                                                               <<04401>>14635000
                                                               <<04401>>14640000
  header := true;   << we made it through ok >>                <<04401>>14645000
                                                               <<04401>>14650000
                                                               <<04401>>14655000
exit'false:                                                    <<04401>>14660000
                                                               <<04401>>14665000
                                                               <<04401>>14670000
end; << of procedure header / trailer >>                       <<04401>>14675000
$PAGE "(GENERAL) PROCEDURE: SLOG"                              <<02580>>14680000
<<**********************************************************>> <<04398>>14685000
<< SLOG places all that is needed to create a spooler system>> <<04398>>14690000
<< loging record on top of stack.  LOG, located in Utilities>> <<04398>>14695000
<< builds the record based on what is on the stack.         >> <<04398>>14700000
<<**********************************************************>> <<04398>>14705000
                                                               <<04398>>14710000
PROCEDURE SLOG (OUT);                                                   14715000
VALUE   OUT;                                                            14720000
LOGICAL OUT;                                                            14725000
OPTION  UNCALLABLE,PRIVILEGED;                                          14730000
   BEGIN                                                                14735000
   INTEGER SLDEV,                                                       14740000
           SLTYPE;                                                      14745000
   LOGICAL POINTER XDD'SUBENTRY,                               <<06912>>14750000
                   USER'ACCT;                                  <<06912>>14755000
   LOGICAL SFILEREQUEST,MIXTURE;                               <<04398>>14760000
   DOUBLE SPHYSICAL'PAGES;                                     <<04398>>14765000
   INTEGER SLINES0,SLINES1,SLOGICAL'PAGES;                     <<04398>>14770000
   << >>                                                                14775000
   SLDEV := DEVICE;                                                     14780000
   SLTYPE := DEVICETYPE;                                                14785000
   SFILEREQUEST := FILEREQUEST;                                <<B0.SZ>>14790000
   SLINES0 := LINES'PRINTED0;                                  <<B0.SZ>>14795000
   SLINES1 := LINES'PRINTED1;                                  <<B0.SZ>>14800000
   @XDD'SUBENTRY := @XDDEP;                                    <<06912>>14805000
   EXCHANGEDB(IF OUT THEN ODD'DST ELSE IDD'DST);               <<06912>>14810000
   <<*******************************************************>> <<04398>>14815000
   << Place User, Account, Job Name and Filename on stack.  >> <<04398>>14820000
   <<*******************************************************>> <<04398>>14825000
   @USER'ACCT := @XDDS'USER'NAME;                              <<06912>>14830000
   X := 0;                                                     <<L8196>>14835000
   DO TOS := USER'ACCT(X) UNTIL (X:=X+1) = 16;                 <<06912>>14840000
   <<*******************************************************>> <<04398>>14845000
   << Job number, Device file ID.  In next word, place      >> <<04398>>14850000
   << Device Type in top half and Spooler logical device    >> <<04398>>14855000
   << number in bottom half.                                >> <<04398>>14860000
   <<*******************************************************>> <<04398>>14865000
   MIXTURE.(0:2)  := XDDS'JOB'TYPE;                            <<J7884>>14870000
   MIXTURE.(2:14) := XDDS'JOB'NUMBER;                          <<J7884>>14875000
   TOS := MIXTURE;                                             <<J7884>>14880000
   MIXTURE.(0:1)  := XDDS'DFID'IN'OR'OUT;                      <<06912>>14885000
   MIXTURE.(1:15) := XDDS'DFID'NUMBER;                         <<06912>>14890000
   TOS := MIXTURE;                                             <<06912>>14895000
   TOS := SLTYPE&LSL(8) + SLDEV;                                        14900000
   <<*******************************************************>> <<04398>>14905000
   << Number of copies left to print in top half and output >> <<04398>>14910000
   << or input priority in bottom half.  Both from XDD.     >> <<04398>>14915000
   <<*******************************************************>> <<04398>>14920000
   TOS := IF NOT OUT THEN 0 ELSE                                        14925000
            (ODDS'NUMBER'COPIES-1)&LSL(8)+XDDS'OUTPUT'PRIORITY;<<06912>>14930000
   <<*******************************************************>> <<04398>>14935000
   << For input, place number of records processed for IDD, >> <<04398>>14940000
   << else, for output place number of lines printed.       >> <<04398>>14945000
   <<*******************************************************>> <<04398>>14950000
   TOS:= IF NOT OUT THEN XDDS'MSW'RECORD'COUNT                 <<06912>>14955000
            ELSE SLINES0;                                      <<B0.SZ>>14960000
   TOS:= IF NOT OUT THEN XDDS'LSW'RECORD'COUNT                 <<06912>>14965000
            ELSE SLINES1;                                      <<B0.SZ>>14970000
    <<******************************************************>> <<04398>>14975000
    <<  Calculate the number of sectors used by # extents   >> <<04398>>14980000
    << times extent size plus last extent size. Put on TOS. >> <<04398>>14985000
    <<******************************************************>> <<04398>>14990000
   TOS := XDDS'NUMBER'EXTENTS;                                 <<06912>>14995000
   IF = THEN TOS := TOS+2;                                              15000000
   TOS := LOGICAL(TOS-1) ** ABSYS'EXTSSECT;                             15005000
   TOS := TOS + DOUBLE(XDDS'LAST'EXTENT'SIZE);                 <<06912>>15010000
   EXCHANGEDB(0);                                              <<04398>>15015000
   <<*******************************************************>> <<04398>>15020000
   << Next, if we have a "page printer", the 2680A laser    >> <<04398>>15025000
   << printer, or a CIPER printer, the 2608S dot matrix     >> <<04398>>15030000
   << printer, obtain logical pages and # of pages printed  >> <<04398>>15035000
   << from the environmental status.  Otherwise, for Input  >> <<04398>>15040000
   << or any other line printer, these values are zero.     >> <<04398>>15045000
   <<*******************************************************>> <<04398>>15050000
                                                               <<04398>>15055000
   IF OUT AND ( CIPER OR PRINTER'2680A ) THEN                  <<04407>>15060000
      BEGIN                                                    <<04398>>15065000
        SPHYSICAL'PAGES := PHYSICAL'PAGES;                     <<04398>>15070000
        SLOGICAL'PAGES := LOGICAL'PAGES;                       <<04398>>15075000
      END                                                      <<04398>>15080000
   ELSE                                                        <<04398>>15085000
      BEGIN                                                    <<04398>>15090000
        SPHYSICAL'PAGES := 0D;                                 <<04398>>15095000
        SLOGICAL'PAGES  := 0;                                  <<04398>>15100000
      END;                                                     <<04398>>15105000
                                                               <<04398>>15110000
   << Place Subytype, logical pages and file request func   >> <<04398>>15115000
   << on TOS along along with the above variables           >> <<04398>>15120000
                                                               <<04398>>15125000
   MIXTURE.(0:8) := DEVICE'SUBTYPE;                            <<04398>>15130000
   MIXTURE.(12:4):= FILEREQUEST;                               <<04398>>15135000
                                                               <<04398>>15140000
   TOS := MIXTURE;                                             <<04398>>15145000
   TOS := SLOGICAL'PAGES;                                      <<04398>>15150000
   TOS := SPHYSICAL'PAGES;                                     <<04398>>15155000
   TOS := 8;  <<LOG REC TYPE>>                                          15160000
                                                                        15165000
   LOG;                                                                 15170000
   END;                                                                 15175000
$PAGE "(OUTPUT) PROCEDURE: UPDATE'CHECKPOINT"                  <<02580>>15180000
procedure update'checkpoint;                                   <<04405>>15185000
                                                               <<04405>>15190000
  option privileged, uncallable;                               <<04405>>15195000
                                                               <<04405>>15200000
begin                                                          <<04405>>15205000
                                                               <<04405>>15210000
                                                               <<04405>>15215000
  COMMENT                                                      <<04405>>15220000
                                                               <<04405>>15225000
    Update user label 0 and write user label of next block of  <<04405>>15230000
    circular queue entries from blocktable on stack.           <<04405>>15235000
  ;                                                            <<04405>>15240000
                                                               <<04405>>15245000
  double                                                       <<04405>>15250000
                                                               <<04405>>15255000
     blknum'                                                   <<04405>>15260000
    ,rec'count'                                                <<04405>>15265000
  ;                                                            <<04405>>15270000
                                                               <<04405>>15275000
  integer                                                      <<04405>>15280000
                                                               <<04405>>15285000
     lastulab                                                  <<04405>>15290000
  ;                                                            <<04405>>15295000
                                                               <<04405>>15300000
                                                               <<04405>>15305000
<< * * *                 Procedure body                * * * >><<04405>>15310000
                                                               <<04405>>15315000
  if (@blockcp < @blocktable) then return; <<suspendspool>>    <<04405>>15320000
                                                               <<04405>>15325000
  blknum' := if blockmode then page'st'blknum else blknum;     <<04405>>15330000
                                                               <<04405>>15335000
  if not update'ckpt'flag then return;                         <<04405>>15340000
                                                               <<04405>>15345000
<< Update ulab 0 >>                                            <<04405>>15350000
  freadlabel(spoolfile,flab);  <<read ulab 0>>                 <<04405>>15355000
                                                               <<04405>>15360000
  spulab'ldev := device;    <<active ldev>>                    <<04405>>15365000
                                                               <<04405>>15370000
  spulab'currext := integer( ( blknum' * 4d +                  <<04405>>15375000
       double( spulab'totulab + 1 ) ) /                        <<04405>>15380000
  double( absys'extssect ) );                                  <<04405>>15385000
                                                               <<04405>>15390000
  spulab'lastblkd := blknum'; <<active block number>>          <<04405>>15395000
                                                               <<04405>>15400000
  spulab'lastrecd := rec'count;  <<active record number>>      <<04405>>15405000
                                                               <<04405>>15410000
  spulab'lastpagd := curr'page; <<last active page>>           <<04405>>15415000
                                                               <<04405>>15420000
    << last cq entry >>                                        <<04405>>15425000
  spulab'ulabentry := ( @blockcp - @blocktable ) / cqentrysize;<<04405>>15430000
                                                               <<04405>>15435000
  spulab'lastulab := if update'ulabnum'flag then currulabno    <<04405>>15440000
       else spulab'lastulab + 1;                               <<04405>>15445000
                                                               <<04405>>15450000
  update'ulabnum'flag := false;                                <<04405>>15455000
                                                               <<04405>>15460000
  currulabno := spulab'lastulab;                               <<04405>>15465000
                                                               <<04405>>15470000
  if not ( maxfopenulab <= spulab'lastulab <= maxuserlabels )  <<04405>>15475000
       then                                                    <<04405>>15480000
    spulab'lastulab := maxfopenulab + 1;                       <<04405>>15485000
                                                               <<04405>>15490000
  lastulab := spulab'lastulab;                                 <<04405>>15495000
                                                               <<04405>>15500000
  spulab'linesperpage := 60;                                   <<04405>>15505000
                                                               <<04405>>15510000
  if spulab'chnskip = 0 then                                   <<04405>>15515000
    spulab'chnskip := channelskip;                             <<04405>>15520000
                                                               <<04405>>15525000
  fwritelabel(spoolfile,flab);  <<write ulab 0>>               <<04405>>15530000
                                                               <<04405>>15535000
  fwritelabel(spoolfile,blocktable,,lastulab);                 <<04405>>15540000
                                                               <<04405>>15545000
end;  << of procedure update'checkpoint >>                     <<04405>>15550000
$PAGE "(OUTPUT) PROCEDURE: CHECKPOINT'PAGE"                    <<04407>>15555000
LOGICAL PROCEDURE CHECKPOINT'PAGE;                             <<01549>>15560000
   OPTION UNCALLABLE,PRIVILEGED;                               <<01549>>15565000
                                                               <<01549>>15570000
   <<  WRITE A CHECKPOINT ENTRY IN USER LABELS>>               <<01549>>15575000
   <<  11-26 FOR A PAGE BOUNDARY CONDITION  >>                 <<01549>>15580000
   <<  KEEPS 128 WORD AREA IN CORE FOR   >>                    <<01549>>15585000
   <<  LAST 16 CIRCULAR QUEUE ENTRIES     >>                   <<01549>>15590000
   <<LAST 8 IF 2680 = BLOCKMODE >>                             <<01549>>15595000
   <<  A CIRCULAR QUEUE ENTRY CONSISTS OF >>                   <<01549>>15600000
   <<     BLOCK NUMBER = DOUBLEWORD    >>                      <<01549>>15605000
   <<     RECORD COUNT = DOUBLEWORD    >>                      <<01549>>15610000
   <<     CURRENT PAGE NUMBER = DOUBLEWORD>>                   <<01549>>15615000
   <<     RESERVED     = DOUBLEWORD      >>                    <<01549>>15620000
                                                               <<01549>>15625000
   BEGIN                                                       <<01549>>15630000
      INTEGER R,Q,LASTULAB;                                    <<01549>>15635000
      <<>>                                                     <<01549>>15640000
      IF BLOCKMODE OR CIPER THEN RETURN;                       <<04397>>15645000
      CHECKPOINT'PAGE:=TRUE;                                   <<02602>>15650000
      CURR'PAGE := CURR'PAGE + 1D;                             <<01549>>15655000
      REC'LAST'PAGE := REC'COUNT;                              <<01549>>15660000
      @BLOCKCP := @BLOCKCP + CQENTRYSIZE; <<ADVANCE POINTER>>  <<01549>>15665000
                  << IN BLOCKTABLE FOR CURRENT POINTER>>       <<01549>>15670000
      IF @BLOCKCP - @BLOCKTABLE >= R :=                        <<01549>>15675000
                  MAXCQENTRIES * CQENTRYSIZE THEN              <<01549>>15680000
      BEGIN  <<RESET POINTERS TO BEGINNING OF BLOCKTABLE>>     <<01549>>15685000
             << AND WRITE USERLABELS 0 AND NEXT CQULAB>>       <<01549>>15690000
         @BLOCKCP := @BLOCKTABLE;                              <<01549>>15695000
         @BLOCKFP := @BLOCKTABLE+CQENTRYSIZE;                  <<01549>>15700000
         UPDATE'CHECKPOINT;                                    <<01549>>15705000
         BLOCKCP := 0;                                         <<01549>>15710000
         MOVE BLOCKCP(1) := BLOCKCP, (127);  <<ZERO OUT TABLE>><<01549>>15715000
      END                                                      <<01549>>15720000
      ELSE                                                     <<01549>>15725000
         IF @BLOCKFP <> @BLOCKTABLE THEN                       <<01549>>15730000
            @BLOCKFP := IF (Q := @BLOCKFP + CQENTRYSIZE) >     <<01549>>15735000
                @BLOCKTABLE + R THEN @BLOCKTABLE               <<01549>>15740000
                    ELSE Q;                                    <<01549>>15745000
      DBLOCKCP(0) := BLKNUM;                                   <<01549>>15750000
      DBLOCKCP(1) := REC'COUNT;                                <<01549>>15755000
      DBLOCKCP(2) := CURR'PAGE;                                <<01549>>15760000
   END; <<CHECKPOINT'PAGE>>                                    <<01549>>15765000
$PAGE "(OUTPUT) PROCEDURE CIPER'CHECKPOINT'PAGE"               <<04406>>15770000
logical procedure ciper'checkpoint'page;                       <<04406>>15775000
   option privileged, uncallable;                              <<U7868>>15780000
                                                               <<04406>>15785000
begin                                                          <<04406>>15790000
                                                               <<04406>>15795000
                                                               <<04406>>15800000
  comment                                                      <<04406>>15805000
                                                               <<04406>>15810000
     Save the environmental status block in a circular         <<04406>>15815000
     queue in user labels 11-26 in a manner similar to         <<04406>>15820000
     that used by CHECKPOINT'PAGE.                             <<04406>>15825000
    ;                                                          <<04406>>15830000
                                                               <<04406>>15835000
  integer                                                      <<04406>>15840000
                                                               <<04406>>15845000
     num'to'delete                                             <<04406>>15850000
    ,status'return                                             <<04406>>15855000
    ;                                                          <<04406>>15860000
                                                               <<04406>>15865000
  logical array                                                <<04406>>15870000
                                                               <<04406>>15875000
     dummy'env'status( 0 : size'of'env'status'block - 1 )      <<04406>>15880000
    ,env'status( 0 : size'of'env'status'block - 1 )            <<04406>>15885000
    ;                                                          <<04406>>15890000
                                                               <<04406>>15895000
  double pointer                                               <<04406>>15900000
                                                               <<04406>>15905000
     d'env'status   = env'status                               <<04406>>15910000
    ;                                                          <<04406>>15915000
                                                               <<04406>>15920000
                                                               <<04406>>15925000
<< * * *                 Procedure body                * * * >><<04406>>15930000
                                                               <<04406>>15935000
  << Read the environmental status into the buffer. >>         <<04406>>15940000
  tos := attachio(device, 0, 0, @env'status,                   <<04406>>15945000
       func'env'stat'buffered, size'of'env'status'block, 0, 0, <<04406>>15950000
  1 << FLAGS := no premption; not special request;           >><<04406>>15955000
  << not diagnostic; not system buffer; blocked;             >><<04406>>15960000
  << wake on completion; impede if no IOQ element            >><<04406>>15965000
  << is available.  >> );                                      <<04406>>15970000
                                                               <<04406>>15975000
  del;                                                         <<04406>>15980000
  status'return := tos.qual'gen'status;                        <<04406>>15985000
                                                               <<04406>>15990000
  if status'return.general'status <> gen'st'ok then            <<04406>>15995000
                                                               <<04406>>16000000
    ciper'checkpoint'page := false                             <<04406>>16005000
                                                               <<04406>>16010000
  else                                                         <<04406>>16015000
    begin                                                      <<04406>>16020000
                                                               <<04406>>16025000
    dev'in'silent'run := false;                                <<04406>>16030000
                                                               <<04406>>16035000
    if d'env'status(env'st'd'block'number) = 0D or             <<04439>>16040000
         d'env'status(env'st'd'checkpoint'number) =            <<04439>>16045000
    double(sent'a'header) then                                 <<04439>>16050000
        << i.e. an "unreachable" block" >>                     <<04439>>16055000
      ciper'checkpoint'page := true << just return >>          <<04406>>16060000
                                                               <<04406>>16065000
    else                                                       <<04406>>16070000
      begin                                                    <<04406>>16075000
                                                               <<04406>>16080000
      if ( d'env'status(env'st'd'checkpoint'number) modd       <<04439>>16085000
           ulab0(ulab0'cq'record'freq) ) = 0 then              <<04406>>16090000
        begin                                                  <<04406>>16095000
                                                               <<04406>>16100000
        num'to'delete := ulab0(ulab0'cq'record'freq) - 1;      <<04406>>16105000
        while num'to'delete > 0 and not end'of'check'points do <<04406>>16110000
          begin                                                <<04406>>16115000
                                                               <<04406>>16120000
          if not fulab(fulab'read'cq, @dummy'env'status, 0)    <<04406>>16125000
               then                                            <<04406>>16130000
            begin                                              <<04406>>16135000
            ciper'checkpoint'page := false;                    <<04406>>16140000
            return;                                            <<04406>>16145000
            end;                                               <<04406>>16150000
                                                               <<04406>>16155000
          num'to'delete := num'to'delete - 1;                  <<04406>>16160000
                                                               <<04406>>16165000
          end;                                                 <<04406>>16170000
                                                               <<04406>>16175000
        end;                                                   <<04406>>16180000
                                                               <<04406>>16185000
      ciper'checkpoint'page := fulab(fulab'write'cq,           <<04406>>16190000
           @env'status, size'of'env'status'block);             <<04406>>16195000
                                                               <<04406>>16200000
      end;                                                     <<04406>>16205000
                                                               <<04406>>16210000
    end;                                                       <<04406>>16215000
                                                               <<04406>>16220000
end; << of procedure ciper'checkpoint'page >>                  <<04406>>16225000
                                                               <<04406>>16230000
$PAGE "(OUTPUT) PROCEDURE SEND'START'OF'BLOCK"                 <<04406>>16235000
logical procedure send'start'of'block;                         <<04406>>16240000
   option privileged, uncallable;                              <<U7868>>16245000
                                                               <<04406>>16250000
begin                                                          <<04406>>16255000
                                                               <<04406>>16260000
                                                               <<04406>>16265000
  double                                                       <<04406>>16270000
                                                               <<04406>>16275000
     block'num                                                 <<04406>>16280000
    ;                                                          <<04406>>16285000
                                                               <<04406>>16290000
  integer                                                      <<04406>>16295000
                                                               <<04406>>16300000
     block'num'lsw   = block'num + 1                           <<04406>>16305000
    ,block'num'msw   = block'num                               <<04406>>16310000
    ,status'return                                             <<04406>>16315000
  ;                                                            <<04406>>16320000
                                                               <<04406>>16325000
                                                               <<04406>>16330000
<< * * *                 Procedure body                * * * >><<04406>>16335000
                                                               <<04406>>16340000
  send'start'of'block := true; << assume success >>            <<04406>>16345000
                                                               <<04406>>16350000
  if ciper then                                                <<04406>>16355000
    begin                                                      <<04406>>16360000
                                                               <<04406>>16365000
    if got'new'block or new'silent'run then                    <<04406>>16370000
      begin                                                    <<04406>>16375000
                                                               <<04406>>16380000
      new'silent'run := false;                                 <<04406>>16385000
                                                               <<04406>>16390000
      block'num := blknum;                                     <<04406>>16395000
                                                               <<04406>>16400000
      tos := attachio(device, 0 << QMISC := NA >>,             <<04406>>16405000
           0 << DSTX := NA >>, 0 << ADDR := NA >>,             <<04406>>16410000
      func'block'start, 0 << CNT := NA >>, block'num'msw,      <<04406>>16415000
      block'num'lsw,                                           <<04406>>16420000
      1 << FLAGS := no premption; not special request;       >><<04406>>16425000
      << not diagnostic; not system buffer; blocked;         >><<04406>>16430000
      << wake on completion; impede if no IOQ element        >><<04406>>16435000
      << is available.  >> );                                  <<04406>>16440000
                                                               <<04406>>16445000
        << analyze io status return >>                         <<04406>>16450000
      del;                                                     <<04406>>16455000
      status'return := tos.qual'gen'status;                    <<04406>>16460000
                                                               <<04406>>16465000
      status'return := ciper'status(status'return);            <<04406>>16470000
                                                               <<04406>>16475000
      if status'return.general'status <> gen'st'ok             <<04406>>16480000
           then                                                <<04406>>16485000
        begin                                                  <<04406>>16490000
        notify'operator( device, status'return );              <<04406>>16495000
        imagetype := ioerr;                                    <<04406>>16500000
        stopspooling := spooleeioerr;                          <<04406>>16505000
        filerequest := relinkfile;                             <<04406>>16510000
        send'start'of'block := false; << failure >>            <<04406>>16515000
        end;                                                   <<04406>>16520000
                                                               <<04406>>16525000
      end;                                                     <<04406>>16530000
                                                               <<04406>>16535000
    end;                                                       <<04406>>16540000
                                                               <<04406>>16545000
end; << of procedure send'start'of'block >>                    <<04406>>16550000
                                                               <<04406>>16555000
$PAGE "(GENERAL) PROCEDURE: SCHECKREQ"                         <<02580>>16560000
PROCEDURE SCHECKREQ;                                                    16565000
OPTION UNCALLABLE,PRIVILEGED;                                           16570000
   BEGIN                                                                16575000
   << >>                                                                16580000
   IF SPOOLER THEN                                                      16585000
      BEGIN                                                             16590000
      DISABLE;                                                          16595000
      IF DADCALLING THEN                                       <<02582>>16600000
         BEGIN                                                          16605000
         X := DADSFILEREQ;                                     <<00.05>>16610000
         IF <> THEN FILEREQUEST := X;                          <<00.05>>16615000
         X := DADSSPOOLREQ;                                             16620000
         IF <> THEN SPOOLREQUEST := X;                                  16625000
         ALTER'DEV := DADSALTER'DEV;                           <<02582>>16630000
          BACKWARDS := BACK;                                   <<01549>>16635000
         PAGECNT := PAGES;                                     <<01549>>16640000
         FILECNT := FILES;                                     <<01549>>16645000
         DADSCALL := BACK := PAGES := FILES := 0;              <<02582>>16650000
         END;                                                           16655000
      ENABLE;                                                           16660000
      END                                                               16665000
   ELSE                                                                 16670000
      BEGIN                                                             16675000
      IF REQUESTSERVICE THEN                                            16680000
         BEGIN                                                          16685000
         FILEREQUEST := DELETEFILE;                                     16690000
         SPOOLREQUEST := QUITSPOOLING;                                  16695000
         END;                                                           16700000
      END;                                                              16705000
   END;                                                                 16710000
$PAGE "(GENERAL) PROCEDURE: SALLOC"                            <<04402>>16715000
logical procedure salloc;                                      <<04402>>16720000
                                                               <<04402>>16725000
  option privileged, uncallable;                               <<04402>>16730000
                                                               <<04402>>16735000
begin                                                          <<04402>>16740000
                                                               <<04402>>16745000
                                                               <<04402>>16750000
  logical                                                      <<04402>>16755000
                                                               <<04402>>16760000
     ldt'sir'save                                              <<04402>>16765000
    ,lpdt'sir'save                                             <<04402>>16770000
    ,status'return                                             <<04402>>16775000
  ;                                                            <<04402>>16780000
                                                               <<04402>>16785000
  INTEGER                                                      <<06334>>16790000
     LDT'INDEX,                                                <<06334>>16795000
     LPDT'INDEX;                                               <<06334>>16800000
                                                               <<06334>>16805000
  LOGICAL POINTER                                              <<06334>>16810000
                                                               <<04402>>16815000
     LDT                                                       <<06334>>16820000
  ;                                                            <<04402>>16825000
                                                               <<04402>>16830000
  integer array                                                <<04402>>16835000
                                                               <<04402>>16840000
     DEVINFO(0 : SIZE'OF'GETDEVINFO-1) = Q                     <<06527>>16845000
  ;                                                            <<04402>>16850000
                                                               <<04402>>16855000
  byte array                                                   <<04402>>16860000
                                                               <<04402>>16865000
     devname( 0 : 8 ) = Q                                      <<04402>>16870000
  ;                                                            <<04402>>16875000
                                                               <<04402>>16880000
                                                               <<04402>>16885000
<< * * *                 Procedure body                * * * >><<04402>>16890000
                                                               <<04402>>16895000
  move devname := ("        ","! ");                           <<04402>>16900000
  ascii(device,10,devname);                                    <<04402>>16905000
                                                               <<04402>>16910000
  salloc := false; << assume failure >>                        <<04402>>16915000
                                                               <<04402>>16920000
  if getdevinfo( devname, devinfo ) = 0 then                   <<04402>>16925000
    begin                                                      <<04402>>16930000
                                                               <<04402>>16935000
    DEVICERECL := G'DEV'RECORD'WIDTH;                          <<06527>>16940000
    recl := devicerecl;                                        <<04402>>16945000
    DEVICETYPE := G'DEV'TYPE;                                  <<06527>>16950000
                                                               <<04402>>16955000
    << extract ldt information >>                              <<04402>>16960000
    @ldt := 0;                                                 <<06334>>16965000
    LDT'INDEX := DEVICE * SIZE'OF'LDT'ENTRY;                   <<06334>>16970000
                                                               <<04402>>16975000
    exchangedb( ldt'dst );                                     <<04402>>16980000
                                                               <<04402>>16985000
    ldt'sir'save := getsir( ldt'sir );                         <<04402>>16990000
    lpdt'sir'save := getsir( lpdt'sir );                       <<06334>>16995000
                                                               <<04402>>17000000
    ldt'file'use'cnt := 1;                                     <<06334>>17005000
    LDT'MAIN'PIN := CURPRC/PCBSIZE;                            <<06425>>17010000
    ldt'avail'to'sys := true;                                  <<06334>>17015000
                                                               <<04402>>17020000
    exchangedb( 0 );                                           <<04402>>17025000
                                                               <<04402>>17030000
    << adjust/extract lpdt information >>                      <<04402>>17035000
    LPDT'INDEX := DEVICE * SIZE'OF'LPDT'ENTRY;                 <<06334>>17040000
    LPDT'DEV'OWN'STATE := LPDT'OWNED;                          <<06334>>17045000
    device'subtype := LPDT'SUBTYPE;                            <<06334>>17050000
                                                               <<04402>>17055000
    << unlock tables >>                                        <<04402>>17060000
    relsir(lpdt'sir,lpdt'sir'save);                            <<06334>>17065000
    relsir(ldt'sir,ldt'sir'save);                              <<06334>>17070000
                                                               <<04402>>17075000
                                                               <<04402>>17080000
    << set spooler modes >>                                    <<04402>>17085000
    printer'2680A := ( ( devicetype = LDT'printer ) land       <<06334>>17090000
         ( device'subtype = subtype'2680a ) );                 <<04402>>17095000
                                                               <<04402>>17100000
    blockmode := printer'2680A;                                <<04402>>17105000
                                                               <<04402>>17110000
    ciper := (devicetype = LDT'printer) land                   <<06334>>17115000
         ( ( device'subtype = subtype'2608B'transparent ) lor  <<04402>>17120000
    ( device'subtype = subtype'2608B'feature ) );              <<04402>>17125000
                                                               <<04402>>17130000
    printer'2608 := ciper lor                                  <<04402>>17135000
         ( ( devicetype = LDT'printer ) land                   <<06334>>17140000
    ( device'subtype = subtype'2608a ) );                      <<04402>>17145000
                                                               <<B9094>>17150000
    printer'2631B := (devicetype = LDT'printer) land           <<B9094>>17155000
       ((device'subtype = subtype'2631B'hardwired) lor         <<B9094>>17160000
        (device'subtype = subtype'2631B'modem));               <<B9094>>17165000
                                                               <<04402>>17170000
    << initialize ciper protocol to device >>                  <<04402>>17175000
    if ciper then << do device open via an fopen >>            <<04402>>17180000
      begin                                                    <<04402>>17185000
                                                               <<04402>>17190000
      tos := attachio( device, 0 << QMISC := NA >>,            <<04402>>17195000
           0 << DSTX := stack >>, 0 << ADDR := DB+0 >>,        <<04402>>17200000
      func'file'open, 0 << CNT  := 0 >>, 0 << P1 := NA >>,     <<04402>>17205000
      0 << P2 := NA >>,                                        <<04402>>17210000
      1 << FLAGS := no premption; not special request;       >><<04402>>17215000
      << not diagnostic; not system buffer; blocked,         >><<04402>>17220000
      << wake on completion, impede if no IOQ element        >><<04402>>17225000
      << is available.  >> );                                  <<04402>>17230000
                                                               <<04402>>17235000
      del;                                                     <<04402>>17240000
      status'return := tos.qual'gen'status;                    <<04402>>17245000
                                                               <<04402>>17250000
      if status'return <> st'ok then                           <<04402>>17255000
        begin                                                  <<04402>>17260000
        stopspooling := spooleeioerr;                          <<04402>>17265000
        notify'operator( device, status'return );              <<04402>>17270000
        go exit'false;                                         <<04402>>17275000
        end;                                                   <<04402>>17280000
                                                               <<04402>>17285000
      end; << ciper >>                                         <<04402>>17290000
                                                               <<04402>>17295000
    salloc := true; << successful >>                           <<04402>>17300000
                                                               <<04402>>17305000
    end                                                        <<04402>>17310000
                                                               <<04402>>17315000
  else                                                         <<04402>>17320000
    stopspooling := nonexistentdev;                            <<04402>>17325000
                                                               <<04402>>17330000
exit'false:                                                    <<04402>>17335000
                                                               <<04402>>17340000
end; << of procedure salloc >>                                 <<04402>>17345000
                                                               <<04402>>17350000
$PAGE "(GENERAL) PROCEDURE: SDEALLOC"                          <<04402>>17355000
procedure sdealloc(in);                                        <<04402>>17360000
                                                               <<04402>>17365000
  value            in ;                                        <<04402>>17370000
                                                               <<04402>>17375000
  logical          in ;                                        <<04402>>17380000
                                                               <<04402>>17385000
  option privileged, uncallable;                               <<04402>>17390000
                                                               <<04402>>17395000
begin                                                          <<04402>>17400000
                                                               <<04402>>17405000
                                                               <<04402>>17410000
  INTEGER                                                      <<06334>>17415000
     LDT'INDEX;                                                <<06334>>17420000
                                                               <<06334>>17425000
  LOGICAL POINTER                                              <<06334>>17430000
                                                               <<04402>>17435000
     LDT                                                       <<06334>>17440000
  ;                                                            <<04402>>17445000
                                                               <<04402>>17450000
                                                               <<04402>>17455000
<< * * *                 Procedure body                * * * >><<04402>>17460000
                                                               <<04402>>17465000
  if stopspooling <> nonexistentdev then                       <<04402>>17470000
    begin                                                      <<04402>>17475000
                                                               <<04402>>17480000
    @LDT := 0;                                                 <<06334>>17485000
    LDT'INDEX := device * size'of'ldt'entry;                   <<06334>>17490000
                                                               <<04402>>17495000
    exchangedb( ldt'dst );                                     <<04402>>17500000
                                                               <<04402>>17505000
    ldt'spool'state := LDT'NOT'SPOOLED;                        <<06334>>17510000
    if in then ldt'down'pending := true;                       <<06334>>17515000
                                                               <<04402>>17520000
    exchangedb( 0 );                                           <<04402>>17525000
                                                               <<04402>>17530000
      << do device'close to device >>                          <<04402>>17535000
    freedevice( device, true);                                 <<04402>>17540000
                                                               <<04402>>17545000
    end;                                                       <<04402>>17550000
                                                               <<04402>>17555000
  genmsg(1, stopspooling, %10000, device,,,,, 0);              <<04402>>17560000
                                                               <<04402>>17565000
end; << of procedure sdealloc >>                               <<04402>>17570000
$PAGE "(OUTPUT) PROCEDURE: ERROR'IN'BLOCK"                     <<02580>>17575000
   PROCEDURE ERROR'IN'BLOCK;                                   <<01549>>17580000
   OPTION UNCALLABLE,PRIVILEGED;                               <<01549>>17585000
   BEGIN                                                       <<01549>>17590000
               IF IMAGETYPE <> PHYSEOF THEN                    <<01549>>17595000
               BEGIN  <<DEFER FILE>>                           <<01549>>17600000
                  FILEREQUEST := DEFERFILE;                    <<01549>>17605000
<< 261 Ldev #\ restart if file #O! read error; file deferred >><<06334>>17610000
                  GENMSG(1,261,%11000,DEVICE,DEVFILEID,,,,0);  <<01549>>17615000
                  RETURN;                                      <<01549>>17620000
               END;                                            <<01549>>17625000
               IF IMAGETYPE = PHYSEOF THEN                     <<01549>>17630000
               BEGIN  <<DEFERFILE =WENT PAST EOF FOR RESTART>> <<01549>>17635000
                  FILEREQUEST := DEFERFILE;                    <<01549>>17640000
                  SPOOLREQUEST := WAITSPOOLING;                <<01549>>17645000
<< 260 Ldev#\restart of file#O! went past eof; file deferred >><<06334>>17650000
                  GENMSG(1,260,%11000,DEVICE,DEVFILEID,,,,0);  <<01549>>17655000
                  UPDATE'CKPT'FLAG := FALSE;                   <<01549>>17660000
                  RETURN;                                      <<01549>>17665000
               END;                                            <<01549>>17670000
     END; <<ERROR'IN'BLOCK>>                                   <<01549>>17675000
                                                               <<01549>>17680000
$PAGE "(OUTPUT) PROCEDURE: ADVANCE'ONE'PAGE"                   <<02580>>17685000
   PROCEDURE ADVANCE'ONE'PAGE(LINESPERPAGE);                   <<01549>>17690000
   VALUE LINESPERPAGE;                                         <<01549>>17695000
   INTEGER LINESPERPAGE;                                       <<01549>>17700000
   OPTION UNCALLABLE,PRIVILEGED;                               <<01549>>17705000
                                                               <<01549>>17710000
   BEGIN                                                       <<01549>>17715000
      INTEGER POINTER RECI;                                    <<01549>>17720000
      INTEGER I:=0;                                            <<01549>>17725000
                                                               <<01549>>17730000
      DO                                                       <<01549>>17735000
         BEGIN  <<READ SPOOLFILE UNTIL PAGE BOUNDARY>>         <<01549>>17740000
               IF NOT SGETBLOCK THEN                           <<01549>>17745000
               BEGIN  <<ERROR IN READ>>                        <<01549>>17750000
                  ERROR'IN'BLOCK;                              <<01549>>17755000
                  RETURN;                                      <<01549>>17760000
               END;                                            <<01549>>17765000
               IF IMAGETYPE = NORMAL THEN                      <<01549>>17770000
               BEGIN  <<CHECKPOINT IF PAGEBOUNDARY>>           <<01549>>17775000
                  SRFUNC := SRFUNC -1;                         <<01549>>17780000
                  IF <= THEN SRFUNC := SWRITE;                 <<01549>>17785000
                  IF SRFUNC = SWRITE THEN                      <<01549>>17790000
                     BEGIN   @RECI := RECP(1);                 <<01549>>17795000
                     IF PAGE'BOUNDARY THEN GO TO CHECKPT;      <<01549>>17800000
                     END;                                      <<01549>>17805000
                  IF SRFUNC = (SOPEN-1) THEN                   <<01549>>17810000
CHECKPT:            BEGIN                                      <<01549>>17815000
                       CHECKPOINT'PAGE;                        <<01549>>17820000
                       RETURN;                                 <<01549>>17825000
                    END;                                       <<01549>>17830000
                END;                                           <<01549>>17835000
             END                                               <<01549>>17840000
             UNTIL (I := I + 1) > LINESPERPAGE;                <<01549>>17845000
                                                               <<01549>>17850000
        END; <<PROCEDURE ADVANCE'ONE'PAGE>>                    <<01549>>17855000
$PAGE "(OUTPUT) PROCEDURE: CHECKOPEN"                          <<02580>>17860000
                                                               <<01549>>17865000
PROCEDURE CHECKOPEN;                                           <<01549>>17870000
OPTION UNCALLABLE,PRIVILEGED;                                  <<01549>>17875000
<< THIS PROCEDURE ISSUES AN >>                                 <<01549>>17880000
<< ATTACHIO TO THE DRIVER   >>                                 <<01549>>17885000
<< FOR BLOCKMODE DEVICES    >>                                 <<01549>>17890000
<< SUCH AS EPOC;            >>                                 <<01549>>17895000
<< IT INITIALIZES MEMORY OF >>                                 <<01549>>17900000
<< THE DEVICE IF STARTING   >>                                 <<01549>>17905000
                                                               <<01549>>17910000
BEGIN                                                          <<01885>>17915000
   INTEGER I := 0;                                             <<01885>>17920000
   LOGICAL ARRAY JOBOPEN'REC(0:7);                             <<01885>>17925000
   DEFINE  JLEN1   = JOBOPEN'REC#,                             <<01885>>17930000
           JLEN2   = JOBOPEN'REC(1)#,                          <<01885>>17935000
           JFUNC   = JOBOPEN'REC(2)#,                          <<01885>>17940000
           JP1     = JOBOPEN'REC(3)#,                          <<01885>>17945000
           JP2     = JOBOPEN'REC(4)#,                          <<01885>>17950000
           JEND    = JOBOPEN'REC(5)#;                          <<01885>>17955000
   EQUATE RETRY'LIMIT = 15;                                    <<01885>>17960000
<<>>                                                           <<01885>>17965000
   JLEN1 := 8;                                                 <<01885>>17970000
   JLEN2 := 0;                                                 <<01885>>17975000
   JFUNC := JOB'OPEN;                                          <<01885>>17980000
   JP1 := JP2 := 0;                                            <<01885>>17985000
   JEND := -1;                                                 <<01885>>17990000
                                                               <<01885>>17995000
SEND'JOB'OPEN:                                                 <<01885>>18000000
WRITEWAIT := TRUE;                                             <<01549>>18005000
WRITEEND := FALSE;                                             <<01885>>18010000
JOB'OPEN'FAILED := FALSE;                                      <<02504>>18015000
RECP(1) := @JOBOPEN'REC;                                       <<01885>>18020000
SRFUNC := 1;                                                   <<01885>>18025000
RECL := 1024;                                                  <<01885>>18030000
SRP1 := 0;                                                     <<01549>>18035000
SRP2 := 0;                                                     <<01549>>18040000
IF NOT SDWRITE(SRFUNC, BLOCKMODE, WRITEEND, WRITEWAIT,         <<04397>>18045000
               IMAGETYPE)                                      <<04397>>18050000
   OR  RECOVER'POWER'FAIL                                      <<04397>>18055000
   OR  JOB'OPEN'FAILED                                         <<04397>>18060000
  THEN                                                         <<04397>>18065000
   BEGIN                                                       <<01885>>18070000
      RECOVER'POWER'FAIL := FALSE;                             <<01885>>18075000
        I := I + 1;                                            <<02504>>18080000
        IF I < RETRY'LIMIT AND ERR'COUNT < ERR'UPPER'LIMIT     <<02504>>18085000
        THEN GO TO SEND'JOB'OPEN                               <<02504>>18090000
        ELSE BEGIN  <<STOPSPOOLING I/O ERROR>>                 <<02504>>18095000
           STOPSPOOLING := SPOOLEEIOERR;                       <<02504>>18100000
           FILEREQUEST := DEFERFILE;                           <<02504>>18105000
        END;                                                   <<02504>>18110000
END;                                                           <<01549>>18115000
END;                                                           <<01549>>18120000
                                                               <<01549>>18125000
$PAGE "(OUTPUT) PROCEDURE: RESTARTFILE"                        <<02580>>18130000
                                                               <<01549>>18135000
PROCEDURE RESTARTFILE(FILECNT,BACKWARDS);                      <<01549>>18140000
   VALUE FILECNT, BACKWARDS;                                   <<01549>>18145000
   INTEGER FILECNT;                                            <<01549>>18150000
   LOGICAL BACKWARDS;                                          <<01549>>18155000
   OPTION UNCALLABLE,PRIVILEGED;                               <<01549>>18160000
   <<>>                                                        <<01549>>18165000
   BEGIN                                                       <<01549>>18170000
                                                               <<01549>>18175000
   DEFINE LABELSPACE =   <<NO.  OF BLOCKS OF USERLABELS>>      <<01549>>18180000
       DOUBLE((MAXUSERLABELS + 1)/4) #;                        <<01549>>18185000
                                                               <<01549>>18190000
                                                               <<01549>>18195000
   INTEGER                                                     <<01549>>18200000
             LINESPERPAGE,                                     <<01885>>18205000
             STATUS,                                           <<01549>>18210000
             NON'PURGE'EXTENT,                                 <<01549>>18215000
             CURR'FOPENNO,                                     <<01549>>18220000
             CURR'EXT  ,                                       <<01549>>18225000
             I         ,                                       <<01549>>18230000
             J         ,                                       <<01549>>18235000
             LASTFOPENENTRY,                                   <<01549>>18240000
             LASTFOPENULAB,                                    <<01549>>18245000
             TARGETULAB,                                       <<01549>>18250000
             TARGETENTRY,                                      <<01549>>18255000
             CURRENTRY ;                                       <<01549>>18260000
                                                               <<01549>>18265000
   LOGICAL   CONTINUE  ;                                       <<01549>>18270000
                                                               <<01549>>18275000
   DOUBLE    LASTFOPENBLK,                                     <<01549>>18280000
              CURR'BLOCK, CURR'REC,                            <<01549>>18285000
             TARGETFOPENBLK, NON'PURGE'BLKNUM;                 <<01549>>18290000
   IF BLOCKMODE OR CIPER THEN                                  <<04403>>18295000
   BEGIN  << CANNOT RESTART 2680A ON A FILE BOUNDARY>>         <<02527>>18300000
      GENMSG(1, IF BLOCKMODE THEN 267 ELSE 270,                <<04403>>18305000
           %10000, DEVICE, , , , ,0 );                         <<04403>>18310000
      FILEREQUEST := RELINKFILE;                               <<02527>>18315000
      SPOOLREQUEST := WAITSPOOLING;                            <<02527>>18320000
      UPDATE'CKPT'FLAG := FALSE;                               <<02527>>18325000
      RETURN;                                                  <<02527>>18330000
   END;                                                        <<02527>>18335000
                                                               <<02527>>18340000
   << PROCEDURE RESTARTFILE FINDS LAST ACTIVE RECORD, BLOCK NUMBER>>    18345000
   << AT WHICH AN FOPEN RECORD OCCURRED>>                      <<01549>>18350000
   << IT USES USERLABELS 1-10 WHICH CONTAIN TWO DOUBLEWORD ENTRIES>>    18355000
   << THE BLOCKNUMBER FOR THE FOPEN AND FOR THE CORRESPONDING FCLOSE>>  18360000
   <<READ USER LABEL 0 TO GET BEARINGS>>                       <<01549>>18365000
   FREADLABEL(SPOOLFILE,FLAB );                                <<01549>>18370000
   IF > THEN <<PRE-USERLABEL SPOOLFILE>>                       <<01549>>18375000
   ELSE                                                        <<01549>>18380000
   BEGIN  <<USE INFO ON WHERE WE LEFT OFF>>                    <<01549>>18385000
      FFILEINFO(SPOOLFILE,39,NON'PURGE'EXTENT);                <<01549>>18390000
      NON'PURGE'BLKNUM :=   <<FIRST NON-PURGED BLOCK>>         <<01549>>18395000
          DOUBLE(NON'PURGE'EXTENT) *                           <<01549>>18400000
          DOUBLE(ABSYS'EXTSSECT/4) - LABELSPACE;               <<01549>>18405000
                                                               <<01549>>18410000
      IF NON'PURGE'EXTENT = 0 THEN NON'PURGE'BLKNUM := 0D;     <<01549>>18415000
      BLKNUM := CURR'BLOCK := SPULAB'LASTBLKD;                 <<01549>>18420000
      CURR'REC := SPULAB'LASTRECD;                             <<01549>>18425000
      CURR'PAGE := SPULAB'LASTPAGD; <<LAST ACTIVE PAGE>>       <<01549>>18430000
      CURR'EXT := SPULAB'CURREXT;                              <<01549>>18435000
      LINESPERPAGE := SPULAB'LINESPERPAGE;                     <<01885>>18440000
      LASTFOPENULAB := SPULAB'LASTFOPEN;                       <<01549>>18445000
      LASTFOPENENTRY := SPULAB'FOPENENTRY;                     <<01549>>18450000
     CHANNELSKIP := SPULAB'CHNSKIP;                            <<01549>>18455000
      << I = USERLABEL # CONTAINING ENTRY J >>                 <<01549>>18460000
        <<CONTAINING BLKNUM OF CURRENT BLK>>                   <<01549>>18465000
      CONTINUE := TRUE;                                        <<01549>>18470000
      I := 1;                                                  <<01549>>18475000
      DO                                                       <<01549>>18480000
      BEGIN                                                    <<01549>>18485000
         FREADLABEL(SPOOLFILE,FLAB ,,I);                       <<01549>>18490000
         IF  FLABDBL(0) > CURR'BLOCK  THEN                     <<01549>>18495000
         BEGIN                                                 <<01549>>18500000
            I := I-1;                                          <<01549>>18505000
            CONTINUE := FALSE;                                 <<01549>>18510000
            FREADLABEL(SPOOLFILE,FLAB ,,I);                    <<01549>>18515000
         END                                                   <<01549>>18520000
      END                                                      <<01549>>18525000
      UNTIL( CONTINUE = FALSE LOR(I:= I+1)> LASTFOPENULAB);    <<01549>>18530000
                                                               <<01549>>18535000
      IF CONTINUE THEN I:=I-1;                                 <<01549>>18540000
      J := 0; CONTINUE := TRUE;                                <<01549>>18545000
      DO                                                       <<01549>>18550000
      BEGIN                                                    <<01549>>18555000
         IF (FLABDBL(J*2) > CURR'BLOCK) THEN                   <<01549>>18560000
         BEGIN                                                 <<01549>>18565000
            J:= J-1;                                           <<01549>>18570000
            CONTINUE := FALSE;                                 <<01549>>18575000
            LASTFOPENBLK := FLABDBL(J*2);                      <<01549>>18580000
         END                                                   <<01549>>18585000
      END                                                      <<01549>>18590000
      UNTIL (CONTINUE = FALSE OR  (J := J+1)> LASTFOPENENTRY); <<01549>>18595000
                                                               <<01549>>18600000
      IF CONTINUE THEN                                         <<01549>>18605000
         BEGIN                                                 <<01549>>18610000
         J := J-1;                                             <<01549>>18615000
         LASTFOPENBLK := FLABDBL(J * 2 ); <<LASTENTRY IN BLK>> <<01549>>18620000
         END;                                                  <<01549>>18625000
      <<NOW WE KNOW WHERE WE LEFT OFF IN SPOOLFILE>>           <<01549>>18630000
      << POSITION FILE SO THAT READ STARTS AT PROPER FOPEN>>   <<01549>>18635000
      CURRENTRY := (I-1) * MAXFOPENENTRY + J ;                 <<01549>>18640000
      TARGETENTRY := IF BACKWARDS THEN                         <<01549>>18645000
         CURRENTRY - FILECNT +1 ELSE                           <<01549>>18650000
         CURRENTRY + FILECNT;                                  <<01549>>18655000
      IF TARGETENTRY < 0 THEN                                  <<01549>>18660000
ERR265: BEGIN  <<RESTART ATTEMPTED BEFORE BEGINNING >>         <<01549>>18665000
<< 265 Ldev#\ restart filecount pointed before start of file >><<06334>>18670000
         GENMSG(1,265,%10000,DEVICE,,,,,0);                    <<01549>>18675000
         CURR'PAGE := 0D; RETURN;                              <<01885>>18680000
      END                                                      <<01549>>18685000
      ELSE                                                     <<01549>>18690000
      IF TARGETENTRY > MAXFOPENENTRY*(LASTFOPENULAB-1)         <<01549>>18695000
          + LASTFOPENENTRY THEN                                <<01549>>18700000
      BEGIN    <<FILECOUNT IS BEYOND END OF FILE>>             <<01549>>18705000
         << 262 Ldev #\ restart filecount pointed beyond eof >><<06334>>18710000
         GENMSG(1,262,%10000,DEVICE,,,,,0);                    <<01549>>18715000
         FILEREQUEST := RELINKFILE;                            <<01549>>18720000
         SPOOLREQUEST := WAITSPOOLING;                         <<01549>>18725000
         UPDATE'CKPT'FLAG := FALSE;                            <<01549>>18730000
         RETURN;                                               <<01549>>18735000
      END;                                                     <<01549>>18740000
      << WE HAVE A VALID FILECOUNT NOW>>                       <<01549>>18745000
                                                               <<01549>>18750000
      TARGETFOPENBLK := 0D ;                                   <<01549>>18755000
      TOS := TARGETENTRY;                                      <<01549>>18760000
      TOS := MAXFOPENENTRY;                                    <<01549>>18765000
      ASSEMBLE(DIV);                                           <<01549>>18770000
      TARGETENTRY := TOS;                                      <<01549>>18775000
      TARGETULAB := TOS;                                       <<01549>>18780000
      FREADLABEL(SPOOLFILE,FLAB ,,TARGETULAB+1);               <<01549>>18785000
      IF FLABDBL(TARGETENTRY * 2) < NON'PURGE'BLKNUM           <<01549>>18790000
         THEN GO TO ERR265;                                    <<01549>>18795000
      TARGETFOPENBLK := FLABDBL(TARGETENTRY*2);                <<01549>>18800000
      IF BLOCKMODE THEN                                        <<01549>>18805000
      BEGIN                                                    <<01549>>18810000
         RESTORE'ENVIR(TARGETFOPENBLK-1D,STATUS);              <<01549>>18815000
         FREADDIR(SPOOLFILE,SBASE,BSIZE,TARGETFOPENBLK-1D);    <<01549>>18820000
      END                                                      <<01549>>18825000
      ELSE                                                     <<01549>>18830000
      BEGIN                                                    <<01549>>18835000
      IF TARGETFOPENBLK <> 0D THEN                             <<01549>>18840000
         FREADDIR(SPOOLFILE,SBASE,BSIZE,TARGETFOPENBLK-1D );   <<01549>>18845000
      SBASE(SCOUNT) := -1;                                     <<01549>>18850000
      BLKNUM := TARGETFOPENBLK - 1D;                           <<01549>>18855000
            DO                                                 <<01549>>18860000
            BEGIN                                              <<01549>>18865000
               IF NOT SGETBLOCK THEN                           <<01549>>18870000
              BEGIN                                            <<01549>>18875000
                 ERROR'IN'BLOCK;                               <<01549>>18880000
                 RETURN;                                       <<01549>>18885000
              END;                                             <<01549>>18890000
               IF IMAGETYPE = NORMAL THEN                      <<01549>>18895000
               BEGIN  <<CHECKPOINT IF PAGEBOUNDARY>>           <<01549>>18900000
                  SRFUNC := SRFUNC -1;                         <<01549>>18905000
               END;                                            <<01549>>18910000
            END                                                <<01549>>18915000
            UNTIL (SRFUNC = SOPEN -1);                         <<01549>>18920000
               TOS := SBASE(510); TOS := SBASE(511);           <<01885>>18925000
               CURR'PAGE := TOS/DOUBLE(LINESPERPAGE);          <<01885>>18930000
            CHECKPOINT'PAGE;                                   <<01549>>18935000
            RECL := SRP1 := SRP2 := 0;                         <<02059>>18940000
            SRFUNC := SOPEN;                                   <<04397>>18945000
            SPUTREC(SRFUNC);                                   <<04397>>18950000
         END;                                                  <<01549>>18955000
      END;                                                     <<01549>>18960000
   END;  <<RESTARTFILE>>                                       <<01549>>18965000
$PAGE "(OUTPUT) PROCEDURE: RESTARTPAGE"                        <<02580>>18970000
PROCEDURE RESTARTPAGE(PAGECNT,BACKWARDS);                      <<01549>>18975000
   VALUE PAGECNT,BACKWARDS;                                    <<01549>>18980000
   INTEGER PAGECNT;                                            <<01549>>18985000
   LOGICAL BACKWARDS;                                          <<01549>>18990000
   OPTION UNCALLABLE,PRIVILEGED;                               <<01549>>18995000
                                                               <<01549>>19000000
BEGIN                                                          <<01549>>19005000
         LOGICAL ARRAY                                         <<01549>>19010000
                      RESTART'PAGE(0:16);                      <<01549>>19015000
         DOUBLE ARRAY                                          <<01549>>19020000
                      D'RESTART'PAGE(*)=                       <<01549>>19025000
                       RESTART'PAGE;                           <<01549>>19030000
         LOGICAL ARRAY                                         <<01721>>19035000
                      OLD'MASTER'ULAB(0:128);                  <<01721>>19040000
   INTEGER                                                     <<01549>>19045000
           LINESPERPAGE,                                       <<01549>>19050000
           CURR'EXT,                                           <<01549>>19055000
           I,                                                  <<01549>>19060000
           J,                                                  <<01549>>19065000
           NON'PURGE'EXTENT,                                   <<01549>>19070000
           TARGETULAB,                                         <<01549>>19075000
           TARGETENTRY,                                        <<01549>>19080000
           LASTQENTRY,                                         <<01549>>19085000
           LASTULABQ,                                          <<01549>>19090000
           PAGECOUNT;                                          <<01549>>19095000
   LOGICAL                                                     <<01549>>19100000
           CONTINUE;                                           <<01549>>19105000
   DOUBLE                                                      <<01549>>19110000
           DELTA'LINECNT,                                      <<01549>>19115000
           DCOUNT,                                             <<01549>>19120000
           NON'PURGE'BLKNUM,                                   <<01549>>19125000
           DRECNO,                                             <<01549>>19130000
           NON'PURGE'RECNUM,                                   <<01549>>19135000
           TARGET'REC,                                         <<01549>>19140000
           CURR'REC,                                           <<01549>>19145000
           TARGET'BLOCK,                                       <<01549>>19150000
           CURR'BLOCK,                                         <<01549>>19155000
           TARGET'PAGE;                                        <<01549>>19160000
   INTEGER POINTER                                             <<01549>>19165000
           RECI,  <<FOR PAGE BOUNDARY CHECK>>                  <<01549>>19170000
           PFLAB;                                              <<01549>>19175000
   DOUBLE POINTER                                              <<01549>>19180000
           PFLABDBL = PFLAB;                                   <<01549>>19185000
                                                               <<01549>>19190000
   DEFINE SET'TARGET'REC'III =                                 <<01549>>19195000
      CURR'REC + DOUBLE(LINESPERPAGE - INTEGER(CURR'REC        <<01549>>19200000
         MODD LOGICAL(LINESPERPAGE)))                          <<01549>>19205000
       +1D - DOUBLE(PAGECNT * LINESPERPAGE) #;                 <<01549>>19210000
   DEFINE LABELSPACE =   <<NO.  OF BLOCKS OF USERLABELS>>      <<01549>>19215000
       DOUBLE((MAXUSERLABELS + 1)/4) #,                        <<01549>>19220000
                                                               <<01549>>19225000
     RESET'CQPTR  =  CURR'PAGE := SPULAB'CQPAGE;               <<01549>>19230000
                       UPDATE'ULABNUM'FLAG := TRUE;            <<01549>>19235000
                       CURRULABNO := TARGETULAB;               <<01549>>19240000
                     @BLOCKCP := @BLOCKTABLE +                 <<01549>>19245000
                      TARGETENTRY * CQENTRYSIZE;#  ,           <<01549>>19250000
                                                               <<01549>>19255000
     SET'REC'COUNT = TOS := SBASE(510); TOS := SBASE(511);     <<01549>>19260000
            REC'COUNT := TOS  #;                               <<01549>>19265000
<<RESTARTPAGE FINDS LAST ACTIVE RECORD AND BLOCKNUMBER>>       <<01549>>19270000
<<FROM USER LABEL 0; INPUT IS PAGECNT AND BACKWARDS>>          <<01549>>19275000
<<FINDS APPROPRIATE BLOCKNUMBER IN SPOOLFILE TO RESUME>>       <<01549>>19280000
<<PRINTING. THERE ARE FIVE CASES.>>                            <<01549>>19285000
<<CASE0: IF PAGECNT = -1 THEN BEGINNING OF FILE      >>        <<01549>>19290000
<<CASEI: IF SKIP TO CHANNEL AND BACKWARDS >>                   <<01549>>19295000
<<       WE COUNT ENTRIES IN CIRCULAR QUEUE OF USER LABELS>>   <<01549>>19300000
<<       AND BEGIN READING AT THE INDICATED RECORD>>           <<01549>>19305000
<<CASEII: IF SKIP TO CHANNEL AND FORWARD>>                     <<01549>>19310000
<<       WE READ CURRENT RECORD (STORED IN ULAB0) AND>>        <<01549>>19315000
<<  COUNT FORWARD SKIPS TO CHANNEL (NUMBER ALSO IN ULAB0)>>    <<01549>>19320000
<<CASEIII: IF NO CHANNEL SKIPS AND BACKWARD>>                  <<01549>>19325000
<<         WE CALCULATE TARGET RECORD NUMBER>>                 <<01549>>19330000
<<         BASED ON LINESPERPAGE (ULAB0) AND>>                 <<01549>>19335000
<<         WE DO A BINARY SEARCH ON FILE FOR >>                <<01549>>19340000
<<         RECORD NUMBER, NOTE THAT THIS INFORMATION>>         <<01549>>19345000
<<         IS KEPT AT THE LAST DOUBLEWORD OF EACH >>           <<01549>>19350000
<<         SPOOLFILE BLOCK>>                                   <<01549>>19355000
<<CASEIV: IF NO CHANNEL SKIP AND FORWARD >>                    <<01549>>19360000
<<        WE READ CURRENT BLOCKNO AND CALCULATE>>              <<01549>>19365000
<<        LINESPERPAGE TIMES PAGECNT TO LOCATE>>               <<01549>>19370000
<<        TARGETRECNO AND COUNT FORWARD SEQUENTIALLY>>         <<01549>>19375000
<< ERROR MESSAGES PRODUCED IF WE PASS THE END OF THE FILE>>    <<01549>>19380000
   FFILEINFO(SPOOLFILE,39,NON'PURGE'EXTENT);                   <<01549>>19385000
   NON'PURGE'BLKNUM := DOUBLE(NON'PURGE'EXTENT) *              <<01549>>19390000
      DOUBLE(ABSYS'EXTSSECT/4) - LABELSPACE;                   <<01549>>19395000
   IF NON'PURGE'EXTENT = 0 THEN NON'PURGE'BLKNUM := 0D;        <<01549>>19400000
<<>>                                                           <<01549>>19405000
   FREADLABEL(SPOOLFILE,FLAB ); <<READ ULAB 0>>                <<01549>>19410000
   IF > THEN   <<PRE-USER LABEL SPOOLFILE>>                    <<01549>>19415000
   ELSE                                                        <<01549>>19420000
   BEGIN   <<FIND OUT WHERE WE LEFT OFF LAST TIME>>            <<01549>>19425000
      IF SPULAB'LDEV <> DEVICE THEN                            <<04403>>19430000
         BEGIN                                                 <<04403>>19435000
         FILEREQUEST := RELINKFILE;                            <<04403>>19440000
         SPOOLREQUEST := WAITSPOOLING;                         <<04403>>19445000
<< 271 Ldev#\ file #O! wasn't most recently active on device >><<06334>>19450000
         GENMSG(1, 271, %11000, DEVICE, DEVFILEID, , , , 0);   <<04403>>19455000
         UPDATE'CKPT'FLAG := FALSE;                            <<04403>>19460000
         RETURN;                                               <<04403>>19465000
         END;                                                  <<04403>>19470000
      CURR'BLOCK := SPULAB'LASTBLKD;                           <<01549>>19475000
      CURR'REC := SPULAB'LASTRECD;                             <<01549>>19480000
      CURR'PAGE := SPULAB'LASTPAGD; <<LAST ACTIVE PAGE>>       <<01549>>19485000
      CURR'EXT := SPULAB'CURREXT;                              <<01549>>19490000
      CONTINUE := TRUE;                                        <<01549>>19495000
      I := 1;                                                  <<01549>>19500000
      LASTULABQ := SPULAB'LASTULAB;                            <<01549>>19505000
      LASTQENTRY := TARGETENTRY := SPULAB'ULABENTRY;           <<01885>>19510000
      CHANNELSKIP := SPULAB'CHNSKIP;                           <<01549>>19515000
      LINESPERPAGE := SPULAB'LINESPERPAGE;                     <<01549>>19520000
CASE0: IF PAGECNT = -1 THEN RETURN; <<RESTART FROM BEGINNING>> <<01549>>19525000
      IF BLOCKMODE THEN GO TO PAGE'PRINTER;                    <<01885>>19530000
      <<SEND FOPEN RECORD>>                                    <<02059>>19535000
      RECL := SRP1 := SRP2 := 0;                               <<02059>>19540000
      SRFUNC := SOPEN;                                         <<04397>>19545000
      SPUTREC(SRFUNC);                                         <<04397>>19550000
      IF CHANNELSKIP <>0 THEN                                  <<01885>>19555000
      BEGIN      <<USE CHANNEL SKIP CHANNEL>>                  <<01549>>19560000
                 <<TO DETERMINE PAGE BOUNDARY>>                <<01549>>19565000
         IF BACKWARDS THEN                                     <<01549>>19570000
CASEI:   BEGIN   <<CALCULATE PAGE>>                            <<01549>>19575000
            <<CALCULATE ULAB CONTAINING PAGE TABLE>>           <<01549>>19580000
            <<ENTRY FOR RESTART POINT>>                        <<01549>>19585000
            TOS := LASTULABQ  * MAXCQENTRIES + LASTQENTRY+1;   <<01549>>19590000
            TOS := TOS - PAGECNT;                              <<01549>>19595000
            TOS := MAXCQENTRIES;                               <<01549>>19600000
            ASSEMBLE(DIV);                                     <<01549>>19605000
            TARGETENTRY := TOS;                                <<01549>>19610000
            TARGETULAB  := TOS;                                <<01549>>19615000
            <<ADJUST FOR CIRCULAR QUEUE>>                      <<01549>>19620000
            IF TARGETULAB <= MAXFOPENULAB THEN                 <<01549>>19625000
               TARGETULAB := MAXUSERLABELS  -1                 <<01721>>19630000
                            -(MAXFOPENULAB - TARGETULAB);      <<01549>>19635000
                                                               <<01721>>19640000
                                                               <<01721>>19645000
                                                               <<01721>>19650000
            <<READ USERLABEL CONTAINING CIRCULAR QUEUE PAGE ENTRY>>     19655000
            FREADLABEL(SPOOLFILE,FLAB ,,TARGETULAB);           <<01549>>19660000
            IF <> THEN                                         <<01549>>19665000
ERR263:                                                        <<01549>>19670000
            BEGIN <<ERROR = RESTART PAGECOUNT OUT OF BOUNDS>>  <<01549>>19675000
<< 263 Ldev#\ restart pagecount pointed before start of file >><<06334>>19680000
               GENMSG(1,263,%10000,DEVICE,,,,,0);              <<01549>>19685000
                   CURR'PAGE := 0D;                            <<01885>>19690000
               RETURN;                                         <<01549>>19695000
            END;                                               <<01549>>19700000
            FREADLABEL(SPOOLFILE,BLOCKTABLE ,,TARGETULAB);     <<01549>>19705000
            @PFLAB := @FLAB + TARGETENTRY*CQENTRYSIZE;         <<01549>>19710000
PAGE'PRINTER: IF BLOCKMODE THEN RESTART'PAGE'2680(PAGECNT,     <<01885>>19715000
                  BACKWARDS, PFLAB) ELSE BEGIN                 <<01549>>19720000
            TARGET'REC := SPULAB'CQRECD; <<RECORD NUMBER>>     <<01549>>19725000
            TARGET'BLOCK := SPULAB'CQBLKD; <<BLOCKNUMBER>>     <<01549>>19730000
            TARGET'PAGE := SPULAB'CQPAGE;  <<PAGENUMBER>>      <<01549>>19735000
            IF TARGET'BLOCK < NON'PURGE'BLKNUM THEN GOTO ERR263;        19740000
            IF (DELTA'LINECNT := DOUBLE(LINESPERPAGE*(PAGECNT  <<01549>>19745000
             +2))) < CURR'REC-TARGET'REC  THEN GOTO CASEIII;   <<01549>>19750000
         IF CURR'PAGE - DOUBLE(PAGECNT) < 0D THEN GOTO ERR263; <<01885>>19755000
            FREADDIR(SPOOLFILE,SBASE,512,TARGET'BLOCK);        <<01549>>19760000
            IF <> THEN GOTO ERR260;                            <<01549>>19765000
           BLKNUM := TARGET'BLOCK; SET'REC'COUNT; RESET'CQPTR; <<01549>>19770000
            ADVANCE'ONE'PAGE(LINESPERPAGE);                    <<01549>>19775000
         END; END  <<CASE I = CHANNELSKIP + BACKWARDS>>        <<01549>>19780000
         ELSE                                                  <<01549>>19785000
CASEII:                                                        <<01549>>19790000
         BEGIN  <<CHANNELSKIP AND FORWARD>>                    <<01549>>19795000
            <<READ LAST BLOCK AND CHECKPOINT NEW PAGE SKIPS>>  <<01549>>19800000
            <<UNTIL WE ADVANCE NNN PAGES(PAGECNT)>>            <<01549>>19805000
            FREADLABEL(SPOOLFILE,OLD'MASTER'ULAB);             <<01721>>19810000
            PAGECOUNT := 0;                                    <<01549>>19815000
            RESET'CQPTR;                                       <<01885>>19820000
            FREADDIR(SPOOLFILE,SBASE,512,CURR'BLOCK);          <<01549>>19825000
            FREADLABEL(SPOOLFILE,BLOCKTABLE,,LASTULABQ);       <<01885>>19830000
            BLKNUM  := CURR'BLOCK; SCOUNT := 0;                <<01549>>19835000
             IF NOT BLOCKMODE THEN BEGIN                       <<01549>>19840000
            DO                                                 <<01549>>19845000
            BEGIN                                              <<01549>>19850000
            ADVANCE'ONE'PAGE(LINESPERPAGE);                    <<01549>>19855000
            PAGECOUNT := PAGECOUNT + 1;                        <<01549>>19860000
            END                                                <<01549>>19865000
                                                               <<01549>>19870000
             UNTIL PAGECOUNT = PAGECNT OR IMAGETYPE<> NORMAL;  <<01549>>19875000
             END                                               <<01549>>19880000
             ELSE                                              <<01549>>19885000
             BEGIN                                             <<01549>>19890000
                FREADLABEL(SPOOLFILE,FLAB,,LASTULABQ);         <<01549>>19895000
                @PFLAB := @FLAB + LASTULABQ*CQENTRYSIZE;       <<01549>>19900000
                RESTART'PAGE'2680(PAGECNT, BACKWARDS,          <<01549>>19905000
                       PFLAB);                                 <<01549>>19910000
             END;                                              <<01549>>19915000
               IF NOT UPDATE'CKPT'FLAG THEN                    <<01721>>19920000
                 << REPLACE ORIGINAL MASTER ULAB 0>>           <<01721>>19925000
                 FWRITELABEL(SPOOLFILE,OLD'MASTER'ULAB);       <<01721>>19930000
                                                               <<01549>>19935000
          END;   <<CASE II>>                                   <<01549>>19940000
      END    <<CHANNEL SKIP CASE>>                             <<01549>>19945000
      ELSE                                                     <<01549>>19950000
                                                               <<01549>>19955000
CASEIII:                                                       <<01549>>19960000
      BEGIN                                                    <<01549>>19965000
         <<ASSUME 60 LINES PER PAGE>>                          <<01549>>19970000
         IF BACKWARDS THEN                                     <<01549>>19975000
         BEGIN  <<  BACKSPACE FILE NNN PAGES - NO CHANNEL>>    <<01549>>19980000
            <<CALCULATE TARGET RECORD FOR RESTART>>            <<01549>>19985000
            <<FIND PAGE BOUNDARY OF FIRST PAGE BY READING>>    <<01549>>19990000
            << THE FIRST NON-PURGED BLOCK OF THE FILE>>        <<01549>>19995000
            << AND OBTAINING THE FIRST RECORD NUMBER>>         <<01549>>20000000
            FREAD(SPOOLFILE,SBASE,512);                        <<01549>>20005000
            TOS := SBASE(510);                                 <<01549>>20010000
            TOS := SBASE(511);                                 <<01549>>20015000
            NON'PURGE'RECNUM := TOS;                           <<01549>>20020000
            TARGET'REC := SET'TARGET'REC'III;                  <<01549>>20025000
                                                               <<01549>>20030000
            IF TARGET'REC < NON'PURGE'RECNUM THEN GOTO ERR263; <<01549>>20035000
            <<CALCULATE TARGET BLOCK FOR FREADDIR CALL>>       <<01549>>20040000
            TARGET'BLOCK := TARGET'REC/16D; <<ESTIMATE>>       <<01549>>20045000
            DCOUNT := 0D;                                      <<01549>>20050000
            DO                                                 <<01549>>20055000
            BEGIN                                              <<01549>>20060000
               IF TARGET'BLOCK+DCOUNT < NON'PURGE'BLKNUM       <<01549>>20065000
                 THEN TARGET'BLOCK:= NON'PURGE'BLKNUM-DCOUNT;  <<01549>>20070000
               FREADDIR(SPOOLFILE,SBASE,512,                   <<01549>>20075000
                       TARGET'BLOCK := TARGET'BLOCK + DCOUNT); <<01549>>20080000
               IF <> THEN                                      <<01549>>20085000
ERR260:                                                        <<01549>>20090000
               BEGIN  <<ERR = OUT OF BOUNDS ON FILE>>          <<01549>>20095000
                  FILEREQUEST := RELINKFILE;                   <<04403>>20100000
                  SPOOLREQUEST := WAITSPOOLING;                <<01549>>20105000
<< 260 Ldev#\restart of file#O! went past eof; file deferred >><<06334>>20110000
                  GENMSG(1,260,%11000,DEVICE,DEVFILEID,,,,0);  <<01549>>20115000
                  UPDATE'CKPT'FLAG := FALSE;                   <<01549>>20120000
                  RETURN;                                      <<01549>>20125000
               END;                                            <<01549>>20130000
                 BLKNUM := TARGET'BLOCK;                       <<01549>>20135000
               TOS := SBASE(510); <<DOUBLEWORD>>               <<01549>>20140000
               TOS := SBASE(511); <<CONTAINING RECNO>>         <<01549>>20145000
               DRECNO := TOS;     <<OF FIRST RECORD IN BLOCK>> <<01549>>20150000
               IF DRECNO = 0D THEN RETURN; <<BEGINNING >>      <<01549>>20155000
            END                                                <<01549>>20160000
          UNTIL (-2<=(INTEGER(DCOUNT:=(TARGET'REC-DRECNO)/16D))<=2);    20165000
            IF DCOUNT < 0D THEN                                <<01549>>20170000
            DO                                                 <<01549>>20175000
            BEGIN                                              <<01549>>20180000
               FREADDIR(SPOOLFILE,SBASE,512,TARGET'BLOCK :=    <<01549>>20185000
                           TARGET'BLOCK -1D);                  <<01549>>20190000
               IF <> THEN GO TO ERR260;                        <<01549>>20195000
                 BLKNUM := TARGET'BLOCK;                       <<01549>>20200000
               TOS := SBASE(510);                              <<01549>>20205000
               TOS := SBASE(511);                              <<01549>>20210000
               DRECNO := TOS;                                  <<01549>>20215000
            END                                                <<01549>>20220000
            UNTIL DRECNO <= TARGET'REC;                        <<01549>>20225000
            BLKNUM := TARGET'BLOCK;                            <<01549>>20230000
            SCOUNT := 0;                                       <<01549>>20235000
            REC'COUNT := DRECNO;                               <<01549>>20240000
            DO                                                 <<01549>>20245000
            BEGIN                                              <<01549>>20250000
               IF NOT SGETBLOCK THEN                           <<01549>>20255000
               BEGIN <<ERROR IN FREAD>>                        <<01549>>20260000
                  ERROR'IN'BLOCK;                              <<01549>>20265000
                  RETURN;                                      <<01549>>20270000
               END;                                            <<01549>>20275000
            END UNTIL(DRECNO := DRECNO + 1D) >= TARGET'REC;    <<01549>>20280000
            IF CHANNELSKIP <> 0 THEN                           <<01549>>20285000
              ADVANCE'ONE'PAGE(LINESPERPAGE);                  <<01549>>20290000
         END  <<CASE III>>                                     <<01549>>20295000
                                                               <<01549>>20300000
         ELSE                                                  <<01549>>20305000
CASEIV:                                                        <<01549>>20310000
         BEGIN  <<FORWARDS NNN PAGES - NO CHANNELSKIP>>        <<01549>>20315000
            <<FIND PAGE BOUNDARY OF FIRST PAGE BY READING>>    <<01549>>20320000
            << THE FIRST NON-PURGED BLOCK OF THE FILE>>        <<01549>>20325000
            << AND OBTAINING THE FIRST RECORD NUMBER>>         <<01549>>20330000
            FREAD(SPOOLFILE,SBASE,512);                        <<01549>>20335000
            TOS := SBASE(510);                                 <<01549>>20340000
            TOS := SBASE(511);                                 <<01549>>20345000
            NON'PURGE'RECNUM := TOS;                           <<01549>>20350000
        <<READ CURRENT RECORD AND READ FORWARD SEQUENTIALLY>>  <<01549>>20355000
            FREADDIR(SPOOLFILE,SBASE,512,CURR'BLOCK);          <<01549>>20360000
            IF <> THEN GOTO ERR260;                            <<01549>>20365000
            BLKNUM := CURR'BLOCK;                              <<01549>>20370000
            SET'REC'COUNT;                                     <<01549>>20375000
            DRECNO := REC'COUNT;                               <<01549>>20380000
            DELTA'LINECNT:= DRECNO -                           <<01549>>20385000
               DOUBLE( DRECNO                                  <<01549>>20390000
               MODD  LOGICAL(LINESPERPAGE));                  <<<01549>>20395000
            TARGET'REC := DELTA'LINECNT + 1D +                 <<01549>>20400000
                    DOUBLE(PAGECNT * LINESPERPAGE);            <<01549>>20405000
            DO                                                 <<01549>>20410000
            BEGIN IF NOT SGETBLOCK THEN BEGIN                  <<01549>>20415000
               ERROR'IN'BLOCK; RETURN;                         <<01549>>20420000
               END;                                            <<01549>>20425000
            END UNTIL (DRECNO := DRECNO + 1D) >= TARGET'REC;   <<01549>>20430000
         END; <<CASE IV>>                                      <<01549>>20435000
      END;  <<NO CHANNEL SKIP>>                                <<01549>>20440000
   END;  <<POST-RESTART SPOOLFILE CASE>>                       <<01549>>20445000
END;  <<RESTARTPAGE>>                                          <<01549>>20450000
$PAGE "(OUTPUT) PROCEDURE: SGETBLOCK"                          <<02580>>20455000
LOGICAL PROCEDURE SGETBLOCK;                                   <<01549>>20460000
OPTION UNCALLABLE,PRIVILEGED;                                           20465000
   BEGIN                                                                20470000
   << >>                                                                20475000
  logical vdev'flags;                                          <<04419>>20480000
   DEFINE LARGECON = 2147483647D#; <<FOR DEBUG>>               <<01549>>20485000
   SGETBLOCK := TRUE;                                                   20490000
   IMAGETYPE := NORMAL;                                                 20495000
   got'new'block := false;                                     <<04397>>20500000
   IF WRITEEND THEN GOTO FIN;                                           20505000
   IF RECOVERING THEN                                                   20510000
      BEGIN                                                             20515000
      RECL := 0;                                                        20520000
      SRFUNC := SOPEN;                                                  20525000
      RECP(1) := 0;                                                     20530000
      GOTO FIN;                                                         20535000
      END;                                                              20540000
   REC'COUNT := REC'COUNT + 1D;                                <<01549>>20545000
   IF SBASE(SCOUNT) = -1 OR BLOCKMODE THEN                     <<01549>>20550000
      BEGIN                                                             20555000
   RECL := FREAD(SPOOLFILE,SBASE,                              <<01549>>20560000
                 IF BLOCKMODE AND NOT SINGLE'BLOCK'MODE        <<01549>>20565000
                              THEN BSIZE*BLOCKS ELSE BSIZE);   <<01549>>20570000
      IF <> THEN                                                        20575000
         BEGIN                                                          20580000
         IMAGETYPE := IF > THEN PHYSEOF                                 20585000
                           ELSE IOSPOOFLERR;                            20590000
         SGETBLOCK := FALSE;                                            20595000
         SBASE := -1;                                                   20600000
         GOTO FIN;                                                      20605000
         END;                                                           20610000
      SCOUNT := 0;                                                      20615000
                                                               <<04397>>20620000
      BLKNUM := BLKNUM + DOUBLE(RECL/BSIZE);                   <<01549>>20625000
                                                               <<06705>>20630000
<< Start new CIPER block every 8th (magic number) spoolfile >> <<06705>>20635000
<< block.                                                   >> <<06705>>20640000
                                                               <<06705>>20645000
      IF BLKNUM MODD 8 = 0 THEN GOT'NEW'BLOCK := TRUE;         <<06705>>20650000
      TOS := SBASE(510); <<RECORD COUNT OF FIRST REC>>         <<01549>>20655000
                         << IN BLOCK KEPT AT END OF BLOCK>>    <<01549>>20660000
      TOS := SBASE(511); << IN A DOUBLEWORD>>                  <<01549>>20665000
      REC'COUNT :=TOS;                                         <<01549>>20670000
   IF REC'COUNT = LARGECON THEN DEBUG; <<TEST FOR EOF>>        <<01549>>20675000
      END;                                                              20680000
<<  THE FOLLOWING WILL BE EXECUTED WHEN >>                     <<01549>>20685000
<<  WE ARE IN BLOCKMODE                 >>                     <<01549>>20690000
<<  BLOCKMODE MEANS READING AND WRITING >>                     <<01549>>20695000
<<  ONE OR MORE SPOOLFILE BLOCKS TO A   >>                     <<01549>>20700000
<<  PAGEPRINTER SUCH AS EPOC WITHOUT    >>                     <<01549>>20705000
<<  EXAMINING INDIVIDUAL RECORDS        >>                     <<01549>>20710000
   IF BLOCKMODE THEN                                           <<01549>>20715000
      BEGIN                                                    <<01549>>20720000
      RECL := RECL&ASL(1);                                     <<01549>>20725000
      SRFUNC := SWRITE;                                        <<01549>>20730000
      SRP1 := 0;                                               <<01549>>20735000
      SRP2 := 0;                                               <<01549>>20740000
      RECP(1) := @SBASE;                                       <<01549>>20745000
      SCOUNT := 0;                                             <<01549>>20750000
      WRITEWAIT := TRUE;                                       <<01549>>20755000
      END                                                      <<01549>>20760000
<< END OF BLOCKMODE PROCESSING          >>                     <<01549>>20765000
   ELSE BEGIN                                                  <<01549>>20770000
   RECL   := SBASE(SCOUNT)-BRECX&ASL(1);                                20775000
   SRFUNC := SBASE(X:=X+2);                                             20780000
   SRP1   := SBASE(X:=X+1);                                             20785000
   SRP2   := SBASE(X:=X+1);                                             20790000
   RECP(1):= @SBASE(X:=X+1);                                            20795000
   SCOUNT := SCOUNT+(RECL+1)&ASR(1)+BRECX+1;                            20800000
  if not (sread <= srfunc <= sclose) <<not a normal function>> <<04419>>20805000
       then                                                    <<04419>>20810000
    if not validdevtype(-1 << spooled >>,  srfunc, vdev'flags) <<04419>>20815000
         << a valid spool file function code >> then           <<04419>>20820000
      go to err;                                               <<04419>>20825000
   WRITEWAIT := (SBASE(SCOUNT)=-1);                                     20830000
    GO TO FIN;                                                 <<01549>>20835000
ERR:                                                                    20840000
      IMAGETYPE := IOSPOOFLERR;                                         20845000
      SGETBLOCK := FALSE;                                               20850000
      GOTO FIN;                                                         20855000
   END;                                                        <<01549>>20860000
FIN:                                                                    20865000
   END;                                                                 20870000
$PAGE "(OUTPUT) PROCEDURE: SDWRITE"                            <<02580>>20875000
LOGICAL PROCEDURE SDWRITE(SRFUNC, BLOCKMODE, WRITEEND,         <<04397>>20880000
                          WRITEWAIT, IMAGETYPE);               <<04397>>20885000
                                                               <<04397>>20890000
INTEGER SRFUNC;     << THE ATTACHIO FUNCTION CODE >>           <<04397>>20895000
                                                               <<04397>>20900000
LOGICAL BLOCKMODE,  <<TRUE for block mode xfers i.e. 2680a>>   <<04397>>20905000
       WRITEEND,<<TRUE if we just want to wait for completion>><<04397>>20910000
        WRITEWAIT,  <<TRUE for blocked write (vs. nowait) >>   <<04397>>20915000
        IMAGETYPE;  <<a general purpose status return >>       <<04397>>20920000
                                                               <<04397>>20925000
   COMMENT                                                     <<04397>>20930000
                                                               <<04397>>20935000
      This procedure is used as the output spooler's primary   <<04397>>20940000
      interface to the I/O system.  Its most frequent use is   <<04397>>20945000
      to do a nowait I/O, saving the IOQ index etc. in the     <<04397>>20950000
      area at RECP.  It can also be used to wait for completion<<04397>>20955000
      and check status (WRITEEND=TRUE) or to do blocked writes <<04397>>20960000
      (WRITEWAIT=TRUE).  If it uses the last available save    <<04397>>20965000
      area for IOQ indexes, it will suspend waiting for all    <<04397>>20970000
      outstanding I/O to complete or for an operator command.  <<04397>>20975000
      It uses the variable IMAGETYPE (a truly confusing mish-  <<04397>>20980000
      mash of bits) to return its status to the caller.        <<04397>>20985000
                                                               <<04397>>20990000
   END OF COMMENT ;                                            <<04397>>20995000
                                                               <<04397>>21000000
OPTION UNCALLABLE,PRIVILEGED;                                           21005000
   BEGIN                                                                21010000
   INTEGER POINTER LAST;                                                21015000
   INTEGER STATUS'RETURN;                                      <<00896>>21020000
   LOGICAL USAGE;                                              <<C7517>>21025000
   EQUATE INVALID'FUNC = 4;                                    <<01549>>21030000
   EQUATE POWER'UP'RESULT = %213;                              <<01549>>21035000
                                                               <<02504>>21040000
   << >>                                                                21045000
SDWRITE'ENTRY:                                                 <<01885>>21050000
   SDWRITE := TRUE;                                                     21055000
   IF NOT CIPER THEN IMAGETYPE := NORMAL;                      <<04420>>21060000
   IF NOT WRITEEND THEN                                                 21065000
      BEGIN                                                             21070000
      IF VALID'FUNC (SRFUNC, USAGE) THEN                       <<C7517>>21075000
         BEGIN                                                 <<C7517>>21080000
         @LAST := @RECP;                                       <<C7517>>21085000
         LINES'PRINTED := LINES'PRINTED + 1D;                  <<C7517>>21090000
         IF CIPER THEN                                         <<C7517>>21095000
            BEGIN                                              <<04397>>21100000
            TOS:=ATTACHIO(DEVICE, 0, 0, RECP(1), SRFUNC, -RECL,<<04397>>21105000
                          SRP1, SRP2, 1);                      <<04397>>21110000
            GO TO EXAMINE'STATUS;                              <<04397>>21115000
            END;                                               <<04397>>21120000
         RECPD(1) := ATTACHIO (DEVICE, 0, 0, RECP(1), SRFUNC,  <<C7517>>21125000
                               -RECL, SRP1, SRP2, 0);          <<C7517>>21130000
         RECP := 1;                                            <<C7517>>21135000
         @RECP := @RECP + 4;                                   <<C7517>>21140000
         END;                                                  <<C7517>>21145000
      IF @RECP <> @DEVICERECP AND                              <<C7517>>21150000
         (WRITEWAIT OR @RECP = @SBASE) THEN                    <<C7517>>21155000
         BEGIN                                                          21160000
         WRITEEND := TRUE;                                              21165000
         @RECP := @DEVICERECP;                                          21170000
         LAST(3) := 1;                                                  21175000
         SETWAKE(LAST(2));                                              21180000
         END;                                                           21185000
      END;                                                              21190000
   IF WRITEEND THEN                                                     21195000
      BEGIN                                                             21200000
CHECKREQ:                                                               21205000
      DISABLE;                                                          21210000
      IF DADCALLING THEN                                                21215000
         IMAGETYPE := MAIL                                              21220000
      ELSE                                                              21225000
         IF RECP <> 0 THEN                                              21230000
            BEGIN                                                       21235000
            TOS := IOSTATUS(RECP(2));                                   21240000
            IF <> THEN                                                  21245000
               BEGIN                                                    21250000
               DDEL;                                                    21255000
               WAIT(IODADWAIT,0);                                       21260000
               GOTO CHECKREQ;                                           21265000
               END;                                                     21270000
            ENABLE;                                                     21275000
            RECP := 0;                                                  21280000
EXAMINE'STATUS:                                                <<04397>>21285000
            DEL;                                                        21290000
            STATUS'RETURN := TOS.QUAL'GEN'STATUS;              <<02593>>21295000
            IF CIPER THEN                                      <<04397>>21300000
               STATUS'RETURN := CIPER'STATUS(STATUS'RETURN);   <<04397>>21305000
            IF STATUS'RETURN.GENERAL'STATUS <> GEN'ST'OK THEN  <<04397>>21310000
              BEGIN                                            <<02606>>21315000
              IF STATUS'RETURN = ST'IO'STATUS'AVAILABLE OR     <<04397>>21320000
                 STATUS'RETURN = ST'IO'ST'AND'RE'XMIT   THEN   <<04397>>21325000
                BEGIN <<Check the %13 & %23 status first>>     <<02606>>21330000
                <<Notify the user via the error trailer>>      <<02606>>21335000
                NOTIFY'USER(DEVICE);                           <<02606>>21340000
                IF JOB'OPEN'FAILED THEN                        <<02606>>21345000
                  BEGIN                                        <<02606>>21350000
                  STATUS'RETURN := ST'JOB'OPEN'FAILURE;        <<04397>>21355000
                  NOTIFY'OPERATOR(DEVICE, STATUS'RETURN);      <<02606>>21360000
                  IMAGETYPE:=IOERR;                            <<02606>>21365000
                  SDWRITE:=FALSE;                              <<02606>>21370000
                  RETURN;                                      <<02606>>21375000
                  END;                                         <<02606>>21380000
                IF ERR'COUNT > ERR'UPPER'LIMIT THEN            <<02606>>21385000
                  BEGIN                                        <<02606>>21390000
                  IF SRFUNC = SFINI-1 THEN GO SDWRITE'ENTRY;   <<02606>>21395000
                  END                                          <<02606>>21400000
                ELSE                                           <<02606>>21405000
                  IF STATUS'RETURN = ST'IO'ST'AND'RE'XMIT      <<04397>>21410000
                     THEN GO TO SDWRITE'ENTRY;                 <<04397>>21415000
                END                                            <<02606>>21420000
              ELSE                                             <<02606>>21425000
                BEGIN <<General status return <> 1,%13,%23>>   <<02606>>21430000
                IF STATUS'RETURN.GENERAL'STATUS = GEN'ST'EOF   <<C7517>>21435000
                   THEN IMAGETYPE := PHYSEOF                   <<C7517>>21440000
                ELSE IF STATUS'RETURN.GENERAL'STATUS =         <<C7517>>21445000
                     GEN'ST'DATA'CTL'INFO THEN                 <<C7517>>21450000
                     IMAGETYPE := IMAGE'DATA'CTL'ERR           <<C7517>>21455000
                ELSE IMAGETYPE := IOERR;                       <<C7517>>21460000
                NOTIFY'OPERATOR(DEVICE, STATUS'RETURN);        <<02606>>21465000
                IF STATUS'RETURN = POWER'UP'RESULT THEN        <<02606>>21470000
                  RECOVER'POWER'FAIL := TRUE;                  <<02606>>21475000
                SDWRITE:=FALSE;                                <<02606>>21480000
                IF BLOCKMODE THEN                              <<02606>>21485000
                  BEGIN                                        <<02606>>21490000
                  WRITEWAIT:=TRUE;                             <<02606>>21495000
                  WRITEEND:=FALSE;                             <<02606>>21500000
                  END;                                         <<02606>>21505000
                END;                                           <<02606>>21510000
              END                                              <<02606>>21515000
            ELSE  <<Everything normal -> Continue>>            <<02606>>21520000
   IF CIPER THEN RETURN                                        <<04397>>21525000
   ELSE                                                        <<04397>>21530000
               IF RECP(3) = 0 THEN                                      21535000
                  BEGIN                                                 21540000
                  @RECP := @RECP+4;                                     21545000
                  GOTO CHECKREQ;                                        21550000
                  END                                                   21555000
               ELSE                                                     21560000
                  BEGIN                                                 21565000
                  @RECP := @DEVICERECP;                                 21570000
                  WRITEEND := FALSE;                                    21575000
                  END;                                                  21580000
            END;                                                        21585000
      END;                                                              21590000
   ENABLE;                                                              21595000
   END;                                                                 21600000
$PAGE "(OUTPUT) PROCEDURE: SABORTWRITE"                        <<02580>>21605000
PROCEDURE SABORTWRITE;                                                  21610000
OPTION UNCALLABLE,PRIVILEGED;                                           21615000
   BEGIN                                                                21620000
   << >>                                                                21625000
                                                               <<01549>>21630000
   ABORTIO(DEVICE);                                            <<02015>>21635000
   @RECP := @DEVICERECP;                                                21640000
   DO                                                                   21645000
      BEGIN                                                             21650000
      IF RECP <> 0 THEN                                                 21655000
         BEGIN                                                          21660000
RETRY:   DISABLE;                                                       21665000
         IOSTATUS(RECP(2));                                             21670000
         IF <> THEN                                                     21675000
            BEGIN                                                       21680000
            SETWAKE(RECP(2));                                           21685000
            WAIT(IODADWAIT,0);                                          21690000
            GOTO RETRY;                                                 21695000
            END;                                                        21700000
         RECP := 0;                                                     21705000
         ENABLE;                                                        21710000
         END;                                                           21715000
      END                                                               21720000
   UNTIL (@RECP := @RECP+4) = @SBASE;                                   21725000
   @RECP := @DEVICERECP;                                                21730000
   WRITEEND := FALSE;                                                   21735000
   IF BLOCKMODE THEN                                           <<02541>>21740000
      IF FILEREQUEST <> FINISHFILE THEN                        <<02541>>21745000
      BEGIN  <<SEND IMMEDIATE CLEAR>>                          <<02541>>21750000
         SRFUNC := IMMEDIATE'CLEAR;                            <<02541>>21755000
         WRITEEND := FALSE;                                    <<02541>>21760000
         WRITEWAIT := TRUE;                                    <<02541>>21765000
         SDWRITE(SRFUNC, BLOCKMODE, WRITEEND, WRITEWAIT,       <<04397>>21770000
                 IMAGETYPE);                                   <<04397>>21775000
      END;                                                     <<02541>>21780000
   IF NOT BLOCKMODE THEN                                       <<01549>>21785000
   WRITEWAIT := FALSE;                                                  21790000
   END;                                                                 21795000
$PAGE "(OUTPUT) PROCEDURE: SPUTREC"                            <<02580>>21800000
LOGICAL PROCEDURE SPUTREC(SRFUNC);                             <<04397>>21805000
INTEGER SRFUNC;                                                <<04397>>21810000
OPTION UNCALLABLE,PRIVILEGED;                                           21815000
   BEGIN                                                                21820000
   INTEGER DTYPE;                                                       21825000
   INTEGER POINTER RECI;                                       <<01549>>21830000
   POINTER LDTP;                                               <<02701>>21835000
   logical usage;                                              <<04407>>21840000
                                                               <<01885>>21845000
   LOGICAL ARRAY ENV'STATUS(0:16);                             <<01885>>21850000
   << >>                                                                21855000
   SPUTREC := TRUE;                                                     21860000
   IF CIPER AND NOT VALID'FUNC (SRFUNC, USAGE) THEN RETURN;    <<C7517>>21865000
                                                               <<04407>>21870000
   if srfunc > sfini then go noremap'srfunc;                   <<04407>>21875000
   SRFUNC := SRFUNC-1;                                                  21880000
   IF <= THEN SRFUNC := SWRITE;                                         21885000
   IF LOGICAL(SRFUNC) THEN                                              21890000
   BEGIN                                                       <<01549>>21895000
noremap'srfunc:                                                <<04407>>21900000
      @RECI := RECP(1);                                        <<01549>>21905000
      SPUTREC := SDWRITE(SRFUNC, BLOCKMODE, WRITEEND,          <<04397>>21910000
                         WRITEWAIT, IMAGETYPE);                <<04397>>21915000
                                                               <<04397>>21920000
      IF CIPER THEN                                            <<04397>>21925000
                                                               <<04397>>21930000
         BEGIN                                                 <<04397>>21935000
                                                               <<04397>>21940000
         STARTED := 1;                                         <<04397>>21945000
         RECOVERING := 0;                                      <<04397>>21950000
                                                               <<04397>>21955000
         IF RECOVER'POWER'FAIL THEN                            <<04397>>21960000
                                                               <<04397>>21965000
            BEGIN                                              <<04397>>21970000
            RECOVER'POWER'FAIL := 0;                           <<04397>>21975000
            IF CIPER'POWER'FAIL THEN SPUTREC:=TRUE;            <<04397>>21980000
            END;                                               <<04397>>21985000
                                                               <<04397>>21990000
         END;                                                  <<04397>>21995000
                                                               <<04397>>22000000
      IF PAGE'BOUNDARY THEN                                    <<01549>>22005000
      BEGIN                                                    <<01549>>22010000
         CHANNELSKIP := 1;                                     <<01549>>22015000
         CHECKPOINT'PAGE;                                      <<01549>>22020000
      END;                                                     <<01549>>22025000
   END                                                         <<01549>>22030000
   ELSE                                                                 22035000
      BEGIN                                                             22040000
      WRITEWAIT := TRUE;                                                22045000
      IF SRFUNC = (SOPEN-1) THEN                                        22050000
         BEGIN            <<SOPEN>>                                     22055000
         IF (NOT RESUMED'SPOOLFLE) AND                         <<02641>>22060000
            (NOT SDOFORMS(RECL,RECP(1))) THEN                  <<02641>>22065000
            IMAGETYPE := DADMAD                                         22070000
         ELSE                                                           22075000
            BEGIN                                                       22080000
            SPUTREC := SDWRITE(SRFUNC, BLOCKMODE, WRITEEND,    <<04397>>22085000
                               WRITEWAIT, IMAGETYPE);          <<04397>>22090000
            IF FOD THEN FORMSALIGN(DEVICE);                             22095000
            END;                                                        22100000
         RECOVERING := 0;                                               22105000
         CHECKPOINT'PAGE;                                      <<01549>>22110000
         END                                                            22115000
      ELSE                                                              22120000
         BEGIN            <<SFINI>>                                     22125000
         RECP(1) := 0;                                                  22130000
         RECL := 0;                                                     22135000
         WRITEEND := FALSE;                                             22140000
         WRITEWAIT := TRUE;                                             22145000
         IF STARTED THEN                                                22150000
            BEGIN                                                       22155000
            if not ciper then                                  <<04397>>22160000
               IF NOT BLOCKMODE THEN                           <<04397>>22165000
               BEGIN  <<BYPASS FCLOSE RECORD>>                 <<01549>>22170000
                  SRFUNC := (SCLOSE-1);                        <<01885>>22175000
                  SDWRITE(SRFUNC, BLOCKMODE, WRITEEND,         <<04397>>22180000
                          WRITEWAIT, IMAGETYPE);               <<04397>>22185000
               END                                             <<01885>>22190000
               ELSE                                            <<01885>>22195000
               BEGIN << SEND DEFAULT ENVIRONMENT >>            <<01885>>22200000
                  <<TOGGLE JOB MARKS TWICE AND PRINT TRAILER>> <<01885>>22205000
               SRFUNC := (SFINI - 1);                          <<01885>>22210000
               IF NOT END'OF'JOB THEN                          <<01885>>22215000
               BEGIN                                           <<01885>>22220000
                  SDWRITE(SRFUNC, BLOCKMODE, WRITEEND,         <<04397>>22225000
                          WRITEWAIT, IMAGETYPE);               <<04397>>22230000
                  IF IMAGETYPE = MAIL THEN                     <<02580>>22235000
                  BEGIN  <<DAD IS CALLING>>                    <<02580>>22240000
                    SCHECKREQ;  <<SEE WHAT DAD WANTS>>         <<02580>>22245000
IF (PRIORDIRECTIVE<=INTEGER(SPOOLREQUEST)<=WAITSPOOLING) OR    <<02581>>22250000
   (FILEREQUEST<>FINISHFILE)                                   <<02581>>22255000
  THEN BEGIN  <<PRE-EMPTIVE QUIT/SUSPEND/DELETE/RELINK/DEFER>> <<02581>>22260000
       SPUTREC:=FALSE;                                         <<02580>>22265000
       RETURN;  <<EXIT NOW TO SPOOLOUTLOOP>>                   <<02580>>22270000
       END;                                                    <<02580>>22275000
                  END;                                         <<02580>>22280000
                  IF RECOVER'POWER'FAIL THEN                   <<02551>>22285000
                  BEGIN  <<CALL PROCEDURE TO POWERFAIL >>      <<02551>>22290000
                          <<RESTART 2680>>                     <<02551>>22295000
                     RECOVER'POWER'FAIL := FALSE;              <<02551>>22300000
                     POWER'FAIL'RESTART;                       <<02551>>22305000
                     <<AND RESEND THE ENTIRE JOB >>            <<02551>>22310000
                     <<FROM THE BEGINNING>>                    <<02551>>22315000
                     SPOOLOUTLOOP;                             <<02551>>22320000
                     FINISHUP;                                 <<04397>>22325000
                     RETURN;                                   <<02551>>22330000
                  END;                                         <<02551>>22335000
                  REPORT'ENV(ENV'STATUS);                      <<01885>>22340000
                  CHECKOPEN; CHECKOPEN;                        <<01885>>22345000
               END;                                            <<01885>>22350000
               IF NOT END'OF'JOB THEN                          <<02605>>22355000
                 IF PRINT'ERRFILE(FALSE) THEN RETURN;          <<02605>>22360000
                                                               <<01885>>22365000
               SCHECKREQ;                                      <<02527>>22370000
                  RECP(1) := 0;                                <<01885>>22375000
                  RECL := 0;                                   <<01885>>22380000
               END;                                            <<01885>>22385000
            TOS := DEVICETYPE;                                          22390000
            TOS.(0:1) := INCOMPLETE;                                    22395000
            TOS.(1:1) := NOSPACE;                                       22400000
            TOS.(2:1) := RESUMED'SPOOLFLE;                     <<02580>>22405000
            DTYPE := TOS;                                               22410000
            IF NOT TRAILER(ODDEP,DEVICE,DTYPE,DEVICERECL) THEN <<04411>>22415000
              BEGIN   <<I/O ERR IN TRAILER>>                   <<04411>>22420000
              IMAGETYPE := IOERR;                              <<04411>>22425000
              SPUTREC := FALSE;                                <<04411>>22430000
              RETURN;                                          <<04411>>22435000
              END;                                             <<04411>>22440000
            if silent'run'at'eoj and ciper and                 <<04437>>22445000
                 filerequest = finishfile then                 <<04437>>22450000
              begin                                            <<04411>>22455000
              filerequest := deferfile;                        <<04411>>22460000
              spoolrequest := waitspooling;                    <<04411>>22465000
<< 260 Ldev#\restart of file#O! went past eof; file deferred >><<06334>>22470000
              genmsg(1, 260, %11000, device, devfileid,,,,0);  <<04411>>22475000
              update'ckpt'flag := false;                       <<04411>>22480000
              return; << get out before any damage is done >>  <<04411>>22485000
              end;                                             <<04411>>22490000
            END;                                               <<04411>>22495000
            IF NOT CIPER THEN                                  <<04397>>22500000
              BEGIN                                            <<04397>>22505000
              SRFUNC := (SFINI-1);                             <<04397>>22510000
              SDWRITE(SRFUNC, BLOCKMODE, WRITEEND, WRITEWAIT,  <<04397>>22515000
                   IMAGETYPE);                                 <<04397>>22520000
              END;                                             <<04397>>22525000
         END;                                                           22530000
      WRITEWAIT := FALSE;                                               22535000
      END;                                                              22540000
   END;                                                                 22545000
$PAGE "(OUTPUT) PROCEDURE: SPUTBLOCKOUT"                       <<04412>>22550000
logical procedure sputblockout;                                <<04412>>22555000
                                                               <<04412>>22560000
  option privileged, uncallable;                               <<04412>>22565000
                                                               <<04412>>22570000
begin                                                          <<04412>>22575000
                                                               <<04412>>22580000
                                                               <<04412>>22585000
  comment                                                      <<04412>>22590000
                                                               <<04412>>22595000
     This procedure handles blockmode writes to                <<04412>>22600000
     printers such as epoc'2680a.  It also handles             <<04412>>22605000
     the device close at end of a spool file.                  <<04412>>22610000
    ;                                                          <<04412>>22615000
                                                               <<04412>>22620000
                                                               <<04412>>22625000
<< * * *                 Procedure body                * * * >><<04412>>22630000
                                                               <<04412>>22635000
  sputblockout := false; << assume failure >>                  <<04412>>22640000
                                                               <<04412>>22645000
    << Check for forms message in block and,                 >><<04412>>22650000
    << force the replacement of invalid epoc'2680a and       >><<04412>>22655000
    << epoc'2680g function codes.                            >><<04412>>22660000
  if not fopen'forms then return;                              <<04412>>22665000
                                                               <<04412>>22670000
  sputblockout := true; << assume success >>                   <<04412>>22675000
                                                               <<04412>>22680000
    << the forms message, if any, wasn't rejected >>           <<04412>>22685000
  if imagetype <> dadmad then                                  <<04412>>22690000
                                                               <<04412>>22695000
      << still at least one block to send >>                   <<04412>>22700000
    if recl >= bsize to'byte then                              <<04412>>22705000
      sputblockout := sdwrite(srfunc, blockmode, writeend,     <<04412>>22710000
           writewait, imagetype);                              <<04412>>22715000
                                                               <<04412>>22720000
  started := true;                                             <<04412>>22725000
  recovering := false;                                         <<04412>>22730000
                                                               <<04412>>22735000
  if recover'power'fail then                                   <<04412>>22740000
    begin                                                      <<04412>>22745000
                                                               <<04412>>22750000
    recover'power'fail := false;                               <<04412>>22755000
    if power'fail'restart then sputblockout := true;           <<04412>>22760000
                                                               <<04412>>22765000
    end; <<power fail case>>                                   <<04412>>22770000
                                                               <<04412>>22775000
end; << of procedure sputblockout >>                           <<04412>>22780000
                                                               <<04412>>22785000
$PAGE "(OUTPUT) PROCEDURE: SFINDFILE"                          <<02580>>22790000
LOGICAL PROCEDURE SFINDFILE;                                            22795000
OPTION UNCALLABLE,PRIVILEGED;                                           22800000
   BEGIN <<SFINDFILE>>                                                  22805000
   LOGICAL DEVFOUND,                                                    22810000
           CLASSFOUND,                                                  22815000
           BELOWFENCE,                                                  22820000
           ODDSIRINUSE,                                                 22825000
           TAKEDEV;                                                     22830000
   INTEGER I;                                                           22835000
   INTEGER OUTFENCE;                                           <<00874>>22840000
   INTEGER ODDEPI;                                             <<01549>>22845000
   LOGICAL DEV'OUTPUT'PRI,                                     <<06912>>22850000
           CLASS'OUTPUT'PRI;                                   <<06912>>22855000
   INTEGER POINTER DEVEP,                                               22860000
                   CLASSEP,                                             22865000
                   DEVHPQ,                                              22870000
                   ODDEPQ = CLASSEP,                                    22875000
                   CLASSHPQ;                                            22880000
   LOGICAL ARRAY XDD(0 : SIZE'OF'XDD0-1),                      <<06912>>22885000
                 XDD'HEAD(0 : SIZE'OF'XDD'HEAD-1),             <<06912>>22890000
                 XDD'SUBENTRY (0 : SIZE'OF'XDD'SUBENTRY-1);    <<06912>>22895000
   DOUBLE ARRAY XDD'DSUBENTRY(*) = XDD'SUBENTRY;               <<06912>>22900000
                                                               <<06912>>22905000
   DECLARE'MOVE'FROM'DATA'SEGMENT;                             <<06912>>22910000
   DECLARE'MOVE'TO'DATA'SEGMENT;                               <<06912>>22915000
   << >>                                                                22920000
   IF PAGECNT <> 0 OR FILECNT <> 0 THEN                        <<01549>>22925000
      IF SFINDODD(LOGICAL(DEVFILEID) LOR %100000,ODDEPI) THEN  <<01549>>22930000
         BEGIN <<USE LAST ACTIVE FILE FOR RESTART>>            <<01549>>22935000
            DEVFILEID := DEVFILEID.(1:15);                     <<01549>>22940000
            ODDSIRINUSE := GETSIR(ODD'SIR);                    <<06912>>22945000
            @ODDEPQ := ODDEPI.(1:15);                          <<06912>>22950000
            MFDS(XDD'SUBENTRY,ODD'DST,@ODDEPQ,                 <<06912>>22955000
                 SIZE'OF'XDD'SUBENTRY);                        <<06912>>22960000
            IF XDDS'SPOOL'STATE = XDDS'READY THEN              <<06912>>22965000
            BEGIN <<PREVIOUSLY ACTIVE FILE IS READY>>          <<01549>>22970000
               SFINDFILE := TRUE;                              <<01549>>22975000
               XDDS'SPOOL'STATE := XDDS'ACTIVE;                <<06912>>22980000
               XDDS'DEVICE := DEVICE;                          <<06912>>22985000
               XDDS'CLASS := 0;                                <<06912>>22990000
               MTDS(ODD'DST,@ODDEPQ,XDD'SUBENTRY,              <<06912>>22995000
                    SIZE'OF'XDD'SUBENTRY);                     <<06912>>23000000
               RELSIR(ODD'SIR,ODDSIRINUSE);                    <<06912>>23005000
               RSQEEZE := 0; <<PURGEEXT = NO>>                 <<01549>>23010000
               IS'SUSPENDED:=0;                                <<02580>>23015000
               <<TELL USER THAT SPOOLER IS RESUMING>>          <<02580>>23020000
               << 269 SP#\/spooler resumed >>                  <<06334>>23025000
               GENMSG(1, RESUMED, %10000, DEVICE,,,,,0);       <<02580>>23030000
               RESUMED'SPOOLFLE:=1;                            <<02580>>23035000
               RETURN;                                         <<01549>>23040000
            END                                                <<01549>>23045000
            ELSE                                               <<01549>>23050000
            BEGIN  <<FILE NOT READY>>                          <<01549>>23055000
               RELSIR(ODD'SIR,ODDSIRINUSE);                    <<06912>>23060000
               PAGECNT := FILECNT := BACKWARDS := 0;           <<01549>>23065000
<< 266 Ldev#\restart attempted of file#O! not in ready state >><<06334>>23070000
               GENMSG(1,266,%11000,DEVICE,DEVFILEID,,,,0);     <<01549>>23075000
               GO TO NOLUCK;                                   <<01549>>23080000
            END;                                               <<01549>>23085000
         END                                                   <<01549>>23090000
      ELSE <<ATTEMPT TO RESTART NON-EXISTENT SPOOFLE>>         <<01549>>23095000
         BEGIN                                                 <<01549>>23100000
            PAGECNT := FILECNT := 0;                           <<01549>>23105000
<< 264 Ldev #\ restart attempted on non-existent spoofle >>    <<06334>>23110000
            GENMSG(1,264,%10000,DEVICE,,,,,0);                 <<01549>>23115000
NOLUCK:                                                        <<01549>>23120000
              SFINDFILE := FALSE;                              <<01549>>23125000
              SPOOLREQUEST := WAITSPOOLING;                    <<01549>>23130000
              RETURN;                                          <<01549>>23135000
         END;                                                  <<01549>>23140000
   <<FIND NEW FILE TO PRINT>>                                  <<01549>>23145000
   IF IS'SUSPENDED THEN                                        <<02580>>23150000
     BEGIN                                                     <<02580>>23155000
     IS'SUSPENDED:=0;                                          <<02580>>23160000
     <<TELL USER THAT SPOOLER IS RESUMING>>                    <<02580>>23165000
     << 269 SP#\/spooler resumed >>                            <<06334>>23170000
     GENMSG(1, RESUMED, %10000, DEVICE,,,,,0);                 <<02580>>23175000
     END;                                                      <<02580>>23180000
   DEVFOUND := CLASSFOUND := BELOWFENCE := FALSE;                       23185000
   @DEVHPQ := @DEVHP;                                                   23190000
   @CLASSHPQ := @CLASSHP;                                               23195000
   TAKEDEV := CHOOSEDEV;                                                23200000
   ODDSIRINUSE := GETSIR(ODD'SIR);                             <<06912>>23205000
   MFDS(XDD,ODD'DST,0,SIZE'OF'XDD0);                           <<06912>>23210000
   MFDS(XDD'HEAD,ODD'DST,@DEVHPQ,SIZE'OF'XDD'HEAD);            <<06912>>23215000
   @DEVEP := XDDH'FIRST'SUBENTRY;                              <<06912>>23220000
   << FIND OUTFENCE FOR SPOOLED DEVICE>>                       <<00874>>23225000
   OUTFENCE := IF XDDH'DEV'OUTFENCE = 0 THEN                   <<06912>>23230000
               XDD0'SYSTEM'OUTFENCE ELSE                       <<06912>>23235000
               XDDH'DEV'OUTFENCE;                              <<06912>>23240000
   << >>                                                                23245000
   WHILE @DEVEP > XDDS'END'OF'CHAIN AND                        <<06912>>23250000
         NOT (DEVFOUND LOR BELOWFENCE) DO                      <<06912>>23255000
      BEGIN <<FIND ENTRY ON DEVICE CHAIN>>                              23260000
      MFDS(XDD'SUBENTRY,ODD'DST,@DEVEP,SIZE'OF'XDD'SUBENTRY);  <<06912>>23265000
      IF integer(XDDS'OUTPUT'PRIORITY) <= OUTFENCE THEN        <<06912>>23270000
         BELOWFENCE := TRUE                                    <<06912>>23275000
      ELSE                                                              23280000
         IF XDDS'SPOOL'STATE = XDDS'READY THEN                 <<06912>>23285000
            BEGIN                                              <<06912>>23290000
            DEVFOUND := TRUE;                                  <<06912>>23295000
            DEV'OUTPUT'PRI := XDDS'OUTPUT'PRIORITY;            <<06912>>23300000
            END                                                <<06912>>23305000
         ELSE @DEVEP := XDDS'NEXT'SUBENTRY;                    <<06912>>23310000
      END <<FIND ENTRY ON DEVICE CHAIN>>;                               23315000
   << >>                                                                23320000
   MFDS(XDD'HEAD,ODD'DST,@CLASSHPQ,SIZE'OF'XDD'HEAD);          <<06912>>23325000
   @CLASSEP := XDDH'FIRST'SUBENTRY;                            <<06912>>23330000
   BELOWFENCE := FALSE;                                                 23335000
   WHILE @CLASSEP > XDDS'END'OF'CHAIN AND                      <<06912>>23340000
         NOT (CLASSFOUND LOR BELOWFENCE) DO                    <<06912>>23345000
      BEGIN <<FIND ENTRY IN CLASS CHAIN>>                               23350000
      MFDS(XDD'SUBENTRY,ODD'DST,@CLASSEP,SIZE'OF'XDD'SUBENTRY);<<06912>>23355000
      IF integer(XDDS'OUTPUT'PRIORITY) <= OUTFENCE THEN        <<06912>>23360000
         BELOWFENCE := TRUE                                    <<06912>>23365000
      ELSE                                                              23370000
         IF XDDS'SPOOL'STATE = XDDS'READY THEN                 <<06912>>23375000
            BEGIN <<IS SPOOLEE IN CLASS?>>                              23380000
            I := 0;                                                     23385000
            WHILE NOT ((I:=I+1) > OUTCLASSES LOR CLASSFOUND) DO<<06912>>23390000
               IF integer(XDDS'DEVICE) = OUTCLASSES(I) THEN    <<06912>>23395000
                  BEGIN                                        <<06912>>23400000
                  CLASSFOUND := TRUE;                                   23405000
                  CLASS'OUTPUT'PRI := XDDS'OUTPUT'PRIORITY;    <<06912>>23410000
                  END;                                         <<06912>>23415000
            END <<IS SPOOLEE IN CLASS?>>;                               23420000
      IF NOT CLASSFOUND THEN @CLASSEP:=XDDS'NEXT'SUBENTRY;     <<06912>>23425000
      END <<FIND ENTRY IN CLASS CHAIN>>;                                23430000
   << >>                                                                23435000
   IF DEVFOUND OR CLASSFOUND THEN                                       23440000
      BEGIN <<HAVE ENTRY>>                                              23445000
      SFINDFILE := TRUE;                                                23450000
      IF DEVFOUND AND CLASSFOUND THEN                                   23455000
         BEGIN <<SELECT ONE>>                                           23460000
         IF DEV'OUTPUT'PRI > CLASS'OUTPUT'PRI THEN             <<06912>>23465000
            CLASSFOUND := FALSE                                <<06912>>23470000
         ELSE                                                  <<06912>>23475000
            IF DEV'OUTPUT'PRI < CLASS'OUTPUT'PRI THEN          <<06912>>23480000
               DEVFOUND := FALSE                               <<06912>>23485000
            ELSE                                                        23490000
               BEGIN <<ALTERNATING SELECTION>>                          23495000
               IF TAKEDEV THEN CLASSFOUND := FALSE                      23500000
               ELSE DEVFOUND := FALSE;                                  23505000
               TAKEDEV := NOT TAKEDEV;                                  23510000
               END <<ALTERNATING SELECTION>>;                           23515000
         END <<SELECT ONE>>;                                            23520000
      << >>                                                             23525000
      IF DEVFOUND THEN @ODDEPQ := @DEVEP;                               23530000
      MFDS(XDD'SUBENTRY,ODD'DST,@ODDEPQ,SIZE'OF'XDD'SUBENTRY); <<06912>>23535000
      XDDS'SPOOL'STATE := XDDS'ACTIVE;                         <<06912>>23540000
      MTDS(ODD'DST,@ODDEPQ,XDD'SUBENTRY,SIZE'OF'XDD'SUBENTRY); <<06912>>23545000
      RELSIR(ODD'SIR,ODDSIRINUSE);                             <<06912>>23550000
      JOBNUMBER := XDDS'JOB'NUMBER;                            <<06912>>23555000
      JOBNUMBER.(0:2) := XDDS'JOB'TYPE;                        << 9072>>23560000
      DEVFILEID := XDDS'DFID'NUMBER;                           <<06912>>23565000
      DEVFILEID.(0:1) := XDDS'DFID'IN'OR'OUT;                  << 9072>>23570000
      SQEEZE := ODDS'PURGE'EXTENTS;                            <<06912>>23575000
      RSQEEZE := 0;                                            <<06912>>23580000
      INCOMPLETE := XDDSD'READY'TIME = 0D;                     <<06912>>23585000
      FOD := ODDS'FORMS'ON'DEVICE;                             <<06912>>23590000
      NOSPACE := XDDS'SPACED'OUT;                              <<06912>>23595000
      ORIGDEST := XDDS'DEVICE;                                 <<06912>>23600000
      IF XDDS'CLASS THEN ORIGDEST := -ORIGDEST;                <<06912>>23605000
      @ODDXP := @ODDEP := @ODDEPQ;                                      23610000
      @ODDXP.(0:1) := 1;                                                23615000
      CHOOSEDEV := TAKEDEV;                                             23620000
      END <<HAVE ENTRY>>                                                23625000
   ELSE                                                                 23630000
      BEGIN <<NO LUCK>>                                                 23635000
      pdisable;                                                <<04400>>23640000
      RELSIR(ODD'SIR,ODDSIRINUSE);                             <<06912>>23645000
      IF NOT DADCALLING THEN WAIT(FILEDADWAIT,0)                        23650000
      ELSE penable;                                            <<04400>>23655000
      END <<NO LUCK>>;                                                  23660000
   END <<SFINDFILE>>;                                                   23665000
$PAGE "(OUTPUT) PROCEDURE: SPOOLOUTLOOP"                       <<02580>>23670000
procedure spooloutloop;                                        <<04418>>23675000
                                                               <<04418>>23680000
  option uncallable, privileged;                               <<04418>>23685000
                                                               <<04418>>23690000
                                                               <<04418>>23695000
begin                                                          <<04418>>23700000
                                                               <<04418>>23705000
                                                               <<04418>>23710000
<< * * *                 Procedure body                * * * >><<04418>>23715000
                                                               <<04418>>23720000
  while not doneimage and filerequest = finishfile do          <<04418>>23725000
    begin <<output spooling inner loop>>                       <<04418>>23730000
                                                               <<04418>>23735000
    if not sgetblock then                                      <<04418>>23740000
      begin                                                    <<04418>>23745000
                                                               <<04418>>23750000
      if imagetype <> physeof then                             <<04418>>23755000
        begin                                                  <<04418>>23760000
                                                               <<04418>>23765000
        filerequest := deferfile;                              <<04418>>23770000
                                                               <<04418>>23775000
        << 230 SP#\/#O! deferred, spoofle I/O error >>         <<06334>>23780000
        genmsg(1,230,%11000,device,devfileid,,,,0);            <<04418>>23785000
                                                               <<04418>>23790000
        end;                                                   <<04418>>23795000
                                                               <<04418>>23800000
      end;                                                     <<04418>>23805000
                                                               <<04418>>23810000
                                                               <<04418>>23815000
    if imagetype = normal then                                 <<04418>>23820000
      begin                                                    <<04418>>23825000
                                                               <<04418>>23830000
      if send'start'of'block then                              <<04418>>23835000
        begin                                                  <<04418>>23840000
                                                               <<04418>>23845000
        if not new'silent'run then                             <<04418>>23850000
          begin                                                <<04418>>23855000
                                                               <<04418>>23860000
          if imagetype = normal then                           <<04418>>23865000
            begin <<have record for output>>                   <<04418>>23870000
                                                               <<04418>>23875000
            if blockmode and not sputblockout or               <<04418>>23880000
                 not blockmode and not sputrec(srfunc) then    <<04418>>23885000
              BEGIN  << Some sort of error.                 >> <<C7517>>23890000
              IF IMAGETYPE = IOERR THEN                        <<C7517>>23895000
                 STOPSPOOLING := SPOOLEEIOERR;                 <<C7517>>23900000
              IF IMAGETYPE = IMAGE'DATA'CTL'ERR                <<C7517>>23905000
                 THEN FILEREQUEST := DEFERFILE                 <<C7517>>23910000
                 ELSE FILEREQUEST := RELINKFILE;               <<C7517>>23915000
              END;   << Some sort of error.                 >> <<C7517>>23920000
                                                               <<04418>>23925000
            end; <<have record for output>>                    <<04418>>23930000
                                                               <<04418>>23935000
          end;                                                 <<04418>>23940000
                                                               <<04418>>23945000
        end;                                                   <<04418>>23950000
                                                               <<04418>>23955000
      end;                                                     <<04418>>23960000
                                                               <<04418>>23965000
                                                               <<04418>>23970000
    if ciper and( imagetype = physeof ) and                    <<04418>>23975000
         ( stopspooling <> spooleeioerr ) and                  <<04418>>23980000
    ( stopspooling <> spoofleioerr ) then                      <<04418>>23985000
      begin                                                    <<04418>>23990000
                                                               <<04418>>23995000
      srfunc := func'job'rprt'immediate;                       <<04418>>24000000
        << don't read any data >>                              <<04418>>24005000
      recl := 0;                                               <<04418>>24010000
        << send pending data, get new job report status >>     <<04418>>24015000
      srp1 := 1;                                               <<04418>>24020000
      srp2 := 0;                                               <<04418>>24025000
                                                               <<04418>>24030000
      if not sdwrite(srfunc, blockmode,                        <<04418>>24035000
          writeend, writewait, imagetype) then                 <<04418>>24040000
        begin                                                  <<04418>>24045000
        stopspooling := spooleeioerr;                          <<04418>>24050000
        filerequest := relinkfile;                             <<04418>>24055000
        end                                                    <<04418>>24060000
                                                               <<04418>>24065000
      else                                                     <<04418>>24070000
        if new'silent'run and ( imagetype = physeof ) and      <<04418>>24075000
             ( stopspooling <> spooleeioerr ) and              <<04418>>24080000
        ( stopspooling <> spoofleioerr ) then                  <<04418>>24085000
          imagetype := normal;                                 <<04418>>24090000
                                                               <<04418>>24095000
      end;                                                     <<04418>>24100000
                                                               <<04418>>24105000
    scheckreq;                                                 <<04418>>24110000
                                                               <<04418>>24115000
    end; <<output spooling inner loop>>                        <<04418>>24120000
                                                               <<04418>>24125000
end; << of procedure spooloutloop >>                           <<04418>>24130000
                                                               <<04418>>24135000
$PAGE "(OUTPUT) PROCEDURE: FINISHUP"                           <<04397>>24140000
procedure finishup;                                            <<04397>>24145000
   option privileged, uncallable;                              <<U7868>>24150000
                                                               <<04397>>24155000
begin                                                          <<04397>>24160000
                                                               <<04397>>24165000
                                                               <<04397>>24170000
  comment                                                      <<04397>>24175000
                                                               <<04397>>24180000
    This procedure cleans up after SPOOLOUTLOOP.               <<04397>>24185000
    If necessary, it aborts I/O.  Does an SFINI,               <<04397>>24190000
    and so on.  Some of the logic is beyond me.                <<04397>>24195000
    It is simply copied from an older spooler.                 <<04397>>24200000
    ;                                                          <<04397>>24205000
                                                               <<04397>>24210000
                                                               <<04397>>24215000
<< * * *                 Procedure body                * * * >><<04397>>24220000
                                                               <<04397>>24225000
  if filerequest <> finishfile and not ciper then              <<04397>>24230000
    sabortwrite;                                               <<04397>>24235000
                                                               <<04397>>24240000
  if stopspooling = spooleeioerr then return;                  <<04397>>24245000
                                                               <<04397>>24250000
  if filerequest <> finishfile then incomplete := true;        <<04397>>24255000
                                                               <<04397>>24260000
  srfunc := sfini;                                             <<04397>>24265000
  if not sputrec(srfunc)  and not ciper then                   <<04397>>24270000
    begin                                                      <<04397>>24275000
                                                               <<04397>>24280000
    sabortwrite;                                               <<04397>>24285000
                                                               <<04397>>24290000
    if filerequest <> finishfile then incomplete := true;      <<04397>>24295000
                                                               <<04397>>24300000
    srfunc := sfini;                                           <<04397>>24305000
    sputrec(srfunc);  << Try once more >>                      <<04397>>24310000
                                                               <<04397>>24315000
    end;                                                       <<04397>>24320000
                                                               <<04397>>24325000
  if not ciper then sabortwrite;                               <<04397>>24330000
                                                               <<04397>>24335000
end; << of procedure finishup >>                               <<04397>>24340000
                                                               <<04397>>24345000
$PAGE "(OUTPUT) PROCEDURE: SPOOLSTUFFOUT"                      <<02580>>24350000
PROCEDURE SPOOLSTUFFOUT;                                                24355000
OPTION UNCALLABLE,PRIVILEGED;                                           24360000
   BEGIN <<SPOOLSTUFFOUT>>                                              24365000
   INTEGER CURDEV,                                                      24370000
           DISPOS;                                                      24375000
   LOGICAL POINTER XDD'SUBENTRY := @ODDEP;                     <<06912>>24380000
   LOGICAL SAVE'LDT'SIR,                                       <<04480>>24385000
           SAVE'ODD'SIR;                                       <<04480>>24390000
   INTEGER NON'PURGE'EXTENT;                                   <<01549>>24395000
   DOUBLE NON'PURGE'BLKNUM;                                    <<01549>>24400000
   << >>                                                                24405000
   FILEREQUEST := FINISHFILE;                                           24410000
   DADSFILEREQ := FINISHFILE;                                           24415000
   CURDEV := DEVICE;                                                    24420000
   LINES'PRINTED := 0D;                                        <<B0.SZ>>24425000
   CURR'PAGE := 0D;                                            <<01549>>24430000
   REC'LAST'PAGE := 0D;                                        <<01549>>24435000
   BLKNUM := -1D;                                              <<01549>>24440000
   CHANNELSKIP := 0;                                           <<01549>>24445000
   @BLOCKFP := @BLOCKCP:= @BLOCKTABLE - CQENTRYSIZE;           <<01549>>24450000
   BLOCKTABLE := 0;                                            <<01549>>24455000
   UPDATE'CKPT'FLAG := TRUE;                                   <<01549>>24460000
   END'OF'JOB := FALSE;                                        <<01885>>24465000
   JOB'HAS'ERRORS := FALSE;                                    <<02512>>24470000
   MOVE BLOCKTABLE(1) := BLOCKTABLE,                           <<01549>>24475000
         (MAXCQENTRIES * CQENTRYSIZE-1);                       <<01549>>24480000
   DEVICEFILE := 0;                                                     24485000
   SPOOLFILE := 0;                                                      24490000
   DAYFILE := 0;                                               <<01885>>24495000
   DAYFILE'LOST := FALSE;                                      <<02527>>24500000
   ERR'COUNT := 0;                                             <<01885>>24505000
   IMAGETYPE := NORMAL;                                                 24510000
   STARTED := 0;                                                        24515000
   RECOVERING := SQEEZE;                                                24520000
      << If the original destination of the opened spoofle >>  <<02599>>24525000
      << is a class, its ODD entry must be relinked to the >>  <<02599>>24530000
      << device list associated with this spooler.  It     >>  <<02599>>24535000
      << will later be relinked back to its original class.>>  <<02599>>24540000
         IF ORIGDEST < 0                                       <<02599>>24545000
            THEN SRELINKODD( ODDEP, DEVICE );                  <<02599>>24550000
                                                               <<02599>>24555000
   WRITEWAIT := IF BLOCKMODE THEN TRUE ELSE FALSE;             <<01549>>24560000
   WRITEEND := 0;                                                       24565000
   SCOUNT := 0;                                                         24570000
   SBASE(SCOUNT) := -1;                                                 24575000
   << THE FOLLOWING OPEN OF A SPOOLFILE >>                     <<01549>>24580000
   << DESIGNATES :                     >>                      <<01549>>24585000
   <<  FOPTION %305 = OLD PERMANENT SYSTEM DOMAIN ASCII>>      <<01549>>24590000
   <<                 SPECIAL VARIABLE  >>                     <<01549>>24595000
   <<  AOPTION %530 = SQUEEZE EXTENTS   >>                     <<01549>>24600000
   <<                 MULTIRECORD READ (NEW) >>                <<01549>>24605000
   <<                 EXCLUSIVE ACCESS       >>                <<01549>>24610000
   <<                 NOBUF                  >>                <<01549>>24615000
   <<          %520 = SAME AS ABOVE EXCEPT   >>                <<01549>>24620000
   <<                 FOR NO SQUEEZING       >>                <<01549>>24625000
   SPOOLFILE := FSOPEN(,%305,IF RSQEEZE THEN %530 ELSE %520,   <<01549>>24630000
          logical(@XDD'SUBENTRY) LOR %100000);                 <<06912>>24635000
   IF < THEN                                                            24640000
      BEGIN <<SPOOLFILE I/O ERROR>>                                     24645000
      IMAGETYPE := IOSPOOFLERR;                                         24650000
      FILEREQUEST := DEFERFILE;                                         24655000
      PAGECNT := FILECNT := BACKWARDS := 0; <<INITIALIZE>>     <<01549>>24660000
      << 230 SP#\/#O! deferred, spoofle I/O error >>           <<06334>>24665000
      GENMSG(1,230,%11000,DEVICE,DEVFILEID,,,,0);              <<0U.EB>>24670000
      END<<SPOOLFILE I/O ERROR>>                                        24675000
   ELSE                                                                 24680000
      BEGIN                                                             24685000
                                                               <<04417>>24690000
      fulab(fulab'open);                                       <<04417>>24695000
                                                               <<04417>>24700000
         IF SPOOLREQUEST = RESUMESPOOLING THEN                 <<01549>>24705000
         BEGIN                                                 <<01549>>24710000
            IF NOT STARTED THEN                                <<01549>>24715000
             BEGIN <<INITIAL HEADER STUFF>>                    <<01549>>24720000
                   IF BLOCKMODE THEN CHECKOPEN;                <<01549>>24725000
                IF NOT                                         <<01549>>24730000
                HEADER(ODDEP,DEVICE,DEVICETYPE,DEVICERECL)     <<01549>>24735000
                THEN                                           <<01549>>24740000
                BEGIN  <<IO'ERROR ON HEADER>>                  <<01549>>24745000
                   IMAGETYPE := IOERR;                         <<01549>>24750000
                   STOPSPOOLING := SPOOLEEIOERR;               <<01549>>24755000
                   FILEREQUEST := RELINKFILE;                  <<01549>>24760000
                END;                                           <<01549>>24765000
              END;                                             <<01549>>24770000
            STARTED :=1;                                       <<01549>>24775000
            FFILEINFO(SPOOLFILE,39,NON'PURGE'EXTENT);          <<01549>>24780000
            NON'PURGE'BLKNUM := DOUBLE(NON'PURGE'EXTENT)       <<01549>>24785000
                 * DOUBLE(ABSYS'EXTSSECT/4); <<BLKS/EXTENT>>   <<01549>>24790000
            BLKNUM := NON'PURGE'BLKNUM;                        <<01549>>24795000
                                                               <<04469>>24800000
            next'page'to'print := 0D;                          <<04469>>24805000
            dev'in'silent'run := false;                        <<04469>>24810000
                                                               <<04469>>24815000
            if filecnt <> 0 then                               <<04469>>24820000
              restartfile(filecnt, backwards)                  <<04469>>24825000
            else                                               <<04469>>24830000
              if pagecnt <> 0 and pagecnt <> -1 then           <<04469>>24835000
                if ciper then                                  <<04469>>24840000
                  ciper'resumespool(pagecnt, backwards)        <<04469>>24845000
                else                                           <<04469>>24850000
                  restartpage(pagecnt, backwards);             <<04469>>24855000
                                                               <<04469>>24860000
            pagecnt := filecnt := backwards := 0;              <<04469>>24865000
         END;                                                  <<01549>>24870000
                                                               <<02599>>24875000
         SPOOLOUTLOOP;                                         <<02599>>24880000
         FINISHUP;                                             <<04397>>24885000
                                                               <<02599>>24890000
      fulab(fulab'close);                                      <<04417>>24895000
                                                               <<04417>>24900000
      << If the original destination was a class, relink   >>  <<02599>>24905000
      << the spoofle to the class unless the DEV has been  >>  <<02599>>24910000
      << altered by an ALTSPOOLFILE command.               >>  <<02599>>24915000
         IF ORIGDEST < 0 THEN                                  <<02599>>24920000
         BEGIN                                                 <<02599>>24925000
            IF NOT ALTER'DEV                                   <<02599>>24930000
               THEN SRELINKODD( ODDEP, ORIGDEST )              <<02599>>24935000
               ELSE ALTER'DEV := 0;                            <<02599>>24940000
         END;                                                  <<02599>>24945000
                                                               <<02599>>24950000
         RESUMED'SPOOLFLE:=0;                                  <<02580>>24955000
      END;                                                              24960000
      PRINT'ERRFILE(TRUE);                                     <<02594>>24965000
   CASE FILEREQUEST OF                                                  24970000
      BEGIN <<EXECUTE FILE REQUEST>>                                    24975000
      << FINISH >>                                                      24980000
         DISPOS := 1;                                                   24985000
      << DELETE >>                                                      24990000
         DISPOS := 4;                                                   24995000
      << DEFER >>                                                       25000000
         BEGIN                                                          25005000
         DISPOS := 0;                                                   25010000
                                                               <<04480>>25015000
<< We must acquire the LDT SIR here, even though SPOOLSTUFF->> <<04480>>25020000
<< OUT doesn't use it directly.  This is because we must ac->> <<04480>>25025000
<< quire the ODD SIR and hold it while we  call  SRELINKODD >> <<04480>>25030000
<< below.  SRELINKODD  immediately tries to acquire the LDT >> <<04480>>25035000
<< SIR.  If we did not acquire it here, we'd get the  wrong >> <<04480>>25040000
<< order of acquisition (ODD, then LDT) leading to possible >> <<04480>>25045000
<< SIR deadlocks.                                           >> <<04480>>25050000
                                                               <<04480>>25055000
         EXCHANGEDB(ODD'DST);                                  <<06912>>25060000
         SAVE'LDT'SIR := GETSIR (LDT'SIR);                     <<06334>>25065000
         SAVE'ODD'SIR := GETSIR (ODD'SIR);                     <<06912>>25070000
         XDDS'OUTPUT'PRIORITY := 0;                            <<06912>>25075000
         TOS := @XDD'SUBENTRY;                                 <<06912>>25080000
         TOS := XDDS'DEVICE;                                   <<06912>>25085000
         IF XDDS'CLASS THEN TOS := -TOS;                       <<06912>>25090000
         IF SPOOLFILE=0 THEN XDDS'SPOOL'STATE := XDDS'READY;   <<06912>>25095000
         SRELINKODD(*,*);                                               25100000
         RELSIR (ODD'SIR, SAVE'ODD'SIR);                       <<06912>>25105000
         RELSIR (LDT'SIR, SAVE'LDT'SIR);                       <<06334>>25110000
         EXCHANGEDB(0);                                                 25115000
         END;                                                           25120000
      << RELINK >>                                                      25125000
         DISPOS := 0;                                                   25130000
      END <<EXECUTE FILE REQUEST>>;                                     25135000
   SLOG(1);                                                             25140000
   UPDATE'CHECKPOINT;                                          <<01549>>25145000
   FSCLOSE(SPOOLFILE,DISPOS,0);                                         25150000
   IF = THEN                                                            25155000
      BEGIN                                                             25160000
      EXCHANGEDB(ODD'DST);                                     <<06912>>25165000
      IF XDDS'CLASS THEN                                       <<06912>>25170000
         SROOSTER(-XDDS'DEVICE)                                <<06912>>25175000
      ELSE                                                              25180000
         IF integer(XDDS'DEVICE) <> CURDEV                     <<06912>>25185000
            THEN SROOSTER(XDDS'DEVICE);                        <<06912>>25190000
      EXCHANGEDB(0);                                                    25195000
      END;                                                              25200000
   END <<SPOOLSTUFFOUT>>;                                               25205000
$PAGE "(OUTPUT) PROCEDURE: SPOOLOUT"                           <<02580>>25210000
PROCEDURE SPOOLOUT;                                                     25215000
OPTION UNCALLABLE,PRIVILEGED;                                           25220000
   BEGIN <<SPOOLOUT>>                                                   25225000
   INTEGER CLASSNO,                                            <<06334>>25230000
           LDEVNO,                                             <<06334>>25235000
           QDEVICE,                                            <<07057>>25240000
           LDT'INDEX,                                          <<06334>>25245000
           CLASSCOUNT,                                                  25250000
           BUFSIZE;                                                     25255000
   LOGICAL POINTER                                             <<06527>>25260000
      LDT,                                                     <<06527>>25265000
      DCT,                                                     <<06527>>25270000
      DCT'HEAD;                                                <<06527>>25275000
                                                               <<02581>>25280000
<<THIS IS FOR GLOBAL INITIALIZATION OF DB TO THE VALUE OF>>    <<02581>>25285000
<<ZERO.  IF MORE VARIABLES ARE ADDED GLOB'INIT'END.      >>    <<02581>>25290000
INTEGER POINTER                                                <<02581>>25295000
                GLOB'INIT'BEGIN                                <<02581>>25300000
               ,GLOB'INIT'END                                  <<02581>>25305000
;                                                              <<02581>>25310000
   << >>                                                                25315000
  <<INITIALIZE DB>>                                            <<02581>>25320000
@GLOB'INIT'BEGIN:=@SPOOLREQUEST;                               <<02581>>25325000
@GLOB'INIT'END := @VALID'FUNC'TABLE; << Last variable in DB >> <<04990>>25330000
GLOB'INIT'BEGIN:=0;                                            <<02581>>25335000
TOS:=DEVICE; <<SAVE THE ONLY GOOD THING IN DB>>                <<02581>>25340000
<<DADSCALL IS SAVED IMPLICITLY BY @GLOB'INIT'BEGIN:=1>>        <<02581>>25345000
MOVE GLOB'INIT'BEGIN(1):=GLOB'INIT'BEGIN,                      <<02581>>25350000
    (@GLOB'INIT'END - @GLOB'INIT'BEGIN);                       <<02581>>25355000
DEVICE:=TOS;                                                   <<02581>>25360000
   QDEVICE := DEVICE;  << need a Q-relative copy >>            <<07057>>25365000
   PUSH(STATUS);                                                        25370000
   TOS.(2:1) := 0;                                                      25375000
   SET(STATUS);                                                         25380000
   << 221 SP#\/spooled out >>                                  <<06334>>25385000
   GENMSG(1,221,%10000,DEVICE,,,,,0);                          <<0U.EB>>25390000
   SPOOLER := TRUE;                                                     25395000
   @LDT := 0;                                                  <<06334>>25400000
   LDT'INDEX := DEVICE * SIZE'OF'LDT'ENTRY;                    <<06334>>25405000
   EXCHANGEDB(LDT'DST);                                        <<06334>>25410000
   TOS := LDT'XDD'HEAD'INDEX * SIZE'OF'XDD'HEAD;               <<06912>>25415000
   EXCHANGEDB(0);                                                       25420000
   @DEVHP := TOS;                                                       25425000
   @LDTP := LDT'INDEX;                                         <<06334>>25430000
   @CLASSHP := XDD'CLASS'INDEX * SIZE'OF'XDD'HEAD;             <<06912>>25435000
   STOPSPOOLING := 0;                                                   25440000
   PAGECNT := FILECNT := 0;  <<INITIALIZE >>                   <<01549>>25445000
   IF NOT SALLOC THEN                                                   25450000
      << Allocation trouble -> Stop spooling >>                <<04419>>25455000
   ELSE                                                                 25460000
      BEGIN                                                             25465000
      << BUILD CLASS LIST>>                                             25470000
      PUSH(S);                                                          25475000
      @OUTCLASSES := TOS + 1;                                           25480000
      TOS := CLASSCOUNT := 0;                                  <<06527>>25485000
      EXCHANGEDB(DCT'DST);                                     <<06527>>25490000
      @DCT'HEAD := 0;                                          <<06527>>25495000
      @DCT := DCTH'DCT'BASE;                                   <<06527>>25500000
      CLASSNO := 1;                                            <<06334>>25505000
      DO BEGIN   << find classes containing spoolee >>         <<06334>>25510000
         LDEVNO := 0;                                          <<06527>>25515000
         DO BEGIN                                              <<06527>>25520000
            IF integer(DCT(LDEVNO+DCT'FIRST'LDEV))=QDEVICE THEN<<07057>>25525000
               BEGIN                                                    25530000
               TOS := CLASSNO;                                 <<06334>>25535000
               CLASSCOUNT := CLASSCOUNT + 1;                            25540000
               END;                                            <<06527>>25545000
            LDEVNO := LDEVNO + 1;                              <<06527>>25550000
            END                                                <<06527>>25555000
         UNTIL LDEVNO = integer(DCT'NUM'DEVICES);              <<06334>>25560000
         @DCT := @DCT + integer(DCT'NEXT'ENTRY); <<next class>><<06334>>25565000
         END      << find classes containing spoolee >>        <<06334>>25570000
      UNTIL (CLASSNO:=CLASSNO+1)>integer(DCTH'NUM'DCT'ENTRIES);<<06527>>25575000
      EXCHANGEDB(0);                                                    25580000
      OUTCLASSES := CLASSCOUNT;                                         25585000
      << >>                                                             25590000
      BUFSIZE := 4*OUTBUFS;                                             25595000
      PUSH(S);                                                          25600000
      @DEVICERECP := TOS+1;                                             25605000
      @RECP := @DEVICERECP;                                             25610000
      @SBASE := @DEVICERECP(BUFSIZE);                                   25615000
      TOS := BSIZE *(IF BLOCKMODE THEN BLOCKS ELSE 1)          <<01549>>25620000
             + BUFSIZE + 1;                                    <<01549>>25625000
      ASSEMBLE(ADDS 0);                                                 25630000
      X := 0;                                                           25635000
      DO DEVICERECP(X) := 0 UNTIL (X:=X+4)>=BUFSIZE;                    25640000
      PUSH(S);    <<NOW ALLOCATE USER LABEL BUFFER FOR>>       <<01549>>25645000
      @FLAB := TOS + 1; <<USER LABEL = FLAB>>                  <<01549>>25650000
      @BLOCKTABLE := @FLAB(128); <<AND A CIRCULAR QUEUE>>      <<01549>>25655000
      TOS := 128 + (MAXCQENTRIES*CQENTRYSIZE) + 1;             <<01549>>25660000
      ASSEMBLE(ADDS 0);  <<BUFFER FOR PAGE TABLE>>             <<01549>>25665000
      PUSH (S);   << Table of valid function codes.         >> <<04990>>25670000
      @VALID'FUNC'TABLE := (TOS+1) & LSL(1);   << Byte ptr. >> <<04990>>25675000
      TOS := (MAX'FUNC - FUNC'LOAD'VFC + 2) & LSR(1);          <<04990>>25680000
      ASSEMBLE (ADDS 0);                                       <<04990>>25685000
      VALID'FUNC'TABLE := 0;                                   <<04990>>25690000
      MOVE VALID'FUNC'TABLE(1) := VALID'FUNC'TABLE,            <<04990>>25695000
           (MAX'FUNC - FUNC'LOAD'VFC);                         <<04990>>25700000
      X := 0;                                                  <<01549>>25705000
      WRITEEND := FALSE;                                                25710000
      DO BEGIN <<OUTPUT SPOOLING>>                                      25715000
         SCHECKREQ;                                                     25720000
         CASE SPOOLREQUEST-1 OF                                         25725000
            BEGIN <<EXECUTE SPOOL REQUEST>>                             25730000
            << OFF >>                                                   25735000
               STOPSPOOLING := NORMALSTOP;                              25740000
            << WAIT >>                                                  25745000
               BEGIN                                                    25750000
               RESUMED'SPOOLFLE:=0;                            <<02580>>25755000
               INCOMPLETE:=0;                                  <<02580>>25760000
               NOSPACE:=0;                                     <<02580>>25765000
               IS'SUSPENDED:=1;                                <<02580>>25770000
                    <<TELL USER THAT SPOOLER IS SUSPENDING>>   <<02580>>25775000
               << 268 SP#\/suspended >>                        <<06334>>25780000
               GENMSG(1, SUSPENDED, %10000, DEVICE,,,,,0);     <<02580>>25785000
               DISABLE;                                                 25790000
               IF NOT DADCALLING THEN WAIT(DADWAIT,0);                  25795000
               ENABLE;                                                  25800000
               END;                                                     25805000
            << GO >>                                                    25810000
               IF SFINDFILE THEN SPOOLSTUFFOUT                          25815000
            END <<EXECUTE SPOOL REQUEST>>;                              25820000
         END <<OUTPUT SPOOLING>>                                        25825000
      UNTIL STOPSPOOLING <> 0;                                          25830000
   END;                                                                 25835000
   SDEALLOC(FALSE);                                                     25840000
   END <<SPOOLOUT>>;                                                    25845000
$PAGE "(INPUT) PROCEDURE: SPUTBLOCK"                           <<02580>>25850000
LOGICAL PROCEDURE SPUTBLOCK;                                            25855000
OPTION UNCALLABLE,PRIVILEGED;                                           25860000
   BEGIN                                                                25865000
   LOGICAL OK := TRUE;                                                  25870000
   LOGICAL LAST := FALSE;                                               25875000
   INTEGER BC;                                                          25880000
                                                                        25885000
  ENTRY SPUTLAST;  <<** LAST BLOCK ENTRY **>>                           25890000
                                                                        25895000
   << >>                                                                25900000
   IF (BC := RECL) > 0 AND RECPB(RECL-1) = " " THEN                     25905000
      BEGIN                                                             25910000
      TOS := @RECPB(X);                                                 25915000
      ASSEMBLE(DUP,DECA);                                               25920000
      TOS := -X;                                                        25925000
      IF <> THEN ASSEMBLE(CMPB ,0);                                     25930000
      BC := -TOS;                                                       25935000
      DEL; DEL;                                                         25940000
      END;                                                              25945000
   IF (SCOUNT+(BC+1)&ASR(1)+BRECX+2) > BSIZE THEN                       25950000
      BEGIN                                                             25955000
      IF LAST THEN                                                      25960000
         BEGIN                                                          25965000
SPUTLAST:                                                               25970000
         LAST := TRUE;                                                  25975000
         END;                                                           25980000
      FWRITE(SPOOLFILE,SBASE,BSIZE,0);                                  25985000
      IF <> THEN OK := FALSE;                                           25990000
      SCOUNT := 0;                                                      25995000
      END;                                                              26000000
   IF OK AND NOT LAST THEN                                              26005000
      BEGIN                                                             26010000
      SBASE(SCOUNT) := BC+BRECX&ASL(1);                                 26015000
      SBASE(X:=X+1) := RECL;                                            26020000
      SBASE(X:=X+1) := SRFUNC;                                          26025000
      SBASE(X:=X+1) := SRP1;                                            26030000
      SBASE(X:=X+1) := SRP2;                                            26035000
      IF BC > 0 THEN                                                    26040000
         BEGIN                                                          26045000
         TOS := @SBASE(X:=X+1)&LSL(1);                         <<00262>>26050000
         TOS := @RECPB;                                                 26055000
         MOVE * := *,(BC);                                              26060000
         END;                                                           26065000
      SCOUNT := SCOUNT+(BC+1)&ASR(1)+BRECX+1;                           26070000
      END;                                                              26075000
   SBASE(SCOUNT) := -1;                                                 26080000
   SPUTBLOCK := OK;                                                     26085000
   END;                                                                 26090000
$PAGE "(INPUT) PROCEDURE: SDREAD"                              <<02580>>26095000
LOGICAL PROCEDURE SDREAD;                                               26100000
OPTION UNCALLABLE,PRIVILEGED;                                           26105000
   BEGIN                                                                26110000
   INTEGER CC',                                                <<04400>>26115000
           STAT,                                                        26120000
           CUR,                                                         26125000
           NEXT := 0;                                                   26130000
   << >>                                                                26135000
   SDREAD := TRUE;                                                      26140000
   CC' := CCE;                                                 <<04400>>26145000
   IF FREEIMAGE THEN                                                    26150000
      BEGIN                                                             26155000
      CUR := @RECP;                                                     26160000
      DO BEGIN                                                          26165000
         IF RECP = 0 THEN                                               26170000
            BEGIN                                                       26175000
            RECPD := ATTACHIO(DEVICE,0,0,@RECP(2),0,                    26180000
                        -DEVICERECL&ASL(1),READCODE,0,2);               26185000
            IF READCODE <= HDWRREAD THEN                                26190000
               READCODE := IF EOFCODE=2 THEN DATAREAD                   26195000
                                        ELSE JOBREAD;                   26200000
            END                                                         26205000
         ELSE                                                           26210000
            BEGIN                                                       26215000
            IF NEXT = 0 THEN NEXT := @RECP;                             26220000
            END;                                                        26225000
         IF (@RECP:=@RECP+RSIZE+2)=@SBASE THEN                          26230000
            @RECP := @DEVICERECP;                                       26235000
         END                                                            26240000
      UNTIL @RECP = CUR;                                                26245000
      IF NEXT <> 0 THEN @RECP := NEXT;                                  26250000
      END;                                                              26255000
   EOFCODE := 0;                                                        26260000
CHECKREQ:                                                               26265000
   DISABLE;                                                             26270000
   IF DADCALLING THEN                                                   26275000
      SDREAD := FALSE                                                   26280000
   ELSE                                                                 26285000
      BEGIN                                                             26290000
      TOS := IOSTATUS(RECP);                                            26295000
      IF <> THEN                                                        26300000
         BEGIN                                                          26305000
         DDEL;                                                          26310000
         WAIT(IODADWAIT,0);                                             26315000
         GOTO CHECKREQ;                                                 26320000
         END;                                                           26325000
      ENABLE;                                                           26330000
      RECP := 0;                                                        26335000
      RECL := -TOS;                                                     26340000
      STAT := TOS.(8:8);                                                26345000
      IF STAT.(13:3) <> 1 THEN                                          26350000
         IF STAT.(13:3) <> 2 THEN                                       26355000
            CC' := CCL                                         <<04400>>26360000
         ELSE                                                           26365000
            BEGIN                                                       26370000
            IF (@RECP:=@RECP+RSIZE+2)=@SBASE THEN                       26375000
               @RECP := @DEVICERECP;                                    26380000
            IF RECP <> 0 THEN GOTO CHECKREQ;                            26385000
            EOFCODE := STAT.(10:3);                                     26390000
            CC' := CCG;                                        <<04400>>26395000
            READCODE := HDWRREAD;                                       26400000
            IF LOGICAL(EOFCODE) THEN                                    26405000
               IF EOFCODE = 1 THEN                                      26410000
                  BEGIN                                                 26415000
                  READCODE := ZEROREAD;                                 26420000
                  ATTACHIO(DEVICE,0,0,0,4,0,0,0,%13);                   26425000
                  END                                                   26430000
               ELSE                                                     26435000
                  BEGIN                                                 26440000
                  RECP(2) := ":E";                                      26445000
                  RECP(3) := IF EOFCODE=7 THEN "OJ" ELSE "OD";          26450000
                  RECL := 4;                                            26455000
                  CC' := CCE;                                  <<04400>>26460000
                  END;                                                  26465000
            END;                                                        26470000
      END;                                                              26475000
   @RECPB := @RECP(2)&LSL(1);                                           26480000
   STATUS'.CC := CC';                                          <<04400>>26485000
   END;                                                                 26490000
$PAGE "(INPUT) PROCEDURE: SABORTREAD"                          <<02580>>26495000
PROCEDURE SABORTREAD;                                                   26500000
OPTION UNCALLABLE,PRIVILEGED;                                           26505000
   BEGIN                                                                26510000
   << >>                                                                26515000
   DO ABORTIO(DEVICE) UNTIL <>;                                         26520000
   @RECP := @DEVICERECP;                                                26525000
   DO                                                                   26530000
      BEGIN                                                             26535000
      IF RECP <> 0 THEN                                                 26540000
         BEGIN                                                          26545000
RETRY:   DISABLE;                                                       26550000
         IOSTATUS(RECP);                                                26555000
         IF <> THEN                                                     26560000
            BEGIN                                                       26565000
            WAIT(IODADWAIT,0);                                          26570000
            GOTO RETRY;                                                 26575000
            END;                                                        26580000
         RECP := 0;                                                     26585000
         ENABLE;                                                        26590000
         END;                                                           26595000
      END                                                               26600000
   UNTIL (@RECP := @RECP+RSIZE+2) = @SBASE;                             26605000
   @RECP := @DEVICERECP;                                                26610000
   END;                                                                 26615000
$PAGE "(INPUT) PROCEDURE: SGETREC"                             <<02580>>26620000
LOGICAL PROCEDURE SGETREC(EXPECTSEQNUM);                       <<02.RO>>26625000
VALUE EXPECTSEQNUM;                                            <<02.RO>>26630000
LOGICAL EXPECTSEQNUM;                                          <<02.RO>>26635000
OPTION UNCALLABLE,PRIVILEGED;                                           26640000
   BEGIN                                                                26645000
   INTEGER A1,A2,A3,A4;                                                 26650000
   BYTE ARRAY BA(*)=A1;                                                 26655000
   BYTE ARRAY BAC(0:23)=PB:=                                            26660000
         ":JOB  :EOJ  :EOD  :DATA ";                                    26665000
   ARRAY GOT(0:3)=PB:=                                                  26670000
         JOB,EOJ,EOD,DATA;                                              26675000
   << >>                                                                26680000
   SGETREC := TRUE;                                                     26685000
   IF SPOOLER THEN                                                      26690000
      BEGIN                                                             26695000
      IF NOT SDREAD THEN                                                26700000
         BEGIN                                                          26705000
         TOS := MAIL;                                                   26710000
         GOTO FIN;                                                      26715000
         END;                                                           26720000
      IF < THEN GOTO ERR;                                               26725000
      IF > THEN IF EOFCODE=1 THEN GOTO EOF ELSE GOTO LEOF;              26730000
      END                                                               26735000
   ELSE                                                                 26740000
      BEGIN                                                             26745000
      IF PROMPTING THEN                                                 26750000
         BEGIN                                                          26755000
         DEVICERECP := "> ";                                            26760000
         PRINT(DEVICERECP,-1,%320);  <<PROMPT>>                         26765000
         END;                                                           26770000
      @RECPB := @DEVICERECP&LSL(1);                                     26775000
      RECL := FREAD(DEVICEFILE,DEVICERECP,-DEVICERECL&ASL(1));          26780000
      IF < THEN GOTO ERR;                                               26785000
      IF > THEN GOTO EOF;                                               26790000
      IF RECPB = PSEUDOCOLON THEN RECPB := ":";                         26795000
      END;                                                              26800000
   IF NOT SPOOLER AND RECPB <> ":" AND EXPECTSEQNUM  THEN      <<00544>>26805000
      <<THEN STRIP SEQUENCE FIELD FROM NON-MPE RECORDS>>       <<00544>>26810000
      IF RECL >= 8 THEN  <<OK TO DELETE SEQUENCE NUMBER>>      <<02.RO>>26815000
         RECL := RECL-8;                                       <<02.RO>>26820000
   TOS := NORMAL;                                                       26825000
   IF RECL >= 4 AND RECPB = ":" THEN                                    26830000
      BEGIN                                                             26835000
      MOVE BA := RECPB,(6);                                             26840000
      BA(6) := " ";                                                     26845000
      MOVE BA(1) := BA(1) WHILE AS;                                     26850000
      IF BA(1) <> "D" THEN BA(5) := " ";                                26855000
      IF RECL < 6 THEN BA(RECL) := " ";                                 26860000
      X := 18;                                                          26865000
      DO BEGIN                                                          26870000
         IF BA = BAC(X),(6) THEN                                        26875000
            BEGIN                                                       26880000
            TOS := GOT(X := X/6);                                       26885000
            IF LS0 = EOD AND PENDACTIVE                                 26890000
               THEN GOTO LEOF                                           26895000
               ELSE GOTO FIN;                                           26900000
            GOTO FIN;                                                   26905000
            END;                                                        26910000
         END                                                            26915000
      UNTIL (X:=X-6) < 0;                                               26920000
      END;                                                              26925000
   GOTO FIN;                                                            26930000
ERR:                                                                    26935000
   TOS := IOERR;                                                        26940000
   SGETREC := FALSE;                                                    26945000
   GOTO FIN;                                                            26950000
EOF:                                                                    26955000
   TOS := PHYSEOF;                                                      26960000
   GOTO FIN;                                                            26965000
LEOF:                                                                   26970000
   TOS := LOGEOF;                                                       26975000
   GOTO FIN;                                                            26980000
FIN:                                                                    26985000
   IMAGETYPE := TOS;                                                    26990000
   END;                                                                 26995000
$PAGE "(INPUT) PROCEDURE: SSTARTFILE"                          <<02580>>27000000
LOGICAL PROCEDURE SSTARTFILE(EXPECTSEQNUM,COND,NEEDWARN);      <<00291>>27005000
LOGICAL EXPECTSEQNUM;  <<LOOK FOR SEQUENCE FIELD IN CONT. LINES<<1.RAO>>27010000
LOGICAL COND; <<DESCRIPT OF UNEXPECTED IMAGE>>                 <<00291>>27015000
LOGICAL NEEDWARN; <<THIS IS SET BY SPOOLINTO IF>>              <<00291>>27020000
                  <<A WARNING IS NEEDED BEFORE >>              <<00291>>27025000
                  <<THE NEXT :JOB/:DATA CARD IS>>              <<00291>>27030000
                  <<PROCESSED.                 >>              <<00291>>27035000
OPTION UNCALLABLE,PRIVILEGED;                                           27040000
   BEGIN                                                                27045000
   LOGICAL ACCEPTSJOBS := TRUE,                                         27050000
      ACCEPTSDATA := TRUE;                                     <<08.EB>>27055000
INTEGER JMATERROR := 0,                                        <<05.EB>>27060000
           LPDT'INDEX,                                         <<06334>>27065000
           ERR := 0,                                           <<M8207>>27070000
           SDCOM,                                                       27075000
           COMLENGTHB;                                                  27080000
   INTEGER POINTER RECPP;                                               27085000
   BYTE POINTER COMIMAGEB;                                              27090000
   EQUATE CRBLK = %6440,                                       <<00291>>27095000
          CR    = %15;                                         <<00291>>27100000
                                                               <<00291>>27105000
$PAGE "(INPUT) PROCEDURE: SSTARTFILE;  SUBROUTINE: EMPTYREC"   <<02580>>27110000
   LOGICAL SUBROUTINE EMPTYREC;                                <<00291>>27115000
   BEGIN                                                       <<00291>>27120000
      COMMENT:                                                 <<00291>>27125000
         THIS ROUTINE RETURNS TRUE IF THE REC                  <<00291>>27130000
         HAS LENGTH ZERO OR IF IT IS ALL BLANK                 <<00291>>27135000
         OTHERWISE RETURN FALSE.                               <<00291>>27140000
         ;                                                     <<00291>>27145000
      EMPTYREC:=FALSE;                                         <<00291>>27150000
      IF RECL = DEVICERECL&LSL(1) THEN  <<FULL REC>>           <<00291>>27155000
         BEGIN  <<CHECK FOR SEQNUM>>                           <<00291>>27160000
         DBINARY( RECPB(RECL-8), 8);                           <<00291>>27165000
         IF = THEN  <<LAST 8 ARE NUMERICS>>                    <<00291>>27170000
            BEGIN   <<ASSUME SEQUENCED FILE>>                  <<00291>>27175000
            RECL := RECL-8;  <<DELETE SEQ FIELD>>              <<00291>>27180000
            END;                                               <<00291>>27185000
         <<ELSE NO SEQUENCE FIELD>>                            <<00291>>27190000
         END;                                                  <<00291>>27195000
      IF RECL=0 THEN EMPTYREC:=TRUE                            <<00291>>27200000
      ELSE IF RECPB(RECL-1)=" " THEN                           <<00291>>27205000
         BEGIN <<POSSIBLE BLANKFILLED LINE>>                   <<00291>>27210000
         RECPB(RECL-1):=CR;                                    <<00291>>27215000
         SCAN RECPB WHILE CRBLK;                               <<00291>>27220000
         IF CARRY THEN EMPTYREC:=TRUE;                         <<00291>>27225000
         END;                                                  <<00291>>27230000
   END <<SUBROUTINE EMPTYREC>>;                                <<00291>>27235000
                                                               <<00291>>27240000
$PAGE "(INPUT) PROCEDURE: SSTARTFILE"                          <<02580>>27245000
   << >>                                                                27250000
   SSTARTFILE := FALSE;                                        <<M8207>>27255000
   COND:=VAL'COMMAND;                                          <<00291>>27260000
   IF SPOOLER THEN                                                      27265000
      BEGIN                                                             27270000
      LPDT'INDEX := DEVICE * SIZE'OF'LPDT'ENTRY;               <<06334>>27275000
      ACCEPTSJOBS := LPDT'JOB'ACCEPT;                          <<06334>>27280000
      ACCEPTSDATA := LPDT'DATA'ACCEPT;                         <<06334>>27285000
      END;                                                              27290000
   IF NOT (ACCEPTSJOBS LOR ACCEPTSDATA) THEN                            27295000
      STOPSPOOLING := NOTACCEPTING                                      27300000
   ELSE                                                                 27305000
      BEGIN <<ACCEPTING SPOOLEE>>                                       27310000
      IF NOT IMAGEHUNGOVER THEN                                         27315000
         BEGIN <<GET RECORD>>                                           27320000
         IF NOT SGETREC(FALSE) THEN                            <<02.RO>>27325000
            BEGIN                                              <<00534>>27330000
            STOPSPOOLING := SPOOLEEIOERR;                      <<00534>>27335000
            IF NOT SPOOLER THEN                                <<00534>>27340000
               STREAMERROR(STRMSPLEEIOERR,FALSE);              <<00751>>27345000
            END                                                <<00534>>27350000
         ELSE                                                           27355000
            IF NOT SPOOLER AND IMAGETYPE = PHYSEOF THEN                 27360000
               BEGIN                                           <<00291>>27365000
               STOPSPOOLING := NORMALSTOP;                              27370000
               COND:=PHYSEOF;                                  <<00291>>27375000
               END;                                            <<00291>>27380000
         END <<GET RECORD>>                                             27385000
      ELSE IMAGEHUNGOVER := FALSE;                                      27390000
      IF STOPSPOOLING = 0 THEN                                          27395000
         BEGIN <<SUCCESSFUL I/O>>                                       27400000
         IF NOT CONTINUING THEN PENDACTIVE := IMAGETYPE;                27405000
         IF NOT (((PENDACTIVE = JOB) LAND ACCEPTSJOBS) LOR              27410000
                 ((PENDACTIVE = DATA) LAND ACCEPTSDATA)) THEN           27415000
            BEGIN                                              <<00291>>27420000
            CONTINUING := FALSE;                               <<00291>>27425000
            <<INDICATE TYPE OF IMAGE>>                         <<00291>>27430000
            COND:=IF EMPTYREC THEN BLANKLINE ELSE INVALID'COM; <<00291>>27435000
            END                                                <<00291>>27440000
         ELSE                                                           27445000
            IF IMAGETYPE <> MAIL THEN                                   27450000
               BEGIN <<HAVE RECORD>>                                    27455000
               IF NEEDWARN AND NOT SPOOLER THEN                <<00291>>27460000
                  BEGIN                                        <<00291>>27465000
                  STREAMERROR(-COMMANDS'IGNRD,FALSE);          <<00751>>27470000
                  NEEDWARN:=FALSE;                             <<00291>>27475000
                  END;                                         <<00291>>27480000
               @RECPP := @RECPB&LSR(1);  <<SOURCE REC PTR>>             27485000
               IF LOGICAL(RECL) THEN                                    27490000
                  BEGIN <<ODD BYTE COUNT>>                              27495000
                  RECPB(RECL) := " ";                                   27500000
                  RECL := RECL + 1;                                     27505000
                  END <<ODD BYTE COUNT>>;                               27510000
               IF NOT CONTINUING THEN                                   27515000
                  BEGIN <<SET UP FOR FIRST RECORD OF IMAGE>>            27520000
                  IF RECL = DEVICERECL&LSL(1) THEN  <<FULL RECO<<1.RAO>>27525000
                     BEGIN  <<CHECK FOR SEQNUM>>               <<1.RAO>>27530000
                     DBINARY( RECPB(RECL-8), 8);               <<1.RAO>>27535000
                     IF = THEN  <<LAST 8 ARE NUMERICS>>        <<1.RAO>>27540000
                        BEGIN   <<ASSUME SEQUENCED FILE>>      <<1.RAO>>27545000
                        EXPECTSEQNUM := TRUE;  <<SET FLAG>>    <<1.RAO>>27550000
                        RECL := RECL-8;  <<DELETE SEQ FIELD>>  <<1.RAO>>27555000
                        END;                                   <<1.RAO>>27560000
                     <<ELSE NO SEQUENCE FIELD>>                <<1.RAO>>27565000
                     END;                                      <<1.RAO>>27570000
                  COMLENGTH := 0;      <<IMAGE LENGTH>>                 27575000
                  RECL := RECL-4;      <<SKIP COMMAND>>                 27580000
                  IF IMAGETYPE = DATA THEN RECPB(4) := " ";             27585000
                  @RECPP := @RECPP+2;    <<FIRST SOURCE WORD>>          27590000
                  END <<SET UP FOR FIRST RECORD OF IMAGE>>              27595000
               ELSE                                                     27600000
                  BEGIN                                        <<1.RAO>>27605000
                  <<PROCESSING CONTINUATION RECORD>>           <<1.RAO>>27610000
                  IF EXPECTSEQNUM AND RECL>8 THEN              <<1.RAO>>27615000
                     RECL := RECL-8;  <<DELETE SEQUENCE FIELD>><<1.RAO>>27620000
                  IF RECL = 0 OR RECPB <> ":" THEN             <<1.RAO>>27625000
                     JMATERROR := NOCOLON                      <<00534>>27630000
                  ELSE                                                  27635000
                     RECPB := " ";     <<WAS ":">>                      27640000
                  END;   <<PROCESSING OF CONTINUATIONS>>       <<1.RAO>>27645000
               IF JMATERROR = 0 THEN                                    27650000
                  BEGIN <<HAVE ":" RECORD>>                             27655000
                  @COMIMAGEB := @COMIMAGE&LSL(1);                       27660000
                  MOVE COMIMAGE(COMLENGTH) :=                           27665000
                       RECPP, (RECL&LSR(1)), 2;                         27670000
                  TOS := ((TOS-1)&LSL(1))+1;<<LAST BYTE>>      <<01.01>>27675000
                  IF BPS0 = " " THEN                                    27680000
                     BEGIN <<LAST BYTE BLANK>>                          27685000
                     ASSEMBLE(DUP,DECB);  <<COMPARE AGAINST ITSELF>>    27690000
                     TOS := - RECL + 1;   <<FOR SO MANY BYTES>>         27695000
                     ASSEMBLE(CMPB ,2);   <<FIND LAST NON-BLANK>>       27700000
                     END <<LAST BYTE BLANK>>;                           27705000
        COMLENGTH := (i's0+1)&LSR(1)-@COMIMAGE;                <<04400>>27710000
                  COMLENGTHB := TOS-@COMIMAGEB;        <<BYTE LENGTH-1>>27715000
                  IF COMLENGTHB > MAXRSIZE THEN                         27720000
                     JMATERROR := COMMANDTOOLONG                        27725000
                  ELSE                                                  27730000
                     IF COMIMAGEB(COMLENGTHB) = "&" THEN                27735000
                        BEGIN <<CONTINUATION>>                          27740000
                        CONTINUING := TRUE;                             27745000
                        COMIMAGEB(COMLENGTHB) := " ";                   27750000
                        END <<CONTINUATION>>                            27755000
                     ELSE                                               27760000
                        BEGIN <<IMAGE COMPLETE>>                        27765000
                        CONTINUING := FALSE;                            27770000
                        COMIMAGEB(COMLENGTHB+1) := %15; <<CR>>          27775000
                        @JMATP := 0;                                    27780000
                        JOBNUMBER := 0;                                 27785000
                        SDCOM := IF PENDACTIVE =JOB                     27790000
                                    THEN 2 ELSE 0;                      27795000
                        ERR := 0;                              <<00534>>27800000
                        IF SPOOLER THEN                        <<00534>>27805000
                           STARTDEVICE(SDCOM,COMIMAGEB,DEVICE, <<00534>>27810000
                                    EXPECTSEQNUM,JMATP,IDDEP,, <<00534>>27815000
                                    ERR,CIPARMNUM)             <<00534>>27820000
                        ELSE                                   <<00534>>27825000
                           STARTDEVICE(SDCOM,COMIMAGEB,        <<S8949>>27830000
                               STREAMDEV,EXPECTSEQNUM,JMATP,   <<S8949>>27835000
                               IDDEP,JOBNUMBER,ERR,CIPARMNUM); <<S8949>>27840000
                        IF ERR = 0 THEN <<NO PARSE PROBLEM>>   <<00751>>27845000
                           SSTARTFILE := TRUE                  <<00751>>27850000
                        ELSE                                   <<00751>>27855000
                           BEGIN                               <<00751>>27860000
                           IF ERR < 0 THEN << WARNING >>       <<00751>>27865000
                              BEGIN  << CONTINUE SPOOLING JOB>><<00751>>27870000
                              SSTARTFILE := TRUE;              <<00751>>27875000
                              IF CIERRNUM <= 0 THEN            <<00751>>27880000
                                 CIERRNUM := ERR;              <<00751>>27885000
                              END                              <<00751>>27890000
                           ELSE << ERR IN JOB CARD >>          <<S8949>>27895000
                              BEGIN <<MSG SENT BY STARTDEVICE>><<S8949>>27900000
                              SSTARTFILE := FALSE;             <<00751>>27905000
                              CIERRNUM := ERR;                 <<00751>>27910000
                              END;                             <<00534>>27915000
                           END;                                <<00534>>27920000
                        END <<IMAGE COMPLETE>>;                         27925000
                  END <<HAVE ":" RECORD>>;                              27930000
               IF JMATERROR <> 0 THEN                                   27935000
                  BEGIN <<TOO LONG OR MISSING COLON>>                   27940000
                  STREAMERROR(JMATERROR,TRUE);                 <<00751>>27945000
                  CONTINUING := FALSE;                                  27950000
                  SSTARTFILE := FALSE;                         <<00751>>27955000
                  END <<TOO LONG OR MISSING COLON>>;                    27960000
               END <<HAVE RECORD>>;                                     27965000
         END <<SUCCESSFUL I/O>>;                                        27970000
      END <<ACCEPTING SPOOLEE>>;                                        27975000
   END <<SSTARTFILE>>;                                                  27980000
$PAGE "(INPUT) PROCEDURE: SPOOLINLOOP"                         <<02580>>27985000
PROCEDURE SPOOLINLOOP(EXPECTSEQNUM);                           <<02.RO>>27990000
VALUE EXPECTSEQNUM;                                            <<02.RO>>27995000
LOGICAL EXPECTSEQNUM;                                          <<02.RO>>28000000
OPTION UNCALLABLE,PRIVILEGED;                                           28005000
   BEGIN <<SPOOLINLOOP>>                                                28010000
   << >>                                                                28015000
   DO BEGIN <<INPUT SPOOLING LOOP>>                                     28020000
      IF NOT SGETREC(EXPECTSEQNUM) THEN                        <<02.RO>>28025000
         BEGIN <<SPOOLEE I/O ERROR>>                                    28030000
         STOPSPOOLING := SPOOLEEIOERR;                                  28035000
         << 227 SP#\/#I! deleted, spoolee I/O error >>         <<06334>>28040000
         IF SPOOLER THEN GENMSG(1,227,%11000,DEVICE,           <<0U.EB>>28045000
            DEVFILEID,,,,0)                                    <<00534>>28050000
         ELSE STREAMERROR(STRMSPLEEIOERR,FALSE);               <<00751>>28055000
         END <<SPOOLEE I/O ERROR>>                                      28060000
      ELSE                                                              28065000
         BEGIN <<NO I/O ERROR>>                                         28070000
         IF PUTIMAGE THEN                                               28075000
            BEGIN <<PUT REC TO SPOOLFILE>>                              28080000
            IF NOT SPUTBLOCK THEN                                       28085000
               BEGIN <<SPOOFLE I/O ERROR>>                              28090000
               STOPSPOOLING := SPOOFLEIOERR;                            28095000
               << 228 SP#\/#I! deleted, spoofle I/O error >>   <<06334>>28100000
               IF SPOOLER THEN GENMSG(1,228,%11000,DEVICE,     <<0U.EB>>28105000
                  DEVFILEID,,,,0)                              <<00534>>28110000
               ELSE STREAMERROR(STRMSPOOFLEIOERR,FALSE);       <<00751>>28115000
               END <<SPOOFLE I/O ERROR>>;                               28120000
            END <<PUT REC TO SPOOLFILE>>                                28125000
         END <<NO I/O ERROR>>;                                          28130000
      IF NOT SPOOLER AND IMAGETYPE = PHYSEOF THEN                       28135000
            STOPSPOOLING := NORMALSTOP;                                 28140000
      IF STOPSPOOLING = 0 THEN SCHECKREQ                                28145000
      ELSE IF STOPSPOOLING <> NORMALSTOP THEN                           28150000
            FILEREQUEST := DELETEFILE;                                  28155000
      END <<INPUT SPOOLING LOOP>>                                       28160000
   UNTIL FILEREQUEST OR DONEIMAGE OR (PENDACTIVE LAND IMAGETYPE);       28165000
   SPUTLAST;                                                            28170000
   END <<SPOOLINLOOP>>;                                                 28175000
$PAGE "(INPUT) PROCEDURE: SPOOLSTUFFIN"                        <<02580>>28180000
PROCEDURE SPOOLSTUFFIN(EXPECTSEQNUM);                          <<02.RO>>28185000
VALUE EXPECTSEQNUM;                                            <<02.RO>>28190000
LOGICAL EXPECTSEQNUM;                                          <<02.RO>>28195000
OPTION UNCALLABLE,PRIVILEGED;                                           28200000
   BEGIN <<SPOOLSTUFFIN>>                                               28205000
   INTEGER JMATINX := 0, SAVE'JMAT'SIR;                        <<S8949>>28210000
   LOGICAL ERRNUM;                                             <<FSCLS>>28215000
   LOGICAL ARRAY JMATARR(0:JMATENTRYSIZE-1);                   <<S8949>>28220000
   LOGICAL POINTER JMATPQ := @JMATP,                           <<06912>>28225000
                   XDD'SUBENTRY := @IDDEP;                     <<06912>>28230000
   DECLARE'MOVE'FROM'DATA'SEGMENT;                             <<S8949>>28235000
   DECLARE'MOVE'TO'DATA'SEGMENT;                               <<S8949>>28240000
   EXCHANGEDB(IDD'DST);                                        <<06912>>28245000
   XDDS'SPOOL'STATE := XDDS'ACTIVE;                            <<06912>>28250000
   TOS := XDDS'JOB'NUMBER;                                     <<06912>>28255000
   TOS.(0:2) := XDDS'JOB'TYPE;                                 << 9072>>28260000
   TOS := XDDS'DFID'NUMBER;                                    <<06912>>28265000
   TOS.(0:1) := XDDS'DFID'IN'OR'OUT;                           <<06912>>28270000
   EXCHANGEDB(0);                                                       28275000
   DEVFILEID := TOS;                                                    28280000
   JOBNUMBER := TOS;                                                    28285000
   SPOOLFILE := FSOPEN(,%304,%501,@XDD'SUBENTRY);              <<06912>>28290000
   IF < THEN                                                            28295000
      BEGIN <<CAN'T INITIALIZE>>                                        28300000
      STOPSPOOLING := CANNOTSINIT;                                      28305000
      FILEREQUEST := DELETEFILE;                                        28310000
      << 228 SP#\/#I! deleted, spoofle I/O error >>            <<06334>>28315000
      IF SPOOLER THEN GENMSG(1,228,%11000,DEVICE,DEVFILEID,    <<0U.EB>>28320000
         ,,,0)                                                 <<00534>>28325000
      ELSE                                                     <<FSCLS>>28330000
         BEGIN   << :STREAM, tell user.                     >> <<FSCLS>>28335000
         FCHECK (SPOOLFILE, ERRNUM);                           <<FSCLS>>28340000
         GENMSG (8, ERRNUM);                                   <<FSCLS>>28345000
         STREAMERROR (STRMSPFLEOPENERR, FALSE);                <<FSCLS>>28350000
         END;    << :STREAM, tell user.                     >> <<FSCLS>>28355000
      END <<CAN'T INITIALIZE>>                                          28360000
   ELSE                                                                 28365000
      BEGIN <<SPOOL A SPOOLFILE >>                                      28370000
      FILEREQUEST := FINISHFILE;       <<FILE NOT PREVIOUSLY ACTIVE>>   28375000
      SBASE := -1;                                                      28380000
      SCOUNT := 0;                                                      28385000
      SRFUNC := SWRITE;                                                 28390000
      SRP1   := 0;                                                      28395000
      SRP2   := 0;                                                      28400000
      SPOOLINLOOP(EXPECTSEQNUM);                               <<02.RO>>28405000
      IF IMAGETYPE = JOB OR IMAGETYPE = DATA                            28410000
         THEN IMAGEHUNGOVER := TRUE;                                    28415000
      END <<SPOOL A SPOOLFILE >>;                                       28420000
   IF FILEREQUEST = FINISHFILE THEN                                     28425000
      BEGIN <<READY SPOOLFILE>>                                         28430000
      FSCLOSE(SPOOLFILE,0,0);                                           28435000
      IF <> THEN                                               <<FSCLS>>28440000
         BEGIN   << Couldn't save file, err msg and purge.  >> <<FSCLS>>28445000
         FCHECK (SPOOLFILE, ERRNUM);                           <<FSCLS>>28450000
         GENMSG (8, ERRNUM);                                   <<FSCLS>>28455000
         STREAMERROR (STRMSPFLECLOSEERR, FALSE);               <<FSCLS>>28460000
         STOPSPOOLING := SPOOFLEIOERR;                         <<FSCLS>>28465000
         FILEREQUEST  := DELETEFILE;                           <<FSCLS>>28470000
         END     << Couldn't save file, err msg and purge.  >> <<FSCLS>>28475000
      ELSE                                                     <<FSCLS>>28480000
         BEGIN   << File closed O.K., finish processing.    >> <<FSCLS>>28485000
         SLOG(0);                                              <<FSCLS>>28490000
         IF @JMATPQ > 0 THEN   << :JOB, not :DATA           >> <<S8949>>28495000
            IF FUTURE'DATE = 0 THEN   << Schedule it now.   >> <<S8949>>28500000
               SCHEDULEJOB (JMATPQ)                            <<S8949>>28505000
            ELSE                                               <<S8949>>28510000
               BEGIN   << Schedule it for later.            >> <<S8949>>28515000
               SAVE'JMAT'SIR := GETSIR (JMATSIR);              <<S8949>>28520000
               MFDS (JMATARR, JMATDST, @JMATPQ, JMATENTRYSIZE);<<S8949>>28525000
               JMATCALENDAR := FUTURE'DATE;                    <<S8949>>28530000
               MOVE JMATTIME := FUTURE'TIME, (2);              <<S8949>>28535000
               MTDS (JMATDST, @JMATPQ, JMATARR, JMATENTRYSIZE);<<S8949>>28540000
               RELSIR (JMATSIR, SAVE'JMAT'SIR);                <<S8949>>28545000
               SCHEDULESCHED (JMATPQ);                         <<S8949>>28550000
               END;    << Schedule it for later.            >> <<S8949>>28555000
         IF NOT SPOOLER THEN STREAMJNUM;                       <<FSCLS>>28560000
         END;    << File closed O.K., finish processing.    >> <<FSCLS>>28565000
      END;   <<READY SPOOLFILE>>                               <<FSCLS>>28570000
   IF FILEREQUEST <> FINISHFILE THEN                           <<FSCLS>>28575000
      BEGIN   << Error somewhere, clean up.                 >> <<FSCLS>>28580000
      FSCLOSE(SPOOLFILE,4,0);                                           28585000
      IF @JMATPQ > 0 THEN <<JOB>>                                       28590000
         BEGIN <<DELETE JMAT ENTRY>>                                    28595000
         EXCHANGEDB(JMATDST);                                           28600000
         SAVE'JMAT'SIR := GETSIR (JMATSIR);                    <<S8949>>28605000
         DEALLOCATE'JMAT(JMATPQ);                              <<07058>>28610000
         RELSIR (JMATSIR, SAVE'JMAT'SIR);                      <<S8949>>28615000
         EXCHANGEDB(0);                                                 28620000
         END <<DELETE JMAT ENTRY>>;                                     28625000
      END;    << Error somewhere, clean up.                 >> <<FSCLS>>28630000
   SAVE'JMAT'SIR := GETSIR (JMATSIR);                          <<S8949>>28635000
   WRITEDSEG(JMATDST);                                                  28640000
   RELSIR (JMATSIR, SAVE'JMAT'SIR);                            <<S8949>>28645000
   END <<SPOOLSTUFFIN>>;                                                28650000
$PAGE "(INPUT) PROCEDURE: SPOOLINTO"                           <<02580>>28655000
PROCEDURE SPOOLINTO;                                                    28660000
OPTION UNCALLABLE,PRIVILEGED;                                           28665000
   BEGIN                                                                28670000
   INTEGER BUFSIZE;                                                     28675000
   LOGICAL EXPECTSEQNUM := FALSE;  <<FLAG FOR SSTARTFILE>>     <<1.RAO>>28680000
   LOGICAL LOGON'PROB,                                         <<00291>>28685000
           NEEDWARN,                                           <<00291>>28690000
           JOBFOUND;                                           <<00291>>28695000
   INTEGER COND;  <<REASON SSTARTFILE FAILED>>                 <<00291>>28700000
   INTEGER JITDSTN,JITJNUM,FOPTIONS;                           <<00718>>28705000
   << Note:  JITJNUMOFFSET depends on JIT format >>            <<06912>>28710000
   EQUATE JITJNUMOFFSET = 7;                                   <<06912>>28715000
   LOGICAL POINTER PCB = SYSPCBINDEX;                          <<06425>>28720000
   LOGICAL PCBPT;                                              <<06425>>28725000
                                                               <<00718>>28730000
   declare'move'from'data'segment;                             <<04400>>28735000
$PAGE                                                          <<02580>>28740000
   << >>                                                                28745000
   BUFSIZE := IF SPOOLER THEN (RSIZE+2)*INBUFS ELSE RSIZE;              28750000
   PUSH(S);                                                             28755000
   @DEVICERECP := TOS+1;                                                28760000
   @RECP := @DEVICERECP;                                                28765000
   @SBASE := @DEVICERECP(BUFSIZE);                                      28770000
   @COMIMAGE := @SBASE;                                                 28775000
   TOS := BSIZE+BUFSIZE+1;                                              28780000
   ASSEMBLE(ADDS 0);                                                    28785000
   IF SPOOLER THEN                                                      28790000
      BEGIN                                                             28795000
      X := 0;                                                           28800000
      DO DEVICERECP(X) := 0 UNTIL (X:=X+RSIZE+2)>=BUFSIZE;              28805000
      END;                                                              28810000
   READCODE := JOBREAD;                                                 28815000
   CONTINUING := FALSE;                                                 28820000
   IMAGEHUNGOVER := FALSE;                                              28825000
   IMAGETYPE := NORMAL;                                                 28830000
   STOPSPOOLING := 0;                                          <<S8949>>28835000
   NEEDWARN:=FALSE;                                            <<00291>>28840000
   JOBFOUND:=FALSE;   <<NO JOB/DATA CARD SEEN YET>>            <<00291>>28845000
   LOGON'PROB:=FALSE; <<IF TRUE THEN :JOB SEEN BUT OTHER PROB>><<00291>>28850000
   CIERRNUM := 0;                                              <<00751>>28855000
   DO BEGIN                                                             28860000
      SCHECKREQ;                                                        28865000
      IF SPOOLREQUEST = KEEPSPOOLING THEN                               28870000
         BEGIN                                                          28875000
         IF SPOOLER  THEN EXPECTSEQNUM := FALSE;  <<NEW JOB>>  <<00544>>28880000
         IF SSTARTFILE(EXPECTSEQNUM,COND,NEEDWARN) THEN        <<00291>>28885000
            BEGIN                                              <<00291>>28890000
            JOBFOUND:=TRUE;                                    <<00291>>28895000
            LOGON'PROB:=FALSE;                                 <<00291>>28900000
            SPOOLSTUFFIN(EXPECTSEQNUM);                        <<02.RO>>28905000
            END                                                <<00291>>28910000
         ELSE IF COND=VAL'COMMAND THEN                         <<00291>>28915000
            BEGIN                                              <<00291>>28920000
            JOBFOUND:=LOGON'PROB:=TRUE;                        <<00291>>28925000
            END                                                <<00291>>28930000
         ELSE IF NOT SPOOLER AND COND=INVALID'COM THEN         <<00291>>28935000
            BEGIN                                              <<00291>>28940000
            <<EITHER PROMPTING OR HAVEN'T SEEN :JOB ...>>      <<00291>>28945000
            <<AND HAVEN'T GIVEN WARNING YET            >>      <<00291>>28950000
            IF PROMPTING THEN                                  <<00534>>28955000
               STREAMERROR(-EXPECTJOB'IGNRD,FALSE)             <<00751>>28960000
            ELSE IF NOT LOGON'PROB THEN NEEDWARN:=TRUE;        <<00291>>28965000
            END;                                               <<00291>>28970000
         END                                                            28975000
      ELSE                                                              28980000
         STOPSPOOLING := NORMALSTOP;                                    28985000
      END                                                               28990000
   UNTIL STOPSPOOLING <> 0;                                             28995000
                                                               <<06425>>29000000
   PCBPT := CURPRC;                                            <<06425>>29005000
   IF SPOOLER THEN SABORTREAD                                  <<00291>>29010000
   ELSE                                                        <<06425>>29015000
   IF NOT JOBFOUND AND (NOT PROMPTING LOR (SPCBPTYPE < 2))     <<06425>>29020000
                                          << programmatic >>   <<06425>>29025000
      THEN STREAMERROR(-MISSINGJOBCOM,FALSE)                   <<06425>>29030000
   ELSE                                                        <<06425>>29035000
   IF NEEDWARN THEN STREAMERROR(-LAST'COM'IGNRD, FALSE);       <<06425>>29040000
                                                               <<00291>>29045000
<< DETERMINE IF FLUSH OF STREAM DATA IS NECESSARY >>           <<00718>>29050000
   IF (NOT SPOOLER) AND (STOPSPOOLING <> NORMALSTOP) THEN      <<00718>>29055000
      BEGIN                                                    <<00718>>29060000
      SETJIT;  << SETS TOS TO JIT DST NUMBER >>                <<00718>>29065000
      JITDSTN := TOS;                                          <<00718>>29070000
      mfds(JITJNUM,JITDSTN,JITJNUMOFFSET,1);                   <<04400>>29075000
      IF JITJNUM.(0:2) = 2 <<JOB>> THEN                        <<00718>>29080000
         BEGIN                                                 <<00718>>29085000
         << DETERMINE IF STREAM SOURCE IS $STDIN >>            <<00718>>29090000
         FGETINFO(DEVICEFILE,,FOPTIONS);                       <<00718>>29095000
         IF FOPTIONS.(10:3) = 4 <<$STDIN>> THEN                <<00718>>29100000
            << FLUSH STREAM DATA >>                            <<00718>>29105000
            DO                                                 <<00718>>29110000
               FREAD(DEVICEFILE,DEVICERECP,-DEVICERECL&ASL(1)) <<00718>>29115000
            UNTIL <>;                                          <<00718>>29120000
         END;                                                  <<00718>>29125000
      END;                                                     <<00718>>29130000
   END;                                                                 29135000
$PAGE "(INPUT) PROCEDURE: SPOOLIN"                             <<02580>>29140000
PROCEDURE SPOOLIN;                                                      29145000
OPTION UNCALLABLE,PRIVILEGED;                                  <<00721>>29150000
   BEGIN <<SPOOLIN>>                                                    29155000
   << >>                                                                29160000
   PUSH(STATUS);                                                        29165000
   TOS.(2:1) := 0;                                                      29170000
   SET(STATUS);                                                         29175000
   << 238 SP#\/spooled in >>                                   <<06334>>29180000
   GENMSG(1,238,%10000,DEVICE,,,,,0);                          <<0U.EB>>29185000
   SPOOLER := TRUE;                                                     29190000
   IF NOT SALLOC THEN                                                   29195000
      STOPSPOOLING := NONEXISTENTDEV                                    29200000
   ELSE                                                                 29205000
      BEGIN                                                             29210000
      SPOOLINTO;                                                        29215000
      END;                                                              29220000
                                                               <<04469>>29225000
  SDEALLOC(TRUE);                                              <<04469>>29230000
   END <<SPOOLIN>>;                                                     29235000
$PAGE "(OUTPUT) PROCEDURE: CIPER'POWER'FAIL"                   <<04410>>29240000
logical procedure ciper'power'fail;                            <<04410>>29245000
                                                               <<04410>>29250000
  option privileged, uncallable;                               <<04410>>29255000
                                                               <<04410>>29260000
begin                                                          <<04410>>29265000
                                                               <<04410>>29270000
  << tell operator what's happening >>                         <<04410>>29275000
                                                               <<04410>>29280000
  << 382 LDEV \ RESTART IN PROGRESS >>                         <<06334>>29285000
  genmsg(1, restart'in'progress, %10000, device,,,,,0);        <<04410>>29290000
                                                               <<04410>>29295000
  ciper'power'fail := ciper'restart'page( 0D, true );          <<04410>>29300000
                                                               <<04410>>29305000
end; << of procedure ciper'power'fail >>                       <<04410>>29310000
                                                               <<04410>>29315000
$PAGE "(OUTPUT) PROCEDURE: POWER'FAIL'RESTART"                 <<02580>>29320000
LOGICAL PROCEDURE POWER'FAIL'RESTART;                          <<01549>>29325000
OPTION PRIVILEGED, UNCALLABLE;                                 <<02580>>29330000
BEGIN                                                          <<01549>>29335000
   LOGICAL ARRAY ENV'STATUS(0:16);                             <<01549>>29340000
   LOGICAL ARRAY PAGE'STATUS(0:16);                            <<01549>>29345000
   INTEGER IO'STATUS;                                          <<01549>>29350000
   DOUBLE ARRAY D'PAGE'STATUS(*) = PAGE'STATUS;                <<01549>>29355000
   DOUBLE LAST'PAGE'PRINTED;                                   <<01549>>29360000
   INTEGER TEMP;                                               <<01549>>29365000
   DEFINE                                                      <<01549>>29370000
      RECOVER'PAGE = D'PAGE'STATUS(3)#,                        <<01549>>29375000
      RECOVER'MODE = PAGE'STATUS(11)#,                         <<01549>>29380000
           LAST'PAGE'01 = ENV'STATUS(14)#,                     <<01549>>29385000
           LAST'PAGE'02 = ENV'STATUS(15)#;                     <<01549>>29390000
                                                               <<01549>>29395000
   << *** PROCEDURE TO AUTOMATICALLY RESPOND TO ***>>          <<01549>>29400000
   << *** A POWER FAIL ON THE 2680 PAGE PRINTER ***>>          <<01549>>29405000
   << *** SEE 2680 DCS ERS FOR DETAILS OF RECOVERY*>>          <<01549>>29410000
                                                               <<01549>>29415000
   << *** READ ENVIRONMENTAL STATUS TO DETERMINE ***>>         <<01549>>29420000
   << *** LAST PAGE NUMBER ACTUALLY PRINTED      ***>>         <<01549>>29425000
  << 382 ldev \ restart in progress >>                         <<06334>>29430000
   GENMSG(1,RESTART'IN'PROGRESS,%10000,DEVICE,,,,,0);          <<01549>>29435000
   TOS := ATTACHIO( DEVICE, 0, 0, @ENV'STATUS,                 <<01885>>29440000
        READ'LAST'PHYS'PAGE,16,0, 0, 1);                       <<01885>>29445000
   DEL; <<DELETE FIRST WORD OF STATUS>>                        <<01549>>29450000
   IO'STATUS := TOS.QUAL'GEN'STATUS;                           <<04397>>29455000
   IF IO'STATUS.GENERAL'STATUS <> GEN'ST'OK THEN               <<04397>>29460000
                                                               <<01549>>29465000
IO'ERROR:                                                      <<01549>>29470000
                                                               <<01549>>29475000
   BEGIN                                                       <<01549>>29480000
      POWER'FAIL'RESTART := FALSE;                             <<01549>>29485000
      NOTIFY'OPERATOR(DEVICE, IO'STATUS);                      <<01549>>29490000
      RETURN;                                                  <<01549>>29495000
   END                                                         <<01549>>29500000
   ELSE                                                        <<01549>>29505000
   BEGIN << WE WERE ABLE TO READ ENVIRONMENT STATUS>>          <<01549>>29510000
      TOS := LAST'PAGE'01;                                     <<01549>>29515000
      TOS := LAST'PAGE'02;                                     <<01549>>29520000
      LAST'PAGE'PRINTED := TOS;                                <<01549>>29525000
      IF LAST'PAGE'PRINTED <> 0D THEN                          <<02541>>29530000
      BEGIN  << GOOD PAGE NUMBER TO RESTART FROM>>             <<01549>>29535000
               << ZERO OUT PAGE RECOVERY BLOCK AND SEND IT>>   <<01885>>29540000
               << AFTER ABORTING ALL IOQS LEFT OVER BEFORE>>   <<01549>>29545000
               << POWER-FAIL OCCURRED   >>                     <<01549>>29550000
               SABORTWRITE;                                    <<01549>>29555000
            PAGE'STATUS := 0;                                  <<01549>>29560000
            MOVE PAGE'STATUS(1) := PAGE'STATUS , (15);         <<01549>>29565000
            RECOVER'PAGE := LAST'PAGE'PRINTED + 1D;            <<02541>>29570000
            RECOVER'MODE := 0;  <<SILENT RUN FROM BEGINNING>>  <<01549>>29575000
            TOS := ATTACHIO( DEVICE, 0, 0,@PAGE'STATUS,        <<01549>>29580000
                    WRITE'PAGE'STATUS'RECOVERY, 16, 0, 0, 1);  <<01549>>29585000
            DEL;                                               <<01549>>29590000
            IO'STATUS := TOS.QUAL'GEN'STATUS;                  <<04397>>29595000
            IF IO'STATUS.GENERAL'STATUS <> GEN'ST'OK THEN      <<04397>>29600000
             GO TO IO'ERROR;                                   <<01549>>29605000
      END;                                                     <<02541>>29610000
                                                               <<01549>>29615000
            << WE HAVE SUCCESSFULLY COMPLETED THE DOWNLOAD >>  <<01549>>29620000
            << OF THE PAGE STATUS RECOVERY BLOCK >>            <<01549>>29625000
            << NEXT REWIND SPOOLFILE AND SEND DATA DOWN >>     <<01549>>29630000
                                                               <<01549>>29635000
            FCONTROL(SPOOLFILE, REWIND, TEMP);                 <<01549>>29640000
            POWER'FAIL'RESTART := TRUE;                        <<01549>>29645000
         CURR'PAGE := 0D;                                      <<02551>>29650000
         REC'LAST'PAGE := 0D;                                  <<02551>>29655000
         BLKNUM := -1D;                                        <<02551>>29660000
         IMAGETYPE := NORMAL;                                  <<02551>>29665000
         STARTED := 0;                                         <<02551>>29670000
         WRITEWAIT := TRUE; WRITEEND := 0;                     <<02551>>29675000
         <<SEND JOB FROM BEGINNING IN SILENT RUN MODE>>        <<02551>>29680000
         <<PREVIOUSLY SET BY PROCEDURE POWER'FAIL'RESTART>>    <<02551>>29685000
         CHECKOPEN;                                            <<02551>>29690000
         HEADER(ODDEP,DEVICE,DEVICETYPE,DEVICERECL);           <<02551>>29695000
         SCOUNT := 0;                                          <<02551>>29700000
         SBASE(SCOUNT) := -1; <<INITIALIZE BUFFER>>            <<02551>>29705000
   END;                                                        <<01549>>29710000
END; << PROCEDURE POWER'FAIL'RESTART>>                         <<01549>>29715000
                                                               <<01549>>29720000
                                                               <<01549>>29725000
                                                               <<01549>>29730000
$PAGE "(OUTPUT) PROCEDURE: RESTORE'ENVIR"                      <<02580>>29735000
PROCEDURE RESTORE'ENVIR(TARGETBLK,STATUS);                     <<01549>>29740000
   VALUE TARGETBLK;                                            <<01549>>29745000
   INTEGER STATUS;                                             <<01549>>29750000
   DOUBLE TARGETBLK;                                           <<01549>>29755000
   OPTION UNCALLABLE,PRIVILEGED;                               <<01549>>29760000
                                                               <<01549>>29765000
BEGIN                                                          <<01549>>29770000
                                                               <<01549>>29775000
   INTEGER LASTULAB,LASTENTRY;                                 <<01549>>29780000
   LOGICAL ARRAY NON'RECOV'STATUS(0:16);                       <<01549>>29785000
   DOUBLE ARRAY D'NON'RECOV'STATUS(*) =                        <<01549>>29790000
         NON'RECOV'STATUS;                                     <<01549>>29795000
   LOGICAL ARRAY PAGE'STATUS(0:16);                            <<01549>>29800000
   DOUBLE ARRAY D'PAGE'STATUS(*) =                             <<01549>>29805000
         PAGE'STATUS;                                          <<01549>>29810000
   INTEGER LASTULABQ, LASTQENTRY;                              <<01549>>29815000
   INTEGER POINTER PFLAB;                                      <<01549>>29820000
   DOUBLE POINTER D'PFLAB = PFLAB;                             <<01549>>29825000
   DOUBLE DELTA'PAGE;                                          <<01549>>29830000
   LOGICAL ARRAY TARGET'PAGE'STATUS(0:16);                     <<01549>>29835000
   DOUBLE ARRAY D'TARGET'PAGE'STATUS(*) =                      <<01549>>29840000
          TARGET'PAGE'STATUS;                                  <<01549>>29845000
   INTEGER TARGETULAB, TARGETENTRY, RESULT;                    <<01549>>29850000
   DOUBLE FROM'BLOCK, TO'BLOCK;                                <<01549>>29855000
   INTEGER MODE;                                               <<01549>>29860000
<<>>                                                           <<01549>>29865000
<<***  PROCEDURE RESTORE'ENVIR RESTORE ENVIRONMENT>>           <<01549>>29870000
<<***  FOR 2680 FILES BEFORE A RESTART CAN OCCUR  >>           <<01549>>29875000
                                                               <<01549>>29880000
COMMENT                                                        <<01549>>29885000
                                                               <<01549>>29890000
     1. GET TARGETBLK NUMBER (PASSED PARM)                     <<01549>>29895000
     2. GET LAST-NON-RECOVERABLE PAGE NUMBER.                  <<01549>>29900000
        IF 0 THERE EITHER IS NO ENVIRONMENT OR                 <<01549>>29905000
        IT EXISTS BEFORE THE FIRST PHYSICAL PAGE               <<01549>>29910000
        IN THE FILE.                                           <<01549>>29915000
     3. GET CIRCULAR QUEUE ENTRY FOR LAST NON-                 <<01549>>29920000
        RECOVERABLE PAGE.                                      <<01549>>29925000
     4. IF ENTRY IS NOT IN QUEUE THEN SILENT RUN               <<01549>>29930000
        TO TARGETBLK'S PAGE OR LAST NON-RECOVERABLE            <<01549>>29935000
        PAGE WHICHEVER IS SMALLER.                             <<01549>>29940000
     5. GET CIRCULAR QUEUE ENTRY FOR PAGE CONTAINING           <<01549>>29945000
        TARGETBLK .                                            <<01549>>29950000
     6. SEND TARGET'BLK'S PAGE STATUS RECOVERY  BLOCK          <<01549>>29955000
        TO BEGIN PRINTING ;                                    <<01549>>29960000
                                                               <<01549>>29965000
COMMENT                                                        <<01549>>29970000
                                                               <<01549>>29975000
     PROCEDURE RETURNS THE FOLLOWING STATUS                    <<01549>>29980000
                                                               <<01549>>29985000
       0 = WE RESTORED THE ENVIRONMENT                         <<01549>>29990000
       1 = WE RESTORED THE ENVIRONMENT AND                     <<01549>>29995000
           DID A SILENT RUN TO TARGET'BLK                      <<01549>>30000000
       2= ERROR ENCOUNTERED, ABORTED                           <<01549>>30005000
                    ;                                          <<01549>>30010000
                                                               <<01549>>30015000
                                                               <<01549>>30020000
   TARGET'PAGE'STATUS := 0;                                    <<01549>>30025000
   MOVE TARGET'PAGE'STATUS(1) := TARGET'PAGE'STATUS ,          <<01549>>30030000
                      (CQENTRYSIZE);                           <<01549>>30035000
   STATUS := 0;                                                <<01549>>30040000
   FREADLABEL(SPOOLFILE ,FLAB); <<REAL ULAB 0>>                <<01549>>30045000
   LASTULABQ := SPULAB'LASTULAB;                               <<01549>>30050000
   LASTQENTRY := SPULAB'ULABENTRY;                             <<01549>>30055000
   CURR'PAGE := SPULAB'LASTPAGD;                               <<01549>>30060000
   FREADLABEL(SPOOLFILE,FLAB,,LASTULABQ);                      <<01549>>30065000
   @PFLAB := @FLAB + LASTQENTRY*CQENTRYSIZE;                   <<01549>>30070000
   MOVE PAGE'STATUS := PFLAB, (CQENTRYSIZE);                   <<01549>>30075000
                                                               <<01549>>30080000
<<*** GET PAGE'STATUS BLOCK FOR TARGETBLK>>                    <<01549>>30085000
<<*** IF POSSIBLE, IF NOT POSSIBLE THEN>>                      <<01549>>30090000
<<*** SILENT'RUN TO TARGET'BLOCK FROM BEGINNING>>              <<01549>>30095000
<<*** IF TARGET BLOCK IS < CURR'BLOCK>>                        <<01549>>30100000
                                                               <<01549>>30105000
<<*** IF NEXT PAGE STATUS RECOVER BLOCK = 0>>                  <<01549>>30110000
<<*** OR THIS IS THE LAST USER LABEL IN CIRCULAR QUEUE>>       <<01549>>30115000
<<*** THEN CONTINUE NORMALLY , OTHERWISE IF TARGETBLK>>        <<01549>>30120000
<<*** < CURR'BLK THEN SILENT RUN TO TARGETBLK (STATUS=1)>>     <<01549>>30125000
                                                               <<01549>>30130000
    IF TARGETBLK > D'PAGE'STATUS(PG'STAT'BLK) THEN             <<01549>>30135000
       GO TO RECOVER'ENV;                                      <<01549>>30140000
    FREADLABEL(SPOOLFILE,FLAB,,TARGETULAB+1);                  <<01549>>30145000
    IF = THEN                                                  <<01549>>30150000
    BEGIN  <<FIND OUT IF TARGETBLK IS IN CIRCULAR QUEUE>>      <<01549>>30155000
       @PFLAB := @FLAB;                                        <<01549>>30160000
       IF TARGETBLK > D'PFLAB THEN                             <<01549>>30165000
          GO TO RECOVER'ENV                                    <<01549>>30170000
       ELSE                                                    <<01549>>30175000
          GO TO SILENT'RUN'MODE;                               <<01549>>30180000
    END                                                        <<01549>>30185000
    ELSE                                                       <<01549>>30190000
   GO TO RECOVER'ENV;                                          <<01549>>30195000
                                                               <<01549>>30200000
SILENT'RUN'MODE:                                               <<01549>>30205000
                                                               <<01549>>30210000
    BEGIN  <<SILENT RUN TO TARGET'BLK>>                        <<01549>>30215000
       STATUS := 1;                                            <<01549>>30220000
       TARGET'PAGE'STATUS(PG'STAT'SP) := RESTART;              <<01549>>30225000
       D'TARGET'PAGE'STATUS(PG'RECOVER'PAGENUM) :=             <<01549>>30230000
         D'PAGE'STATUS(PG'STAT'PAGENUM);                       <<01549>>30235000
       FROM'BLOCK := 0D;                                       <<01549>>30240000
       TO'BLOCK := TARGETBLK;                                  <<01549>>30245000
       MODE := 0;  <<SILENT RUN FROM BEGINNING TO TARGETBLK>>  <<01549>>30250000
       GO TO EXEC'SILENT'RUN;                                  <<01549>>30255000
    END;                                                       <<01549>>30260000
                                                               <<01549>>30265000
RECOVER'ENV:                                                   <<01549>>30270000
                                                               <<01549>>30275000
    IF D'PAGE'STATUS(PG'STAT'NON'RECOVER'PG) = 0D THEN         <<01549>>30280000
    BEGIN <<SILENT RUN TO FIRST PAGE>>                         <<01549>>30285000
       TARGET'PAGE'STATUS(PG'STAT'SP) := RESTART;              <<01549>>30290000
       D'TARGET'PAGE'STATUS(PG'RECOVER'PAGENUM) :=             <<01549>>30295000
             5D; <<GO FORWARD TO FIFTH PAGE BUT>>              <<01549>>30300000
        MODE := 1;<<REALLY STOP AT FIRST PAGE>>                <<01549>>30305000
        FROM'BLOCK := 0D;                                      <<01549>>30310000
        TO'BLOCK := 0D;                                        <<01549>>30315000
        GO TO EXEC'SILENT'RUN;                                 <<01549>>30320000
     END                                                       <<01549>>30325000
     ELSE                                                      <<01549>>30330000
     BEGIN  <<SILENT RUN TO LAST'NON'RECOVERABLE PAGE>>        <<01549>>30335000
        TARGET'PAGE'STATUS(PG'STAT'SP) := RESTART;             <<01549>>30340000
        D'TARGET'PAGE'STATUS(PG'RECOVER'PAGENUM) :=            <<01549>>30345000
            D'PAGE'STATUS(PG'STAT'NON'RECOVER'PG);             <<01549>>30350000
        FROM'BLOCK := 0D;                                      <<01549>>30355000
        TO'BLOCK := TARGETBLK;                                 <<01549>>30360000
        MODE := 2; <<FROM'BLOCK TO RECOVERY BLOCK>>            <<01549>>30365000
     END;                                                      <<01549>>30370000
                                                               <<01549>>30375000
EXEC'SILENT'RUN:                                               <<01549>>30380000
                                                               <<01549>>30385000
     UPDATE'CKPT'FLAG := FALSE;                                <<01549>>30390000
     SILENT'RUN(FROM'BLOCK, TARGET'PAGE'STATUS,TO'BLOCK,       <<01549>>30395000
           MODE,RESULT);                                       <<01549>>30400000
     IF RESULT <> 0 THEN STATUS := 2;  <<BAD NEWS>>            <<01549>>30405000
END;  <<RESTORE'ENVIR>>                                        <<01549>>30410000
                                                               <<01549>>30415000
                                                               <<01549>>30420000
$PAGE "(OUTPUT) PROCEDURE: SILENT'RUN"                         <<02581>>30425000
PROCEDURE SILENT'RUN(FROM'BLOCK,RECOVER'STATUS'BLOCK,          <<01549>>30430000
        TO'BLOCK, MODE, RESULT);                               <<01549>>30435000
   VALUE FROM'BLOCK,TO'BLOCK,MODE;                             <<01549>>30440000
   DOUBLE FROM'BLOCK, TO'BLOCK;                                <<01549>>30445000
   INTEGER MODE, RESULT;                                       <<01549>>30450000
   LOGICAL ARRAY RECOVER'STATUS'BLOCK;                         <<01549>>30455000
   OPTION PRIVILEGED,UNCALLABLE;                               <<01549>>30460000
                                                               <<01549>>30465000
   BEGIN                                                       <<01549>>30470000
   <<>>                                                        <<01549>>30475000
                                                               <<01549>>30480000
   <<***  MODE DEFINES THE OPERATION OF SILENT'RUN>>           <<01549>>30485000
   <<***  SILENT RUN IN GENERAL IS A METHOD OF >>              <<01549>>30490000
   <<***  RESTARTING 2680 BY SENDING DATA AND CONTROL>>        <<01549>>30495000
   <<***  INCLUDING ENVIRONMENTS EMBEDDED IN THE DATA>>        <<01549>>30500000
   <<***  AND COMMANDING THE PRINTER TO START PRINTING>>       <<01549>>30505000
   <<***  AFTER A CERTAIN POINT IN THE DATA      >>            <<01549>>30510000
                                                               <<01549>>30515000
   <<***     THE VALUES OF MODE ARE:             >>            <<01549>>30520000
   <<          0 = RUN FROM FROM'BLOCK TO TO'BLOCK>>           <<01549>>30525000
   <<          1 = RUN TO FIRST PHYSICAL PAGE    >>            <<01549>>30530000
   <<          2 = RUN FROM FROM'BLOCK TO RECOVERY>>           <<01549>>30535000
   <<                    PAGE SUPPLIED IN                      <<01549>>30540000
   <<                  RECOVER'STATUS'BLOCK      >>            <<01549>>30545000
                                                               <<01549>>30550000
   <<    RESULT IS RETRURNED  >>                               <<01549>>30555000
   <<       0 = SUCCESSFUL    >>                               <<01549>>30560000
   <<       RESULT = GENMSG ERRNUMBER OTHERWISE >>             <<01549>>30565000
                                                               <<01549>>30570000
                                                               <<01549>>30575000
   DOUBLE COUNT;                                               <<01549>>30580000
   INTEGER IO'STATUS, TEMP;                                    <<01549>>30585000
   LOGICAL CONTINUE;                                           <<01549>>30590000
                                                               <<01549>>30595000
   DOUBLE ARRAY D'RECOVER'STATUS'BLOCK(*) =                    <<01549>>30600000
          RECOVER'STATUS'BLOCK;                                <<01549>>30605000
                                                               <<01549>>30610000
$PAGE"(OUTPUT) PROCEDURE: SILENT'RUN;  SUBROUTINE: READ'BLOCKS"<<02580>>30615000
   LOGICAL SUBROUTINE READ'BLOCKS;                             <<01549>>30620000
                                                               <<01549>>30625000
      BEGIN                                                    <<01549>>30630000
                                                               <<01549>>30635000
        READ'BLOCKS := TRUE;  <<INIT>>                         <<01549>>30640000
        IF NOT DONEIMAGE AND FILEREQUEST=FINISHFILE THEN       <<01549>>30645000
        BEGIN                                                  <<01549>>30650000
           IF NOT SGETBLOCK THEN                               <<01549>>30655000
           IF IMAGETYPE <> PHYSEOF THEN                        <<01549>>30660000
           BEGIN                                               <<01549>>30665000
              FILEREQUEST := DEFERFILE;                        <<01549>>30670000
              << 230 SP#\/#O! deferred, spoofle I/O error >>   <<06334>>30675000
              GENMSG(1,230, %11000, DEVICE, DEVFILEID,,,,0);   <<01549>>30680000
           END;                                                <<01549>>30685000
           IF IMAGETYPE <> NORMAL THEN READ'BLOCKS := FALSE;   <<01549>>30690000
        END                                                    <<01549>>30695000
        ELSE                                                   <<01549>>30700000
          READ'BLOCKS := FALSE;                                <<01549>>30705000
      END; <<SUBROUTINE READ'BLOCKS>>                          <<01549>>30710000
                                                               <<01549>>30715000
$PAGE &                                                        <<02580>>30720000
$ "(OUTPUT) PROCEDURE: SILENT'RUN;  SUBROUTINE: WRITE'BLOCKS"  <<02580>>30725000
   LOGICAL SUBROUTINE WRITE'BLOCKS;                            <<01549>>30730000
      BEGIN                                                    <<01549>>30735000
         WRITE'BLOCKS := TRUE;                                 <<01549>>30740000
         IF NOT SPUTBLOCKOUT THEN                              <<01549>>30745000
         BEGIN                                                 <<01549>>30750000
            IF IMAGETYPE <> PHYSEOF THEN                       <<01549>>30755000
               STOPSPOOLING := SPOOLEEIOERR;                   <<01549>>30760000
               FILEREQUEST := RELINKFILE;                      <<01549>>30765000
               WRITE'BLOCKS := FALSE;                          <<01549>>30770000
         END;                                                  <<01549>>30775000
         SCHECKREQ;                                            <<01549>>30780000
      END; <<SUBROUTINE WRITE'BLOCKS>>                         <<01549>>30785000
                                                               <<01549>>30790000
$PAGE "(OUTPUT) PROCEDURE: SILENT'RUN"                         <<02580>>30795000
                                                               <<01549>>30800000
   <<INITIALIZE>>                                              <<01549>>30805000
   RESULT := 0;                                                <<01549>>30810000
   BLKNUM := FROM'BLOCK - 1D;                                  <<01549>>30815000
   CURR'PAGE := D'RECOVER'STATUS'BLOCK(PG'STAT'PAGENUM);       <<01549>>30820000
   << SEND RECOVERY BLOCK>>                                    <<01549>>30825000
   TOS := ATTACHIO(DEVICE,0,0,@RECOVER'STATUS'BLOCK,           <<01549>>30830000
          WRITE'PAGE'STATUS'RECOVERY, CQENTRYSIZE,             <<01549>>30835000
            0,0,1);                                            <<01549>>30840000
   DEL;                                                        <<01549>>30845000
   IO'STATUS := TOS.QUAL'GEN'STATUS;                           <<04397>>30850000
   IF IO'STATUS.GENERAL'STATUS <> GEN'ST'OK THEN               <<04397>>30855000
   BEGIN                                                       <<01549>>30860000
                                                               <<01549>>30865000
IOERR':                                                        <<01549>>30870000
                                                               <<01549>>30875000
      RESULT := 1;                                             <<01549>>30880000
      NOTIFY'OPERATOR(DEVICE, IO'STATUS);                      <<01549>>30885000
      RETURN;                                                  <<01549>>30890000
   END                                                         <<01549>>30895000
   ELSE                                                        <<01549>>30900000
   BEGIN <<READ FROM'BLOCK>>                                   <<01549>>30905000
      IF FROM'BLOCK = 0D THEN                                  <<01549>>30910000
        FCONTROL(SPOOLFILE, REWIND, TEMP)                      <<01549>>30915000
      ELSE                                                     <<01549>>30920000
         FREADDIR(SPOOLFILE, SBASE, 512, FROM'BLOCK-1D);       <<01549>>30925000
      CONTINUE := TRUE;                                        <<01549>>30930000
                                                               <<01549>>30935000
      <<INITIALIZE FOR MODE>>                                  <<01549>>30940000
                                                               <<01549>>30945000
      CASE MODE OF                                             <<01549>>30950000
      BEGIN                                                    <<01549>>30955000
         BEGIN << MODE 0>>                                     <<01549>>30960000
            COUNT := FROM'BLOCK;                               <<01549>>30965000
            IF TO'BLOCK - FROM'BLOCK < DOUBLE(BLOCKS) THEN     <<01549>>30970000
              SINGLE'BLOCK'MODE := TRUE;                       <<01549>>30975000
         END;                                                  <<01549>>30980000
                                                               <<01549>>30985000
               <<MODE 1>>                                      <<01549>>30990000
            SINGLE'BLOCK'MODE := TRUE;                         <<01549>>30995000
                                                               <<01549>>31000000
               <<MODE 2 >>                                     <<01549>>31005000
            COUNT := D'RECOVER'STATUS'BLOCK(PG'STAT'PAGENUM);  <<01549>>31010000
                                                               <<01549>>31015000
            CURR'PAGE := COUNT;                                <<01549>>31020000
      END; <<CASE>>                                            <<01549>>31025000
                                                               <<01549>>31030000
      DO                                                       <<01549>>31035000
      BEGIN                                                    <<01549>>31040000
        IF NOT READ'BLOCKS THEN                                <<01549>>31045000
        BEGIN                                                  <<01549>>31050000
           RESULT := RESTART'FAILED;                           <<01549>>31055000
           GO TO EXIT;                                         <<01549>>31060000
        END;                                                   <<01549>>31065000
        IF MODE = 0 THEN                                       <<01549>>31070000
        BEGIN   <<MODE = 0>>                                   <<01549>>31075000
           COUNT := COUNT + DOUBLE(RECL/BSIZE);                <<01549>>31080000
           IF COUNT + DOUBLE(RECL/BSIZE) > TO'BLOCK            <<01549>>31085000
             THEN <<SET SINGLE'BLOCK'MODE>>                    <<01549>>31090000
               SINGLE'BLOCK'MODE := TRUE;                      <<01549>>31095000
           IF COUNT >= TO'BLOCK-1D THEN CONTINUE := FALSE;     <<01549>>31100000
        END;                                                   <<01549>>31105000
                                                               <<01549>>31110000
        IF NOT WRITE'BLOCKS THEN                               <<01549>>31115000
        BEGIN                                                  <<01549>>31120000
           RESULT := RESTART'FAILED;                           <<01549>>31125000
           GO TO EXIT;                                         <<01549>>31130000
        END;                                                   <<01549>>31135000
                                                               <<01549>>31140000
        CASE MODE OF                                           <<01549>>31145000
        BEGIN                                                  <<01549>>31150000
            ;  <<MODE 0>>                                      <<01549>>31155000
           BEGIN  <<MODE 1>>                                   <<01549>>31160000
              IF  CURR'PAGE >= 1D THEN                         <<01549>>31165000
                CONTINUE := FALSE;                             <<01549>>31170000
           END;                                                <<01549>>31175000
           BEGIN  <<MODE 2>>                                   <<01549>>31180000
                 COUNT := CURR'PAGE;                           <<01549>>31185000
                 IF COUNT >= D'RECOVER'STATUS'BLOCK(           <<01549>>31190000
                    PG'RECOVER'PAGENUM) THEN                   <<01549>>31195000
                     CONTINUE := FALSE;                        <<01549>>31200000
           END;                                                <<01549>>31205000
        END;<< CASE>>                                          <<01549>>31210000
       END <<DO LOOP>>                                         <<01549>>31215000
       UNTIL NOT CONTINUE;                                     <<01549>>31220000
   END;                                                        <<01549>>31225000
EXIT:                                                          <<01549>>31230000
                                                               <<01549>>31235000
     SINGLE'BLOCK'MODE := FALSE;                               <<01549>>31240000
END; <<SILENT'RUN>>                                            <<01549>>31245000
                                                               <<01549>>31250000
$PAGE "(OUTPUT) PROCEDURE: RESTART'PAGE'2680"                  <<02580>>31255000
   PROCEDURE RESTART'PAGE'2680(PAGECNT,BACKWARDS,PAGE'BLOCK);  <<01549>>31260000
   VALUE PAGECNT,BACKWARDS;                                    <<01549>>31265000
                                                               <<01549>>31270000
                                                               <<01549>>31275000
   LOGICAL PAGECNT, BACKWARDS;                                 <<01549>>31280000
   LOGICAL ARRAY PAGE'BLOCK;                                   <<01549>>31285000
   OPTION PRIVILEGED, UNCALLABLE;                              <<01549>>31290000
                                                               <<01549>>31295000
   BEGIN                                                       <<01549>>31300000
                                                               <<01549>>31305000
   <<>>                                                        <<01549>>31310000
                                                               <<01549>>31315000
   LOGICAL ARRAY ENV'STATUS'BLOCK(0:16);                       <<01885>>31320000
   DOUBLE ARRAY D'ENV'STATUS'BLOCK(*) =                        <<01885>>31325000
               ENV'STATUS'BLOCK;                               <<01885>>31330000
   LOGICAL ARRAY PAGE'STATUS'BLOCK(0:16);                      <<01549>>31335000
   DOUBLE ARRAY D'PAGE'STATUS'BLOCK(*) =                       <<01549>>31340000
       PAGE'STATUS'BLOCK;                                      <<01549>>31345000
   LOGICAL ARRAY RESTART'BLOCK(0:16);                          <<01549>>31350000
   DOUBLE ARRAY D'RESTART'BLOCK(*) =                           <<01549>>31355000
        RESTART'BLOCK;                                         <<01549>>31360000
   INTEGER STATUS;                                             <<01549>>31365000
   INTEGER IO'STATUS;                                          <<01549>>31370000
                                                               <<01549>>31375000
   <<>>                                                        <<01549>>31380000
                                                               <<01549>>31385000
<<DO A DEVICE CLOSE BEFORE RESTART ATTEMPT>>                   <<02541>>31390000
RECP(1) := 0;                                                  <<02541>>31395000
RECL := 0;                                                     <<02541>>31400000
WRITEEND := FALSE;                                             <<02541>>31405000
WRITEWAIT := TRUE;                                             <<02541>>31410000
SRFUNC := (SFINI - 1);                                         <<02541>>31415000
SDWRITE(SRFUNC, BLOCKMODE, WRITEEND, WRITEWAIT, IMAGETYPE);    <<04397>>31420000
   GO TO BUILD'RECOVERY;                                       <<01885>>31425000
   TOS := ATTACHIO(DEVICE, 0, 0, @ENV'STATUS'BLOCK,            <<01885>>31430000
         READ'ENVIR'STATUS, 16, 0, 0, 1);                      <<01885>>31435000
   DEL;                                                        <<01885>>31440000
   IO'STATUS := TOS.QUAL'GEN'STATUS;                           <<04397>>31445000
   IF IO'STATUS.GENERAL'STATUS <> GEN'ST'OK THEN               <<04397>>31450000
ERR'RESTART:                                                   <<01885>>31455000
   BEGIN  <<UNUSUAL COMPLETION>>                               <<01885>>31460000
      IF IO'STATUS <> %13 THEN                                 <<01885>>31465000
      BEGIN <<IO'ERROR STOP SPOOLING>>                         <<01885>>31470000
         NOTIFY'OPERATOR(DEVICE, IO'STATUS);                   <<01885>>31475000
         GO TO LX;                                             <<01885>>31480000
      END;                                                     <<01885>>31485000
      NOTIFY'USER(DEVICE);                                     <<01885>>31490000
   END;                                                        <<01885>>31495000
                                                               <<01885>>31500000
BUILD'RECOVERY:                                                <<01885>>31505000
      <<BUILD RECOVER BLOCK AND RESTART>>                      <<01549>>31510000
                                                               <<01549>>31515000
      D'RESTART'BLOCK(PG'RECOVER'PAGENUM) :=                   <<01549>>31520000
         CURR'PAGE  +                                          <<01885>>31525000
         (IF BACKWARDS THEN -DOUBLE(PAGECNT) ELSE              <<02527>>31530000
            DOUBLE(PAGECNT));                                  <<01885>>31535000
         IF D'RESTART'BLOCK(PG'RECOVER'PAGENUM) < 0D THEN      <<01885>>31540000
            BEGIN <<ATTEMPT TO START BEFORE BEGINNING OF FILE>><<02527>>31545000
ERR263:                                                        <<02527>>31550000
<< 263 Ldev#\ restart pagecount pointed before start of file >><<06334>>31555000
               GENMSG(1,263,%10000,DEVICE,,,,,0);              <<02527>>31560000
               CURR'PAGE := 0D;                                <<02527>>31565000
                    CHECKOPEN;                                 <<02541>>31570000
               GO TO LX;                                       <<02527>>31575000
            END;                                               <<02527>>31580000
      RESTART'BLOCK(PG'STAT'SP) :=                             <<01549>>31585000
         IF BACKWARDS THEN RECOVER ELSE                        <<01549>>31590000
           SKIP'PHYS'PAGES;                                    <<01549>>31595000
         <<SEND RECOVERY BLOCK>>                               <<01549>>31600000
                                                               <<01549>>31605000
         TOS := ATTACHIO(DEVICE,0,0,@RESTART'BLOCK,            <<01549>>31610000
            WRITE'PAGE'STATUS'RECOVERY, CQENTRYSIZE,0,0,1);    <<01549>>31615000
         DEL;                                                  <<01549>>31620000
         IO'STATUS := TOS.QUAL'GEN'STATUS;                     <<04397>>31625000
         IF IO'STATUS.GENERAL'STATUS <> GEN'ST'OK THEN         <<04397>>31630000
          GO TO ERR'RESTART;                                   <<01549>>31635000
                                                               <<01885>>31640000
         CHECKOPEN;                                            <<01885>>31645000
         HEADER(ODDEP, DEVICE, DEVICETYPE, DEVICERECL);        <<01885>>31650000
LX:                                                            <<01885>>31655000
   END; <<RESTART'PAGE'2680>>                                  <<01549>>31660000
                                                               <<01549>>31665000
$PAGE "(OUTPUT) PROCEDURE: REPORT'ENV"                         <<02580>>31670000
   PROCEDURE REPORT'ENV(ENV'STATUS);                           <<01885>>31675000
      LOGICAL ARRAY ENV'STATUS;                                <<01885>>31680000
      OPTION UNCALLABLE,PRIVILEGED;                            <<01885>>31685000
                                                               <<01885>>31690000
   BEGIN                                                       <<01885>>31695000
                                                               <<01885>>31700000
      DEFINE                                                   <<01885>>31705000
             DATA'BLOCKS               =  0).(8:8 #,           <<01885>>31710000
             BUCKETS'AVAIL             =  1       #,           <<01885>>31715000
             BUCKETS'USED              =  2       #,           <<01885>>31720000
             MEMORY                    =  3).(0:4 #,           <<01885>>31725000
                                                               <<01885>>31730000
             VFCS                      =  3).(4:6 #,           <<01885>>31735000
             FORMS                     =  3).(10:6#,           <<01885>>31740000
             CHARS                     =  4).(10:6#,           <<01885>>31745000
             LOG'PAGES                 =  4).(4:6 #,           <<01885>>31750000
                                                               <<01885>>31755000
             CHAR'WORDS                =  5       #,           <<01885>>31760000
             FORM'WORDS                =  6       #,           <<01885>>31765000
             VFC'WORDS                 =  7       #,           <<01885>>31770000
                                                               <<01885>>31775000
             PAGE'LENGTH               =  8).(0:8 #,           <<01885>>31780000
             PAGE'WIDTH                =  8).(8:8 #,           <<01885>>31785000
                                                               <<01885>>31790000
             PICTURES                  =  9).(0:6 #,           <<04140>>31795000
             MODEL                     =  9).(9:3 #,           <<04140>>31800000
             PICT'CLIPPED              =  9).(12:1 #,          <<04140>>31805000
             EOJ'IN'SILENT'RUN         =  9).(13:1#,           <<02527>>31810000
             FORMS'REGIS'ERROR         =  9).(14:1#,           <<01885>>31815000
             DATA'TRUNC                =  9).(15:1#,           <<01885>>31820000
             CHARS'CLIPPED             = 12       #,           <<01885>>31825000
                                                               <<01885>>31830000
             TOTAL'USER'MEM            = 10       #,           <<01885>>31835000
             DATE'CODE                 = 11       #,           <<01885>>31840000
                                                               <<01885>>31845000
             PICTURE'WORDS             = 13 #,                 <<04140>>31850000
             PHYS'PAGES01              = 14       #,           <<01885>>31855000
             PHYS'PAGES02              = 15       #;           <<01885>>31860000
                                                               <<01885>>31865000
   EQUATE                                                      <<01885>>31870000
             DAYFILE'MSG'SET           = 25,                   <<04140>>31875000
             BLANK                     = 90,                   <<04140>>31880000
             ENV'TITLE                 = 91,                   <<04140>>31885000
             MEMORY'STAT               = 92,                   <<04140>>31890000
             ENV'TYPES                 = 93,                   <<04140>>31895000
             ENV'WORDS                 = 94,                   <<04140>>31900000
             PAGE'LEN                  = 95,                   <<04140>>31905000
             ERR'TYPES                 = 96,                   <<04140>>31910000
             DATEINFO                  = 97,                   <<04140>>31915000
             PAGES'PRINTED             = 98,                   <<04140>>31920000
             PAGE'WDTH                 = 99;                   <<04140>>31925000
                                                               <<01885>>31930000
   DOUBLE D'CHAR, D'FORM, D'VFC, TOT'MEMORY;                   <<01885>>31935000
   DOUBLE D'CHARS'CLIPPED, D'PICT;                             <<04140>>31940000
                                                               <<04140>>31945000
   DOUBLE MULTIPLIER;     << TO CONVERT WORD COUNTS >>         <<04140>>31950000
                                                               <<04140>>31955000
   EQUATE   MULT'4'MODEL = 0;                                  <<04140>>31960000
                                                               <<04140>>31965000
                                                               <<01885>>31970000
   INTEGER IO'STATUS;                                          <<01885>>31975000
   INTEGER ARRAY PB'YES(0:2)=PB:=                              <<02581>>31980000
                   "YE",[8/"S",8/0],0;                         <<02581>>31985000
   INTEGER ARRAY PB'NO(0:1)=PB:=                               <<02581>>31990000
                   "NO",0;                                     <<02581>>31995000
   INTEGER ARRAY WYES(0:2);                                    <<02581>>32000000
   INTEGER ARRAY WNO(0:1);                                     <<02581>>32005000
   BYTE ARRAY YES(*)=WYES;                                     <<02581>>32010000
   BYTE ARRAY NO(*)=WNO;                                       <<02581>>32015000
   INTEGER NUMBER, FRACTION;                                   <<02541>>32020000
   REAL RNUM;                                                  <<02541>>32025000
   INTEGER B, B1, C, C1;                                       <<02541>>32030000
                                                               <<01885>>32035000
   <<>>                                                        <<01885>>32040000
$PAGE &                                                        <<02580>>32045000
$  "(OUTPUT) PROCEDURE: REPORT'ENV;  SUBROUTINE: CONVERT'REAL" <<02580>>32050000
   SUBROUTINE CONVERT'REAL(NUM);                               <<02541>>32055000
      VALUE NUM;                                               <<02541>>32060000
      REAL NUM;                                                <<02541>>32065000
                                                               <<02541>>32070000
   COMMENT - THIS PROCEDURE CONVERTS A REAL NUMBER INTO TWO    <<02541>>32075000
             INTEGER VALUES SO THEY MAY BE TRANSMITTED IN A    <<02541>>32080000
             PRINT OR GENMSG STATEMENT.;                       <<02541>>32085000
                                                               <<02541>>32090000
   BEGIN                                                       <<02541>>32095000
                                                               <<02541>>32100000
      NUMBER := INTEGER(FIXT(NUM));                            <<02541>>32105000
      FRACTION := INTEGER(FIXR((NUM - REAL(NUMBER))*100.0));   <<02580>>32110000
      <<FRACTION = REAL FRACTION FOR 2 PLACE ACCURACY>>        <<02541>>32115000
   END;  <<CONVERT'REAL>>                                      <<02541>>32120000
                                                               <<02541>>32125000
<<>>                                                           <<02541>>32130000
                                                               <<02541>>32135000
$PAGE "(OUTPUT) PROCEDURE: REPORT'ENV"                         <<02580>>32140000
READ'STATUS'ENTRY:                                             <<01885>>32145000
   TOS := ATTACHIO(DEVICE, 0, 0, @ENV'STATUS,                  <<01885>>32150000
         READ'ENVIR'STATUS, 16, 0, 0, 1);                      <<01885>>32155000
   DEL;                                                        <<01885>>32160000
   IO'STATUS := TOS.QUAL'GEN'STATUS;                           <<04397>>32165000
   IF IO'STATUS.GENERAL'STATUS <> GEN'ST'OK THEN               <<04397>>32170000
   BEGIN  <<UNUSUAL COMPLETION>>                               <<01885>>32175000
      IF IO'STATUS <> %13 AND IO'STATUS <> %23 THEN            <<02504>>32180000
      BEGIN <<IO'ERROR STOP SPOOLING>>                         <<01885>>32185000
         NOTIFY'OPERATOR(DEVICE, IO'STATUS);                   <<01885>>32190000
         IMAGETYPE := IOERR;                                   <<02504>>32195000
      END;                                                     <<01885>>32200000
         SABORTWRITE;                                          <<02504>>32205000
                                                               <<02504>>32210000
      SRFUNC := IMMEDIATE'CLEAR;                               <<02504>>32215000
      WRITEEND := FALSE;                                       <<02504>>32220000
      WRITEWAIT := TRUE;                                       <<02504>>32225000
      SDWRITE(SRFUNC, BLOCKMODE, WRITEEND, WRITEWAIT,          <<04397>>32230000
              IMAGETYPE);                                      <<04397>>32235000
   END;                                                        <<01885>>32240000
                                                               <<01885>>32245000
   << PARSE ENVIRONMENTAL STATUS BLOCK >>                      <<01885>>32250000
                                                               <<01885>>32255000
      TOS := ENV'STATUS(PHYS'PAGES01);                         <<01885>>32260000
      TOS := ENV'STATUS(PHYS'PAGES02);                         <<01885>>32265000
      CURR'PAGE  := TOS;                                       <<01885>>32270000
                                                               <<04398>>32275000
      <<Below are variables used in system logging          >> <<04398>>32280000
                                                               <<04398>>32285000
      PHYSICAL'PAGES := CURR'PAGE;                             <<04398>>32290000
      LOGICAL'PAGES  := ENV'STATUS(LOG'PAGES);                 <<04398>>32295000
                                                               <<04398>>32300000
      IF ENV'STATUS(EOJ'IN'SILENT'RUN) THEN                    <<02527>>32305000
      BEGIN  <<WE TRIED TO RESTART THE JOB BY SILENT>>         <<02527>>32310000
             <<RUNNING BUT WE WENT PAST EOF>>                  <<02527>>32315000
ERR260:                                                        <<02527>>32320000
<< 260 Ldev#\restart of file#O! went past eof; file deferred >><<06334>>32325000
        GENMSG(1,260,%11000,DEVICE,DEVFILEID,,,,0);            <<02527>>32330000
        SET'DISPOSITION; <<DEFER,INCOMPLETE>>                  <<02527>>32335000
        SPOOLREQUEST := WAITSPOOLING;                          <<02527>>32340000
        UPDATE'CKPT'FLAG := FALSE;                             <<02527>>32345000
      END;                                                     <<02527>>32350000
      @BLOCKCP := @BLOCKTABLE;                                 <<01885>>32355000
      UPDATE'CHECKPOINT;                                       <<01885>>32360000
                                                               <<01885>>32365000
   IF ENV'STATUS(CHARS'CLIPPED) <> 0 OR                        <<01885>>32370000
        ENV'STATUS(FORMS'REGIS'ERROR) <> 0 OR                  <<01885>>32375000
        ENV'STATUS(DATA'TRUNC) <> 0 OR                                  32380000
        ENV'STATUS(PICT'CLIPPED) <> 0 OR                       <<04140>>32385000
        JOB'HAS'ERRORS THEN                                    <<02512>>32390000
   BEGIN  <<REPORT ERRORS>>                                    <<01885>>32395000
      JOB'HAS'ERRORS := TRUE;                                  <<02512>>32400000
      IF DAYFILE = 0 THEN                                      <<01885>>32405000
         OPEN'ERRFILE(DEVICE);                                 <<02595>>32410000
      IF DAYFILE = 2 <<DAYFILE IS CONSOLE>>                    <<02504>>32415000
      THEN GO TO LX; <<BYPASS PRINTING OF ERRORS TO CONSOLE>>  <<02504>>32420000
      GENMSG(DAYFILE'MSG'SET,BLANK,,,,,,,-DAYFILE);            <<01885>>32425000
      GENMSG(DAYFILE'MSG'SET,ENV'TITLE,,,,,,,-DAYFILE);        <<01885>>32430000
      GENMSG(DAYFILE'MSG'SET,BLANK,,,,,,,-DAYFILE);            <<01885>>32435000
      GENMSG(DAYFILE'MSG'SET,MEMORY'STAT, %11110,              <<01885>>32440000
         ENV'STATUS(DATA'BLOCKS), ENV'STATUS(BUCKETS'AVAIL),   <<01885>>32445000
         ENV'STATUS(BUCKETS'USED), (ENV'STATUS(MEMORY)+1)*128, <<01885>>32450000
         ,-DAYFILE);                                           <<01885>>32455000
      GENMSG(DAYFILE'MSG'SET,ENV'TYPES, %11111,                <<04140>>32460000
         ENV'STATUS(VFCS), ENV'STATUS(FORMS),                  <<01885>>32465000
         ENV'STATUS(CHARS), ENV'STATUS(LOG'PAGES),             <<01885>>32470000
         ENV'STATUS(PICTURES), -DAYFILE);                      <<04140>>32475000
      IF ENV'STATUS(MODEL) = MULT'4'MODEL                      <<04140>>32480000
         THEN MULTIPLIER := 4D                                 <<04140>>32485000
         ELSE MULTIPLIER := 16D;                               <<04140>>32490000
      D'CHAR := DOUBLE(ENV'STATUS(CHAR'WORDS))                 <<01885>>32495000
           * MULTIPLIER;                                       <<04140>>32500000
      D'FORM := DOUBLE(ENV'STATUS(FORM'WORDS))                 <<01885>>32505000
           * MULTIPLIER;                                       <<04140>>32510000
      D'VFC  := DOUBLE(ENV'STATUS(VFC'WORDS)) ;                <<01885>>32515000
                                                               <<01885>>32520000
      D'PICT := DOUBLE(ENV'STATUS(PICTURE'WORDS))              <<04140>>32525000
           * MULTIPLIER;                                       <<04140>>32530000
      GENMSG(DAYFILE'MSG'SET, ENV'WORDS, %22220,               <<04140>>32535000
         @D'CHAR, @D'FORM, @D'VFC, @D'PICT,, - DAYFILE);       <<04140>>32540000
      CONVERT'REAL(RNUM := REAL(ENV'STATUS(PAGE'LENGTH))*.25); <<02541>>32545000
      B := NUMBER;                                             <<02541>>32550000
      B1 := FRACTION;                                          <<02541>>32555000
      CONVERT'REAL(RNUM := RNUM * 2.54);  <<METRIC UNITS>>     <<02541>>32560000
      C := NUMBER;                                             <<02541>>32565000
      C1 := FRACTION;                                          <<02541>>32570000
      GENMSG(DAYFILE'MSG'SET, PAGE'LEN, %11110,                <<02541>>32575000
             B, B1, C, C1, , -DAYFILE);                        <<02541>>32580000
      CONVERT'REAL(RNUM := REAL(ENV'STATUS(PAGE'WIDTH))*.10);  <<02541>>32585000
      B := NUMBER;                                             <<02541>>32590000
      B1 := FRACTION;                                          <<02541>>32595000
      CONVERT'REAL(RNUM := RNUM * 2.54);  <<METRIC UNITS>>     <<02541>>32600000
      C := NUMBER;                                             <<02541>>32605000
      C1 := FRACTION;                                          <<02541>>32610000
      GENMSG(DAYFILE'MSG'SET, PAGE'WDTH, %11110,               <<02541>>32615000
             B, B1, C, C1, , -DAYFILE);                        <<02541>>32620000
      MOVE WYES := PB'YES, (3);                                <<02581>>32625000
      MOVE WNO := PB'NO, (2);                                  <<02581>>32630000
      D'CHARS'CLIPPED := DOUBLE(ENV'STATUS(CHARS'CLIPPED));    <<01885>>32635000
      GENMSG(DAYFILE'MSG'SET, ERR'TYPES, %200,                 <<02541>>32640000
         IF ENV'STATUS(FORMS'REGIS'ERROR) THEN @YES ELSE @NO,  <<02541>>32645000
         IF ENV'STATUS(DATA'TRUNC) THEN @YES ELSE @NO,         <<02541>>32650000
         @D'CHARS'CLIPPED,                                     <<04140>>32655000
         IF ENV'STATUS(PICT'CLIPPED) THEN @YES ELSE @NO,       <<04140>>32660000
         , -DAYFILE);                                          <<01885>>32665000
      TOT'MEMORY:=DOUBLE(ENV'STATUS(TOTAL'USER'MEM)) *         <<04140>>32670000
                  MULTIPLIER;                                  <<04140>>32675000
      GENMSG(DAYFILE'MSG'SET, DATEINFO, %21000,                <<01885>>32680000
         @TOT'MEMORY,ENV'STATUS(DATE'CODE),                    <<01885>>32685000
         ,,, -DAYFILE);                                        <<01885>>32690000
      GENMSG(DAYFILE'MSG'SET,PAGES'PRINTED, %20000,            <<01885>>32695000
         @CURR'PAGE,,,,,  -DAYFILE);                           <<01885>>32700000
                                                               <<01885>>32705000
   END;                                                        <<01885>>32710000
LX:                                                            <<01885>>32715000
END; <<REPORT'ENV>>                                            <<01885>>32720000
                                                               <<01885>>32725000
$PAGE "(OUTPUT) PROCEDURE: SCAN'FOR'FOPEN"                     <<02619>>32730000
LOGICAL PROCEDURE SCAN'FOR'FOPEN                               <<02619>>32735000
                  (BUFFER, BBUFFER'LEN, INDEX, NUMRECS);       <<02619>>32740000
VALUE                      BBUFFER'LEN                 ;       <<02619>>32745000
INTEGER ARRAY      BUFFER                              ;       <<02619>>32750000
INTEGER                    BBUFFER'LEN, INDEX, NUMRECS ;       <<02619>>32755000
OPTION PRIVILEGED, UNCALLABLE;                                 <<02619>>32760000
BEGIN                                                          <<02619>>32765000
                                                               <<02619>>32770000
COMMENT                                                        <<02619>>32775000
     Scans the spoofle record BUFFER area for FOPEN (i.e.      <<02619>>32780000
SOPEN) records.  If one is found SCAN'FOR'FOPEN returns TRUE,  <<02619>>32785000
sets NUMRECS to the number of records which precede the FOPEN  <<02619>>32790000
record, and sets INDEX to be the offset to the FOPEN record    <<02619>>32795000
from BUFFER.                                                   <<02619>>32800000
;                                                              <<02619>>32805000
                                                               <<02619>>32810000
LOGICAL FOUND'FOPEN  <<Used to exit once an FOPEN is found>>   <<02619>>32815000
       ,IS'MORE'DATA  <<Haven't found -1 in spoofle block>>    <<02619>>32820000
;                                                              <<02619>>32825000
INTEGER BLK'PTR'LIM  <<End adr of the base buffer>             <<02619>>32830000
       ,LDT'INDEX := 0                                         <<F9070>>32835000
       ,USAGE                                                  <<04413>>32840000
       ,REC'LEN  <<Length of the current spoofle record>>      <<02619>>32845000
       ,REC'PTR'LIM  <<End adr of the current spoofle block>>  <<02619>>32850000
;                                                              <<02619>>32855000
INTEGER POINTER BLK'PTR  <<Points to block boundaries>>        <<02619>>32860000
               ,REC'PTR  <<Points to record boundaries>>       <<02619>>32865000
;                                                              <<02619>>32870000
LOGICAL ARRAY LDT(0:SIZE'OF'LDT'ENTRY-1);                      <<F9070>>32875000
                                                               <<F9070>>32880000
DECLARE'MOVE'FROM'DATA'SEGMENT;                                <<F9070>>32885000
                                                               <<02619>>32890000
BLK'PTR'LIM := @SBASE + BBUFFER'LEN&ASR(1);  <<A word length>> <<02619>>32895000
@BLK'PTR:=@BUFFER;  <<1st block is at beginning of BUFFER>>    <<02619>>32900000
FOUND'FOPEN:=FALSE;  <<Haven't found one yet>>                 <<02619>>32905000
                                                               <<02619>>32910000
WHILE (@BLK'PTR < BLK'PTR'LIM) AND <<i.e. not end of BUFFER>>  <<02619>>32915000
      NOT FOUND'FOPEN DO <<No FOPENs>>                         <<02619>>32920000
  BEGIN                                                        <<02619>>32925000
  NUMRECS:=-1;  <<RESET FOR EACH BLOCK>>                       <<02661>>32930000
  @REC'PTR:=@BLK'PTR;  <<Point to beginning of block>>         <<02619>>32935000
  REC'PTR'LIM := @REC'PTR + BSIZE;  <<Find end of block>>      <<02619>>32940000
  REC'LEN:=-3;  <<REC'LEN will have no effect the 1st time>>   <<02619>>32945000
  IS'MORE'DATA := TRUE;  <<Haven't hit the end of the block>>  <<02619>>32950000
                                                               <<02619>>32955000
  WHILE (@REC'PTR < REC'PTR'LIM) AND <<i.e. not end of block>> <<02619>>32960000
        NOT FOUND'FOPEN AND <<No FOPENs>>                      <<02619>>32965000
        IS'MORE'DATA DO <<i.e. no -1 in block yet>>            <<02619>>32970000
    BEGIN                                                      <<02619>>32975000
    @REC'PTR:=@REC'PTR+(REC'LEN+3)&ASR(1);<<point to next rec>><<02619>>32980000
    NUMRECS:=NUMRECS+1;  <<increment the # of rec skipped>>    <<02619>>32985000
                                                               <<04413>>32990000
    IF REC'PTR = -1 THEN IS'MORE'DATA:=FALSE                   <<02619>>32995000
    ELSE                                                       <<04413>>33000000
                                                               <<06007>>33005000
<< The purpose of SCAN'FOR'FOPEN and  its  brethren  is  to >> <<06007>>33010000
<< intercept any FOPEN's so that the current 2680 block may >> <<06007>>33015000
<< be broken up into two blocks, one containing all records >> <<06007>>33020000
<< before the FOPEN, and the other containing the FOPEN and >> <<06007>>33025000
<< all records to the end of the original block.  This  al- >> <<06007>>33030000
<< lows any forms messages (contained in the FOPEN records) >> <<06007>>33035000
<< to be processed at the proper time.  One doesn't encoun- >> <<06007>>33040000
<< ter 2680 forms messages every day (I've never seen one), >> <<06007>>33045000
<< so breaking the transfer up for all FOPEN's is very  in- >> <<06007>>33050000
<< efficient.  In  addition,  the  resulting  special short >> <<06007>>33055000
<< transfers trigger a bug (now fixed) in the  2680  micro- >> <<06007>>33060000
<< code  which  can result in SPOOLER BLOCK CONTAINS FORMAT >> <<06007>>33065000
<< ERROR or undetected data errors.                         >> <<06007>>33070000
<<   In short, it doesn't make much  sense  to  single  out >> <<06007>>33075000
<< FOPEN's unnecessarily, so the following test [REC'PTR(1) >> <<06007>>33080000
<< <> 0] has been added.  It basically says, if there is no >> <<06007>>33085000
<< forms message in the FOPEN record then process the FOPEN >> <<06007>>33090000
<< as normal data, that is, don't make anything special out >> <<06007>>33095000
<< of it.                                                   >> <<06007>>33100000
<<   If the previous FOPEN used special forms but this  one >> <<F9070>>33105000
<< doesn't,  then  make this a special FOPEN (i.e., pretend >> <<F9070>>33110000
<< we have a forms message) so the 268x will flush its data >> <<F9070>>33115000
<< and pause to let the operator remount standard forms.    >> <<F9070>>33120000
                                                               <<06007>>33125000
      IF REC'PTR(2) = SOPEN THEN                               <<F9070>>33130000
         BEGIN  << Check for beginning/end of special forms >> <<F9070>>33135000
         MFDS (LDT, LDT'DST, @LDTP, SIZE'OF'LDT'ENTRY);        <<F9070>>33140000
         IF REC'PTR(1) <> 0 OR LDT'SPECIAL'FORMS THEN          <<F9070>>33145000
            FOUND'FOPEN := TRUE;                               <<F9070>>33150000
         END    << Check for beginning/end of special forms >> <<F9070>>33155000
      ELSE                                                     <<04413>>33160000
           << Check if the function code is valid >>           <<04413>>33165000
        IF NOT VALID'FUNC(REC'PTR(2), USAGE) THEN              <<04413>>33170000
               << Change the invalid function code to a NOP >> <<04413>>33175000
          BEGIN                                                <<04413>>33180000
          REC'PTR(2) := FUNC'MOVE'PEN'RELATIVE;                <<04413>>33185000
          REC'PTR(3) := 0; << Set x displacement >>            <<04413>>33190000
          REC'PTR(4) := 0; << Set y displacement >>            <<04413>>33195000
          END;                                                 <<04413>>33200000
                                                               <<04413>>33205000
    REC'LEN:=REC'PTR;  <<Remember this record's length>>       <<02619>>33210000
    END;  <<of block checking loop>>                           <<02619>>33215000
                                                               <<02619>>33220000
  IF NOT IS'MORE'DATA THEN                                     <<02619>>33225000
    @BLK'PTR:=@BLK'PTR + BSIZE; <<Go to the next BLK>>         <<02619>>33230000
                                                               <<02619>>33235000
  END;  <<of BUFFER checking loop>>                            <<02619>>33240000
                                                               <<02619>>33245000
IF (SCAN'FOR'FOPEN := FOUND'FOPEN) THEN                        <<02619>>33250000
  INDEX := @REC'PTR - @BUFFER;  <<No need to set if no FOPEN>> <<02619>>33255000
                                                               <<02619>>33260000
END;  <<SCAN'FOR'FOPEN>>                                       <<02619>>33265000
$PAGE "(OUTPUT) PROCEDURE: FOPEN'FORMS"                        <<02580>>33270000
LOGICAL PROCEDURE FOPEN'FORMS;                                 <<04413>>33275000
OPTION PRIVILEGED, UNCALLABLE;                                 <<02619>>33280000
BEGIN                                                          <<02619>>33285000
                                                               <<02619>>33290000
COMMENT                                                        <<02619>>33295000
     Check a the buffer area SBASE for FOPEN's which require   <<02619>>33300000
a form change and ask the operator if he wants to change forms.<<02619>>33305000
If so continue, otherwise set IMAGETYPE to DADMAD and return.  <<02619>>33310000
;                                                              <<02619>>33315000
                                                               <<02619>>33320000
INTEGER INDEX                                                  <<02619>>33325000
       ,FOPEN'REC'LEN                                          <<04413>>33330000
       ,KEEP                                                   <<02619>>33335000
       ,NUMRECS                                                <<02619>>33340000
       ,ORIG'BUF'LEN                                           <<02619>>33345000
       ,PREFOPEN'BLKS                                          <<02619>>33350000
       ,TEMP'RECL                                              <<02619>>33355000
;                                                              <<02619>>33360000
INTEGER POINTER BUF;                                           <<02619>>33365000
DOUBLE POINTER DBUF            = BUF;                          <<02619>>33370000
                                                               <<02619>>33375000
$PAGE "PROCEDURE: FOPEN'FORMS;  SUBROUTINE: WRITE'UPTO'FOPEN"  <<02619>>33380000
LOGICAL SUBROUTINE WRITE'UPTO'FOPEN;                           <<02619>>33385000
BEGIN                                                          <<02619>>33390000
                                                               <<02619>>33395000
COMMENT                                                        <<02619>>33400000
     This subroutine ensures that any FOPEN with forms on it   <<02619>>33405000
causes all data in BUFFER before the FOPEN to be written       <<02619>>33410000
before doing the forms mount.                                  <<02619>>33415000
The returns are:                                               <<02619>>33420000
     FALSE = The operator's REPLY was no to SDOFORMS.          <<02619>>33425000
     TRUE  = The operator's REPLY was yes to SDOFORMS.         <<02619>>33430000
;                                                              <<02619>>33435000
                                                               <<02619>>33440000
FOPEN'REC'LEN:=(BUF(INDEX)+3)&ASR(1); <<Make it a word count>> <<02619>>33445000
                                                               <<02619>>33450000
  <<Save the first word of the next record in BUF>>            <<02619>>33455000
KEEP:=BUF(INDEX+FOPEN'REC'LEN);                                <<02619>>33460000
                                                               <<02619>>33465000
  <<Now, set first word of next record to end-of-block state>> <<02619>>33470000
BUF(INDEX+FOPEN'REC'LEN):=-1;                                  <<02619>>33475000
                                                               <<02619>>33480000
  <<Calculate an actual byte count to write>>                  <<02619>>33485000
PREFOPEN'BLKS:=(INDEX+BSIZE)/BSIZE; <<Get # 512 word blocks+1>><<02619>>33490000
RECL:=(PREFOPEN'BLKS*BSIZE)&ASL(1); <<Set byte count>>         <<02619>>33495000
                                                               <<02619>>33500000
  <<Change FOPEN to a dummy record indicating flush>>          <<02619>>33505000
BUF(INDEX+2):=FLUSH;                                           <<02619>>33510000
BUF(INDEX+3):=0;                                               <<02619>>33515000
BUF(INDEX+4):=0;                                               <<02619>>33520000
                                                               <<02619>>33525000
<< Write up to the FOPEN now!>>                                <<04413>>33530000
                                                               <<04413>>33535000
IF NOT SDWRITE(SRFUNC, BLOCKMODE, WRITEEND, WRITEWAIT,         <<04413>>33540000
     IMAGETYPE) THEN                                           <<04413>>33545000
  GO TO SDWRITE'ERROR;                                         <<04413>>33550000
                                                               <<02619>>33555000
  <<Restore first word of next record from end-of-block>>      <<02619>>33560000
  <<condition to the value saved in the KEEP variable.>>       <<02619>>33565000
BUF(INDEX+FOPEN'REC'LEN):=KEEP;                                <<02619>>33570000
BUF(INDEX+2):=SOPEN; <<Restore the FOPEN record>>              <<02619>>33575000
                                                               <<02619>>33580000
  <<Do the forms thing>>                                       <<02619>>33585000
WRITE'UPTO'FOPEN:=SDOFORMS(BUF(INDEX)-8,@BUF(INDEX+5));        <<02619>>33590000
                                                               <<02619>>33595000
  <<Set up to get to a normal block boundary>>                 <<02619>>33600000
PREFOPEN'BLKS:=PREFOPEN'BLKS-1; <<Back up one block>>          <<02619>>33605000
@BUF:=@BUF+(PREFOPEN'BLKS*BSIZE); <<Block boundary>>           <<02619>>33610000
INDEX:=INDEX MOD BSIZE; <<Set INDEX to be relative to BUF>>    <<02619>>33615000
  <<Fake up initial dummy record to be skipped>>               <<02619>>33620000
BUF:=(INDEX+FOPEN'REC'LEN-1)&ASL(1); <<Set long record cnt>>   <<02619>>33625000
BUF(1):=0;      <<Padded blank count is set to zero>>          <<02619>>33630000
BUF(2):=FLUSH;  <<Function is another flush>>                  <<02619>>33635000
BUF(3):=0;      <<P1 must be zero for begin flush>>            <<02619>>33640000
BUF(4):=0;      <<P2 not used, but this makes it consistent>>  <<02619>>33645000
                                                               <<02619>>33650000
  <<Make starting record correct>>                             <<02619>>33655000
DBUF(255):=DBUF(255)+DOUBLE(NUMRECS);                          <<02619>>33660000
                                                               <<02619>>33665000
  <<Ensure that actual BUF start & record cnt are correct>>    <<02619>>33670000
RECL:=ORIG'BUF'LEN-((@BUF-@SBASE)&ASL(1));                     <<02619>>33675000
RECP(1):=@BUF;                                                 <<02619>>33680000
                                                               <<02619>>33685000
END; <<WRITE'UPTO'FOPEN>>                                      <<02619>>33690000
$PAGE "PROCEDURE: FOPEN'FORMS"                                 <<02619>>33695000
  FOPEN'FORMS := TRUE; << assume success >>                    <<04469>>33700000
                                                               <<04469>>33705000
  IF END'OF'JOB THEN                                           <<04469>>33710000
      << No forms change for ERR files >>                      <<04469>>33715000
                                                               <<04469>>33720000
  ELSE                                                         <<04469>>33725000
    BEGIN                                                      <<04469>>33730000
    ORIG'BUF'LEN := RECL;                                      <<04469>>33735000
    @BUF := @SBASE;                                            <<04469>>33740000
                                                               <<04469>>33745000
      <<INDEX and NUMRECS variables do not need initializing>> <<04469>>33750000
    WHILE SCAN'FOR'FOPEN(BUF, ORIG'BUF'LEN, INDEX, NUMRECS) DO <<04469>>33755000
      IF NOT WRITE'UPTO'FOPEN THEN                             <<04469>>33760000
        BEGIN                                                  <<04469>>33765000
        IMAGETYPE := DADMAD; << Operator replied no to forms>> <<04469>>33770000
        RETURN;                                                <<04469>>33775000
        END;                                                   <<04469>>33780000
                                                               <<04469>>33785000
    END;                                                       <<04469>>33790000
                                                               <<04469>>33795000
  RETURN; << success! >>                                       <<04469>>33800000
                                                               <<04469>>33805000
                                                               <<04469>>33810000
SDWRITE'ERROR: << spoolee i/o error >>                         <<04469>>33815000
                                                               <<04469>>33820000
  FOPEN'FORMS := FALSE; << failure >>                          <<04469>>33825000
                                                               <<04469>>33830000
END; << of procedure FOPEN'FORMS >>                            <<04469>>33835000
                                                               <<04469>>33840000
$PAGE "(OUTPUT) PROCEDURE: CIPER'RESTART'PAGE"                 <<04409>>33845000
logical procedure ciper'restart'page(offset, dev'power'fail);  <<04409>>33850000
                                                               <<04409>>33855000
  value                              offset, dev'power'fail ;  <<04409>>33860000
                                                               <<04409>>33865000
  double                             offset                 ;  <<04409>>33870000
                                                               <<04409>>33875000
  logical                                    dev'power'fail ;  <<04409>>33880000
                                                               <<04409>>33885000
  option privileged, uncallable;                               <<04409>>33890000
                                                               <<04409>>33895000
begin                                                          <<04409>>33900000
                                                               <<04409>>33905000
                                                               <<04409>>33910000
  equate                                                       <<04409>>33915000
                                                               <<04409>>33920000
     retry'limit     = 20                                      <<04409>>33925000
  ;                                                            <<04409>>33930000
                                                               <<04409>>33935000
  integer                                                      <<04409>>33940000
                                                               <<04409>>33945000
     retry'cnt                                                 <<04409>>33950000
    ,silent'run'rec'len                                        <<04409>>33955000
    ,status'return                                             <<04409>>33960000
  ;                                                            <<04409>>33965000
                                                               <<04409>>33970000
  logical                                                      <<04409>>33975000
                                                               <<04409>>33980000
     dummy                                                     <<04409>>33985000
  ;                                                            <<04409>>33990000
                                                               <<04409>>33995000
  logical array                                                <<04409>>34000000
                                                               <<04409>>34005000
     avail'returns( 0 : size'of'avail'returns - 1 )            <<04409>>34010000
    ,check'point( 0 : size'of'check'point - 1 )                <<04409>>34015000
    ,device'status( 0 : size'of'device'status - 1 )            <<04409>>34020000
    ,env'status( 0 : size'of'env'status'block - 1 )            <<04409>>34025000
  ;                                                            <<04409>>34030000
                                                               <<04409>>34035000
  double pointer                                               <<04409>>34040000
                                                               <<04409>>34045000
     d'check'point = check'point                               <<04409>>34050000
    ,d'env'status  = env'status                                <<04409>>34055000
  ;                                                            <<04409>>34060000
                                                               <<04409>>34065000
$PAGE "(OUTPUT) ",&                                            <<04409>>34070000
$"PROCEDURE: CIPER'RESTART'PAGE;  SUBROUTINE: DO'ATTACHIO"     <<04409>>34075000
subroutine do'attachio(addr, func, cnt, p1, p2);               <<04409>>34080000
                                                               <<04409>>34085000
  value                addr, func, cnt, p1, p2 ;               <<04409>>34090000
                                                               <<04409>>34095000
  integer              addr, func, cnt, p1, p2 ;               <<04409>>34100000
                                                               <<04409>>34105000
begin                                                          <<04409>>34110000
                                                               <<04409>>34115000
                                                               <<04409>>34120000
  tos := attachio(device, 0 << QMISC := NA >>,                 <<04409>>34125000
       0 << DSTX := stack >>,                                  <<04409>>34130000
  addr, func, cnt, p1, p2,                                     <<04409>>34135000
  1 << FLAGS := no premption; not special request;           >><<04409>>34140000
  << not diagnostic; not system buffer; blocked;             >><<04409>>34145000
  << wake on completion; impede if no IOQ element            >><<04409>>34150000
  << is available.  >> );                                      <<04409>>34155000
                                                               <<04409>>34160000
  del;  << get rid of transmission log/control returns       >><<04409>>34165000
  status'return := tos.qual'gen'status; << save io status's  >><<04409>>34170000
                                                               <<04409>>34175000
    << intercept status'return 's which are ok, >>             <<04409>>34180000
    << but indicate other statuses are available >>            <<04409>>34185000
  if status'return = st'ok'plus'status then                    <<04409>>34190000
    status'return := st'ok;                                    <<04409>>34195000
                                                               <<04409>>34200000
  if status'return.general'status = gen'st'irrecoverable then  <<04409>>34205000
    go exit'device'ioerr;                                      <<04409>>34210000
                                                               <<04409>>34215000
end; << of subroutine do'attachio >>                           <<04409>>34220000
                                                               <<04409>>34225000
$PAGE "(OUTPUT) ",&                                            <<04409>>34230000
$"PROCEDURE: CIPER'RESTART'PAGE;  SUBROUTINE: ANALYZE'STATUS"  <<04409>>34235000
subroutine analyze'status;                                     <<04409>>34240000
                                                               <<04409>>34245000
begin                                                          <<04409>>34250000
                                                               <<04409>>34255000
                                                               <<04409>>34260000
  if status'return.general'status = gen'st'ok then return;     <<04409>>34265000
                                                               <<04409>>34270000
  if status'return = st'device'power'up then                   <<04409>>34275000
    go handle'power'fail;                                      <<04409>>34280000
                                                               <<04409>>34285000
  if status'return = st'not'ok'plus'status then                <<04409>>34290000
    begin                                                      <<04409>>34295000
    << Figure out what went wrong; take corrective action >>   <<04409>>34300000
                                                               <<04409>>34305000
    do'attachio( @device'status, func'dev'stat'composite,      <<04409>>34310000
         size'of'device'status, 0, 0);                         <<04409>>34315000
                                                               <<04409>>34320000
    if status'return.general'status = gen'st'irrecoverable then<<04409>>34325000
      go exit'device'ioerr;                                    <<04409>>34330000
                                                               <<04409>>34335000
    if device'status(dev'st'self'test'failed) then             <<04409>>34340000
         << self test failed; stop spooling >>                 <<04409>>34345000
      go exit'device'ioerr                                     <<04409>>34350000
                                                               <<04409>>34355000
    else                                                       <<04409>>34360000
      begin                                                    <<04409>>34365000
                                                               <<04409>>34370000
      if device'status(dev'st'power'fail) then                 <<04409>>34375000
        go handle'power'fail;                                  <<04409>>34380000
                                                               <<04409>>34385000
      if device'status(dev'st'protocol'errors) <> 0 then       <<04409>>34390000
        begin                                                  <<04409>>34395000
                                                               <<04409>>34400000
        retry'cnt := retry'cnt + 1;                            <<04409>>34405000
                                                               <<04409>>34410000
        if retry'cnt > retry'limit then                        <<04409>>34415000
          go exit'device'ioerr                                 <<04409>>34420000
                                                               <<04409>>34425000
        else                                                   <<04409>>34430000
          go try'again;                                        <<04409>>34435000
                                                               <<04409>>34440000
        end;                                                   <<04409>>34445000
                                                               <<04409>>34450000
        << clear on-line bit >>                                <<04409>>34455000
      device'status(dev'st'on'line) := false;                  <<04409>>34460000
                                                               <<04409>>34465000
      if ( device'status(dev'st'peripheral'status) <> 0 ) then <<04409>>34470000
        go try'again;                                          <<04409>>34475000
                                                               <<04409>>34480000
      end;                                                     <<04409>>34485000
                                                               <<04409>>34490000
    end                                                        <<04409>>34495000
                                                               <<04409>>34500000
  else                                                         <<04409>>34505000
                                                               <<04409>>34510000
    if status'return.general'status = gen'st'unusual then      <<04409>>34515000
      go exit'device'ioerr;                                    <<04409>>34520000
                                                               <<04409>>34525000
end; << of subroutine analyze'status >>                        <<04409>>34530000
                                                               <<04409>>34535000
$PAGE "(OUTPUT)",&                                             <<04409>>34540000
$"PROCEDURE: CIPER'RESTART'PAGE;  ",&                          <<04409>>34545000
$"SUBROUTINE: COMPUTE'NEXT'PAGE'TO'PRINT"                      <<04409>>34550000
subroutine compute'next'page'to'print;                         <<04409>>34555000
                                                               <<04409>>34560000
begin                                                          <<04409>>34565000
                                                               <<04409>>34570000
                                                               <<04409>>34575000
  if dev'in'silent'run then                                    <<04409>>34580000
    << use same next'page'to'print as before >>                <<04409>>34585000
  else                                                         <<04409>>34590000
    begin                                                      <<04409>>34595000
                                                               <<04409>>34600000
    if offset <> 0D then                                       <<04409>>34605000
      next'page'to'print := offset                             <<04409>>34610000
                                                               <<04409>>34615000
    else                                                       <<04409>>34620000
      next'page'to'print :=                                    <<04409>>34625000
           d'env'status(env'st'd'checkpoint'number);           <<04409>>34630000
                                                               <<04409>>34635000
    end;                                                       <<04409>>34640000
                                                               <<04409>>34645000
end; << of subroutine compute'next'page'to'print >>            <<04409>>34650000
                                                               <<04409>>34655000
$PAGE "(OUTPUT)",&                                             <<04409>>34660000
$"PROCEDURE: CIPER'RESTART'PAGE;  ",&                          <<04409>>34665000
$"SUBROUTINE: SEARCH'FOR'CHECK'POINT"                          <<04409>>34670000
subroutine search'for'check'point(page'we'want, nrc'of'zero);  <<04409>>34675000
                                                               <<04409>>34680000
  value                           page'we'want, nrc'of'zero ;  <<04409>>34685000
                                                               <<04409>>34690000
  double                          page'we'want              ;  <<04409>>34695000
                                                               <<04409>>34700000
  logical                                       nrc'of'zero ;  <<04409>>34705000
                                                               <<04409>>34710000
begin                                                          <<04409>>34715000
                                                               <<04409>>34720000
                                                               <<04409>>34725000
  do                                                           <<04409>>34730000
    if not fulab(fulab'read'cq, @check'point,                  <<04409>>34735000
         size'of'check'point) then go exit'false               <<04409>>34740000
  until                                                        <<04409>>34745000
                                                               <<04409>>34750000
    end'of'check'points                                        <<04409>>34755000
    lor                                                        <<04409>>34760000
    (                                                          <<04409>>34765000
      (                                                        <<04409>>34770000
        nrc'of'zero                                            <<04409>>34775000
        land                                                   <<04409>>34780000
        (                                                      <<04409>>34785000
          d'check'point(env'st'd'last'not'recoverable)         <<04409>>34790000
          =                                                    <<04409>>34795000
          0D                                                   <<04409>>34800000
        )                                                      <<04409>>34805000
      )                                                        <<04409>>34810000
      lor                                                      <<04409>>34815000
      (                                                        <<04409>>34820000
        not nrc'of'zero                                        <<04409>>34825000
        land                                                   <<04409>>34830000
        (                                                      <<04409>>34835000
          d'check'point(env'st'd'checkpoint'number)            <<04409>>34840000
          <=                                                   <<04438>>34845000
          page'we'want                                         <<04409>>34850000
        )                                                      <<04409>>34855000
      )                                                        <<04409>>34860000
    )                                                          <<04409>>34865000
  ;                                                            <<04409>>34870000
                                                               <<04409>>34875000
                                                               <<04409>>34880000
  if end'of'check'points then                                  <<04409>>34885000
    begin                                                      <<04409>>34890000
    d'check'point(env'st'd'block'number) := 1D;                <<04409>>34895000
    d'check'point(env'st'd'byte'offset) := 0D;                 <<04409>>34900000
    d'check'point(env'st'd'checkpoint'number) :=               <<04409>>34905000
         double( sent'a'header );                              <<04409>>34910000
    d'check'point(env'st'd'last'non'recoverable) := 0D;        <<04409>>34915000
    silent'run'rec'len := silent'run'min'rec'size;             <<04409>>34920000
    end                                                        <<04409>>34925000
                                                               <<04409>>34930000
  else                                                         <<04409>>34935000
    begin                                                      <<04409>>34940000
    if not fulab(fulab'write'cq, @check'point,                 <<04409>>34945000
         size'of'check'point) then go exit'false;              <<04409>>34950000
    silent'run'rec'len := size'of'check'point;                 <<04409>>34955000
    end;                                                       <<04409>>34960000
                                                               <<04409>>34965000
end; << of subroutine search'for'check'point >>                <<04409>>34970000
                                                               <<04409>>34975000
$PAGE "(OUTPUT) PROCEDURE: CIPER'RESTART'PAGE"                 <<04409>>34980000
                                                               <<04409>>34985000
                                                               <<04409>>34990000
<< * * *                 Procedure body                * * * >><<04409>>34995000
                                                               <<04409>>35000000
  ciper'restart'page := false; << assume failure >>            <<04409>>35005000
                                                               <<04409>>35010000
  retry'cnt := 0;                                              <<04421>>35015000
                                                               <<04421>>35020000
  if false then                                                <<04409>>35025000
                                                               <<04409>>35030000
handle'power'fail:                                             <<04409>>35035000
                                                               <<04409>>35040000
    dev'power'fail := true;                                    <<04409>>35045000
                                                               <<04409>>35050000
                                                               <<04409>>35055000
try'again:                                                     <<04409>>35060000
                                                               <<04409>>35065000
                                                               <<04409>>35070000
  do'attachio( @env'status, func'env'stat'immediate,           <<04409>>35075000
       size'of'env'status'block, 0, 0);                        <<04409>>35080000
                                                               <<04409>>35085000
  analyze'status;                                              <<04409>>35090000
                                                               <<04409>>35095000
  if d'env'status(env'st'd'checkpoint'number) >                <<04438>>35100000
       next'page'to'print then                                 <<04438>>35105000
    dev'in'silent'run := false;                                <<04438>>35110000
                                                               <<04438>>35115000
  compute'next'page'to'print;                                  <<04409>>35120000
                                                               <<04409>>35125000
  search'for'check'point(next'page'to'print, false);           <<04409>>35130000
                                                               <<04409>>35135000
  if dev'power'fail or                                         <<04409>>35140000
       ( d'check'point(env'st'd'last'non'recoverable) <>       <<04409>>35145000
  d'env'status(env'st'd'last'non'recoverable) ) then           <<04409>>35150000
    search'for'check'point( 0D << dummy >> , true );           <<04409>>35155000
                                                               <<04409>>35160000
  blknum := d'check'point(silent'run'd'block'number) - 1D;     <<04409>>35165000
                                                               <<04409>>35170000
    << prime input buffer >>                                   <<04409>>35175000
  freaddir( spoolfile, sbase, bsize, blknum );                 <<04409>>35180000
  if <> then go exit'spoolfile'ioerr;                          <<04409>>35185000
                                                               <<04409>>35190000
    << reset input buffer to start of this block >>            <<04409>>35195000
  scount := 0;                                                 <<04409>>35200000
  blknum := blknum + 1D;                                       <<04409>>35205000
                                                               <<04409>>35210000
  dev'in'silent'run := true;                                   <<04409>>35215000
                                                               <<04409>>35220000
  d'check'point(silent'run'd'start'print'checkpoint) :=        <<04409>>35225000
       next'page'to'print;                                     <<04409>>35230000
                                                               <<04409>>35235000
  do'attachio( @check'point, func'start'silent'recovery,       <<04409>>35240000
       silent'run'rec'len, 0, 0);                              <<04409>>35245000
                                                               <<04409>>35250000
  analyze'status;                                              <<04409>>35255000
                                                               <<04409>>35260000
    << force a start of block to occur                       >><<04409>>35265000
  new'silent'run := true;                                      <<04409>>35270000
                                                               <<04409>>35275000
                                                               <<04409>>35280000
exit'true:                                                     <<04409>>35285000
                                                               <<04409>>35290000
  ciper'restart'page := true;                                  <<04409>>35295000
  return;                                                      <<04409>>35300000
                                                               <<04409>>35305000
                                                               <<04409>>35310000
exit'device'ioerr:                                             <<04409>>35315000
                                                               <<04409>>35320000
  notify'operator( device, status'return );                    <<04409>>35325000
  imagetype := ioerr;                                          <<04409>>35330000
  stopspooling := spooleeioerr;                                <<04409>>35335000
  filerequest := relinkfile;                                   <<04409>>35340000
  go exit'false;                                               <<04409>>35345000
                                                               <<04409>>35350000
                                                               <<04409>>35355000
exit'spoolfile'ioerr:                                          <<04409>>35360000
                                                               <<04409>>35365000
  << 230 SP#\/#O! deferred, spoofle I/O error >>               <<06334>>35370000
  genmsg(1,230,%11000,device,devfileid,,,,0);                  <<04409>>35375000
  imagetype := iospooflerr;                                    <<04409>>35380000
  filerequest := deferfile;                                    <<04409>>35385000
  go exit'false;                                               <<04409>>35390000
                                                               <<04409>>35395000
                                                               <<04409>>35400000
exit'false:                                                    <<04409>>35405000
                                                               <<04409>>35410000
  ciper'restart'page := false;                                 <<04409>>35415000
                                                               <<04409>>35420000
end; << of procedure ciper'restart'page >>                     <<04409>>35425000
                                                               <<04409>>35430000
$PAGE "(OUTPUT) VALID'FUNC"                                    <<04414>>35435000
LOGICAL PROCEDURE VALID'FUNC (FUNC, USAGE);                    <<04990>>35440000
   VALUE FUNC;                                                 <<04990>>35445000
   INTEGER FUNC, USAGE;                                        <<04990>>35450000
   OPTION PRIVILEGED, UNCALLABLE;                              <<04990>>35455000
                                                               <<04990>>35460000
BEGIN COMMENT --                                               <<04990>>35465000
  VALID'FUNC makes sure that a  function  code  in  the  range <<04990>>35470000
handled  by FDEVICECONTROL (currently 64-255) is valid for our <<04990>>35475000
spooled device. (Calling procedures discard any record with an <<04990>>35480000
invalid function code to avoid device I/O errors).  VALID'FUNC <<04990>>35485000
uses procedure VALIDDEVTYPE in module  NRIO.  VALIDDEVTYPE  is <<04990>>35490000
very  inefficient,  and the use of proportional spacing on the <<04990>>35495000
2680 requires almost one FDEVICECONTROL code per word of  out- <<04990>>35500000
put.  To  avoid repeated time-consuming calls to VALIDDEVTYPE, <<04990>>35505000
we only call it once per FDEVICECONTROL code.  The  result  of <<04990>>35510000
that  call is stored in a local table, VALID'FUNC'TABLE (built <<04990>>35515000
in SPOOLOUTs Q+ area with a pointer in DB).  Subsequent  calls <<04990>>35520000
using the same code look up the results in VALID'FUNC'TABLE.   <<04990>>35525000
;                                                              <<04990>>35530000
LOGICAL RESULT;                                                <<04990>>35535000
                                                               <<04990>>35540000
DEFINE                                                         <<04990>>35545000
   ALREADY'CHECKED = (8:1) #,                                  <<04990>>35550000
   FLAG'BITS       = (13:3)#,                                  <<04990>>35555000
   VALID'BIT       = (9:1) #;                                  <<04990>>35560000
                                                               <<04990>>35565000
VALID'FUNC := FALSE;                                           <<04990>>35570000
USAGE := 0;                                                    <<04990>>35575000
IF FUNC'READ'DATA <= FUNC <= FUNC'LOAD'VFC - 1 THEN            <<04990>>35580000
   VALID'FUNC := TRUE   << Not FDVCNTRL call, assume O.K.   >> <<04990>>35585000
ELSE IF FUNC > MAX'FUNC THEN                                   <<04990>>35590000
   VALID'FUNC := FALSE                                         <<04990>>35595000
ELSE IF LOGICAL (VALID'FUNC'TABLE(FUNC-FUNC'LOAD'VFC).         <<04990>>35600000
   ALREADY'CHECKED) THEN                                       <<04990>>35605000
      BEGIN   << VALIDDEVTYPE result exists locally, use it >> <<04990>>35610000
      VALID'FUNC := LOGICAL (VALID'FUNC'TABLE(X).VALID'BIT);   <<04990>>35615000
      USAGE := INTEGER (VALID'FUNC'TABLE(X).FLAG'BITS);        <<04990>>35620000
      END   << VALIDDEVTYPE result exists locally.          >> <<04990>>35625000
   ELSE                                                        <<04990>>35630000
      BEGIN   << Must call VALIDDEVTYPE.                    >> <<04990>>35635000
      RESULT := VALIDDEVTYPE (DEVICE, FUNC, USAGE);            <<04990>>35640000
      TOS := 0;   << Poor person's word-to-byte conversion. >> <<04990>>35645000
      TOS.FLAG'BITS := USAGE;                                  <<04990>>35650000
      TOS.VALID'BIT := RESULT;                                 <<04990>>35655000
      TOS.ALREADY'CHECKED := TRUE;                             <<04990>>35660000
      VALID'FUNC'TABLE(FUNC-FUNC'LOAD'VFC) := TOS;             <<04990>>35665000
      VALID'FUNC := RESULT;                                    <<04990>>35670000
      END;    << Must call VALIDDEVTYPE.                    >> <<04990>>35675000
END;   << of VALID'FUNC.                                    >> <<04990>>35680000
$PAGE "(OUTPUT) PROCEDURE: FULAB"                              <<04416>>35685000
logical procedure fulab(fulab'func, target'addr, target'len);  <<04416>>35690000
                                                               <<04416>>35695000
  value                 fulab'func, target'addr, target'len ;  <<04416>>35700000
                                                               <<04416>>35705000
  integer               fulab'func, target'addr, target'len ;  <<04416>>35710000
                                                               <<04416>>35715000
  option privileged, uncallable, variable;                     <<04416>>35720000
                                                               <<04416>>35725000
begin                                                          <<04416>>35730000
                                                               <<04416>>35735000
                                                               <<04416>>35740000
  define                                                       <<04416>>35745000
                                                               <<04416>>35750000
     cq'ptr'ulab          = (0:8) #                            <<04416>>35755000
    ,cq'ptr'entry         = (8:8) #                            <<04416>>35760000
                                                               <<04416>>35765000
    ,get'ulab0            = get'ulab(ulab0, 0) #               <<04416>>35770000
    ,put'ulab0            = put'ulab(ulab0, 0) #               <<04416>>35775000
    ;                                                          <<04416>>35780000
                                                               <<04416>>35785000
  integer                                                      <<04416>>35790000
                                                               <<04416>>35795000
     current'ulab    = currulabno                              <<04416>>35800000
    ,num'ulabs                                                 <<04416>>35805000
    ,sub'func        = target'addr                             <<04416>>35810000
    ;                                                          <<04416>>35815000
                                                               <<04416>>35820000
  logical pointer                                              <<04416>>35825000
                                                               <<04416>>35830000
     tail                                                      <<04416>>35835000
    ,target          = target'addr                             <<04416>>35840000
    ,ulab'cq         = blocktable                              <<04416>>35845000
    ;                                                          <<04416>>35850000
                                                               <<04416>>35855000
$PAGE "(OUTPUT) ",&                                            <<04416>>35860000
$"PROCEDURE: FULAB;  SUBROUTINE: PUT'ULAB"                     <<04416>>35865000
subroutine put'ulab(ulab, ulab'num);                           <<04416>>35870000
                                                               <<04416>>35875000
  value             ulab, ulab'num ;                           <<04416>>35880000
                                                               <<04416>>35885000
  logical pointer   ulab           ;                           <<04416>>35890000
                                                               <<04416>>35895000
  integer                 ulab'num ;                           <<04416>>35900000
                                                               <<04416>>35905000
begin                                                          <<04416>>35910000
                                                               <<04416>>35915000
                                                               <<04416>>35920000
  fwritelabel(spoolfile, ulab, size'of'ulab, ulab'num);        <<04416>>35925000
  if <> then go exit'spoolfile'ioerr;                          <<04416>>35930000
                                                               <<04416>>35935000
end; << of subroutine put'ulab >>                              <<04416>>35940000
                                                               <<04416>>35945000
$PAGE "(OUTPUT) ",&                                            <<04416>>35950000
$"PROCEDURE: FULAB;  SUBROUTINE: GET'ULAB"                     <<04416>>35955000
subroutine get'ulab(ulab, ulab'num);                           <<04416>>35960000
                                                               <<04416>>35965000
  value             ulab, ulab'num ;                           <<04416>>35970000
                                                               <<04416>>35975000
  logical pointer   ulab           ;                           <<04416>>35980000
                                                               <<04416>>35985000
  integer                 ulab'num ;                           <<04416>>35990000
                                                               <<04416>>35995000
begin                                                          <<04416>>36000000
                                                               <<04416>>36005000
                                                               <<04416>>36010000
  freadlabel(spoolfile, ulab, size'of'ulab, ulab'num);         <<04416>>36015000
                                                               <<04416>>36020000
  if < then go exit'spoolfile'ioerr;                           <<04416>>36025000
                                                               <<04416>>36030000
  if > then                                                    <<04416>>36035000
    begin                                                      <<04416>>36040000
                                                               <<04416>>36045000
    ulab := 0;                                                 <<04416>>36050000
    move ulab(1) := ulab, (size'of'ulab - 1);                  <<04416>>36055000
                                                               <<04416>>36060000
    put'ulab(ulab, ulab'num);                                  <<04416>>36065000
                                                               <<04416>>36070000
    end;                                                       <<04416>>36075000
                                                               <<04416>>36080000
end; << of subroutine get'ulab >>                              <<04416>>36085000
                                                               <<04416>>36090000
$PAGE "(OUTPUT ",&                                             <<04416>>36095000
$"PROCEDURE: FULAB;  SUBROUTINE: CQ'PTR'TO'PTR"                <<04416>>36100000
integer subroutine cq'ptr'to'ptr(cq'ptr);                      <<04416>>36105000
                                                               <<04416>>36110000
  value                          cq'ptr ;                      <<04416>>36115000
                                                               <<04416>>36120000
  logical                        cq'ptr ;                      <<04416>>36125000
                                                               <<04416>>36130000
begin                                                          <<04416>>36135000
                                                               <<04416>>36140000
                                                               <<04416>>36145000
  if \current'ulab\ <> integer(cq'ptr.cq'ptr'ulab) then        <<04416>>36150000
    begin                                                      <<04416>>36155000
    if current'ulab > 0 then                                   <<04416>>36160000
      put'ulab(ulab'cq, current'ulab);                         <<04416>>36165000
    get'ulab(ulab'cq, integer( cq'ptr.cq'ptr'ulab ));          <<04416>>36170000
    end;                                                       <<04416>>36175000
                                                               <<04416>>36180000
  current'ulab := cq'ptr.cq'ptr'ulab;                          <<04416>>36185000
                                                               <<04416>>36190000
  cq'ptr'to'ptr := @ulab'cq( integer( cq'ptr.cq'ptr'entry ) *  <<04416>>36195000
       integer( ulab0(ulab0'cq'max'entry'size) ) );            <<04416>>36200000
                                                               <<04416>>36205000
end; << of subroutine cq'ptr'to'ptr >>                         <<04416>>36210000
                                                               <<04416>>36215000
$PAGE "(OUTPUT) ",&                                            <<04416>>36220000
$"PROCEDURE: FULAB;  SUBROUTINE: INCREMENT'CQ'PTR"             <<04416>>36225000
subroutine increment'cq'ptr(cq'ptr);                           <<04416>>36230000
                                                               <<04416>>36235000
  logical                   cq'ptr ;                           <<04416>>36240000
                                                               <<04416>>36245000
begin                                                          <<04416>>36250000
                                                               <<04416>>36255000
                                                               <<04416>>36260000
  cq'ptr.cq'ptr'entry := cq'ptr.cq'ptr'entry + 1;              <<04416>>36265000
                                                               <<04416>>36270000
  if cq'ptr.cq'ptr'entry = ulab0(ulab0'cq'per'ulab) then       <<04416>>36275000
    begin                                                      <<04416>>36280000
    cq'ptr.cq'ptr'entry := 0;                                  <<04416>>36285000
    cq'ptr.cq'ptr'ulab := cq'ptr.cq'ptr'ulab + 1;              <<04416>>36290000
    if cq'ptr.cq'ptr'ulab > ulab0(ulab0'cq'last'ulab) then     <<04416>>36295000
      cq'ptr.cq'ptr'ulab := ulab0(ulab0'cq'first'ulab);        <<04416>>36300000
    end;                                                       <<04416>>36305000
                                                               <<04416>>36310000
end; << of subroutine increment'cq'ptr >>                      <<04416>>36315000
                                                               <<04416>>36320000
$PAGE "(OUTPUT) ",&                                            <<04416>>36325000
$"PROCEDURE: FULAB;  SUBROUTINE: DECREMENT'CQ'PTR"             <<04416>>36330000
subroutine decrement'cq'ptr(cq'ptr);                           <<04416>>36335000
                                                               <<04416>>36340000
  logical                   cq'ptr ;                           <<04416>>36345000
                                                               <<04416>>36350000
begin                                                          <<04416>>36355000
                                                               <<04416>>36360000
                                                               <<04416>>36365000
  if cq'ptr.cq'ptr'entry = 0 then                              <<04416>>36370000
    begin                                                      <<04416>>36375000
    cq'ptr.cq'ptr'entry := ulab0(ulab0'cq'per'ulab) - 1;       <<04416>>36380000
    cq'ptr.cq'ptr'ulab := cq'ptr.cq'ptr'ulab - 1;              <<04416>>36385000
    if cq'ptr.cq'ptr'ulab < ulab0(ulab0'cq'first'ulab) then    <<04416>>36390000
      cq'ptr.cq'ptr'ulab := ulab0(ulab0'cq'last'ulab);         <<04416>>36395000
    end                                                        <<04416>>36400000
                                                               <<04416>>36405000
  else                                                         <<04416>>36410000
    cq'ptr.cq'ptr'entry := cq'ptr.cq'ptr'entry - 1;            <<04416>>36415000
                                                               <<04416>>36420000
end; << of subroutine decrement'cq'ptr >>                      <<04416>>36425000
                                                               <<04416>>36430000
$PAGE "(OUTPUT) ",&                                            <<04416>>36435000
$"PROCEDURE: FULAB;  SUBROUTINE: FUNC'OPEN"                    <<04416>>36440000
subroutine func'open;                                          <<04416>>36445000
                                                               <<04416>>36450000
begin                                                          <<04416>>36455000
                                                               <<04416>>36460000
                                                               <<04416>>36465000
  ffileinfo(spoolfile, 17                                      <<04416>>36470000
       << number of user labels >>, num'ulabs);                <<04416>>36475000
  if < then go exit'spoolfile'ioerr;                           <<04416>>36480000
  if num'ulabs = 0 then                                        <<04416>>36485000
    begin                                                      <<04416>>36490000
    fulab'func'mask := false;                                  <<04416>>36495000
    go exit'true;                                              <<04416>>36500000
    end;                                                       <<04416>>36505000
                                                               <<04416>>36510000
  current'ulab := 0;                                           <<04416>>36515000
                                                               <<04416>>36520000
  get'ulab0;                                                   <<04416>>36525000
                                                               <<04416>>36530000
  if ( integer( ulab0(ulab0'device'type) ) <> device'type ) or <<04416>>36535000
       ( integer( ulab0(ulab0'device'subtype) ) <>             <<04416>>36540000
  device'subtype ) or ( integer( ulab0(ulab0'device) )  <>     <<04416>>36545000
  device ) then                                                <<04416>>36550000
    begin                                                      <<04416>>36555000
                                                               <<04416>>36560000
    ulab0(ulab0'device) := device;                             <<04416>>36565000
    ulab0(ulab0'num'ulabs) := num'ulabs;                       <<04416>>36570000
                                                               <<04416>>36575000
    ulab0(ulab0'device'type) := device'type;                   <<04416>>36580000
    ulab0(ulab0'device'subtype) := device'subtype;             <<04416>>36585000
                                                               <<04416>>36590000
    ulab0(ulab0'cq'first'ulab) := maxfopenulab + 1;            <<04416>>36595000
    ulab0(ulab0'cq'last'ulab) := maxuserlabels - 1;            <<04469>>36600000
                                                               <<04416>>36605000
    ulab0(ulab0'cq'head'ulab) := ulab0(ulab0'cq'first'ulab);   <<04416>>36610000
    ulab0(ulab0'cq'head'entry) := 0;                           <<04416>>36615000
                                                               <<04416>>36620000
    ulab0(ulab0'cq'tail'ulab) := ulab0(ulab0'cq'first'ulab);   <<04416>>36625000
    ulab0(ulab0'cq'tail'entry) := 0;                           <<04416>>36630000
                                                               <<04416>>36635000
    ulab0(ulab0'cq'max'entry'size) := cqentrysize;             <<04416>>36640000
    ulab0(ulab0'cq'per'ulab) := maxcqentries;                  <<04416>>36645000
                                                               <<04416>>36650000
    ulab0(ulab0'max'cq'entries) := cqentrysize *               <<04416>>36655000
         maxcqentries << number/ulab >>;                       <<04416>>36660000
                                                               <<04416>>36665000
    ulab0(ulab0'cq'empty) := true;                             <<04416>>36670000
    ulab0(ulab0'cq'record'freq) := 4; << hardcoded for 2608B >><<04416>>36675000
                                                               <<04416>>36680000
    ulab0(ulab0'sp'mit'version) := mit'version;                <<04416>>36685000
    ulab0(ulab0'sp'mit'update) := mit'update;                  <<04416>>36690000
    ulab0(ulab0'sp'mit'fix) := mit'fix;                        <<04416>>36695000
                                                               <<04416>>36700000
    ulab0(ulab0'spoolfle'block'size) := size'of'spoolfle'block;<<04416>>36705000
                                                               <<04416>>36710000
    put'ulab0;                                                 <<04416>>36715000
                                                               <<04416>>36720000
    end;                                                       <<04416>>36725000
                                                               <<04416>>36730000
  fulab'func'mask := true;                                     <<04416>>36735000
                                                               <<04416>>36740000
  if num'ulabs < integer( ulab0(ulab0'cq'last'ulab) ) then     <<04416>>36745000
    begin                                                      <<04416>>36750000
    fulab'func'mask.(fulab'read'cq:1) := false;                <<04416>>36755000
    fulab'func'mask.(fulab'write'cq:1) := false;               <<04416>>36760000
    end'of'check'points := true;                               <<04416>>36765000
    end;                                                       <<04416>>36770000
                                                               <<04416>>36775000
  go exit'true;                                                <<04416>>36780000
                                                               <<04416>>36785000
end; << of subroutine func'open >>                             <<04416>>36790000
                                                               <<04416>>36795000
$PAGE "(OUTPUT) ",&                                            <<04416>>36800000
$"PROCEDURE: FULAB;  SUBROUTINE: FUNC'READ'CQ"                 <<04416>>36805000
subroutine func'read'cq;                                       <<04416>>36810000
                                                               <<04416>>36815000
begin                                                          <<04416>>36820000
                                                               <<04416>>36825000
                                                               <<04416>>36830000
  if not parm'mask.(14:1) then go exit'false;                  <<04416>>36835000
                                                               <<04416>>36840000
  if not parm'mask.(15:1) then                                 <<04416>>36845000
    target'len := ulab0(ulab0'cq'max'entry'size);              <<04416>>36850000
                                                               <<04416>>36855000
  end'of'check'point := ulab0(ulab0'cq'empty);                 <<04416>>36860000
                                                               <<04416>>36865000
  if not ulab0(ulab0'cq'empty) then                            <<04416>>36870000
    begin                                                      <<04416>>36875000
                                                               <<04416>>36880000
    @tail := cq'ptr'to'ptr( ulab0(ulab0'cq'tail'ptr) );        <<04416>>36885000
    move target := tail, (target'len);                         <<04416>>36890000
                                                               <<04416>>36895000
    if ulab0(ulab0'cq'head'ptr) = ulab0(ulab0'cq'tail'ptr) then<<04416>>36900000
      ulab0(ulab0'cq'empty) := true                            <<04416>>36905000
    else                                                       <<04416>>36910000
      decrement'cq'ptr( ulab0(ulab0'cq'tail'ptr) );            <<04416>>36915000
                                                               <<04416>>36920000
    end;                                                       <<04416>>36925000
                                                               <<04416>>36930000
end; << of subroutine func'read'cq >>                          <<04416>>36935000
                                                               <<04416>>36940000
$PAGE "(OUTPUT) ",&                                            <<04416>>36945000
$"PROCEDURE: FULAB;  SUBROUTINE: FUNC'WRITE'CQ"                <<04416>>36950000
subroutine func'write'cq;                                      <<04416>>36955000
                                                               <<04416>>36960000
begin                                                          <<04416>>36965000
                                                               <<04416>>36970000
                                                               <<04416>>36975000
  if not parm'mask.(14:1) then go exit'false;                  <<04416>>36980000
                                                               <<04416>>36985000
  if not parm'mask.(15:1) then                                 <<04416>>36990000
    target'len := ulab0(ulab0'cq'max'entry'size);              <<04416>>36995000
                                                               <<04416>>37000000
  if ulab0(ulab0'cq'empty) then                                <<04416>>37005000
    begin                                                      <<04416>>37010000
                                                               <<04416>>37015000
    @tail := cq'ptr'to'ptr( ulab0(ulab0'cq'tail'ptr) );        <<04416>>37020000
    move tail := target, (target'len);                         <<04416>>37025000
                                                               <<04469>>37030000
    ulab0(ulab0'cq'empty) := false;                            <<04416>>37035000
    end'of'check'points := false;                              <<04469>>37040000
                                                               <<04416>>37045000
    end                                                        <<04416>>37050000
  else                                                         <<04416>>37055000
    begin                                                      <<04416>>37060000
                                                               <<04416>>37065000
    increment'cq'ptr( ulab0(ulab0'cq'tail'ptr) );              <<04416>>37070000
    @tail := cq'ptr'to'ptr( ulab0(ulab0'cq'tail'ptr) );        <<04416>>37075000
    move tail := target, (target'len);                         <<04416>>37080000
                                                               <<04416>>37085000
    if ulab0(ulab0'cq'head'ptr) = ulab0(ulab0'cq'tail'ptr) then<<04416>>37090000
      increment'cq'ptr( ulab0(ulab0'cq'head'ptr) );            <<04416>>37095000
                                                               <<04416>>37100000
    end;                                                       <<04416>>37105000
                                                               <<04416>>37110000
  put'ulab(ulab'cq, current'ulab);                             <<04416>>37115000
                                                               <<04416>>37120000
end; << of subroutine func'write'cq >>                         <<04416>>37125000
                                                               <<04416>>37130000
$PAGE "(OUTPUT) ",&                                            <<04416>>37135000
$"PROCEDURE: FULAB;  SUBROUTINE: SET'FUNC'MASK"                <<04416>>37140000
subroutine set'func'mask(new'value);                           <<04416>>37145000
                                                               <<04416>>37150000
  value                  new'value ;                           <<04416>>37155000
                                                               <<04416>>37160000
  logical                new'value ;                           <<04416>>37165000
                                                               <<04416>>37170000
begin                                                          <<04416>>37175000
                                                               <<04416>>37180000
                                                               <<04416>>37185000
  if parm'mask.(14:1) then                                     <<04416>>37190000
    begin                                                      <<04416>>37195000
    fulab'func'mask := fulab'func'mask &csl(sub'func + 1);     <<04416>>37200000
    fulab'func'mask.(15:1) := new'value;                       <<04416>>37205000
    fulab'func'mask := fulab'func'mask &csr(sub'func + 1);     <<04416>>37210000
    end                                                        <<04416>>37215000
  else                                                         <<04416>>37220000
    fulab'func'mask := new'value;                              <<04416>>37225000
                                                               <<04416>>37230000
end; << of subroutine func'write'cq >>                         <<04416>>37235000
                                                               <<04416>>37240000
$PAGE "(OUTPUT) PROCEDURE: FULAB"                              <<04416>>37245000
                                                               <<04416>>37250000
                                                               <<04416>>37255000
<< * * *                 Procedure body                * * * >><<04416>>37260000
                                                               <<04416>>37265000
  if not parm'mask.(13:1) then go exit'false;                  <<04416>>37270000
                                                               <<04416>>37275000
  if not ( fulab'min <= fulab'func <= fulab'max ) then         <<04416>>37280000
       << invalid function >>                                  <<04416>>37285000
    go exit'false;                                             <<04416>>37290000
                                                               <<04416>>37295000
  if not logical( fulab'func'mask &csl(fulab'func+1) ) and     <<04416>>37300000
       not ( fulab'func = fulab'open ) then                    <<04416>>37305000
    begin                                                      <<04416>>37310000
    if fulab'func = fulab'read'cq then                         <<04416>>37315000
      end'of'check'points := true;                             <<04416>>37320000
    go exit'true;                                              <<04416>>37325000
    end;                                                       <<04416>>37330000
                                                               <<04416>>37335000
  if not ciper then go exit'true;                              <<04416>>37340000
                                                               <<04416>>37345000
  case fulab'func of                                           <<04416>>37350000
                                                               <<04416>>37355000
    case'begin                                                 <<04416>>37360000
                                                               <<04416>>37365000
                                                               <<04416>>37370000
      << fulab'open >>                                         <<04416>>37375000
    func'open;                                                 <<04416>>37380000
                                                               <<04416>>37385000
                                                               <<04416>>37390000
      << fulab'close >>                                        <<04416>>37395000
    ;                                                          <<04416>>37400000
                                                               <<04416>>37405000
      << fulab'read'cq >>                                      <<04416>>37410000
    func'read'cq;                                              <<04416>>37415000
                                                               <<04416>>37420000
                                                               <<04416>>37425000
      << fulab'write'cq >>                                     <<04416>>37430000
    func'write'cq;                                             <<04416>>37435000
                                                               <<04416>>37440000
                                                               <<04416>>37445000
      << fulab'enable'func >>                                  <<04416>>37450000
    set'func'mask( true );                                     <<04416>>37455000
                                                               <<04416>>37460000
                                                               <<04416>>37465000
      << fulab'disable'func >>                                 <<04416>>37470000
    set'func'mask( false );                                    <<04416>>37475000
                                                               <<04416>>37480000
                                                               <<04416>>37485000
    case'end;                                                  <<04416>>37490000
                                                               <<04416>>37495000
  put'ulab0;                                                   <<04416>>37500000
                                                               <<04416>>37505000
                                                               <<04416>>37510000
exit'true:                                                     <<04416>>37515000
                                                               <<04416>>37520000
  fulab := true;                                               <<04416>>37525000
  return;                                                      <<04416>>37530000
                                                               <<04416>>37535000
                                                               <<04416>>37540000
exit'spoolfile'ioerr:                                          <<04416>>37545000
                                                               <<04416>>37550000
  << 230 SP#\/#O! deferred, spoofle I/O error >>               <<06334>>37555000
  genmsg(1,230,%11000,device,devfileid,,,,0);                  <<04416>>37560000
  imagetype := iospooflerr;                                    <<04416>>37565000
  filerequest := deferfile;                                    <<04416>>37570000
  go exit'false;                                               <<04416>>37575000
                                                               <<04416>>37580000
                                                               <<04416>>37585000
exit'false:                                                    <<04416>>37590000
                                                               <<04416>>37595000
  fulab := false;                                              <<04416>>37600000
                                                               <<04416>>37605000
end; << of procedure fulab >>                                  <<04416>>37610000
                                                               <<04416>>37615000
$PAGE "(OUTPUT) PROCEDURE: CIPER'RESUMESPOOL"                  <<04415>>37620000
logical procedure ciper'resumespool(pagecnt, backwards);       <<04415>>37625000
                                                               <<04415>>37630000
  value                             pagecnt, backwards ;       <<04415>>37635000
                                                               <<04415>>37640000
  integer                           pagecnt            ;       <<04415>>37645000
                                                               <<04415>>37650000
  logical                                    backwards ;       <<04415>>37655000
                                                               <<04415>>37660000
  option privileged, uncallable;                               <<04415>>37665000
                                                               <<04415>>37670000
begin                                                          <<04415>>37675000
                                                               <<04415>>37680000
                                                               <<04415>>37685000
  double                                                       <<04415>>37690000
                                                               <<04415>>37695000
     last'checkpoint                                           <<04415>>37700000
    ,offset                                                    <<04415>>37705000
  ;                                                            <<04415>>37710000
                                                               <<04415>>37715000
                                                               <<04415>>37720000
<< * * *                 Procedure body                * * * >><<04415>>37725000
                                                               <<04415>>37730000
  last'checkpoint := ulab0'd(ulab0'd'last'checkpoint);         <<04415>>37735000
                                                               <<04415>>37740000
  if backwards then                                            <<04415>>37745000
    begin                                                      <<04415>>37750000
                                                               <<04415>>37755000
    if double(pagecnt) + double(sent'a'header) >               <<04469>>37760000
         last'checkpoint then                                  <<04469>>37765000
      begin                                                    <<04415>>37770000
<< 263 Ldev#\ restart pagecount pointed before start of file >><<06334>>37775000
      genmsg(1, 263, %10000, device,,,,, 0);                   <<04469>>37780000
      offset := double(sent'a'header);                         <<04415>>37785000
      end                                                      <<04415>>37790000
                                                               <<04415>>37795000
    else                                                       <<04415>>37800000
      offset := last'checkpoint - double(pagecnt);             <<04415>>37805000
                                                               <<04415>>37810000
    end                                                        <<04415>>37815000
  else                                                         <<04415>>37820000
    offset := last'checkpoint + double(pagecnt);               <<04415>>37825000
                                                               <<04415>>37830000
  ciper'resumespool := ciper'restart'page(offset, false);      <<04415>>37835000
                                                               <<04415>>37840000
end; << of procedure ciper'resumespool >>                      <<04415>>37845000
                                                               <<04415>>37850000
$PAGE "GLOBAL SYMBOL TABLE"                                    <<04397>>37855000
$PAGE                                                          <<04397>>37860000
$CONTROL SEGMENT= MAIN                                         <<04397>>37865000
END. << of module Spooling >>                                  <<04397>>37870000
