$CONTROL NOWARN,USLINIT,MAP,CODE,MAIN=SDFMAINLINE                       00010000
$copyright     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1976. ",            & 00015000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00020000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00025000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00030000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00035000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00040000
$title "GLOBAL DATA DEFINITIONS."                                       00045000
begin                                                                   00050000
                                                                        00055000
                                                                        00060000
<<-----------------------------------------------------------------     00065000
          software dump facility mainline                               00070000
----------------------------------------------------------------->>     00075000
                                                                        00080000
                                                                        00085000
<<* * * miscellaneous definitions * * *>>                               00090000
                                                                        00095000
integer array deltaq(*)=q-0;                                            00100000
logical stat=q-1;                                                       00105000
logical returnp=q-2;  <<return pointer in stack marker>>                00110000
logical pmap=q-4;     <<option variable parameter map>>                 00115000
integer xreg=x;                                                         00120000
integer s0=s-0,s1=s-1,s2=s-2,s3=s-3,s4=s-4,s5=s-5;                      00125000
pointer sp0=s-0;                                                        00130000
integer qm0=q-0,qm5=q-5,qm7=q-7;                                        00135000
logical ls0=s-0, ls1=s-1;                                      <<03017>>00140000
byte bs0=s-0,bs1=s-1;                                                   00145000
byte pointer bps0=s-0,bps1=s-1;                                         00150000
double ds3=s-3,ds6=s-6;                                                 00155000
integer runparm=q-4;                                                    00160000
integer version:=%01;                                          <<d8951>>00165000
logical saveareasectorsize;  <<may be 128 for discs or>>       <<03605>>00170000
                             <<512 for linus cartridge tape>>  <<03605>>00175000
                                                                        00180000
equate                                                                  00185000
      recsize         = 72,                                             00190000
   sectorsize        = 128,                                             00195000
   quadruplesectorsize = 512,   <<linus sector is 512 words>>  <<03605>>00200000
   deviceclose       = 4,                                               00205000
   rewind            = 5,                                      <<b8100>>00210000
   writeof           = 6,                                               00215000
   forwardspacefile  = 7,                                               00220000
   setdensity1600    = 16,  << density for dump to 7976 >>     <<02669>>00225000
   clear7976         = 17,  << 7976 dvr clear function  >>     <<02669>>00230000
   immedreport       = 18,  << 7974 enable immediate report >> <<k7526>>00235000
   carriagereturn    = %15,                                             00240000
   maxbank           = 15,                                              00245000
   maxunit           = 15,                                              00250000
   maxdrt          = %777,                                     <<03749>>00255000
   mindrt            = 4,                                               00260000
   forever           = true,                                            00265000
   ccg               = 0,                                               00270000
   ccl               = 1,                                               00275000
   cce               = 2;                                               00280000
define                                                                  00285000
   carrybit          = stat.(5:1)#,                                     00290000
   asmb     =assemble#,                                        <<03605>>00295000
   conditioncode     = stat.(6:2)#;                                     00300000
integer pointer                                                         00305000
   contextbase      = 3;                                                00310000
                                                                        00315000
                                                                        00320000
<<* * *  message numbers * * *>>                                        00325000
                                                                        00330000
equate                                                                  00335000
   mountnewpack     = 55,                                               00340000
   fatalerror       = 56,                                               00345000
   softwarerror     = 57,                                               00350000
   badpackformat    = 58,                                               00355000
   systemdiscerr    = 59,                                               00360000
   checksumerr      = 60,                                               00365000
   hardwarerrormsg  = 61,                                               00370000
   powerfailmsg     = 62,                                               00375000
   sysdiscdrt       = 63,                                               00380000
   serialdiscerr    = 64,                                               00385000
   invalidnum       = 65,                                               00390000
   invalidev        = 66,                                               00395000
   invalidisc       = 67,                                               00400000
   entersubtype     = 68;                                               00405000
                                                                        00410000
                                                                        00415000
<<* * * performio logical devices * * *>>                               00420000
                                                                        00425000
equate                                                                  00430000
   systemdisc       = 1,                                                00435000
   serialdevice     = 2,                                                00440000
   commandisc       = 3,                                                00445000
   dumpdisc         = 4;                                                00450000
                                                                        00455000
                                                                        00460000
<<* * * driver function codes * * *>>                                   00465000
                                                                        00470000
equate                                                                  00475000
   input            = 0,                                                00480000
   output           = 1,                                                00485000
   insertdisc       = 2;                                                00490000
                                                                        00495000
                                                                        00500000
<<* * * performio return status * * *>>                                 00505000
                                                                        00510000
equate                                                                  00515000
   successfulio     = 1,                                                00520000
   badio            = 4;                                                00525000
                                                                        00530000
                                                                        00535000
                                                                        00540000
<<* * * device types and subtypes * * *>>                               00545000
                                                                        00550000
equate                                                                  00555000
   t13037           = 0,    <<discs using 13037 controller>>            00560000
   tflexible        = 2,                                                00565000
   tconsole         = 16,                                               00570000
   t'cs'80      =  3,    <<type for command set 80 devices>>   <<03605>>00575000
   stype'a9140  =  0,    <<subtype for linus cartridge tape>>  <<03605>>00580000
   tmagtape         = 24,                                      <<02669>>00585000
   stype7976        =  1,                                      <<k7526>>00590000
   stype7978        =  2,                                      <<k7526>>00595000
   stype7974        =  3;                                      <<k7526>>00600000
                                                                        00605000
equate                                                                  00610000
   r7905            = 4,                                                00615000
   f7905            = 5,                                                00620000
   a7905            = 6,                                                00625000
   fhdiscreplacement= 7,                                                00630000
   a7920            = 8,                                                00635000
   a7925            = 9,                                                00640000
   r7906            = 10,                                               00645000
   f7906            = 11,                                               00650000
   a7906            = 12;                                               00655000
                                                                        00660000
                                                                        00665000
<<* * * desc fields * * *>>                                             00670000
                                                                        00675000
   define                                                               00680000
      descdrt             = desc0.(0:9)     #,                 <<03017>>00685000
      descsubtype         = desc0.(9:4)     #,                 <<03017>>00690000
      descunit            = desc0.(13:3)    #,                 <<03017>>00695000
      desctype            = desc1           #;                          00700000
                                                                        00705000
                                                                        00710000
<<* * * modes * * *>>                                                   00715000
                                                                        00720000
<<sdf execution modes>>                                                 00725000
equate                                                                  00730000
   syntaxchecking    = 0,                                               00735000
   command           = 1,                                               00740000
   interactive       = 2;                                               00745000
                                                                        00750000
<<dump mode>>                                                           00755000
equate                                                                  00760000
                                                                        00765000
   <<variables used by dumpsysdisc>>                                    00770000
   serialdevicedump  = 0,                                               00775000
   discfiledump      = 1;                                               00780000
                                                                        00785000
integer                                                                 00790000
   mode,dumpmode;                                                       00795000
integer                                                                 00800000
   recordcount:=0;                                                      00805000
logical                                                                 00810000
   nosystemdisc;                                                        00815000
                                                                        00820000
<<* * * command processing parameters * * *>>                           00825000
equate                                                                  00830000
   <<values returned by getnextparm>>                                   00835000
   keywordparm        = 0,                                              00840000
   dictionaryparm     = 1,                                              00845000
   alphanumericparm   = 2,                                              00850000
   numericparm        = 3,                                              00855000
   nullparm           = 4,                                              00860000
   invalidparm        = 5,                                              00865000
                                                                        00870000
   maxcommandnum      = 10,                                             00875000
   maxparms           = 40,                                             00880000
   maxparmlength      = 8,                                              00885000
   comma              = 0,                                              00890000
   dash               = 1,                                              00895000
   equal              = 2,                                              00900000
   semicolon          = 3,                                              00905000
   cr                 = 4;                                              00910000
                                                                        00915000
                                                                        00920000
byte array                                                              00925000
   delim(0:4):=",-=;",%15;                                              00930000
                                                                        00935000
integer                                                                 00940000
   commandtype;                                                         00945000
                                                                        00950000
                                                                        00955000
<<* * * variables implicitly accessed by low level procedures * * *>>   00960000
  << sdfmap  - storage map related >>                          <<03017>>00965000
  <<===============================>>                          <<03017>>00970000
                                                               <<03017>>00975000
equate                                                         <<03017>>00980000
     memory        = 1,                                        <<03017>>00985000
     sdf'file      = 2,                                        <<03017>>00990000
     mapentrysize  = 8;    <<record length in words>>          <<03017>>00995000
                                                               <<03017>>01000000
equate      <<fields in map records>>                          <<03017>>01005000
     srcmedia      = 0,    <<source was from mem,disc, etc>>   <<03017>>01010000
     stgmedia      = 1,    <<storage is on disc,mem,etc.>>     <<03017>>01015000
   dsrc'start      = 1,    <<source start address>>            <<03017>>01020000
     src'start'hi  = 2,                                        <<03017>>01025000
     src'start'lo  = 3,                                        <<03017>>01030000
   dsrc'end        = 2,    <<source end address>>              <<03017>>01035000
     src'end'hi    = 4,                                        <<03017>>01040000
     src'end'lo    = 5,                                        <<03017>>01045000
   dstg            = 3,    <<storage address>>                 <<03017>>01050000
     stg'hi        = 6,                                        <<03017>>01055000
     stg'lo        = 7;                                        <<03017>>01060000
                                                               <<03017>>01065000
logical                                                        <<03017>>01070000
     sdf'map'buffer'loaded := false;                           <<03017>>01075000
                           <<set to true when a copy of the>>  <<03017>>01080000
                           <<storage map has been read>>       <<03017>>01085000
                                                               <<03017>>01090000
array sdfmapbuffer (0:127);                                    <<03017>>01095000
     <<global buffer for sdf "STORAGE" map >>                  <<03017>>01100000
                                                               <<03017>>01105000
define sdfmap'maxbank = sdfmapbuffer(36)#;                     <<03017>>01110000
   <<bank number of upper memory bound >>                      <<03017>>01115000
                                                               <<03017>>01120000
double array                                                            01125000
   dparms(0:maxparms);                                                  01130000
array                                                                   01135000
   parms(*)=dparms;                                                     01140000
byte array                                                              01145000
   commandbuf(0:80),buf(0:80);                                          01150000
integer                                                                 01155000
   numparms,currentparm;                                                01160000
pointer                                                                 01165000
   config;                                                              01170000
double pointer                                                          01175000
   configd=config;                                                      01180000
byte pointer                                                            01185000
   commandefn,bufb:=@buf;                                               01190000
byte array                                                              01195000
   commandict(0:1034):=                                                 01200000
   23, 4, "DUMP", <<length 174>>                                        01205000
       ">DUMP [BANK NUM]",                                              01210000
     <<" [;DSEG=SEG...[,SEG]]  [;DISC=ITEM...[,ITEM]]",>>"#",           01215000
     <<" WHERE:#",>>                                                    01220000
     <<"  SEG  = ALL#",>>                                               01225000
     <<"         STACKS#",>>                                            01230000
     <<"         SYSTEM#",>>                                            01235000
     <<"         SEG NUMBER#",>>                                        01240000
     <<"         SEG NUMBER - SEG NUMBER#",>>                           01245000
   50, 8, "DUMPFILE",  <<continuation of definition for dump command>>  01250000
     <<"  ITEM = SYS DISC SECTOR#",>>                                   01255000
     <<"         SYS DISC SECTOR - SYS DISC SECTOR#",>>                 01260000
       " DUMPS MAIN MEMORY",                                            01265000
     <<", VIRTUAL MEMORY, AND/OR SYSTEM DISC AREAS#",>>                 01270000
       " TO THE DUMP DEVICE.##",                                        01275000
   58, 7, "COMMENT",                                                    01280000
       ">COMMENT <STRING>#",                                            01285000
       " COMMENT COMMANDS ARE IGNORED##",                               01290000
   57, 7, "CONSOLE",                                                    01295000
       ">CONSOLE DRT#",                                                 01300000
       " CHANGES THE CONSOLE'S DRT NUMBER##",                           01305000
   51, 5, "DEBUG",                                                      01310000
       ">DEBUG#",                                                       01315000
       " ENTERS THE HELP DEBUGGING FACILITY##",                         01320000
   83, 7, "DUMPDEV",                                                    01325000
       ">DUMPDEV [DRT  [,UNIT]]#",                                      01330000
     <<"         [DISC]#", >>                                           01335000
       " CHANGES THE DUMP DEVICE'S DRT AND UNIT NUMBERS.",              01340000
     <<" IS SPECIFIED, THE DUMP FILE NAMED IN THE DUMPFILE COMMAND#",>> 01345000
     <<" WILL BE USED",>>                                               01350000
       "##",                                                            01355000
   47, 4, "HALT",                                                       01360000
       ">HALT#",                                                        01365000
       " CAUSES SDF TO HALT ITS EXECUTION##",                           01370000
  173, 4, "HELP",                                                       01375000
       ">HELP [COMMAND NAME] [,COMMAND NAME] ... [,COMMAND NAME]#",     01380000
       " PRINTS A BRIEF EXPLANATION OF THE SPECIFIED COMMANDS.  IF#",   01385000
       " NO COMMAND NAME IS INPUT, THEN LIST ALL COMMANDS##",           01390000
   72, 11, "INTERACTIVE",                                               01395000
       ">INTERACTIVE#",                                                 01400000
       " OBTAINS REMAINING COMMANDS FROM THE CONSOLE##",                01405000
   44, 9, "WARMSTART",                                                  01410000
       ">WARMSTART#",                                                   01415000
       " INITIATES WARMSTART##",                                        01420000
   0;                                                                   01425000
                                                                        01430000
                                                                        01435000
<<* * * syntax checking parameters * * *>>                              01440000
                                                                        01445000
<<fclose>>                                                              01450000
equate                                                                  01455000
   nochange           = 0,                                              01460000
   save               = 1,                                              01465000
   purge              = 4,                                              01470000
   nosecurity         = 0;                                              01475000
<<foptions>>                                                            01480000
equate                                                                  01485000
   f1                 = 6,                                              01490000
   file               = 0,                                              01495000
   nofile             = 1,                                              01500000
   f2                 = 2,                                              01505000
   nocctl             = 0,                                              01510000
   cctl               = 1,                                              01515000
   f3                 = 2,                                              01520000
   fixed              = 0,                                              01525000
   varyable           = 1,                                              01530000
   undefined          = 2,                                              01535000
   f4                 = 3,                                              01540000
   filename           = 0,                                              01545000
   stdlist            = 1,                                              01550000
   newpass            = 2,                                              01555000
   oldpass            = 3,                                              01560000
   stdin              = 4,                                              01565000
   stdinx             = 5,                                              01570000
   null               = 6,                                              01575000
   f5                 = 1,                                              01580000
   byenary            = 0,                                              01585000
   arscii             = 1,                                              01590000
   f6                 = 2,                                              01595000
   newfile            = 0,                                              01600000
   oldsystemfile      = 1,                                              01605000
   temporaryfile      = 2,                                              01610000
   olduserfile        = 3;                                              01615000
                                                                        01620000
<<aoptions>>                                                            01625000
equate                                                                  01630000
   a1                 = 8,                                              01635000
   buffering          = 0,                                              01640000
   nobuffering        = 1,                                              01645000
   a2                 = 2,                                              01650000
   defaultaccess      = 0,                                              01655000
   exclusive          = 1,                                              01660000
   semiexclusive      = 2,                                              01665000
   share              = 3,                                              01670000
   a3                 = 6,                                              01675000
   readonly           = 0,                                              01680000
   writeonly          = 1,                                              01685000
   writesaveonly      = 2,                                              01690000
   appendonly         = 3,                                              01695000
   update             = 4,                                              01700000
   execute            = 5;                                              01705000
                                                                        01710000
define                                                                  01715000
   devtype            = 8:8#,                                           01720000
   rectype            = 8:2#;                                           01725000
                                                                        01730000
integer array                                                           01735000
   filenumber(0:3)=db:=4(0);                                            01740000
integer                                                                 01745000
   listfn=filenumber,inputfn=filenumber+1,commandfn=filenumber+2,       01750000
   oldcommandfn=filenumber+3;                                           01755000
equate                                                                  01760000
   listfx             = 0,                                              01765000
   inputfx            = 1,                                              01770000
   commandfx          = 2,                                              01775000
   oldcommandfx       = 3,                                              01780000
   endofinput         = 4;                                              01785000
logical                                                                 01790000
   syntaxerror:=false;                                                  01795000
                                                                        01800000
                                                                        01805000
<<* * * dump command data * * *>>                                       01810000
                                                                        01815000
byte array                                                              01820000
   dumpdict(0:12):=                                                     01825000
   6,4,"DSEG",                                                          01830000
   6,4,"DISC",                                                          01835000
   0;                                                                   01840000
byte array                                                              01845000
   virtdict(0:21):=                                                     01850000
   5,3,"ALL",                                                           01855000
   8,6,"STACKS",                                                        01860000
   8,6,"SYSTEM",                                                        01865000
   0;                                                                   01870000
equate                                                                  01875000
   virtualmemory     = 1;                                               01880000
                                                                        01885000
                                                                        01890000
<<* * * dump device command data * * *>>                                01895000
                                                                        01900000
byte array                                                              01905000
   dumpdevdict(0:6):=                                                   01910000
   6,4,"DISC",                                                          01915000
   0;                                                                   01920000
                                                                        01925000
                                                                        01930000
<<* * * dump file label parameters * * *>>                              01935000
                                                                        01940000
equate                                                                  01945000
   flablen          = 77;                                               01950000
define                                                                  01955000
   flmaxnumrecords  = flabd(15)        #,                               01960000
   flblocksize      = flab(38)         #,                               01965000
   flsectoroffset   = flab(39).(0:8)   #,                               01970000
   flnumextents     = flab(39).(11:5)  #,                               01975000
   flextentsize     = flab(41)         #,                               01980000
   flnumrecords     = flab(43)         #,                               01985000
   flextentbase     = flabd(22)        #;                               01990000
array                                                                   01995000
   oldflab(0:76):=flablen(0);                                           02000000
                                                                        02005000
                                                                        02010000
<<* * * command abort variables * * *>>                                 02015000
integer                                                                 02020000
   abortsregister,abortdeltaq,abortpregister,abortstatus,oldabortplabel;02025000
                                                                        02030000
                                                                        02035000
<<* * * * print strings * * *>>                                         02040000
                                                                        02045000
byte array                                                              02050000
   space(0:1):=" #";                                                    02055000
byte array                                                              02060000
   prompt(0:1):=">#";                                                   02065000
byte array                                                              02070000
   badcommandfile(0:35):="COMMAND FILE HAS INVALID ATTRIBUTES#";        02075000
byte array                                                              02080000
   badevice(0:24):="INVALID DEVICE SPECIFIED#";                         02085000
byte array                                                              02090000
   badsystemdisc(0:41):="ONLY DUMPED MEMORY DUE TO BAD SYSTEM DISC#";   02095000
byte array                                                              02100000
   commandfileof(0:27):="END-OF-FILE ON COMMAND FILE#";                 02105000
byte array                                                              02110000
   commandfilerr(0:18):="COMMAND FILE ERROR#";                          02115000
byte array                                                              02120000
   dumpdevicefail(0:25):="DUMP FILE DEVICE FAILURE#";                   02125000
byte array                                                              02130000
   errormessage(0:18):="* * * ERROR * * * #";                           02135000
byte array                                                              02140000
   expectedkeyword(0:26):="EXPECTED KEYWORD PARAMETER#";                02145000
byte array                                                              02150000
   exhaustedumpfile(0:19):="EXHAUSTED DUMP FILE#";                      02155000
byte array                                                              02160000
   expectednumber(0:28):="EXPECTED NUMERICAL PARAMETER#";               02165000
byte array                                                              02170000
   expectedparm(0:28):="EXPECTED POSITIONAL PARAMETER#";                02175000
byte array                                                              02180000
   extraparm(0:20):="EXTRANEOUS PARAMETER#";                            02185000
byte array                                                              02190000
   invalidrange(0:45):="END OF RANGE SMALLER THAN BEGINNING OF RANGE #";02195000
byte array                                                              02200000
   invalidvalue(0:23):="INVALID PARAMETER VALUE#";                      02205000
byte array                                                              02210000
   nodumpdevice(0:15):="NO DUMP DEVICE #";                              02215000
byte array                                                              02220000
   nodumpfilextant(0:20):="NO DUMP FILE EXISTS #";                      02225000
byte array eotserialdevice(0:45):=                                      02230000
   "END-OF-TAPE ON DUMP DEVICE, MOUNT NEXT VOLUME#";                    02235000
byte array                                                              02240000
   serialdevicefail(0:21):="SERIAL DEVICE FAILURE#";                    02245000
byte array                                                              02250000
   successful(0:10):="SUCCESSFUL#";                                     02255000
byte array                                                              02260000
   systemdiscfail(0:19):="SYSTEM DISC FAILURE#";                        02265000
byte array                                                              02270000
   uglydumpfilelabel(0:28):="INVALID DUMP FILE FILE-LABEL#";            02275000
byte array                                                              02280000
   unknowncommand(0:15):="UNKNOWN COMMAND#";                            02285000
byte array                                                     <<03110>>02290000
  tryagain1(0:41):="SERIAL DEVICE I/O ERROR - You are now in#";<<03110>>02295000
byte array                                                     <<03110>>02300000
  tryagain2(0:41):="SOFTDUMP INTERACTIVE MODE.  Please mount#";<<03110>>02305000
byte array                                                     <<03110>>02310000
  tryagain3(0:40):="new media, then type 'DUMP' in response#"; <<03110>>02315000
byte array                                                     <<03110>>02320000
  tryagain4(0:19):="to the prompt '>'.#";                      <<03110>>02325000
                                                                        02330000
                                                                        02335000
<<* * * icf/25 instruction definitions * * *>>                          02340000
                                                                        02345000
define                                                                  02350000
   siop             = con %20302; con 0    #,                           02355000
   hiop             = con %20302; con 1    #,                           02360000
   rioc             = con %20302; con 2    #,                           02365000
   wioc             = con %20302; con 3    #,                           02370000
   rocl             = con %20302; con 4    #,                           02375000
   iocl             = con %20302; con 5    #,                           02380000
   init             = con %20302; con 6    #,                           02385000
   mcs              = con %20302; con 7    #,                           02390000
   seml             = con %20302; con 8    #,                           02395000
   strt             = con %20302; con 9    #,                           02400000
   dumper           = con %20302; con 10   #,                           02405000
   rioa             = con %20302; con 11   #,                  <<03017>>02410000
   wioa             = con %20302; con 12   #,                  <<03017>>02415000
   rccr             = con %20104; con 0    #,                           02420000
   sclr             = con %20104; con 1    #,                           02425000
   toff             = con %20104; con 2    #,                           02430000
   ton              = con %20104; con 3    #,                           02435000
   hbpe             = con %20104; con 4    #,                           02440000
   hbpd             = con %20104; con 5    #,                           02445000
   sinc             = con %20104; con 8    #;                           02450000
$page "CONFIGURE DATA SEGMENT"                                          02455000
<<* * * configuration table * * *>>                                     02460000
                                                                        02465000
equate                                                                  02470000
   ctconfiglen      = 68,                                               02475000
   ctblocklen       = 1024,                                             02480000
   ctblockloc       = 3;                                                02485000
                                                                        02490000
define                                                                  02495000
   ctchecksum       = config           #,                               02500000
   ctnumberbanks    = config(1)        #,                               02505000
                                                                        02510000
   ctdumpdevdesc    = configd(1)       #,                               02515000
   ctdumpdevdrt     = config(2).(0:9)  #,                      <<03017>>02520000
   ctdumpdevsubtype = config(2).(9:4)  #,                      <<03017>>02525000
   ctdumpdevunit    = config(2).(13:3) #,                      <<03017>>02530000
   ctdumpdevtype    = config(3)        #,                               02535000
                                                                        02540000
   ctlineptrdesc    = configd(2)       #,                               02545000
   ctlineptrdrt     = config(4).(0:9)  #,                      <<03017>>02550000
   ctlineptrsubtype = config(4).(9:4)  #,                      <<03017>>02555000
   ctlineptrunit    = config(4).(13:3) #,                      <<03017>>02560000
   ctlineptrdevtype = config(5)        #,                               02565000
                                                                        02570000
   ctconsoledesc    = configd(3)       #,                               02575000
   ctconsoledrt     = config(6).(0:9)  #,                      <<03017>>02580000
   ctconsolesubtype = config(6).(9:4)  #,                      <<03017>>02585000
   ctconsoleunit    = config(6).(13:3) #,                      <<03017>>02590000
   ctconsoledevtype = config(7)        #,                               02595000
                                                                        02600000
   ctcommandesc     = configd(4)       #,                               02605000
   ctcommandrt      = config(8).(0:9)  #,                      <<03017>>02610000
   ctcommandsubtype = config(8).(9:4)  #,                      <<03017>>02615000
   ctcommandunit    = config(8).(13:3) #,                      <<03017>>02620000
   ctcommandevtype  = config(9)        #,                               02625000
                                                                        02630000
   ctsysdiscdesc    = configd(5)       #,                               02635000
   ctsysdiscdrt     = config(10).(0:9) #,                      <<03017>>02640000
   ctsysdiscsubtype = config(10).(9:4) #,                      <<03017>>02645000
   ctsysdiscunit    = config(10).(13:3)#,                      <<03017>>02650000
   ctsysdiscdevtype = config(11)       #,                               02655000
                                                                        02660000
   ctdumpfiledesc   = configd(6)       #,                               02665000
   ctdumpfiledrt    = config(12).(0:9) #,                      <<03017>>02670000
   ctdumpfilesubtype= config(12).(9:4) #,                      <<03017>>02675000
   ctdumpfileunit   = config(12).(13:3)#,                      <<03017>>02680000
   ctdumpfiledevtype= config(13)       #,                               02685000
   ctdumpfilelen    = config(14)       #,                               02690000
                                                                        02695000
   ctmode           = config(15)       #,                               02700000
   ctcommandfile    = configd(8)       #,                               02705000
   ctdumpfile       = configd(9)       #,                               02710000
   ctoverlaysecnum  = configd(10)      #,                               02715000
   ctbadsysdisc     = config(22).(0:1) #,                               02720000
   ctbackupdump     = config(22).(1:1) #,                               02725000
   ctcommandlength  = config(23)       #;                               02730000
                                                                        02735000
                                                                        02740000
<<* * * context area * * *>>                                            02745000
                                                                        02750000
define                                                                  02755000
   cnmachineid      = contextbase(0).(8:8) #,                  <<03017>>02760000
   cndumpdesc       = contextbase(1)       #,                           02765000
   cndumpdevdrt     = contextbase(1).(7:9) #,                  <<03017>>02770000
   cnxregister      = contextbase(2)       #,                           02775000
   cndlregister     = contextbase(3)       #,                           02780000
   cndbankregister  = contextbase(4)       #,                           02785000
   cndbregister     = contextbase(5)       #,                           02790000
   cnqregister      = contextbase(6)       #,                           02795000
   cnsregister      = contextbase(7)       #,                           02800000
   cnsbankregister  = contextbase(8)       #,                           02805000
   cnzregister      = contextbase(9)       #,                           02810000
   cnstatusregister = contextbase(10)      #,                           02815000
   cnpbankregister  = contextbase(11)      #,                           02820000
   cnpbregister     = contextbase(12)      #,                           02825000
   cnpregister      = contextbase(13)      #,                           02830000
   cnplregister     = contextbase(14)      #,                           02835000
   cnciregister     = contextbase(15)      #,                           02840000
   cnnumbanks       = contextbase(16)      #,                           02845000
   cnsystemfailnum  = contextbase(17)      #,                           02850000
   cninterruptstatus= contextbase(18)      #,                           02855000
   cnbanksdumped    = contextbase(19)      #,                           02860000
   cninterruptmask  = contextbase(%110)    #,                           02865000
   cndumpdrt0       = contextbase(%111)    #,                           02870000
   cndumpdrt1       = contextbase(%112)    #,                           02875000
   cndumpdrt2       = contextbase(%113)    #,                           02880000
   cndumpdrt3       = contextbase(%114)    #,                  <<03017>>02885000
   cndrtbank        = contextbase(%122)    #,                  <<03017>>02890000
   cndrtoffset      = contextbase(%123)    #,                  <<03017>>02895000
   cnmaskimb0       = contextbase(%124)    #,                  <<03017>>02900000
   cnmaskimb1       = contextbase(%125)    #,                  <<03017>>02905000
   cnmaskimb2       = contextbase(%126)    #,                  <<03017>>02910000
   cnmaskimb3       = contextbase(%127)    #,                  <<03017>>02915000
   cnsdfinitversion = contextbase(%130)    #,                  <<03017>>02920000
   cnciversion      = contextbase(%131)    #,                  <<03017>>02925000
   cnutilversion    = contextbase(%132)    #,                  <<03017>>02930000
   cntapeversion    = contextbase(%133)    #;                  <<03017>>02935000
$page "EXTERNAL PROCEDURES."                                            02940000
intrinsic                                                               02945000
   print,quit,xcontrap,ascii,dascii,binary,dbinary,fopen,fread,fwrite,  02950000
   fgetinfo,frename,fclose,terminate,printfileinfo,mycommand,search;    02955000
                                                               <<d8951>>02960000
<<================= external procedure declarations ========>> <<d8951>>02965000
                                                               <<d8951>>02970000
logical procedure consoleislynx;                               <<d8951>>02975000
   option external;                                            <<d8951>>02980000
                                                               <<d8951>>02985000
procedure lynxstopidle;                                        <<d8951>>02990000
   option external;                                            <<d8951>>02995000
                                                               <<d8951>>03000000
integer procedure getio (num);                                 <<d8951>>03005000
value num;                                                     <<d8951>>03010000
integer num;                                                   <<d8951>>03015000
   option external;                                            <<d8951>>03020000
                                                               <<d8951>>03025000
logical procedure drtr (drt, offset);                          <<d8951>>03030000
value drt, offset;                                             <<d8951>>03035000
integer  drt, offset;                                          <<d8951>>03040000
   option external;                                            <<d8951>>03045000
                                                               <<d8951>>03050000
procedure setio (dat, cod);                                    <<d8951>>03055000
value dat, cod;                                                <<d8951>>03060000
integer dat, cod;                                              <<d8951>>03065000
   option external;                                            <<d8951>>03070000
                                                               <<d8951>>03075000
integer procedure ttyin (buf, count);                          <<d8951>>03080000
value count;                                                   <<d8951>>03085000
integer count;                                                 <<d8951>>03090000
byte array buf;                                                <<d8951>>03095000
   option external;                                            <<d8951>>03100000
                                                               <<d8951>>03105000
procedure crlf;                                                <<d8951>>03110000
   option external;                                            <<d8951>>03115000
                                                               <<d8951>>03120000
procedure print'dus'rev;                                       <<d8951>>03125000
   option external;                                            <<d8951>>03130000
                                                               <<d8951>>03135000
procedure print'sdfutil'rev;                                   <<d8951>>03140000
   option external;                                            <<d8951>>03145000
                                                               <<d8951>>03150000
<<========== end of external procedure declarations ========>> <<d8951>>03155000
                                                                        03160000
                                                                        03165000
integer procedure printstring(text,count,control);                      03170000
value text,count,control;                                               03175000
byte pointer text;                                                      03180000
integer count,control;                                                  03185000
option variable,forward;                                                03190000
$page "REQUIRED BUT NOT USED PROCEDURES FOR SYNTAX CHECKING MODE."      03195000
$control segment=synseg                                                 03200000
procedure fatal;                                                        03205000
   begin                                                                03210000
   array fatalmsg(0:40);                                                03215000
   move fatalmsg:="* * * FATAL SOFTWARERROR * * *",2;                   03220000
   print(fatalmsg,s0-@fatalmsg,0);                                      03225000
   end  <<fatal>>;                                                      03230000
                                                               <<02669>>03235000
                                                               <<02669>>03240000
<< delay for "TIME" milliseconds >>                            <<02669>>03245000
procedure delay(time);                                         <<02669>>03250000
value time;                                                    <<02669>>03255000
double time;                                                   <<02669>>03260000
fatal;                                                         <<02669>>03265000
                                                               <<02669>>03270000
                                                               <<02669>>03275000
                                                                        03280000
                                                                        03285000
logical procedure checkdisc(desc);                                      03290000
value desc;                                                             03295000
double desc;                                                            03300000
fatal;                                                                  03305000
                                                                        03310000
procedure waitinsertdisc(ldev);                                         03315000
value ldev;                                                             03320000
integer ldev;                                                           03325000
fatal;                                                                  03330000
                                                                        03335000
procedure initadcc(n);                                                  03340000
value n;                                                                03345000
integer n;                                                              03350000
fatal;                                                                  03355000
                                                                        03360000
procedure help;                                                         03365000
fatal;                                                                  03370000
                                                                        03375000
procedure message(n);                                                   03380000
value n; integer n;    <<message number>>                               03385000
fatal;                                                                  03390000
                                                                        03395000
logical procedure identifydevice(drtunit,desc);                         03400000
value drtunit;                                                          03405000
integer                                                                 03410000
   drtunit;           <<(0:8) - drt # of device to be identified        03415000
                        (8:8) - unit # of the device>>                  03420000
double                                                                  03425000
   desc;              <<drt, subtype, unit, type format>>               03430000
fatal;                                                                  03435000
                                                                        03440000
double procedure performio(ldev,function,target,count,parm);            03445000
value ldev,function,count,parm;                                         03450000
integer                                                                 03455000
   ldev,              <<logical device number                           03460000
                        1 = system disc                                 03465000
                        2 = serial disc                                 03470000
                        3 = mag tape                                    03475000
                        4 = aux disc 1                                  03480000
                        5 = aux disc 2>>                                03485000
   function,          <<0 = read                                        03490000
                        1 = write                                       03495000
                        others are driver defined>>                     03500000
   count;             <<length of the buffer                            03505000
                        + = words                                       03510000
                        - = bytes>>                                     03515000
array                                                                   03520000
   target;            <<db relative addr of data buffer>>               03525000
double                                                                  03530000
   parm;              <<driver defined                                  03535000
                        disc driver - logical segment addr>>            03540000
option variable;                                                        03545000
   begin                                                                03550000
   define condcode=stat.(6:2)#;                                         03555000
   equate cce=2;                                                        03560000
   integer i;                                                           03565000
   if function=0 then                                                   03570000
      for i:=0 until count-1 do target(i):=i;                           03575000
   condcode:=cce;                                                       03580000
   end;                                                                 03585000
                                                                        03590000
logical procedure exchangedb(dstx);                                     03595000
value dstx;                                                             03600000
integer dstx;         <<target data segment number>>                    03605000
fatal;                                                                  03610000
                                                                        03615000
                                                                        03620000
procedure changedevice(sysdiscdesc,serdiscdesc,auxdisc1desc,            03625000
   auxdisc2desc,consoledesc,printerdesc);                               03630000
value sysdiscdesc,serdiscdesc,auxdisc1desc,auxdisc2desc,                03635000
   consoledesc,printerdesc;                                             03640000
double                                                                  03645000
   sysdiscdesc,       <<device descriptors>>                            03650000
   serdiscdesc,       <<word 0 - 0:8  - drt>>                           03655000
   auxdisc1desc,      <<         8:4  - subtype>>                       03660000
   auxdisc2desc,      <<         12:4 - unit>>                          03665000
   consoledesc,       <<word 1 - device type>>                          03670000
   printerdesc;                                                         03675000
option variable;                                                        03680000
fatal;                                                                  03685000
$page "SYNTAX CHECKING MODE PROCEDURES"                                 03690000
$control segment=seg'                                                   03695000
                                                               <<d8951>>03700000
<<read from the console>>                                      <<d8951>>03705000
integer procedure read(target,targetlen);                      <<d8951>>03710000
value targetlen;                                               <<d8951>>03715000
byte array target;                                             <<d8951>>03720000
integer targetlen;                                             <<d8951>>03725000
begin                                                          <<d8951>>03730000
   read := ttyin (target, targetlen);                          <<d8951>>03735000
   crlf;                                                       <<d8951>>03740000
end;                                                           <<d8951>>03745000
                                                               <<d8951>>03750000
<< shuts off ctl y/atn channel program>>                       <<d8951>>03755000
procedure stopidle;                                            <<d8951>>03760000
begin                                                          <<d8951>>03765000
integer hold, waittime;                                        <<d8951>>03770000
logical interruptcode, interruptstatus, hardwarestatus;        <<d8951>>03775000
   if consoleislynx then                                       <<d8951>>03780000
      lynxstopidle    <<halt channel program>>                 <<d8951>>03785000
   else                                                        <<d8951>>03790000
      begin                                                    <<d8951>>03795000
         hold := getio (0);                                    <<d8951>>03800000
         asmb (load hold; hiop);                               <<d8951>>03805000
         while drtr (hold, 3) <> 0 do;  <<wait for hiop>>      <<d8951>>03810000
      end;                                                     <<d8951>>03815000
   setio (0, 6);  <<clear atn location>>                       <<d8951>>03820000
end  <<stopidle>>;                                             <<d8951>>03825000
                                                               <<d8951>>03830000
procedure syntaxexit(filex);                                            03835000
value filex;                                                            03840000
integer                                                                 03845000
   filex;              <<=  0 no file failed                            03850000
                         <> 0 failing file's index into file array>>    03855000
   begin                                                                03860000
   define                                                               03865000
      oldcfoptions    = [f1/nofile,f2/nocctl,f3/fixed,f4/filename,      03870000
                         f5/arscii,f6/oldsystemfile]#,                  03875000
      oldcaoptions    = [a1/buffering,a2/exclusive,a3/writeonly]#;      03880000
   integer i,length,dummy;                                              03885000
   byte array desig(0:28),desig1(0:28);                                 03890000
                                                                        03895000
   subroutine errortermination;                                         03900000
      begin                                                             03905000
      <<insure that all the files are closed>>                          03910000
      fclose(listfn,save,nosecurity);                                   03915000
      fclose(inputfn,nochange,nosecurity);                              03920000
      fclose(commandfn,nochange,nosecurity);                            03925000
      fclose(oldcommandfn,nochange,nosecurity);                         03930000
                                                                        03935000
      <<inform user that no new command file was created>>              03940000
      move buf:="* * * NO NEW COMMAND FILE CREATED * * *",2;            03945000
      print(buf,@buf-s0,0);                                             03950000
      quit(0);                                                          03955000
      end  <<errortermination>>;                                        03960000
                                                                        03965000
   if filex <= oldcommandfx then                                        03970000
      begin   <<error in file access>>                                  03975000
      printfileinfo(filex);                                             03980000
      move bufb:="* * * FILE ERROR ON ",2;                              03985000
      case filex of                                                     03990000
         begin                                                          03995000
         move *:="LIST FILE * * *",2;                                   04000000
         move *:="INPUT FILE * * *",2;                                  04005000
         move *:="COMMAND FILE * * *",2;                                04010000
         move *:="EXISTING COMMAND FILE * * *",2;                       04015000
         end  <<case>>;                                                 04020000
      print(bufb,@bufb-s0,0);                                           04025000
      errortermination;                                                 04030000
      end  <<file access error>>                                        04035000
   else if syntaxerror then                                             04040000
      errortermination                                                  04045000
   else                                                                 04050000
      begin                                                             04055000
      <<no errors, close the files>>                                    04060000
      fclose(listfn,save,nosecurity);                                   04065000
      if <> then syntaxexit(listfx);                                    04070000
      fclose(commandfn,temporaryfile,nosecurity);                       04075000
      if <> then syntaxexit(commandfx);                                 04080000
      end  <<close files>>;                                             04085000
   move bufb:="NEW COMMAND FILE CREATED ",2;                            04090000
   print(buf,@bufb-s0,0);                                               04095000
   terminate;                                                           04100000
   end  <<syntaxexit>>;                                                 04105000
procedure syntaxinitialize;                                             04110000
   begin                                                                04115000
   define                                                               04120000
      listfoptions    = [f1/file,f2/nocctl,f3/fixed,f4/stdlist,         04125000
                         f5/arscii,f6/newfile]#,                        04130000
      listaoptions    = [a1/buffering,a2/defaultaccess,a3/writeonly]#,  04135000
      inputfoptions   = [f1/file,f2/nocctl,f3/fixed,f4/filename,        04140000
                         f5/arscii,f6/oldsystemfile]#,                  04145000
      inputaoptions   = [a1/buffering,a2/defaultaccess,a3/readonly]#,   04150000
      dfoptions       = [f1/file,f2/nocctl,f3/fixed,f4/filename,        04155000
                         f5/arscii,f6/temporaryfile]#,                  04160000
      cfoptions       = [f1/file,f2/nocctl,f3/fixed,f4/filename,        04165000
                         f5/arscii,f6/newfile]#,                        04170000
      caoptions       = [a1/buffering,a2/defaultaccess,a3/writeonly]#;  04175000
   byte array desig(0:8),cdevice(0:4);                                  04180000
   double cfilesize,filesize;                                           04185000
   integer                                                              04190000
      dummy,foptions,aoptions,recsize,devicetype,blocksize,numextent;   04195000
   equate                                                               04200000
      listrecsize       = -132,                                         04205000
      crecsize          = -72,                                          04210000
      cnumextent        = 1,                                            04215000
      cblockfactor      = 3,                                            04220000
      cblocksize        = crecsize*cblockfactor;                        04225000
                                                                        04230000
   <<open list, input, and command files>>                              04235000
   move desig:="LIST ";                                                 04240000
   listfn:=fopen(desig,listfoptions,listaoptions,listrecsize);          04245000
   if <> then syntaxexit(listfx);                                       04250000
   move desig:="INPUT ";                                                04255000
   inputfn:=fopen(desig,inputfoptions,inputaoptions);                   04260000
   if <> then syntaxexit(inputfx);                                      04265000
   fgetinfo(inputfn,,,,,,,,,,cfilesize);                                04270000
   move desig:="SDFCOM ";                                               04275000
   move cdevice:="DISC ";                                               04280000
   dummy:=fopen(desig,dfoptions);  <<purge possible temp sdfcom>>       04285000
   if = then fclose(dummy,purge,0);                                     04290000
   commandfn:=fopen(desig,cfoptions,caoptions,crecsize,cdevice,,,       04295000
      cblockfactor,,cfilesize,cnumextent);                              04300000
   if <> then syntaxexit(commandfx);                                    04305000
   fgetinfo(commandfn,,foptions,,recsize,devicetype,,,,,,filesize,,,    04310000
      blocksize,,numextent);                                            04315000
   if foptions.(rectype)<>fixed or blocksize<>cblocksize                04320000
      or recsize<>crecsize  or numextent<>cnumextent                    04325000
      or ((devicetype.(devtype)<>t13037)                       <<04855>>04330000
         land (devicetype.(devtype)<>t'cs'80))                 <<04855>>04335000
         <<we must also allow for cs'80 discs (type 3)>>       <<04855>>04340000
      or filesize<cfilesize then                               <<04855>>04345000
         begin                                                          04350000
         printstring(badcommandfile);                                   04355000
         syntaxexit(commandfx);                                         04360000
         end;                                                           04365000
                                                                        04370000
   end  <<syntaxinitialization>>;                                       04375000
$page "UTILITY PROCEDURES."                                             04380000
procedure initialize;                                                   04385000
   begin                                                                04390000
   @config:=xreg;                                                       04395000
   mode:=if ctcommandfile <> 0d then command else interactive;          04400000
   push(s); abortsregister:=tos;                                        04405000
   push(q); abortdeltaq:=tos-deltaq;                                    04410000
   abortpregister:=returnp; abortstatus:=stat;                          04415000
   nosystemdisc:=ctbadsysdisc;                                          04420000
   if ctdumpfile <> 0d then                                             04425000
      begin                                                             04430000
      performio(dumpdisc,input,oldflab,flablen,ctdumpfile);             04435000
      if <> then                                                        04440000
         begin                                                          04445000
         printstring(uglydumpfilelabel);                                04450000
         ctdumpfile:=0d;                                                04455000
         dumpmode:=serialdevicedump;                                    04460000
         end;                                                           04465000
      end;                                                              04470000
   end  <<initialization>>;                                             04475000
integer procedure printstring(text,count,control);                      04480000
value text,count,control;                                               04485000
byte pointer text;                                                      04490000
integer count,control;                                                  04495000
option variable;                                                        04500000
   begin                                                                04505000
   <<outputs character string to the list file.                         04510000
     input:                                                             04515000
       text       - text string to be listed.                           04520000
       count      - length of string (+ words, - bytes).  if this       04525000
                    parameter is omitted then the text string must      04530000
                    be delimited by either a carriage return or         04535000
                    by a pound sign (#).                                04540000
       control    - spacing control.  if omitted then a value of        04545000
                    %40 will be used (single space).                    04550000
       printstring- byte index of the end of print string + 1.          04555000
   >>                                                                   04560000
   byte array                                                           04565000
      outstring(0:79);                                                  04570000
   if pmap.(15:1)=0 then                                                04575000
      control:=if mode=syntaxchecking then " " else %201;               04580000
   if pmap.(14:1)=0 then                                                04585000
      begin                                                             04590000
      scan text until %6443,1;                                          04595000
      count:=-tos+@text;                                                04600000
      end;                                                              04605000
   count:=if count < 0 then -count else 2*count;                        04610000
   printstring:=count+1;                                                04615000
   do                                                                   04620000
      begin                                                             04625000
      <<print a line>>                                                  04630000
      move outstring:=text,(80);                                        04635000
      fwrite(listfn,outstring,-(count mod 80),control);                 04640000
      @text:=@text+80;                                                  04645000
      end until (count:=count-80) <= 0;                                 04650000
   end;                                                                 04655000
procedure printerror(errmsg,charaddr);                                  04660000
value errmsg,charaddr;                                                  04665000
byte pointer                                                            04670000
   errmsg,            <<byte addr of the error message>>                04675000
   charaddr;          <<byte addr of the offending word>>               04680000
option variable;                                                        04685000
   begin                                                                04690000
   <<1) prints an arrow underneath the offending word.                  04695000
     2) prints the error statement.                                     04700000
     3) sets the error flag.                                            04705000
   >>                                                                   04710000
   integer i;                                                           04715000
   if mode=syntaxchecking then print(commandbuf,-recsize,0);            04720000
   if pmap then                                                         04725000
      begin  <<print arrow>>                                            04730000
      bufb:=" "; move bufb(1):=bufb,(79);                               04735000
      i:=@charaddr-@commandbuf;                                         04740000
      bufb(i):=%136; bufb(i+1):="#";                                    04745000
      printstring(bufb);                                                04750000
      end;                                                              04755000
   printstring(errormessage);                                           04760000
   printstring(errmsg);                                                 04765000
   printstring(space);                                                  04770000
   syntaxerror:=true;                                                   04775000
   if mode = command then mode:=interactive;                            04780000
   end  <<printerror>>;                                                 04785000
procedure abortcommand;                                                 04790000
   begin                                                                04795000
   <<aborts the current command by returning directly to                04800000
     the mainline.                                                      04805000
   >>                                                                   04810000
   xcontrap(0,oldabortplabel);                                          04815000
   move bufb:="* * * COMMAND ABORTED * * *#";                           04820000
   printstring(bufb);                                                   04825000
   mode:=interactive;                                                   04830000
   push(q); deltaq:=tos-abortdeltaq;                                    04835000
   returnp:=abortpregister; stat:=abortstatus;                          04840000
   xcontrap(@abortcommand,oldabortplabel);                              04845000
   end  <<abortcommand>>;                                               04850000
procedure getnextcommand(commandbuf);                                   04855000
byte array commandbuf;                                                  04860000
   begin                                                                04865000
   <<syntax checking mode - gets next command from input file and       04870000
                            and writes it to the output file.           04875000
     command file mode    - gets next command from the command file     04880000
                            and writes it to the console.               04885000
     interactive mode     - gets next command from the console.         04890000
   >>                                                                   04895000
   equate                                                               04900000
      blockfactor     = 3;                                              04905000
   integer i:=recsize,count;                                            04910000
   array discbuf(0:sectorsize);                                         04915000
   byte pointer recordloc;                                              04920000
   commandbuf:=carriagereturn;                                          04925000
   move commandbuf(1):=commandbuf,(73);                                 04930000
   case mode of                                                         04935000
      begin                                                             04940000
      begin                     <<**syntax checking mode>>              04945000
      count:=fread(inputfn,commandbuf,-recsize);                        04950000
      if < then syntaxexit(inputfx);                                    04955000
      if > then syntaxexit(endofinput);                                 04960000
      fwrite(commandfn,commandbuf,-count,0);                            04965000
      if <> then syntaxexit(commandfx);                                 04970000
      end  <<syntax checking mode>>;                                    04975000
      begin                     <<**command mode>>                      04980000
      if logical(recordcount:=recordcount+1) > ctcommandlength then     04985000
         begin  <<end-of-file on command file>>                         04990000
         mode:=interactive;                                             04995000
         printstring(commandfileof);                                    05000000
         end                                                            05005000
      else                                                              05010000
         begin                                                          05015000
         performio(commandisc,input,discbuf,sectorsize,                 05020000
            ctcommandfile+double((recordcount-1)/blockfactor));         05025000
         if = then                                                      05030000
            begin  <<successful>>                                       05035000
            @recordloc:=@discbuf&lsl(1)                                 05040000
               +((recordcount-1) mod blockfactor)*recsize;              05045000
            move commandbuf:=recordloc,(recsize);                       05050000
            while (i:=i-1)>0 and commandbuf(i)=" " do                   05055000
               commandbuf(i):=carriagereturn;                           05060000
            printstring(commandbuf,-recsize);                           05065000
            xcontrap(@abortcommand,oldabortplabel);                     05070000
            end                                                         05075000
         else                                                           05080000
            begin  <<error in command file access>>                     05085000
            <<change mode to interactive and get next command from      05090000
              the console.                                              05095000
            >>                                                          05100000
            printstring(commandfilerr);                                 05105000
            mode:=interactive;                                          05110000
            getnextcommand(commandbuf);                                 05115000
            end;                                                        05120000
         end;                                                           05125000
      end  <<command file mode>>;                                       05130000
      begin                     <<**interactive mode>>                  05135000
      printstring(space);                                               05140000
      printstring(prompt,,%320);                                        05145000
      count:=read(commandbuf,-recsize);                        <<03749>>05150000
      while count<recsize do                                   <<03749>>05155000
         <<if a control x was done the count returned by the >><<03749>>05160000
         <<read procedure may be less than the number of     >><<03749>>05165000
         <<characters actually put into the buffer, so we    >><<03749>>05170000
         <<overwrite any extra chars with carriage returns   >><<03749>>05175000
         begin                                                 <<03749>>05180000
         commandbuf(count):=carriagereturn;                    <<03749>>05185000
         count:=count+1;                                       <<03749>>05190000
         end;                                                  <<03749>>05195000
      move commandbuf:=commandbuf while a,1;                            05200000
      move commandbuf(recsize):=commandbuf(71),(s0-@commandbuf-recsize);05205000
      xcontrap(@abortcommand,oldabortplabel);                           05210000
      end  <<interactive mode>>;                                        05215000
      end  <<case>>;                                                    05220000
   end  <<getnextcommand>>;                                             05225000
   procedure readisc(buffer,length,sector);                             05230000
   value length,sector;                                                 05235000
   array buffer;                                                        05240000
   integer length;                                                      05245000
   double sector;                                                       05250000
      begin                                                             05255000
      performio(systemdisc,input,buffer,length,sector);                 05260000
      if <> then quit(systemdiscerr);                                   05265000
      end  <<readisc>>;                                                 05270000
                                                               <<03017>>05275000
procedure load'sdf'map'buffer;                                 <<03017>>05280000
<<===========================>>                                <<03017>>05285000
begin                                                          <<03017>>05290000
                                                               <<03017>>05295000
  equate sdfmapaddr = 1;   <<words 1,2 are sector address>>    <<03017>>05300000
   readisc( sdfmapbuffer,sectorsize,3d);                       <<03017>>05305000
   tos := @sdfmapbuffer;                                       <<03017>>05310000
   tos := sectorsize;                                          <<03017>>05315000
   tos := sdfmapbuffer(sdfmapaddr);                            <<03017>>05320000
   tos := sdfmapbuffer(sdfmapaddr+1);                          <<03017>>05325000
   readisc( *,*,*);                                            <<03017>>05330000
                                                               <<03017>>05335000
   sdfmap'maxbank := ctnumberbanks - 1;  <<load highest bank>> <<03017>>05340000
      <<number into last memory storage record = upper mem>>   <<03017>>05345000
      <<bound.  this must be dynamically loaded for getarea >> <<03017>>05350000
   sdf'map'buffer'loaded := true;                              <<03017>>05355000
end;                                                           <<03017>>05360000
                                                               <<03017>>05365000
procedure getarea ( source, target, tcount );                  <<03017>>05370000
<<==========================================>>                 <<03017>>05375000
 value source,target,tcount;                                   <<03017>>05380000
                                                               <<03017>>05385000
 double                                                        <<03017>>05390000
   source;    <<source bank and absolute address>>             <<03017>>05395000
 pointer                                                       <<03017>>05400000
   target;    <<db-rel destination address>>                   <<03017>>05405000
 logical                                                       <<03017>>05410000
   tcount;    <<length of destination area in words>>          <<03017>>05415000
              <<if not specified then 1 word is used>>         <<03017>>05420000
                                                               <<03017>>05425000
 option variable;                                              <<03017>>05430000
begin                                                          <<03017>>05435000
                                                               <<03017>>05440000
 pointer                                                       <<03017>>05445000
   ptr;            <<pointer into map buffer>>                 <<03017>>05450000
 double pointer                                                <<03017>>05455000
   dptr = ptr;     <<double word pointer (same) into map>>     <<03017>>05460000
                                                               <<03017>>05465000
 double                                                        <<03017>>05470000
   end'addr,       <<last desired word of request>>            <<03017>>05475000
                                                               <<03017>>05480000
   xfer'start,     <<start address for current transfer>>      <<03017>>05485000
   cur'sector,     <<sector number for current transfer>>      <<03017>>05490000
   full'sectors,   <<number of full sectors to transfer>>      <<03017>>05495000
   sector'offset;  <<sector offset from start sector>>         <<03017>>05500000
                   <<of current storage record>>               <<03017>>05505000
 logical                                                       <<03017>>05510000
   xfer'bank=xfer'start,  <<bank portion of xfer'start>>       <<03017>>05515000
   cur'len,        <<length of current transfer>>              <<03017>>05520000
   xfer'len,       <<length of record transfer>>               <<03017>>05525000
   word'offset,    <<word offset from start addr of stg rec>>  <<03017>>05530000
   bank'offset,    <<bank offset from start addr of stg rec>>  <<03017>>05535000
   leading'words,  <<number of words before first sector bnd>> <<03017>>05540000
   trailing'words; <<number of words in last partial sector>>  <<03017>>05545000
 array sectorbuf (0:511);                                      <<03605>>05550000
                                                               <<03017>>05555000
 <<------------------------------------------------------->>   <<03017>>05560000
                                                               <<03017>>05565000
 if not pmap then tcount := 1;                                 <<03017>>05570000
    <<if optional param is omitted use default 1 word>>        <<03017>>05575000
                                                               <<03017>>05580000
 end'addr := source + double( tcount) - 1d;                    <<03017>>05585000
    <<calculate last desired word of request>>                 <<03017>>05590000
                                                               <<03017>>05595000
 xfer'start := source;                                         <<03017>>05600000
    <<first transfer to start at specified start addr>>        <<03017>>05605000
                                                               <<03017>>05610000
 if not sdf'map'buffer'loaded                                  <<03017>>05615000
 then load'sdf'map'buffer;                                     <<03017>>05620000
       <<insure that we have a copy of the map>>               <<03017>>05625000
                                                               <<03017>>05630000
 @ptr := @sdfmapbuffer;                                        <<03017>>05635000
    <<insure pointers aim at first record in map buffer>>      <<03017>>05640000
                                                               <<03017>>05645000
                                                               <<03017>>05650000
 do begin  <<get the requested area>>                          <<03017>>05655000
       <<this may require multiple transfers from>>            <<03017>>05660000
       <<various storage records>>                             <<03017>>05665000
                                                               <<03017>>05670000
   if xfer'start > dptr(dsrc'end)                              <<03017>>05675000
   then                                                        <<03017>>05680000
       <<start address falls beyond end of current>>           <<03017>>05685000
       <<map record. we have to advance to next rec.>>         <<03017>>05690000
     @ptr := @ptr + mapentrysize                               <<03017>>05695000
                                                               <<03017>>05700000
   else begin                                                  <<03017>>05705000
       <<start address falls within current record>>           <<03017>>05710000
       <<=========================================>>           <<03017>>05715000
       <<check to see if remaining amount of request>>         <<03017>>05720000
       <<can be satisfied from this storage record>>           <<03017>>05725000
                                                               <<03017>>05730000
     if end'addr <= dptr(dsrc'end)                             <<03017>>05735000
     then                                                      <<03017>>05740000
       <<entirely contained within this record>>               <<03017>>05745000
       xfer'len :=logical(end'addr-xfer'start) + 1             <<03017>>05750000
     else                                                      <<03017>>05755000
       <<desired request goes beyond current record>>          <<03017>>05760000
       <<we will transfer to end of this record, >>            <<03017>>05765000
       <<and pick up the rest next pass around from>>          <<03017>>05770000
       <<the next storage record>>                             <<03017>>05775000
       xfer'len := logical(dptr(dsrc'end)-xfer'start)+1;       <<03017>>05780000
                                                               <<03017>>05785000
       <<calculate the offsets from the actual start>>         <<03017>>05790000
       <<address of the storage record, to the first>>         <<03017>>05795000
       <<desired word in the storage we wish to access>>       <<03017>>05800000
                                                               <<03017>>05805000
    word'offset := logical(xfer'start-dptr(dsrc'start));       <<03017>>05810000
    bank'offset := xfer'bank - ptr(src'start'hi);              <<03017>>05815000
    sector'offset := double( word'offset/saveareasectorsize);  <<03605>>05820000
                                                               <<03017>>05825000
       <<based on the storage record, determine if >>          <<03017>>05830000
       <<this current xfer is from memory or disc>>            <<03017>>05835000
       <<and perform the current transfer>>                    <<03017>>05840000
                                                               <<03017>>05845000
    if ptr(stgmedia) = memory                                  <<03017>>05850000
    then begin                                                 <<03017>>05855000
       <<storage is in memory. use move absolute for xfer>>    <<03017>>05860000
       <<------------------------------------------------>>    <<03017>>05865000
                                                               <<03017>>05870000
      push(db);                                                <<03017>>05875000
      tos:=tos+@target;           <<destination>>              <<03017>>05880000
      tos:=dptr(dstg);            <<source=storage address>>   <<03017>>05885000
      ls1 := ls1 + bank'offset;   <<correct for bank offset>>  <<03017>>05890000
      tos := tos+word'offset;     <<correct for offset>>       <<03017>>05895000
      tos := xfer'len;            <<length for move>>          <<03017>>05900000
                                                               <<03017>>05905000
      assemble(mabs);                                          <<03017>>05910000
      @target:=logical( @target )+xfer'len;                    <<03017>>05915000
      end  <<storage is in memory>>                            <<03017>>05920000
           <<-------------------->>                            <<03017>>05925000
                                                               <<03017>>05930000
    else begin                                                 <<03017>>05935000
       <<storage is on disc>>                                  <<03017>>05940000
       <<------------------>>                                  <<03017>>05945000
                                                               <<03017>>05950000
      word'offset := word'offset mod saveareasectorsize;       <<03605>>05955000
        <<now remainder beyond sector'offset>>                 <<03017>>05960000
                                                               <<03017>>05965000
      cur'sector := dptr(dstg) + sector'offset;                <<03017>>05970000
        <<add our known offset to start address of storage>>   <<03017>>05975000
        <<this will be the start sector for our first xfer>>   <<03017>>05980000
                                                               <<03017>>05985000
        <<determine possible number of leading words until>>   <<03017>>05990000
        <<the first sector boundary>>                          <<03017>>05995000
      leading'words:= saveareasectorsize - word'offset;        <<03605>>06000000
      leading'words:= if leading'words < xfer'len              <<03017>>06005000
                      then leading'words else xfer'len;        <<03017>>06010000
                                                               <<03017>>06015000
      if leading'words > 0                                     <<03017>>06020000
      then begin                                               <<03017>>06025000
        <<read the sector into a temp buffer and then copy>>   <<03017>>06030000
        <<the partial sector of leading words to target>>      <<03017>>06035000
                                                               <<03017>>06040000
        readisc(sectorbuf,saveareasectorsize,cur'sector);      <<03605>>06045000
        move target:=sectorbuf(word'offset),(leading'words);   <<03017>>06050000
        cur'sector:=cur'sector+1d;                             <<03017>>06055000
        @target:=logical(@target)+leading'words;               <<03017>>06060000
        cur'len := xfer'len - leading'words;                   <<03017>>06065000
      end;                                                     <<03017>>06070000
                                                               <<03017>>06075000
      trailing'words:= cur'len mod saveareasectorsize;         <<03605>>06080000
      full'sectors := double( cur'len/saveareasectorsize);     <<03605>>06085000
      cur'len := cur'len - trailing'words;                     <<03017>>06090000
                                                               <<03017>>06095000
      if full'sectors > 0d                                     <<03017>>06100000
      then begin                                               <<03017>>06105000
        <<transfer all full sectors direct to target >>        <<03017>>06110000
        <<in one large disc read>>                             <<03017>>06115000
                                                               <<03017>>06120000
        readisc(target, cur'len,cur'sector);                   <<03017>>06125000
        cur'sector := cur'sector + full'sectors;               <<03017>>06130000
        @target := logical( @target) + cur'len;                <<03017>>06135000
      end;                                                     <<03017>>06140000
                                                               <<03017>>06145000
      if trailing'words > 0                                    <<03017>>06150000
      then begin                                               <<03017>>06155000
        <<transfer the remaining partial sector direct>>       <<03017>>06160000
        <<to target in one read>>                              <<03017>>06165000
                                                               <<03017>>06170000
        readisc( target, trailing'words, cur'sector);          <<03017>>06175000
        @target := logical(@target) + trailing'words;          <<03017>>06180000
      end;                                                     <<03017>>06185000
    end;  <<storage is on disc>>                               <<03017>>06190000
                                                               <<03017>>06195000
       <<update tcount to reflect the transfer>>               <<03017>>06200000
       <<and advance to the next record>>                      <<03017>>06205000
    tcount := tcount - xfer'len;                               <<03017>>06210000
    @ptr := @ptr + mapentrysize;                               <<03017>>06215000
    xfer'start := xfer'start +double(xfer'len);                <<03017>>06220000
                                                               <<03017>>06225000
   end; <<start address fell within current record>>           <<03017>>06230000
        <<========================================>>           <<03017>>06235000
                                                               <<03017>>06240000
 end until tcount = 0; <<total request is completed>>          <<03017>>06245000
                                                               <<03017>>06250000
end; <<procedure getarea>>                                     <<03017>>06255000
procedure checkbackup;                                                  06260000
   begin                                                                06265000
   integer array checksumbuf(0:127);                                    06270000
   integer checksum:=%123456;                                           06275000
   define                                                               06280000
      bootsec       = 3d#;                                              06285000
   equate                                                               06290000
      stackglobaldst = 9,                                               06295000
      serialdiscdst  = 15;                                              06300000
   double                                                               06305000
      currentdiscwrite=db+%26,currentdiscread=db+%30;                   06310000
   <<determine if a backup sdf disc>>                                   06315000
   performio(serialdevice,input,checksumbuf,sectorsize,bootsec);        06320000
   for xreg:=1 until sectorsize-1 do                                    06325000
      checksum:=checksum+checksumbuf(xreg);                             06330000
   if checksum = checksumbuf then                                       06335000
      begin  <<backup disc, skip over sdfload file>>                    06340000
      performio(serialdevice,forwardspacefile);                         06345000
      exchangedb(serialdiscdst);                                        06350000
      currentdiscwrite:=currentdiscread;                                06355000
      exchangedb(stackglobaldst);                                       06360000
      ctbackupdump:=1                                                   06365000
      end                                                               06370000
   else                                                                 06375000
      begin                                                             06380000
      performio(serialdevice,writeof);                                  06385000
      ctbackupdump:=0;                                                  06390000
      end;                                                              06395000
   end  <<checkbackup>>;                                                06400000
$page "COMMAND PARAMETER ANALYZER."                                     06405000
logical procedure getnextparm(keywordict,type,parmvalue,parmaddr,       06410000
   delimnum,defn,dparm);                                                06415000
byte array keywordict;                                                  06420000
integer type,parmvalue,delimnum;                                        06425000
byte pointer parmaddr,defn;                                             06430000
double dparm;                                                           06435000
option variable;                                                        06440000
   begin                                                                06445000
   <<obtains the next parameter from the current command                06450000
     input                                                              06455000
       keyword        - search dictionary for (possible) keyword        06460000
                        command.  should be in the same format as       06465000
                        the "DICT" command of the search intrinsic.     06470000
     output:                                                            06475000
       getnextparm    true = a parameter was found                      06480000
                      false= no more parameters on the current keyword  06485000
                            (if not executing in a keyword then no      06490000
                            more parameters in this command).           06495000
       type           0 = key word.                                     06500000
                      1 = alphanumeric with match in dictionary.        06505000
                      2 = alphanumeric.                                 06510000
                      3 = numeric.                                      06515000
                      4 = invalid parameter.                            06520000
       parmvalue      - value returned is dependant of the value of     06525000
                        "GETNEXTPARM".                                  06530000
                        getnextparm value.   parmvalue meaning.         06535000
                        -----------------    -----------------          06540000
                        0                    undefined.                 06545000
                        1                    binary value.              06550000
                        2                    entry number in command    06555000
                                             dictionary.                06560000
                        3                    entry number in command    06565000
                                             dictionary.                06570000
                        4                    length of alphanumeric seq.06575000
                        5                    illegal parameter value.   06580000
       parmaddr       - byte address of the parameter                   06585000
       delimnum       - type of delimiter                               06590000
                        0  comma                                        06595000
                        1  dash                                         06600000
                        2  semicolon                                    06605000
                        3  carriage return                              06610000
                        4  equal                                        06615000
       defn           - byte address of the "DEFINITION" portion of the 06620000
                        keyword commands and alpha dictionary commands. 06625000
   >>                                                                   06630000
   own logical                                                          06635000
      endofkeyword:=false;                                              06640000
   integer                                                              06645000
      i,en,dumparmval,defnaddress=q-6,parmvalueaddress=q-9,             06650000
      typeaddress=q-10,keywordictaddress=q-11,dumtype,parmlength,       06655000
      dumdict:=0;                                                       06660000
   byte pointer                                                         06665000
      parmaddress,dumpntr:=@dumdict;                                    06670000
   integer                                                              06675000
     dumdum=dumpntr;                                                    06680000
   pointer                                                              06685000
      dumdefnaddress:=@dumdum;                                          06690000
   equate                                                               06695000
      binarytype       = 2;                                             06700000
   define                                                               06705000
      keywordictpres   = pmap.(9:1) #,                                  06710000
      typepres         = pmap.(10:1)#,                                  06715000
      parmvaluepres    = pmap.(11:1)#,                                  06720000
      parmaddrpres     = pmap.(12:1)#,                                  06725000
      delimpres        = pmap.(13:1)#,                                  06730000
      defnpres         = pmap.(14:1)#,                                  06735000
      dparmpres        = pmap.(15:1)#,                                  06740000
      entrynumber      = parmvalue#,                                    06745000
      binaryvalue      = parmvalue#,                                    06750000
      parameteraddress = defn#,                                         06755000
      pparmaddress     = parms(i-1)#,                                   06760000
      pparmlength      = parms(i).(0:8)#,                               06765000
      pchartype        = parms(i).(8:3)#,                               06770000
      pparmtype        = parms(i).(11:5)#;                              06775000
                                                                        06780000
   <<test for presence of parameters>>                                  06785000
   if not defnpres then defnaddress:=@dumdefnaddress;                   06790000
   if not parmvaluepres then parmvalueaddress:=@dumparmval;             06795000
   if not typepres then typeaddress:=@dumtype;                          06800000
   if not keywordictpres then keywordictaddress:=@dumdict;              06805000
                                                                        06810000
   <<check if at end of command or keyword>>                            06815000
   i:=2*currentparm-1;                                                  06820000
   if parmaddrpres then @parmaddr:=pparmaddress+pparmlength;            06825000
   if endofkeyword then                                                 06830000
      begin                                                             06835000
      endofkeyword:=false;                                              06840000
      if currentparm <> 0 then return;                                  06845000
      end;                                                              06850000
   if currentparm+1 > numparms then return;                             06855000
   i:=i+2; currentparm:=currentparm+1;                                  06860000
   getnextparm:=true;                                                   06865000
   if delimpres then delimnum:=pparmtype;                               06870000
                                                                        06875000
   <<get parameter address and length>>                                 06880000
   @parmaddress:=pparmaddress;                                          06885000
   if parmaddrpres then @parmaddr:=@parmaddress;                        06890000
   if pparmtype = semicolon then endofkeyword:=true;                    06895000
                                                                        06900000
   <<start parameter catagorization>>                                   06905000
   if (parmlength:=pparmlength) = 0 then                                06910000
      type:=nullparm                                                    06915000
   else if pparmtype = equal then                                       06920000
      type:=  <<keyword parameter>>                                     06925000
        if (entrynumber:=search(parmaddress,parmlength,keywordict,defn))06930000
        <> 0 then keywordparm else invalidparm                          06935000
   else                                                                 06940000
      begin   <<positional parameter>>                                  06945000
      <<see if the parameter can be found in the dictionary>>           06950000
      if (en:=search(parmaddress,parmlength,keywordict,defn))<>0 then   06955000
         begin                                                          06960000
         type:=dictionaryparm;                                          06965000
         entrynumber:=en                                                06970000
         end                                                            06975000
      else                                                              06980000
         begin   <<test if numeric>>                                    06985000
         if dparmpres then                                              06990000
            dparm:=dbinary(parmaddress,parmlength)                      06995000
         else                                                           07000000
            binaryvalue:=binary(parmaddress,parmlength);                07005000
         type:=if = then numericparm else alphanumericparm;             07010000
         end  <<numeric parameter test>>;                               07015000
      end  <<positional parameter>>;                                    07020000
   end  <<getnextparm>>;                                                07025000
$page "SYNTAX CHECKING ROUTINES"                                        07030000
logical procedure dumpsyntax;                                           07035000
   begin                                                                07040000
   byte pointer parmaddr;                                               07045000
   integer type,pv,delimnum;                                            07050000
   double dpv;                                                          07055000
                                                                        07060000
   subroutine leave(message);                                           07065000
   byte array message;                                                  07070000
      begin                                                             07075000
      if message <> "SUCCESSFUL" then                                   07080000
         printerror(message,parmaddr)                                   07085000
      else                                                              07090000
         dumpsyntax:=true;                                              07095000
      assemble(exit 0);                                                 07100000
      end  <<leave>>;                                                   07105000
subroutine dsrangecheck(firstvalue);                                    07110000
value firstvalue;                                                       07115000
integer firstvalue;                                                     07120000
   begin                                                                07125000
   if not getnextparm(,type,pv,parmaddr) or type <> numericparm then    07130000
      leave(expectednumber);                                            07135000
   if firstvalue > pv then leave(invalidrange);                         07140000
   end  <<dsrangecheck>>;                                               07145000
                                                                        07150000
subroutine discrangecheck(firstvalue);                                  07155000
value firstvalue;                                                       07160000
double firstvalue;                                                      07165000
   begin                                                                07170000
   if not getnextparm(,type,,parmaddr,,,dpv) or type <> numericparm then07175000
      leave(expectednumber);                                            07180000
   if firstvalue > dpv then leave(invalidrange);                        07185000
   end  <<discrangecheck>>;                                             07190000
                                                                        07195000
   if getnextparm(,type,pv,parmaddr) then                               07200000
      begin  <<parameter scan>>                                         07205000
      <<number of banks>>                                               07210000
      if type <> nullparm then                                          07215000
         begin                                                          07220000
         if type <> numericparm then leave(expectednumber);             07225000
         if not (0<= pv <= maxbank) then leave(invalidvalue);           07230000
         end;                                                           07235000
      if getnextparm(,,,parmaddr) then leave(extraparm);                07240000
      while getnextparm(dumpdict,type,pv,parmaddr) do                   07245000
         begin  <<keyword scan>>                                        07250000
         if type <> keywordparm then leave(expectedkeyword);            07255000
         if pv = virtualmemory then                                     07260000
            begin  <<virtual memory data segments>>                     07265000
            if not getnextparm(virtdict,type,pv,parmaddr,delimnum) then 07270000
               leave(expectedparm);                                     07275000
            do if type = numericparm and pv<>0 then                     07280000
               begin                                                    07285000
               if delimnum = dash then dsrangecheck(pv);                07290000
               end                                                      07295000
            else if type <> dictionaryparm then                         07300000
               leave(invalidvalue)                                      07305000
            until not getnextparm(virtdict,type,pv,parmaddr,delimnum);  07310000
            end                                                         07315000
         else                                                           07320000
            begin   <<disc sectors>>                                    07325000
            if not getnextparm(,type,,parmaddr,delimnum,,dpv) then      07330000
               leave(expectedparm);                                     07335000
            do                                                          07340000
               if type <> numericparm then                              07345000
                  leave(expectednumber)                                 07350000
               else if delimnum = dash then                             07355000
                  discrangecheck(dpv)                                   07360000
            until not getnextparm(,type,,parmaddr,delimnum,,dpv);       07365000
            end;                                                        07370000
         end  <<keyword scan>>;                                         07375000
      end  <<parameter scan>>;                                          07380000
   leave(successful);                                                   07385000
   end  <<dumpsyntax>>;                                                 07390000
logical procedure consolesyntax;                                        07395000
   begin                                                                07400000
   byte pointer parmaddr;                                               07405000
   integer type,parmvalue;                                              07410000
   if getnextparm(,type,parmvalue,parmaddr) then                        07415000
      begin                                                             07420000
      if type <> numericparm then                                       07425000
         printerror(expectednumber,parmaddr)                            07430000
      else if not (mindrt <= parmvalue <= maxdrt) then                  07435000
         printerror(invalidvalue,parmaddr)                              07440000
      else                                                              07445000
         consolesyntax:=true;                                           07450000
      end  <<drt parameter>>                                            07455000
   else                                                                 07460000
      printerror(expectedparm);                                         07465000
   end  <<consolesyntax>>;                                              07470000
logical procedure dumpdevsyntax;                                        07475000
   begin                                                                07480000
   byte pointer parmaddr;                                               07485000
   integer type,parmvalue;                                              07490000
   if getnextparm(dumpdevdict,type,parmvalue,parmaddr) then             07495000
      begin  <<parameter scan>>                                         07500000
      if type = dictionaryparm then                                     07505000
         dumpdevsyntax:=true                                            07510000
      else if type = numericparm then                                   07515000
         begin  <<drt,unit scan>>                                       07520000
         if not(mindrt <= parmvalue <= maxdrt) then                     07525000
            printerror(invalidvalue,parmaddr);                          07530000
         else if getnextparm(,type,parmvalue,parmaddr) then             07535000
            begin  <<unit>>                                             07540000
            if type <> numericparm then                                 07545000
               printerror(expectednumber,parmaddr)                      07550000
            else if not (0<=parmvalue<=maxunit) then                    07555000
               printerror(invalidvalue,parmaddr)                        07560000
            else                                                        07565000
               dumpdevsyntax:=true;                                     07570000
            end  <<unit>>                                               07575000
         else                                                           07580000
            dumpdevsyntax:=true;                                        07585000
         end  <<drt,unit scan>>                                         07590000
      else                                                              07595000
         printerror(invalidvalue,parmaddr);                             07600000
      end  <<parameter scan>>;                                          07605000
   else                                                                 07610000
      printerror(expectedparm);                                         07615000
   end  <<dumpdevsyntax>>;                                              07620000
logical procedure explainsyntax;                                        07625000
   begin                                                                07630000
   integer type;                                                        07635000
   byte pointer parmaddr;                                               07640000
   if getnextparm(commandict,type,,parmaddr) then                       07645000
      do                                                                07650000
         if type <> dictionaryparm then                                 07655000
            begin                                                       07660000
            printerror(unknowncommand,parmaddr);                        07665000
            return;                                                     07670000
            end                                                         07675000
      until not getnextparm(commandict,type,,parmaddr);                 07680000
   explainsyntax:=true;                                                 07685000
   end  <<explainsyntax>>;                                              07690000
$page "COMMAND EXECUTOR ROUTINES"                                       07695000
procedure dump(dumpmode);                                               07700000
value dumpmode;                                                         07705000
integer                                                                 07710000
   dumpmode;          <<0 - dump to serial disc/mag tape>>              07715000
                      <<1 - dump to disc file>>                         07720000
   begin                                                                07725000
   equate                                                               07730000
      desclength     = 4,                                               07735000
      vacant         = %100000,                                         07740000
      dbufsize       = 4096,                                            07745000
      banksdumpedloc = %1423,                                           07750000
      banklimit      = 15,  <<64k/dbufsize-1>>                          07755000
      vheaderlength  = 7,                                               07760000
      datasegmentid  = 0,                                               07765000
      dumpsysdiscid  = 1;                                               07770000
   define                                                               07775000
      bootsec        = 3d#,                                             07780000
      dstloc         = 2d#,                                             07785000
      dbufnumsector  = double(dbufsize/sectorsize)#,                    07790000
                                                                        07795000
      <<data segment header format>>                                    07800000
      vid            = dumpbuf       #,                                 07805000
      vdsegnum       = dumpbuf(1)    #,                                 07810000
      vdseglen       = dumpbuf(2)    #,                                 07815000
      vdsegdesc      = dumpbuf(3)    #,                                 07820000
                                                                        07825000
      <<disc sector header format>>                                     07830000
      did            = dumpbuf       #,                                 07835000
      dsectorlen     = dumpbuf(1)    #,                                 07840000
      dfirstsecnum   = dumpbufd(1)   #,                                 07845000
      dnumsec        = dumpbufd(2)   #,                                 07850000
                                                                        07855000
      <<data segment table entry>>                                      07860000
      dsabsent       = desc0.(0:1)= 1#,                                 07865000
      dslength       = desc0.(3:13)  #,                                 07870000
      dsbanknum      = desc2.(12:4)  #,                                 07875000
      dsaddress      = desc3         #,                                 07880000
      dshiorderdisc  = desc2.(12:4)  #,                                 07885000
      dslorderdisc   = desc3         #;                                 07890000
                                                                        07895000
   <<variables used by all subroutines>>                                07900000
   double                                                               07905000
      datasegmentsector,numsec,sectornum,sectorlimit;                   07910000
   integer                                                              07915000
      type,parmvalue,banknum,i,j,vestige,lastdataseg,length,dstaddr,    07920000
      headr,delimnum,desc0,desc1,desc2,desc3;                           07925000
   array desc(*)=desc0,dumpbuf(0:dbufsize);                             07930000
   array                                                                07935000
      discnumbuffer(0:9),flab(0:76);                                    07940000
   double array                                                         07945000
      dumpbufd(*)=dumpbuf,flabd(*)=flab;                                07950000
                                                                        07955000
   <<variables used by outputdump>>                                     07960000
   equate                                                               07965000
      endoftape       = %31;                                            07970000
   double                                                               07975000
      dvrstat,dfilesector;                                              07980000
   integer                                                              07985000
      stat=dvrstat,nextdiscnum:=0;                                      07990000
                                                                        07995000
   <<variables used by dumpdseg>>                                       08000000
   integer                                                              08005000
      count,sec0=datasegmentsector,sec1=datasegmentsector+1,            08010000
      startseg=parmvalue,endseg;                                        08015000
                                                                        08020000
                                                                        08025000
   <<variables used by dumpsystemsegment>>                              08030000
   define                                                               08035000
      systemsegment      = logical(desc2.(11:1))#;                      08040000
                                                                        08045000
   <<variables used by dumpstacks>>                                     08050000
   array                                                                08055000
      vdsl(0:1023);                                                     08060000
   integer                                                              08065000
      vdslength;                                                        08070000
   define                                                               08075000
      stackdatasegment   = vdsl(i).(3:1)#;                              08080000
   equate                                                               08085000
      vdsl'dst           = 40;                                          08090000
                                                                        08095000
   subroutine dumpdiscio(function,target,tcount,sector);                08100000
   value function,tcount,sector;                                        08105000
   integer function,tcount;                                             08110000
   array target;                                                        08115000
   double sector;                                                       08120000
      begin                                                             08125000
      performio(dumpdisc,function,target,tcount,dfilesector);           08130000
      if <> then                                                        08135000
         begin  <<error on accessing dump file>>                        08140000
         printstring(dumpdevicefail);                                   08145000
         assemble(exit 1);                                              08150000
         end;                                                           08155000
      end  <<dumpdiscio>>;                                              08160000
                                                                        08165000
   subroutine outputdump(target,tcount);                                08170000
   value tcount;                                                        08175000
   array target;                                                        08180000
   integer tcount;                                                      08185000
   begin                                                                08190000
      if dumpmode = discfiledump then                                   08195000
         begin  <<dump to disc file>>                                   08200000
         if double(flnumrecords:=flnumrecords+1) > flmaxnumrecords then 08205000
            begin  <<end-of-file>>                                      08210000
            printstring(exhaustedumpfile);                              08215000
            assemble(exit 1);                                           08220000
            end;                                                        08225000
         dfilesector:=double((flnumrecords-1)*flblocksize)+flextentbase;08230000
         dumpdiscio(output,target,tcount,dfilesector);                  08235000
         end  <<dump file mode>>                                        08240000
      else                                                              08245000
         begin  <<serial device dump mode>>                             08250000
         do                                                             08255000
            begin  <<attempt to write the record>>                      08260000
            dvrstat:=performio(serialdevice,output,target,tcount);      08265000
            if <> then                                                  08270000
               begin  <<i/o problem>>                                   08275000
               if stat = endoftape then                                 08280000
                  begin                                                 08285000
                  <<write eof, # of next disc, and 2 eofs>>             08290000
                  performio(serialdevice,writeof);                      08295000
                  discnumbuffer:=(nextdiscnum:=nextdiscnum+1);          08300000
                  move discnumbuffer(1):=discnumbuffer,(9);             08305000
                  performio(serialdevice,output,discnumbuffer,10);      08310000
                  performio(serialdevice,writeof);                      08315000
                  performio(serialdevice,writeof);                      08320000
                  performio(serialdevice,deviceclose);                  08325000
                  <<mount new disc, write disc #>>                      08330000
                  printstring(eotserialdevice);                         08335000
                  if ctdumpdevtype<>tmagtape                   <<03749>>08340000
                    then waitinsertdisc(1);<<for serial discs>><<03749>>08345000
                  changedevice(,ctdumpdevdesc);                         08350000
                  if ctdumpdevtype<>tmagtape                   <<03749>>08355000
                    then checkbackup;      <<for serial discs>><<03749>>08360000
                  performio(serialdevice,output,discnumbuffer,10);      08365000
                  end                                                   08370000
               else                                                     08375000
                  begin  <<i/o failure on serial device>>               08380000
                  mode:=interactive;                           <<03110>>08385000
                  <<tell user to use new media and   >>        <<03110>>08390000
                  <<try again                        >>        <<03110>>08395000
                  printstring(tryagain1);                      <<03110>>08400000
                  printstring(tryagain2);                      <<03110>>08405000
                  printstring(tryagain3);                      <<03110>>08410000
                  printstring(tryagain4);                      <<03110>>08415000
                  assemble(exit 1);                                     08420000
  << exit back to sdf mainline with mode set to interactive >> <<03749>>08425000
                  end;                                                  08430000
               end  <<i/o problem>>;                                    08435000
            end until stat <> endoftape;                                08440000
         end  <<serial device dump mode>>;                              08445000
      end  <<outputdump>>;                                              08450000
                                                                        08455000
   subroutine dumpdatasegment(datasegment);                             08460000
   value datasegment;                                                   08465000
   integer datasegment;                                                 08470000
      begin                                                             08475000
      <<get contents of the segment's descriptor in the data segment    08480000
        table.                                                          08485000
      >>                                                                08490000
      getarea(double(dstaddr+4*datasegment),desc,desclength);           08495000
                                                                        08500000
      if (datasegment < lastdataseg) or (desc0 <> vacant) then          08505000
         begin  <<segment exists>>                                      08510000
         if dsabsent or dsbanknum > banknum then                        08515000
            begin  <<segment was not written out in memory dump>>       08520000
            <<format header field>>                                     08525000
            vid:=datasegmentid; vdsegnum:=datasegment;                  08530000
            move vdsegdesc:=desc,(4);                                   08535000
            headr:=sectorsize;  <<make room for header field>>          08540000
            if (length:=4*dslength) = 0 then                            08545000
               outputdump(dumpbuf,vheaderlength)                        08550000
            else if dsabsent then                                       08555000
               begin                                                    08560000
               sec0:=dshiorderdisc; sec1:=dslorderdisc;                 08565000
               while length > 0 do                                      08570000
                  begin                                                 08575000
                  count:=if length>dbufsize then dbufsize else length;  08580000
                  readisc(dumpbuf(headr),count,datasegmentsector);      08585000
                  outputdump(dumpbuf,count+headr);                      08590000
                  headr:=0;                                             08595000
                  length:=length-dbufsize;                              08600000
                  datasegmentsector:=datasegmentsector-dbufnumsector;   08605000
                  end  <<while>>;                                       08610000
               end  <<absent data segment>>                             08615000
            else                                                        08620000
               begin  <<present data segment>>                          08625000
               while length > 0 do                                      08630000
                  begin                                                 08635000
                  count:=if length>dbufsize then dbufsize else length;  08640000
                  tos:=dsbanknum; tos:=dsaddress;                       08645000
                  getarea(*,dumpbuf,count);                             08650000
                  dsaddress:=dsaddress+dbufsize;                        08655000
                  outputdump(dumpbuf,count);                            08660000
                  length:=length-dbufsize;                              08665000
                  end  <<while>>;                                       08670000
               end  <<present data segment>>;                           08675000
            end  <<dumpable data segment>>;                             08680000
         end  <<segment exists>>;                                       08685000
      end  <<dumpdatasegment>>;                                         08690000
   subroutine dumpstacks;                                               08695000
      begin                                                             08700000
      getarea(double(dstaddr+4*vdsl'dst),desc,desclength);              08705000
      vdslength:=4*dslength;                                            08710000
      getarea(double(dsaddress),vdsl,vdslength);                        08715000
      for i:=0 until lastdataseg do                                     08720000
         if stackdatasegment then dumpdatasegment(i);                   08725000
      end  <<dumpstacks>>;                                              08730000
                                                                        08735000
   subroutine dumpsystemsegments;                                       08740000
      begin                                                             08745000
      for i:=1 until lastdataseg do                                     08750000
         begin                                                          08755000
         getarea(double(dstaddr+4*i),desc,desclength);                  08760000
         if systemsegment then dumpdatasegment(i);                      08765000
         end;                                                           08770000
      end  <<dumpsystemsegments>>;                                      08775000
                                                                        08780000
    subroutine dumpvirtualmemory;                                       08785000
      begin                                                             08790000
      while getnextparm(virtdict,type,parmvalue,,delimnum) do           08795000
         if type = numericparm then                                     08800000
            begin                                                       08805000
            if delimnum = dash then                                     08810000
               getnextparm(,,endseg)                                    08815000
            else                                                        08820000
               endseg:=startseg;                                        08825000
            for i:=startseg until endseg do dumpdatasegment(i);         08830000
            end  <<numeric parameter>>                                  08835000
         else                                                           08840000
            case parmvalue-1 of    <<keyword parameter>>                08845000
               begin                                                    08850000
               for i:=1 until lastdataseg do dumpdatasegment(i);<<all>> 08855000
               dumpstacks;                                   <<stacks>> 08860000
               dumpsystemsegments;                           <<system>> 08865000
               end  <<case>>;                                           08870000
      end  <<dumpvirtualmemory>>;                                       08875000
                                                                        08880000
   subroutine dumpsysdisc;                                              08885000
      begin                                                             08890000
      while getnextparm(,,,,delimnum,,sectornum) do                     08895000
         begin                                                          08900000
         <<format header record>>                                       08905000
         did:=dumpsysdiscid; dsectorlen:=sectorsize;                    08910000
         dfirstsecnum:=sectornum;                                       08915000
         if delimnum = dash then                                        08920000
            getnextparm(,,,,,,sectorlimit)                              08925000
         else                                                           08930000
            sectorlimit:=sectornum;                                     08935000
         dnumsec:=numsec:=sectorlimit-sectornum+1d;                     08940000
         headr:=sectorsize;                                             08945000
         <<write out the sectors>>                                      08950000
         while numsec >= dbufnumsector do                               08955000
            begin                                                       08960000
            <<write out a buffersize worth of the sectors>>             08965000
            readisc(dumpbuf(headr),dbufsize-headr,sectornum);           08970000
            outputdump(dumpbuf,dbufsize);                               08975000
            headr:=0;                                                   08980000
            numsec:=numsec-dbufnumsector;                               08985000
            sectornum:=sectornum+dbufnumsector;                         08990000
            end;                                                        08995000
         if (vestige:=integer(numsec)*sectorsize) > 0 then              09000000
            begin                                                       09005000
            <<write out the remaining sectors (partial record>>         09010000
            readisc(dumpbuf(headr),vestige,sectornum);                  09015000
            outputdump(dumpbuf(headr),vestige);                         09020000
            end;                                                        09025000
         end  <<while>>;                                                09030000
      end  <<dumpsysdisc>>;                                             09035000
                                                               <<03749>>09040000
<< ** procedure dump mainline ** >>                            <<03749>>09045000
                                                                        09050000
   <<rewind the dump device>>                                           09055000
   if dumpmode = discfiledump then                                      09060000
      move flab:=oldflab,(flablen)                                      09065000
   else                                                                 09070000
      begin                                                             09075000
      if ctdumpdevdesc = 0d then                                        09080000
         begin                                                          09085000
         printstring(nodumpdevice);                                     09090000
         mode:=interactive; <<if no dump device is configured>><<03749>>09095000
                            <<then go into interactive mode  >><<03749>>09100000
         return;                                                        09105000
         end;                                                           09110000
      changedevice(,ctdumpdevdesc);                                     09115000
      if < then                                                         09120000
         begin  <<not a serial device>>                                 09125000
         printstring(badevice);                                         09130000
         return;                                                        09135000
         end;                                                           09140000
      <<determine if a backup sdf disc>>                                09145000
      if ctdumpdevtype <> tmagtape then checkbackup;                    09150000
      end;                                                              09155000
                                                                        09160000
   if (ctsysdiscdevtyp=t'cs'80)and(ctsysdiscsubtyp=stype'a9140)<<03605>>09165000
   then begin                                                  <<03605>>09170000
        saveareasectorsize:=quadruplesectorsize;               <<03605>>09175000
        <<a linus sector is 4 times as large as a disc>>       <<03605>>09180000
        end                                                    <<03605>>09185000
   else begin                                                  <<03605>>09190000
        saveareasectorsize:=sectorsize;                        <<03605>>09195000
        end;                                                   <<03605>>09200000
   <<dump main memory>>                                                 09205000
   if not getnextparm(,type,banknum) or type <> numericparm             09210000
      or logical(banknum) > (ctnumberbanks-1) then                      09215000
      banknum:=ctnumberbanks-1;                                         09220000
   getnextparm;  <<flush semicolon>>                                    09225000
   if (ctdumpdevtype=tmagtape) and (ctdumpdevsubtyp=stype7976) <<02669>>09230000
    then  << we must set density to 1600 bpi on hp7976 >>      <<02669>>09235000
    begin  << actions to set density to 1600bpi on 7976 >>     <<02669>>09240000
     performio(serialdevice,clear7976,dumpbuf,dbufsize);       <<02669>>09245000
     performio(serialdevice,setdensity1600,dumpbuf,dbufsize);  <<02669>>09250000
    end;                                                       <<02669>>09255000
   if (ctdumpdevtype=tmagtape) and (ctdumpdevsubtyp=stype7974  <<k7526>>09260000
      or ctdumpdevsubtyp=stype7978)                            <<k7526>>09265000
    then  << we must set density to 1600 bpi on hp7974/86 >>   <<k7526>>09270000
    begin  << actions to set density to 1600bpi on 7976 >>     <<k7526>>09275000
     performio(serialdevice,clear7976,dumpbuf,dbufsize);       <<k7526>>09280000
     performio(serialdevice,immedreport,dumpbuf,dbufsize);     <<k7526>>09285000
     performio(serialdevice,setdensity1600,dumpbuf,dbufsize);  <<k7526>>09290000
    end;                                                       <<k7526>>09295000
   for i:=0 until banknum do                                            09300000
      for j:=0 until banklimit do  <<dump a bank>>                      09305000
         begin  <<write one dump record>>                               09310000
         tos:=i; tos:=dbufsize*j;       <<source bank and address>>     09315000
         getarea(*,dumpbuf,dbufsize);                                   09320000
         if i=0 and j=0 then dumpbuf(banksdumpedloc):=banknum+1;        09325000
         outputdump(dumpbuf,dbufsize);                                  09330000
         end;                                                           09335000
                                                                        09340000
   <<dump virtual memory and/or system disc sectors>>                   09345000
   if getnextparm(dumpdict,type,parmvalue) then                         09350000
      if nosystemdisc then                                              09355000
         printstring(badsystemdisc)                                     09360000
      else                                                              09365000
         begin                                                          09370000
         performio(serialdevice,writeof);                               09375000
         <<get data segment table location>>                            09380000
         getarea(dstloc,dstaddr);                                       09385000
         getarea(double(dstaddr),lastdataseg);                          09390000
         do case parmvalue-1 of                                         09395000
            begin                                                       09400000
            dumpvirtualmemory;             <<dseg>>                     09405000
            dumpsysdisc;                   <<disc>>                     09410000
            end until not getnextparm(dumpdict,type,parmvalue);         09415000
         end;                                                           09420000
   if dumpmode = discfiledump then  <<update dump file label>>          09425000
      dumpdiscio(output,flab,flablen,ctdumpfile)                        09430000
   else                                                                 09435000
    begin                                                      <<b8100>>09440000
      performio(serialdevice,rewind);                          <<b8100>>09445000
      performio(serialdevice,deviceclose);                              09450000
    end;                                                       <<b8100>>09455000
   end  <<dump>>;                                                       09460000
logical procedure changeconsole;                                        09465000
   begin                                                                09470000
   double descriptor;                                                   09475000
   integer type,desc0=descriptor,desc1=descriptor+1;                    09480000
   integer drt;                                                         09485000
   getnextparm(,,drt);                                                  09490000
     if identifydevice(drt&lsl(7),descriptor) and              <<03017>>09495000
        desctype=tconsole then                                 <<03017>>09500000
      begin                                                             09505000
      changeconsole:=true;                                              09510000
      changedevice(,,,,descriptor);                                     09515000
      end                                                               09520000
   else                                                                 09525000
      printstring(badevice);                                            09530000
   end  <<changeconsole>>;                                              09535000
logical procedure changedumpdev(dumpmode);                              09540000
integer                                                                 09545000
   dumpmode;          <<0 - use serial disc/mag tape>>                  09550000
                      <<1 - use disc file>>                             09555000
   begin                                                                09560000
   double descriptor;                                                   09565000
   logical sertype,drt,unit:=0;                                         09570000
   integer parmvalue,type,desc0=descriptor,desc1=descriptor+1;          09575000
   getnextparm(,type,drt);                                              09580000
   if type=numericparm then                                             09585000
      begin                                                             09590000
      getnextparm(,,unit);                                              09595000
     if identifydevice(drt&lsl(7) lor unit,descriptor) then    <<03017>>09600000
         begin                                                          09605000
         changedevice(,descriptor);                                     09610000
         if = then                                                      09615000
            begin  <<valid device>>                                     09620000
            dumpmode:=serialdevicedump;                                 09625000
            ctdumpdevdesc:=descriptor;                                  09630000
            changedumpdev:=true;                                        09635000
            end                                                         09640000
         else                                                           09645000
            begin  <<invalid device>>                                   09650000
            if desctype = tconsole then initadcc(0);                    09655000
            printstring(badevice);                                      09660000
            end;                                                        09665000
         end  <<identified device>>                                     09670000
      else                                                              09675000
         printstring(badevice);                                         09680000
      end  <<numeric parameter>>                                        09685000
   else                                                                 09690000
      if ctdumpfile <> 0d then                                          09695000
         begin  <<dump to disc dump file>>                              09700000
         changedumpdev:=true;                                           09705000
         dumpmode:=discfiledump;                                        09710000
         end                                                            09715000
      else                                                              09720000
         printstring(nodumpfilextant);                                  09725000
   end  <<changedumpdev>>;                                              09730000
procedure explain;                                                      09735000
   begin                                                                09740000
   <<explains the syntax of the commands.                               09745000
   >>                                                                   09750000
   integer i;                                                           09755000
   byte pointer defn,next;                                              09760000
                                                                        09765000
   if not getnextparm(commandict,,,,,defn) then                         09770000
      begin   <<list all commands>>                                     09775000
      @defn:=@commandict;                                               09780000
      for i:=1 until maxcommandnum-1 do                                 09785000
         begin   <<list one command at a time>>                         09790000
         @next:=@defn+integer(defn(1))+2;                               09795000
         do                                                             09800000
            begin                                                       09805000
            <<print a line of the command's explanation>>               09810000
            @next:=@next+printstring(next);                             09815000
            if next(2)="DUMPFILE" then                                  09820000
               begin  <<continuation of dump description>>              09825000
               @defn:=@defn+integer(defn);                              09830000
               @next:=@next+10;                                         09835000
               end;                                                     09840000
            end until next = "#";                                       09845000
         @defn:=@defn+integer(defn);                                    09850000
         end;                                                           09855000
      end  <<list all commands>>                                        09860000
   else                                                                 09865000
      do   <<list only selected parameters>>                            09870000
         do                                                             09875000
            begin                                                       09880000
            <<print a line of the command's explanation>>               09885000
            @defn:=@defn+printstring(defn);                             09890000
            if defn(2)="DUMPFILE" then @defn:=@defn+10; <<cont command>>09895000
            end until defn = "#"                                        09900000
         until not getnextparm(commandict,,,,,defn);                    09905000
   end  <<explain>>;                                                    09910000
procedure warmstart;                                                    09915000
   begin                                                                09920000
   integer subtype;                                                     09925000
   subtype:=ctsysdiscsubtype;                                           09930000
   tos:=if subtype = r7905 or subtype = r7906 then 1 else 0;            09935000
   tos:=ctsysdiscdrt;                                                   09940000
   assemble(strt);                                                      09945000
   end  <<warmstart>>;                                                  09950000
$page "MAINLINE."                                                       09955000
if (mode:=runparm) = syntaxchecking then                                09960000
   syntaxinitialize                                                     09965000
else                                                                    09970000
   begin                                                                09975000
   initialize;                                                          09980000
   tos:=abortsregister; set(s);                                         09985000
   end;                                                                 09990000
while forever do                                                        09995000
   begin                                                                10000000
   getnextcommand(commandbuf);                                          10005000
   currentparm:=0;                                                      10010000
   commandtype:=                                                        10015000
      mycommand(commandbuf,delim,maxparms,numparms,dparms,commandict);  10020000
   if >= then                                                           10025000
      begin  <<recognizable command>>                                   10030000
      case commandtype-1 of                                             10035000
         begin                                                          10040000
         <<syntax check the command before executing it>>               10045000
         tos:=dumpsyntax;                     <<dump>>                  10050000
         tos:=true;                           <<dumpfile>>              10055000
         tos:=true;                           <<comment>>               10060000
         tos:=consolesyntax;                  <<console>>               10065000
         tos:=true;                           <<debug>>                 10070000
         tos:=dumpdevsyntax;                  <<dumpdev>>               10075000
         tos:=true;                           <<halt>>                  10080000
         tos:=explainsyntax;                  <<help>>                  10085000
         tos:=true;                           <<interactive>>           10090000
         tos:=true;                           <<warmstart>>             10095000
         end  <<case>>;                                                 10100000
      if tos and mode <> syntaxchecking then                            10105000
         begin                                                          10110000
         <<execute command>>                                            10115000
         currentparm:=0;                                                10120000
         case commandtype-1 of                                          10125000
            begin  <<invoke the command executor>>                      10130000
            dump(dumpmode);                   <<dump>>                  10135000
            ;                                 <<dummy>>                 10140000
            ;                                 <<comment>>               10145000
                                              <<console>>               10150000
            if not changeconsole then mode:=interactive;                10155000
            help;                             <<debug>>                 10160000
            if not changedumpdev(dumpmode) then<<dumpdev>>              10165000
               mode:=interactive;                                       10170000
            assemble(halt 0);                 <<halt>>                  10175000
            explain;                          <<help>>                  10180000
            mode:=interactive;                <<interactive>>           10185000
            warmstart;                        <<warmstart>>             10190000
            end  <<case statement>>;                                    10195000
         end  <<command executor>>                                      10200000
      end  <<recognizable command>>                                     10205000
   else                                                                 10210000
      printerror(unknowncommand)  <<unrecognizable command>>;           10215000
   end  <<command interpretor>>;                                        10220000
end  <<mainline>>;                                                      10225000
